hunner/dotfiles
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rename emacs stuff to make room for spacemacs

Browse source
This commit is contained in:
Hunter Haugen 2015-01-08 12:29:53 -08:00
parent 0c3a0642f6
commit b52ede2d51
38 changed files with 0 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

939
.emacs.d.backup/babel.el Normal file
View file

@ -0,0 +1,939 @@
;;; babel.el --- interface to web translation services such as Babelfish
;;;
;;; Git blob $Id$
;;;
;;; Author: Eric Marsden <emarsden@laas.fr>
;;; Juergen Hoetzel <juergen@hoetzel.info>
;;; Keywords: translation, web
;;; Copyright: (C) 1999-2001 Eric Marsden
;;; 2005-2009 Juergen Hoetzel
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public
;; License along with this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;
;; Please send suggestions and bug reports to <juergen@hoetzel.info>.
;; The latest version of this package should be available at
;;
;; http://github.com/juergenhoetzel/babel/tree/master
;;; Commentary:
;;; Overview ==========================================================
;;
;; This module provides an Emacs interface to different translation
;; services available on the Internet. You give it a word or paragraph
;; to translate and select the source and destination languages, and
;; it connects to the translation server, retrieves the data, and
;; presents it in a special *babel* buffer. Currently the following
;; backends are available:
;;
;; * the FOSS MT platform Apertium
;; * the Babelfish service at babelfish.yahoo.com
;; * the Google service at translate.google.com
;; * the Transparent Language motor at FreeTranslation.com
;;
;; Entry points: either 'M-x babel', which prompts for a phrase, a
;; language pair and a backend, or 'M-x babel-region', which prompts
;; for a language pair and backend, then translates the currently
;; selected region, and 'M-x babel-buffer' to translate the current
;; buffer.
;;
;; If you ask for a language combination which several backends could
;; translate, babel.el will allow you to choose which backend to
;; use. Since most servers have limits on the quantity of text
;; translated, babel.el will split long requests into translatable
;; chunks and submit them sequentially.
;;
;; Please note that the washing process (which takes the raw HTML
;; returned by a translation server and attempts to extract the useful
;; information) is fragile, and can easily be broken by a change in
;; the server's output format. In that case, check whether a new
;; version is available (and if not, warn me; I don't translate into
;; Welsh very often).
;;
;; Also note that by accessing an online translation service you are
;; bound by its Terms and Conditions; in particular
;; FreeTranslation.com is for "personal, non-commercial use only".
;;
;;
;; Installation ========================================================
;;
;; Place this file in a directory in your load-path (to see a list of
;; appropriate directories, type 'C-h v load-path RET'). Optionally
;; byte-compile the file (for example using the 'B' key when the
;; cursor is on the filename in a dired buffer). Then add the
;; following lines to your ~/.emacs.el initialization file:
;;
;; (autoload 'babel "babel"
;; "Use a web translation service to translate the message MSG." t)
;; (autoload 'babel-region "babel"
;; "Use a web translation service to translate the current region." t)
;; (autoload 'babel-as-string "babel"
;; "Use a web translation service to translate MSG, returning a string." t)
;; (autoload 'babel-buffer "babel"
;; "Use a web translation service to translate the current buffer." t)
;;
;; babel.el requires emacs >= 23
;;
;;
;; Backend information =================================================
;;
;; A babel backend named <zob> must provide three functions:
;;
;; (babel-<zob>-translation from to)
;;
;; where FROM and TO are three-letter language abbreviations from
;; the alist `babel-languages'. This should return non-nil if the
;; backend is capable of translating between these two languages.
;;
;; (babel-<zob>-fetch msg from to)
;;
;; where FROM and TO are as above, and MSG is the text to
;; translate. Connect to the appropriate server and fetch the raw
;; HTML corresponding to the request.
;;
;; (babel-<zob>-wash)
;;
;; When called on a buffer containing the raw HTML provided by the
;; server, remove all the uninteresting text and HTML markup.
;;
;; I would be glad to incorporate backends for new translation servers
;; which are accessible to the general public.
;;
;; babel.el was inspired by a posting to the ding list by Steinar Bang
;; <sb@metis.no>. Morten Eriksen <mortene@sim.no> provided several
;; patches to improve InterTrans washing. Thanks to Per Abrahamsen and
;; Thomas Lofgren for pointing out a bug in the keymap code. Matt
;; Hodges <pczmph@unix.ccc.nottingham.ac.uk> suggested ignoring case
;; on completion. Colin Marquardt suggested
;; `babel-preferred-to-language'. David Masterson suggested adding a
;; menu item. Andy Stewart provided
;; `babel-remember-window-configuration' functionality, output window
;; adjustments and more improvements.
;;
;; User quotes: Dieses ist die größte Sache seit geschnittenem Brot.
;; -- Stainless Steel Rat <ratinox@peorth.gweep.net>
;;; History
;; Discontinued Log (Use GIT: git://github.com/juergenhoetzel/babel.git)
;; 1.4 * `babel-region' now yank the translation instead insert him at
;; point.
;; 1.3 n* Added new Google languages
;; 1.2 * Added FOSS MT platform Apertium
;; (by Kevin Brubeck Unhammer)
;; * Assume UTF-8, if HTTP header missing
;; 1.1 * Fixed invalid language code mapping for serveral
;; languages
;; 1.0 * Fixed Google backend (new regex)
;; * New custom variables `babel-buffer-name',
;; `babel-echo-area', `babel-select-output-window'
;; * Disable use of echo area usage on xemacs if lines > 1
;; (resize of minibuffer does not work reliable)
;; * `babel-url-retrieve' fix for xemacs from Uwe Brauer
;; 0.9 * Use `babel-buffer-name' for output buffer
;; 0.8 * Remember window config if `babel-remember-window-configuration'
;; is non-nil.
;; * made *babel* buffer read-only
;; * use echo area (like `shell-command')
;; * New functions `babel-as-string-default',`babel-region-default',
;; `babel-buffer-default', `babel-smart' (provided by Andy)
;; 0.7 * error handling if no backend is available for translating
;; the supplied languages
;; * rely on url-* functions (for charset decoding) on GNU emacs
;; * increased chunk size for better performance
;; * added support for all Google languages
;; * `babel-region' with prefix argument inserts the translation
;; output at point.
;; 0.6 * get rid of w3-region (implementend basic html entity parsing)
;; * get rid of w3-form-encode-xwfu (using mm-url-form-encode-xwfu)
;; * no character classes in regex (for xemacs compatibility)
;; * default backend: Google
;; 0.5: * Fixed Google and Babelfish backends
;; 0.4: * revised FreeTranslation backend
;;; 0.3: * removed non-working backends: systran, intertrans, leo, e-PROMPT
;;; * added Google backend
;;; * revised UTF-8 handling
;;; * Added customizable variables: babel-preferred-to-language, babel-preferred-from-language
;;; * revised history handling
;;; * added helper function: babel-wash-regex
;; TODO:
;;
;; * Use google xml output
;;
;; * Adjust output window height. Current versions use
;; `with-current-buffer' instead `with-output-to-temp-buffer'. So
;; `temp-buffer-show-hook' will fail to adjust output window height
;; -> Use (fit-window-to-buffer nil babel-max-window-height) to
;; adjust output window height in new version.
;;
;; * use non-blocking `url-retrieve'
;;
;; * improve function `babel-simple-html-parse'.
;;
;; * In `babel-quite' function, should be add (boundp
;; 'babel-previous-window-configuration) to make value of
;; `babel-previous-window-configuration' is valid
;;
(require 'cl)
(require 'mm-url)
(require 'json)
(require 'easymenu)
;; xemacs compatibility
(eval-and-compile
(when (featurep 'xemacs)
(defun url-retrieve-synchronously (url)
(save-excursion
(cdr (url-retrieve url))))))
;; ======================================================================
;;; Customizables
;; ======================================================================
(defgroup babel nil
"provides an Emacs interface to different translation services available on the Internet"
:group 'applications)
(defconst babel-version "1.4"
"The version number of babel.el")
(defconst babel-languages
'(("Afrikaans" . "af")
("Albanian" . "sq")
("Arabic" . "ar")
("Belarusian" . "be")
("Bulgarian" . "bg")
("Catalan" . "ca")
("Chinese" . "zh-CN")
("Croatian" . "hr")
("Czech" . "cs")
("Danish" . "da")
("Dutch" . "nl")
("English" . "en")
("Estonian" . "et")
("Filipino" . "tl")
("Finnish" . "fi")
("French" . "fr")
("Galician" . "gl")
("German" . "de")
("Greek" . "el")
("Hebrew" . "iw")
("Hindi" . "hi")
("Hungarian" . "hu")
("Icelandic" . "is")
("Indonesian" . "id")
("Irish" . "ga")
("Italian" . "it")
("Japanese" . "ja")
("Korean" . "ko")
("Latvian" . "lv")
("Lithuanian" . "lt")
("Macedonian" . "mk")
("Malay" . "ms")
("Maltese" . "mt")
("Norwegian" . "no")
("Persian" . "fa")
("Polish" . "pl")
("Portuguese" . "pt")
("Romanian" . "ro")
("Russian" . "ru")
("Serbian" . "sr")
("Slovak" . "sk")
("Slovenian" . "sl")
("Spanish" . "es")
("Swahili" . "sw")
("Swedish" . "sv")
("Thai" . "th")
("Turkish" . "tr")
("Ukrainian" . "uk")
("Vietnamese" . "vi")
("Welsh" . "cy")
("Yiddish" . "yi")))
(defcustom babel-preferred-to-language "German"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,@(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-to-history (list value)))
:group 'babel)
(defcustom babel-preferred-from-language "English"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,@(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-from-history (list value)))
:group 'babel)
(defcustom babel-remember-window-configuration t
"Whether remeber window configuration before transform. If this
variable is t, will use `babel-quit' command restore window
configuration."
:type 'boolean
:group 'babel)
(defcustom babel-max-window-height 30
"The max height that babel output window."
:type 'integer
:group 'babel)
(defcustom babel-buffer-name "*babel*"
"The buffer name of `babel' transform output."
:type 'string
:group 'babel)
(defcustom babel-echo-area t
"If this option is `non-nil' and the output is short enough to
display in the echo area (which is determined by the variables
`resize-mini-windows' and `max-mini-window-height'), it is shown in
echo area.
Default is `t'."
:type 'boolean
:group 'babel)
(defcustom babel-select-output-window t
"Select output window after transform complete.
This is useful when you have a complex window layout.
Save you time to switch babel output window."
:type 'boolean
:group 'babel)
(defvar babel-previous-window-configuration nil
"The window configuration before transform.")
(defvar babel-to-history (list babel-preferred-to-language))
(defvar babel-from-history (list babel-preferred-to-language))
(defvar babel-backend-history (list))
(defvar babel-mode-hook nil)
(defvar babel-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") #'bury-buffer)
(define-key map (kbd "SPC") #'scroll-up)
(define-key map (kbd "DEL") #'scroll-down)
(define-key map (kbd "<") #'beginning-of-buffer)
(define-key map (kbd ">") #'end-of-buffer)
(define-key map (kbd "s") #'isearch-forward)
(define-key map (kbd "r") #'isearch-backward)
(define-key map (kbd "h") #'describe-mode)
map)
"Keymap used in Babel mode.")
(defvar babel-backends
'(("Google" . google)
("Babelfish at Yahoo" . fish)
("FreeTranslation" . free)
("Apertium" . apertium))
"List of backends for babel translations.")
(defun babel-sentence-end()
"portability function. emacs 22.0.50 introduced sentence-end
function, not available on other emacsen"
(if (fboundp 'sentence-end)
(sentence-end)
sentence-end))
;; xemacs compatibility
(eval-and-compile
(if (featurep 'xemacs)
;; XEmacs
(defun babel-url-retrieve (url)
"Retrieve URL and decode"
(let ((current (current-buffer))
(tmp (url-retrieve-synchronously url)))
(with-current-buffer tmp
;;shrug: we asume utf8
(decode-coding-region (point-min) (point-max) 'utf-8)
(copy-to-buffer current (point-min) (point-max)))))
;; GNUs Emacs
(require 'url-handlers)
(defun babel-url-retrieve (url)
(let* ((url-show-status nil)
(tmp (url-retrieve-synchronously url)))
(unless (cadr (url-insert tmp))
(mm-decode-coding-region (point-min) (point-max) 'utf-8))))))
(defun babel-wash-regex (regex)
"Extract the useful information from the HTML returned by fetch function
translated text should be inside parenthesized expression in regex"
(goto-char (point-min))
(if (search-forward-regexp regex (point-max) t)
(progn
(delete-region (match-end 1) (point-max))
(delete-region (point-min) (match-beginning 1))
t)))
;;;###autoload
(defun babel (msg &optional no-display accept-default-setup)
"Use a web translation service to translate the message MSG.
Display the result in a buffer *babel* unless the optional argument
NO-DISPLAY is nil.
If the output is short enough to display in the echo area (which is
determined by the variables `resize-mini-windows' and
`max-mini-window-height'), it is shown there, but it is nonetheless
available in buffer `*babel*' even though that buffer is not
automatically displayed."
(interactive "sTranslate phrase: ")
(let* ((completion-ignore-case t)
(from-suggest (or (first babel-from-history) (caar babel-languages)))
(from-long
(if accept-default-setup
babel-preferred-from-language
(completing-read (format "Translate from (%s): " from-suggest)
babel-languages nil t
nil
'babel-from-history
from-suggest)))
(to-avail (remove* from-long babel-languages
:test #'(lambda (a b) (string= a (car b)))))
(to-suggest (or (first
(remove* from-long babel-to-history
:test #'string=))
(caar to-avail)))
(to-long
(if accept-default-setup
babel-preferred-to-language
(completing-read (format "Translate to (%s): " to-suggest)
to-avail nil t
nil
'babel-to-history
to-suggest)))
(from (cdr (assoc from-long babel-languages)))
(to (cdr (assoc to-long babel-languages)))
(backends (babel-get-backends from to)))
(if (not backends)
(error "No Backend available for translating %s to %s"
from-long to-long)
(let* ((backend-str
(if accept-default-setup (caar backends)
(completing-read "Using translation service: "
backends nil t
(cons (or (member (first babel-backend-history)
backends) (caar backends)) 0)
'babel-backend-history)))
(backend (symbol-name (cdr (assoc backend-str babel-backends))))
(fetcher (intern (concat "babel-" backend "-fetch")))
(washer (intern (concat "babel-" backend "-wash")))
(chunks (babel-chunkify msg 7000))
(translated-chunks '())
(view-read-only nil))
(loop for chunk in chunks
do (push (babel-work chunk from to fetcher washer)
translated-chunks))
(if no-display
(apply #'concat (nreverse translated-chunks))
(let ((pop-up-frames nil)
(temp-buffer-show-hook
'(lambda ()
(fit-window-to-buffer nil babel-max-window-height)
(shrink-window-if-larger-than-buffer))))
(if (and babel-remember-window-configuration
(null babel-previous-window-configuration))
(setq babel-previous-window-configuration (current-window-configuration)))
(with-current-buffer
(get-buffer-create babel-buffer-name)
;; ensure buffer is writeable
(setq buffer-read-only nil)
(erase-buffer)
(loop for tc in (nreverse translated-chunks)
do (insert tc))
(save-excursion
(with-current-buffer babel-buffer-name
(let ((lines
(if (= (buffer-size) 0)
0
;; xemacs compatibility
(if (not (featurep 'xemacs))
(count-screen-lines nil nil nil (minibuffer-window))
(count-lines (point-min) (point-max))))))
(babel-mode)
(cond ((= lines 0))
((and babel-echo-area (or (<= lines 1)
(and (not (featurep 'xemacs))
(<= lines
(if resize-mini-windows
(cond ((floatp max-mini-window-height)
(* (frame-height)
max-mini-window-height))
((integerp max-mini-window-height)
max-mini-window-height)
(t
1))
1))))
;; Don't use the echo area if the output buffer is
;; already dispayed in the selected frame.
(not (get-buffer-window (current-buffer))))
;; Echo area
(goto-char (point-max))
(when (bolp)
(backward-char 1))
(message "%s" (buffer-substring (point-min) (point))))
(t
;; Buffer
(goto-char (point-min))
(display-buffer (current-buffer))))))))))))))
(defun babel-as-string-default (msg)
"Use a web translation service to translate MSG, returning a string."
(interactive "sTranslate phrase: ")
(babel msg t t))
(defun babel-region-default (start end &optional arg)
"Use a web translation service to translate the current region.
With prefix argument, yank the translation to the kill-ring."
(interactive "r\nP")
(if arg
(kill-new (babel (buffer-substring-no-properties start end) t))
(babel (buffer-substring-no-properties start end) nil t)))
(defun babel-buffer-default ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string-default
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region-default (point-min) (point-max))))))
(defun babel-smart (&optional prefix)
"Smart babel function. If you use prefix keystroke, prompt with
input. Same effect with `babel'. If mark active with current buffer,
transform region. Same effect with `babel-region'. Otherwise
transform all content of current buffer. Same effect with
`babel-buffer'."
(interactive "P")
(if (null prefix)
(if mark-active
(babel-region-default (region-beginning) (region-end) 'yank)
(babel-buffer-default))
(babel (read-string "Translate phrase: ") nil t)))
(defun babel-quit ()
"Quit babel window. If `babel-remember-window-configuration' is t,
restore window configuration before transform. Otherwise just do
`bury-buffer'."
(interactive)
(if (and babel-remember-window-configuration
babel-previous-window-configuration)
(progn
(kill-buffer (get-buffer babel-buffer-name))
(set-window-configuration babel-previous-window-configuration)
(setq babel-previous-window-configuration nil))
(bury-buffer)))
;;;###autoload
(defun babel-region (start end &optional arg)
"Use a web translation service to translate the current region.
With prefix argument, yank the translation to the kill-ring."
(interactive "r\nP")
(if arg
(kill-new (babel (buffer-substring-no-properties start end) t))
(babel (buffer-substring-no-properties start end))))
;;;###autoload
(defun babel-as-string (msg)
"Use a web translation service to translate MSG, returning a string."
(interactive "sTranslate phrase: ")
(babel msg t))
;; suggested by Djalil Chafai <djalil@free.fr>
;;
;;;###autoload
(defun babel-buffer ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region (point-min) (point-max))))))
(defun babel-work (msg from to fetcher washer)
(with-temp-buffer
(funcall fetcher (babel-preprocess msg) from to)
(funcall washer)
(babel-postprocess)
(babel-simple-html-parse)
(buffer-substring-no-properties (point-min) (point-max))))
(defun babel-get-backends (from to)
"Return a list of those backends which are capable of translating
language FROM into language TO."
(loop for b in babel-backends
for name = (symbol-name (cdr b))
for translator = (intern (concat "babel-" name "-translation"))
for translatable = (funcall translator from to)
if translatable collect b))
(defconst babel-html-entity-regex
"&\\(#\\([0-9]+\\)\\|\\([a-zA-Z]+\\)\\);")
(defun babel-decode-html-entitiy (str)
(if (and str (string-match babel-html-entity-regex
str))
(if (string= (substring str 1 2) "#")
;TODO: xemacs
(if (not (featurep 'xemacs))
(let ((number (match-string-no-properties 2 str)))
(decode-char 'ucs (string-to-number number)))
str)
(let ((letter (match-string-no-properties 3 str)))
(cond ((string= "gt" letter) ">")
((string= "lt" letter) "<")
(t "?"))))))
(defun babel-display ()
"Parse and display the region of this for basic HTML entities."
(save-excursion
(goto-char (point-min))
(while (and (< (point) (point-max)) (search-forward-regexp
babel-html-entity-regex
(point-max) t))
(let* ((start (match-beginning 0))
(end (match-end 0))
(entity (buffer-substring start end))
(replacement (babel-decode-html-entitiy entity)))
(delete-region start end)
(insert replacement)))))
(defun babel-mode ()
(interactive)
(kill-all-local-variables)
(use-local-map babel-mode-map)
(setq major-mode 'babel-mode
mode-name "Babel"
buffer-read-only t)
(buffer-disable-undo)
(run-hooks 'babel-mode-hook))
(cond ((fboundp 'string-make-unibyte)
(fset 'babel-make-unibyte #'string-make-unibyte))
((fboundp 'string-as-unibyte)
(fset 'babel-make-unibyte #'string-as-unibyte))
(t
(fset 'babel-make-unibyte #'identity)))
;; from nnweb.el, with added `string-make-unibyte'.
(defun babel-form-encode (pairs)
"Return PAIRS encoded for forms."
(mapconcat
(lambda (data)
(concat (mm-url-form-encode-xwfu (babel-make-unibyte (car data))) "="
(mm-url-form-encode-xwfu (babel-make-unibyte (cdr data)))))
pairs "&"))
;; We mark paragraph endings with a special token, so that we can
;; recover a little information on the original message's format after
;; translation and washing and rendering. Should really be using
;; `paragraph-start' and `paragraph-separate' here, but we no longer
;; have any information on the major-mode of the buffer that STR was
;; ripped from.
;;
;; This kludge depends on the fact that all the translation motors
;; seem to leave words they don't know how to translate alone, passing
;; them through untouched.
(defun babel-preprocess (str)
(while (string-match "\n\n\\|^\\s-+$" str)
(setq str (replace-match " FLOBSiCLE " nil t str)))
str)
;; decode paragraph endings in current buffer
(defun babel-postprocess ()
(goto-char (point-min))
(while (search-forward "FLOBSiCLE" nil t)
(replace-match "\n<p>" nil t)))
(defun babel-simple-html-parse ()
"Replace basic html markup"
(goto-char (point-min))
(while (re-search-forward "<\\(br\\|p\\)/?>" nil t)
(replace-match "\n"))
(goto-char (point-min))
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "")))
;; split STR into chunks of around LENGTH characters, trying to
;; maintain sentence structure (this is used to send big requests in
;; several batches, because otherwise the motors cut off the
;; translation).
(defun babel-chunkify (str chunksize)
(let ((start 0)
(pos 0)
(chunks '()))
(while (setq pos (string-match (babel-sentence-end) str pos))
(incf pos)
(when (> (- pos start) chunksize)
(push (substring str start pos) chunks)
(setq start pos)))
(when (/= start (length str))
(push (substring str start) chunks))
(nreverse chunks)))
;;;###autoload
(defun babel-version (&optional here)
"Show the version number of babel in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((version-string
(format "Babel version %s" babel-version)))
(if here
(insert version-string)
(if (interactive-p)
(message "%s" version-string)
version-string))))
;; Babelfish-specific functions ================================================
;;
;; Babelfish (which uses the SysTran engine) is only able to translate
;; between a limited number of languages.
;; translation from generic names to Babelfish 2-letter names
(defconst babel-fish-languages
'(("en" . "en")
("de" . "de")
("it" . "it")
("pt" . "pt")
("es" . "es")
("fr" . "fr")))
;; those inter-language translations that Babelfish is capable of
(defconst babel-fish-translations
'("en_fr" "en_de" "en_it" "en_pt" "en_es" "fr_en" "de_en" "it_en"
"es_en" "pt_en"))
;; if Babelfish is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-fish-translation (from to)
(let* ((fromb (cdr (assoc from babel-fish-languages)))
(tob (cdr (assoc to babel-fish-languages)))
(comb (and fromb tob (concat fromb "_" tob))))
(find comb babel-fish-translations :test #'string=)))
(defun babel-fish-fetch (msg from to)
"Connect to the Babelfish server and request the translation."
(let ((translation (babel-fish-translation from to)))
(unless translation
(error "Babelfish can't translate from %s to %s" from to))
(let* ((pairs `(("trtext" . ,(mm-encode-coding-string msg 'utf-8))
("lp" . ,translation)
("ei" . "UTF-8")
("doit" . "done")
("fr" . "bf-res")
("intl" . "1")
("tt" . "urltext")
("btnTrTxt" . "Translate")))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://babelfish.yahoo.com/translate_txt" ))))
(defun babel-fish-wash ()
"Extract the useful information from the HTML returned by Babelfish."
(if (not (babel-wash-regex "<div id=\"result\"><div style=\"padding:[0-9.]*em;\">\\([^<]*\\)</div></div>"))
(error "Babelfish HTML has changed ; please look for a new version of babel.el")))
;; FreeTranslation.com stuff ===========================================
;; translation from generic letter names to FreeTranslation names
(defconst babel-free-languages
'(("en" . "English")
("de" . "German")
("it" . "Italian")
("nl" . "Dutch")
("pt" . "Portuguese")
("es" . "Spanish")
("no" . "Norwegian")
("ru" . "Russian")
("zh-CN" . "SimplifiedChinese")
("zh-TW" . "TraditionalChinese")
("fr" . "French")))
;; those inter-language translations that FreeTranslation is capable of
(defconst babel-free-translations
'("English/Spanish" "English/French" "English/German" "English/Italian" "English/Dutch" "English/Portuguese"
"English/Russian" "English/Norwegian" "English/SimplifiedChinese" "English/TraditionalChinese" "Spanish/English"
"French/English" "German/English" "Italian/English" "Dutch/English" "Portuguese/English"))
(defun babel-free-translation (from to)
(let* ((ffrom (cdr (assoc from babel-free-languages)))
(fto (cdr (assoc to babel-free-languages)))
(trans (concat ffrom "/" fto)))
(find trans babel-free-translations :test #'string=)))
(defun babel-free-fetch (msg from to)
"Connect to the FreeTranslation server and request the translation."
(let ((coding-system-for-read 'utf-8)
(translation (babel-free-translation from to))
(url "http://ets.freetranslation.com/"))
(unless translation
(error "FreeTranslation can't translate from %s to %s" from to))
(let* ((pairs `(("sequence" . "core")
("mode" . "html")
("template" . "results_en-us.htm")
("srctext" . ,msg)
("charset" . "UTF-8")
("language" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-mime-accept-string "text/html")
(url-request-method "POST")
(url-privacy-level '(email agent))
(url-mime-charset-string "utf-8")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")
("Referer" . "http://ets.freetranslation.com/"))))
(babel-url-retrieve url))))
(defun babel-free-wash ()
"Extract the useful information from the HTML returned by FreeTranslation."
;;; <textarea name="dsttext" cols="40" rows="6">hello together</textarea><br />
(if (not (babel-wash-regex "<textarea name=\"dsttext\"[^>]+>\\([^<]*\\)</textarea>"))
(error "FreeTranslations HTML has changed ; please look for a new version of babel.el")))
;; Google stuff ===========================================
;; Google supports all languages
(defconst babel-google-languages
babel-languages)
(defun babel-google-translation (from to)
;; Google can always translate in both directions
(find to babel-google-languages
:test '(lambda (st el)
(string= (cdr el) st))))
(defun babel-google-fetch (msg from to)
"Connect to google server and request the translation."
;; Google can always translate in both directions
(if (not (find to babel-google-languages
:test '(lambda (st el)
(string= (cdr el) st))))
(error "Google can't translate from %s to %s" from to)
(let* ((langpair (format "%s|%s" from to))
(pairs `(("q" . ,(mm-encode-coding-string msg 'utf-8))
("langpair" . ,langpair)
("v" . "1.0")))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://ajax.googleapis.com/ajax/services/language/translate"))))
(defun babel-google-wash ()
"Extract the useful information from the HTML returned by google."
(beginning-of-buffer)
(let* ((json-object-type 'alist)
(json-response (json-read)))
(erase-buffer)
(if json-response
(insert-string
(cdr (assoc 'translatedText (assoc 'responseData json-response))))
(error "Google API has changed ; please look for a new version of babel.el"))))
(defconst babel-apertium-languages
'(("English" . "en")
("Spanish" . "es")
("Esperanto" . "eo")))
(defun babel-apertium-translation (from to)
(member (cons from to)
'(("en" . "es")
("es" . "en")
("en" . "eo"))))
(defun babel-apertium-fetch (msg from to)
"Connect to apertium server and request the translation."
(if (not (babel-apertium-translation from to))
(error "Apertium can't translate from %s to %s" from to)
(let* ((lang-pair (concat from "-" to))
(pairs `(("pair" . ,lang-pair)
("text" . ,msg)))
(request-url
(concat "http://www.neuralnoise.com/ApertiumWeb2/xml.php?"
(babel-form-encode pairs)))
(url-request-method "GET"))
(babel-url-retrieve request-url))))
(defun babel-apertium-wash ()
"Extract the useful information from the XML returned by apertium."
(if (not (babel-wash-regex
"<translation>\\(\\(.\\|\n\\)*?\\)</translation>"))
(error "Apertium XML has changed ; please look for a
new version of babel.el")))
;; TODO: ecs.freetranslation.com
;; (defun babel-debug ()
;; (let ((buf (get-buffer-create "*babel-debug*")))
;; (set-buffer buf)
;; (babel-free-fetch "state mechanisms are too busy" "eng" "ger")))
(easy-menu-add-item nil '("tools") ["Babel Translation" babel t])
(provide 'babel)
;; babel.el ends here

187
.emacs.d.backup/bar-cursor.el Normal file
View file

@ -0,0 +1,187 @@
;;; @(#) bar-cursor.el -- package used to switch block cursor to a bar
;;; @(#) $Id: bar-cursor.el,v 1.1 2001/07/10 00:18:40 jcasa Exp $
;; This file is not part of Emacs
;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
;; Author: Joe Casadonte (emacs@northbound-train.com)
;; Maintainer: Joe Casadonte (emacs@northbound-train.com)
;; Created: July 1, 2001
;; Keywords: bar cursor overwrite
;; Latest Version: http://www.northbound-train.com/emacs.html
;; COPYRIGHT NOTICE
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;
;; Simple package to convert the block cursor into a bar cursor. In
;; overwrite mode, the bar cursor changes back into a block cursor.
;; This is a quasi-minor mode, meaning that it can be turned on & off
;; easily though only globally (hence the quasi-)
;;; Installation:
;;
;; Put this file on your Emacs-Lisp load path and add the following to
;; your ~/.emacs startup file
;;
;; (require 'bar-cursor)
;; (bar-cursor-mode 1)
;;
;; To add a directory to your load-path, use something like the following:
;;
;; (add-to-list 'load-path (expand-file-name "/some/load/path"))
;;; Usage:
;;
;; M-x `bar-cursor-mode'
;; Toggles bar-cursor-mode on & off. Optional arg turns
;; bar-cursor-mode on iff arg is a positive integer.
;;; To Do:
;;
;; o Nothing, at the moment.
;;; Credits:
;;
;; The basis for this code comes from Steve Kemp by way of the
;; NTEmacs mailing list.
;;; Comments:
;;
;; Any comments, suggestions, bug reports or upgrade requests are welcome.
;; Please send them to Joe Casadonte (emacs@northbound-train.com).
;;
;; This version of bar-cursor was developed and tested with NTEmacs
;; 20.7.1 under Windows 2000 & NT 4.0 and Emacs 20.7.1 under Linux
;; (RH7). Please, let me know if it works with other OS and versions
;; of Emacs.
;;; Change Log:
;;
;; see http://www.northbound-train.com/emacs/bar-cursor.log
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; **************************************************************************
;;; Code:
(eval-when-compile
;; silence the old byte-compiler
(defvar byte-compile-dynamic nil)
(set (make-local-variable 'byte-compile-dynamic) t))
;;; **************************************************************************
;;; ***** version related routines
;;; **************************************************************************
(defconst bar-cursor-version
"$Revision: 1.1 $"
"Version number for 'bar-cursor' package.")
;; ---------------------------------------------------------------------------
(defun bar-cursor-version-number ()
"Return 'bar-cursor' version number."
(string-match "[0123456789.]+" bar-cursor-version)
(match-string 0 bar-cursor-version))
;; ---------------------------------------------------------------------------
(defun bar-cursor-display-version ()
"Display 'bar-cursor' version."
(interactive)
(message "bar-cursor version <%s>." (bar-cursor-version-number)))
;;; **************************************************************************
;;; ***** real functions
;;; **************************************************************************
(defvar bar-cursor-mode nil "Non-nil if 'bar-cursor-mode' is enabled.")
;;; --------------------------------------------------------------------------
;;;###autoload
(defun bar-cursor-mode (&optional arg)
"Toggle use of 'bar-cursor-mode'.
This quasi-minor mode changes cursor to a bar cursor in insert mode,
and a block cursor in overwrite mode. It may only be turned on and
off globally, not on a per-buffer basis (hence the quasi- designation).
Optional ARG turns mode on iff ARG is a positive integer."
(interactive "P")
;; toggle on and off
(let ((old-mode bar-cursor-mode))
(setq bar-cursor-mode
(if arg (or (listp arg)
(> (prefix-numeric-value arg) 0))
(not bar-cursor-mode)))
(when (not (equal old-mode bar-cursor-mode))
;; enable/disable advice
(if bar-cursor-mode
(ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)
(ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad))
(ad-activate 'overwrite-mode)
;; set the initial cursor type now
(bar-cursor-set-cursor)
;; add or remove to frame hook
(if bar-cursor-mode
(add-hook 'after-make-frame-functions 'bar-cursor-set-cursor)
(remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor))
)))
;;;--------------------------------------------------------------------------
(defadvice overwrite-mode (after bar-cursor-overwrite-mode-ad disable)
"Advice that controls what type of cursor is displayed."
(bar-cursor-set-cursor))
;;;--------------------------------------------------------------------------
(defun bar-cursor-set-cursor-type (cursor &optional frame)
"Set the cursor-type for the named frame.
CURSOR is the name of the cursor to use (bar or block -- any others?).
FRAME is optional frame to set the cursor for; current frame is used
if not passed in."
(interactive)
(if (not frame)
(setq frame (selected-frame)))
;; Do the modification.
(modify-frame-parameters frame
(list (cons 'cursor-type cursor))))
;;; --------------------------------------------------------------------------
(defun bar-cursor-set-cursor (&optional frame)
"Set the cursor-type according to the insertion mode.
FRAME is optional frame to set the cursor for; current frame is used
if not passed in."
(if (and bar-cursor-mode (not overwrite-mode))
(bar-cursor-set-cursor-type 'bar frame)
(bar-cursor-set-cursor-type 'block frame)))
;;; **************************************************************************
;;; ***** we're done
;;; **************************************************************************
(provide 'bar-cursor)
;;; bar-cursor.el ends here
;;; **************************************************************************
;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF *************

1666
.emacs.d.backup/color-theme.el Normal file
View file

File diff suppressed because it is too large Load diff

89
.emacs.d.backup/ergoemacs-keybindings-5.1/_HISTORY.txt Executable file
View file

@ -0,0 +1,89 @@
-*- coding: utf-8 -*-
Note: When the context is about keys on the keyboard hardware, then QWERTY is used to indicate the key. For example, “Changed M+y to something”, that “y” means the key that is under the key 7. (which is Dvorak's “f”).
version 5, 2009-09-15 • A much improved version, by David Capello. This version is now a full featured minor mode. It supports 3 different keyboard layout: US QWERTY, US Dvorak, and “Spanish (Spain)” (aka “Spanish (International sort)”). Also supports a new command where-is-old-binding (with shortcut Ctrl+h o).
version 4.3.13, 2009-08-28 • improved shrink-whitespaces. Now, when called twice, it removes the remaining single space. Thanks to David Capello for the code.
version 4.3.12.2, 2009-08-15 • Fixed a bug where delete-selection-mode migth be turned off. Changed “(delete-selection-mode t)” to “(delete-selection-mode 1)”.
version 4.3.12.1, 2009-08-14 • A minor implementation improvement. In one place, changed the use of functionp to fboundp for checking the existing of a emacs 23 feature recenter-top-bottom. Was using functionp because i forgot about fboundp.
version 4.3.12, 2009-08-13 • Alt+p is now “recenter-top-bottom” for emacs 23 users. In emacs 22, it is “recenter”.
version 4.3.11, 2009-08-05 • Added a hook to fix message-mode.
version 4.3.10, 2009-06-14 • fixed a previous/next reversal for f11/f12 keys in rcirc-mode-hook. • diff-mode uses some bindings in M-‹key› space. Fixed by adding a diff-mode-hook. (thanks to lwarxx)
version 4.3.9, 2009-06-14 • unbind C-x 3 (use Alt+@ for split-window-horizontally) • unbind C-M-% (use Alt+% for query-replace-regexp). • unbind C-@ (use Alt+SPACE for set-mark-command). • unbind M-{ (use Alt+U for backward-paragraph). • unbind M-} (use Alt+O for forward-paragraph). Thanks to marciomazza
version 4.3.8, 2009-06-14 • added 【】 to select-text-in-quote.
version 4.3.7, 2009-05-27 • ibuffer's M-s changed in emacs 23, such that M-s is now a prefix. For Dvorak users, M-s should be isearch. This is reclaimed to be isearch. For qwerty users, M-s should be other-window. Fixed.
version 4.3.6, 2009-05-26 • dired's M-s changed in emacs 23, such that M-s is now a prefix. For Dvorak users, M-s should be isearch. This is reclaimed to be isearch. For qwerty users, M-s should be other-windox. Fixed.
version 4.3.5, 2009-05-10 • experimental modification to shrink-whitespaces.
version 4.3.4, 2009-04-19 • Added Alt+Shift+PageDown for forward-page (move cursor to the next ascii formfeed char (often displayed as ^L)). Same for PageDown key.
version 4.3.3, 2009-03-16 • Added Ctrl+Shift+n for opening a new window (make-frame-command). Removed “C-x 5 2”. Added Ctrl+Shift+w for closing window (delete-frame), removed “C-x 5 0”.
version 4.3.2, 2009-03-11 • Removed C-x o for other-window. (use Alt+s and Alt+Shift+s instead.)
version 4.3.1, 2009-03-04 • A better implementation for making M-t call M-TAB. So that, describe-key on M-t will show better documentation.
version 4.3.0, 2009-03-02 • Added Alt+Shift+x for cut-all and Alt+Shift+c for copy-all.
version 4.2.4, 2009-03-01 • Removed Ctrl+x Ctrl+w for write-file. Use Ctrl+Shift+s. • Fixed Ctrl+o for ibuffer to run find-file instead of ibuffer-visit-buffer-other-window-noselect.
version 4.2.3, 2009-03-01 • fixed a dired binding so that Ctrl+o runs find-file instead of dired-display-file
version 4.2.2, 2009-03-01 • Removed the default keybinding for split-window-vertically (Ctrl+x 2). Use Alt+2 instead. • The key “Ctrl+x Ctrl+b” is now ibuffer, instead of list-buffers. • “Ctrl+h m” now calls describe-major-mode.
version 4.2.1, 2009-02-28 Changed the keybinding for previous-user-buffer from Ctrl+← to Ctrl+PageUp. And previous-emacs-buffer from Ctrl+Shift+← to Ctrl+Shift+PageUp. Similar for the “next” versions. Rationale: The Ctrl+Arrow are standard editing shortcuts commond in Windows, Mac, Linux.
version 4.2.0, 2009-02-27 Added Alt+t for keyword completion. Rationale: The default M-TAB is used by Windows, Mac, Linux, to switch apps.
version 4.1.8, 2009-02-15 Corrected the keybinding for Save As (write-file)
version 4.1.7, 2008-12-10 Made compact-uncompact-block to work on text selection if there's one.
version 4.1.6, 2008-12-09. Added select-text-in-quote.
version 4.1.5, 2008-10-21. Added extend-selection by Nikolaj Schumacher.
version 4.1.4, 2008-10-20. Fixed close-current-buffer: sometimes when closing a buffer not associated with a file, it'll prompt whether to kill instead of whether to save.
version 4.1.3, 2008-10-18. Fixed minor bug in toggle-letter-case. It now works non-english letters such as éÉ and single letter word “a teapot” or words starting with a number “1st timer”. Thanks to Andreas Politz and Nikolaj Schumacher. • next-frame-command is renamed to switch-to-next-frame. Similar for previous-frame-command.
version 4.1.2, 2008-10-16. Removed C-x h for mark-whole-buffer. (use Ctrl+a instead) Improved compact-uncompact-block and shrink-whitespaces.
version 4.1.1, 2008-10-07. Removed unfill-paragraph and unfill-region because they are defined in ourcomments-util.el bundled with emacs 22, also because they are not used in this file now (compact-uncompact-block replaced most of their functionality).
version 4.1, 2008-10-06. Added keys for previous-user-buffer, next-user-buffer, next-frame-command, previous-frame-command, query-replace and query-replace-regexp, move-cursor-to-next-pane, move-cursor-to-previous-pane, split-window-horizontally, toggle-letter-case. Combined delete-blank-lines and just-one-space to shrink-whitespaces. Moved delete-window to be with delete-other-window.
version 4.0.1, 2008-09-23. Fixed C-o in dired mode.
version 4, 2008-09-21. Unbind almost all Meta-‹key› and Ctrl-‹key› space bindings. Added about 11 commands, such as next-user-buffer, close-current-buffer etc.
version 3.6, 2008-09-18. Reclaimed keybindings in text-mode.
version 3.5, 2008-09-16. Reclaimed keybindings in ibuffer.
version 3.4, 2008-09-06. Fixed key bindings in the Meta-‹key› space in about 10 modes.
version 3.3, 2008-09-05. Fixed cua-mode-hook by setting symbol property 'CUA to nil, so that a bunch of no-select-* functions kludge is no longer needed. Thanks to Lennart Borgman.
version 3.2, 2008-09-02. Moved cua fix functions to modern_operations.el. The functinos are: no-select-cua-scroll-down, no-select-cua-scroll-up, no-select-backward-paragraph, no-select-forward-paragraph, no-select-beginning-of-buffer, no-select-end-of-buffer, no-select-move-end-of-line.
version 3.1, 2008-09-02. Added just-one-space, delete-blank-lines. Added fill-paragraph, unfill-paragraph. Added comment-dwim.
version 3, 2008-08-31. Added isearch. Added redo, kill-line-backward, shell-command. Added bug fix for cua-mode. Now, commands with Shift keys won't go into a selection mode.
version 2, 2008-08-29. Somewhat major change. Positions for undo, cut, copy, paste, paste previous, has been moved. Added delete-char, delete-backward-char, kill-word, backward-kill-word. Removed the now redundant binding of kill-word and backward-kill-word using the backspace key. Removed the other-frame binding.
version 1.1, 2007-12-18. changed keycode to consistantly use kbd syntax. Fixed a scroll-up and scroll-down mixup.
version 1.0, 2007-08-01. first version, by Xah Lee

64
.emacs.d.backup/ergoemacs-keybindings-5.1/_INSTALL.txt Executable file
View file

@ -0,0 +1,64 @@
-*- coding: utf-8 -*-
INSTALLATION INSTRUCTIONS
------------------------------
1. Unzip the folder.
If you downloaded a file named “ergoemacs-keybindings_v123.zip”, unzip it.
Now you should have a folder named “ergoemacs-keybindings_v123”.
------------------------------
2. Place the folder somewhere in your home directory. For examples:
On Windows:
C:\Users\mary\.emacs.d\ergoemacs-keybindings_v123
On Mac OS X or Linux:
/Users/mary/.emacs.d/ergoemacs-keybindings_v123
------------------------------
3. Specify your keyboard layout.
Place one of the following line in your emacs init file (~/.emacs):
(setenv "ERGOEMACS_KEYBOARD_LAYOUT" "us") ; US layout
(setenv "ERGOEMACS_KEYBOARD_LAYOUT" "dv") ; US Dvorak layout
(setenv "ERGOEMACS_KEYBOARD_LAYOUT" "sp") ; Spanish (Spain) (aka “Spanish (International sort)”)
(setenv "ERGOEMACS_KEYBOARD_LAYOUT" "it") ; Italian layout
(setenv "ERGOEMACS_KEYBOARD_LAYOUT" "colemak") ; Colemak layout
------------------------------
4. Make Emacs load the file, and turn on the mode.
Place the following lines in your emacs init file. Make sure that the path points to your file is correct. You do not need to have the file path end in “.el”.
;; load ErgoEmacs keybinding
(load "~/.emacs.d/ergoemacs-keybindings/ergoemacs-mode")
;; turn on minor mode ergoemacs-mode
(ergoemacs-mode 1)
These lines should be placed below your keyboard layout in step 3.
------------------------------
5. Restart emacs.
Now, your will be using the new keybinding. The shortcut for emacs's “M-x” is now “Alt+a”.
To turn off the mode, type “Alt+a” then “ergoemacs-mode”. After that, your keybinding is the same as GNU Emacs's default keybinding.
The command “ergoemacs-mode” toggles the minor mode.
--------------------------------------------------
Byte Compile Elisp Files (Optional)
If you like, you can byte-compile the elisp files. To byte compile them, call the command byte-compile-file, then the elisp file name. Once you do that, emacs will create a file with “.elc” ending, and will automatically load byte compiled file if there is one.
Byte compiled files makes loading and running programs about 5 or more times faster, but for small elisp files, the speed increse is probably not noticeable.
You do not need to change any lines in the emacs initialization given above.

106
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-layout-colemak.el Normal file
View file

@ -0,0 +1,106 @@
;-*- coding: utf-8 -*-
;; Shortcuts for ERGOEMACS_KEYBOARD_LAYOUT=colemak
;;; --------------------------------------------------
;;; CURSOR MOVEMENTS
;; Single char cursor movement
(defconst ergoemacs-backward-char-key (kbd "M-n"))
(defconst ergoemacs-forward-char-key (kbd "M-i"))
(defconst ergoemacs-previous-line-key (kbd "M-u"))
(defconst ergoemacs-next-line-key (kbd "M-e"))
;; Move by word
(defconst ergoemacs-backward-word-key (kbd "M-l"))
(defconst ergoemacs-forward-word-key (kbd "M-y"))
;; Move by paragraph
(defconst ergoemacs-backward-paragraph-key (kbd "M-L"))
(defconst ergoemacs-forward-paragraph-key (kbd "M-Y"))
;; Move to beginning/ending of line
(defconst ergoemacs-move-beginning-of-line-key (kbd "M-h"))
(defconst ergoemacs-move-end-of-line-key (kbd "M-H"))
;; Move by screen (page up/down)
(defconst ergoemacs-scroll-down-key (kbd "M-U"))
(defconst ergoemacs-scroll-up-key (kbd "M-E"))
;; Move to beginning/ending of file
(defconst ergoemacs-beginning-of-buffer-key (kbd "M-N"))
(defconst ergoemacs-end-of-buffer-key (kbd "M-I"))
;; isearch
(defconst ergoemacs-isearch-forward-key (kbd "M-o"))
(defconst ergoemacs-isearch-backward-key (kbd "M-O"))
(defconst ergoemacs-recenter-key (kbd "M-;"))
;;; MAJOR EDITING COMMANDS
;; Delete previous/next char.
(defconst ergoemacs-delete-backward-char-key (kbd "M-s"))
(defconst ergoemacs-delete-char-key (kbd "M-t"))
; Delete previous/next word.
(defconst ergoemacs-backward-kill-word-key (kbd "M-f"))
(defconst ergoemacs-kill-word-key (kbd "M-p"))
; Copy Cut Paste, Paste previous
(defconst ergoemacs-kill-region-key (kbd "M-x"))
(defconst ergoemacs-kill-ring-save-key (kbd "M-c"))
(defconst ergoemacs-yank-key (kbd "M-v"))
(defconst ergoemacs-yank-pop-key (kbd "M-V"))
(defconst ergoemacs-copy-all-key (kbd "M-C"))
(defconst ergoemacs-cut-all-key (kbd "M-X"))
;; undo and redo
(defconst ergoemacs-redo-key (kbd "M-Z"))
(defconst ergoemacs-undo-key (kbd "M-z"))
; Kill line
(defconst ergoemacs-kill-line-key (kbd "M-d"))
(defconst ergoemacs-kill-line-backward-key (kbd "M-D"))
;;; Textual Transformation
(defconst ergoemacs-mark-paragraph-key (kbd "M-S-SPC"))
(defconst ergoemacs-shrink-whitespaces-key (kbd "M-w"))
(defconst ergoemacs-comment-dwim-key (kbd "M-'"))
(defconst ergoemacs-toggle-letter-case-key (kbd "M-/"))
; keyword completion, because Alt+Tab is used by OS
(defconst ergoemacs-call-keyword-completion-key (kbd "M-g"))
; Hard-wrap/un-hard-wrap paragraph
(defconst ergoemacs-compact-uncompact-block-key (kbd "M-q"))
;;; EMACS'S SPECIAL COMMANDS
; Mark point.
(defconst ergoemacs-set-mark-command-key (kbd "M-SPC"))
(defconst ergoemacs-execute-extended-command-key (kbd "M-a"))
(defconst ergoemacs-shell-command-key (kbd "M-A"))
;;; WINDOW SPLITING
(defconst ergoemacs-move-cursor-next-pane-key (kbd "M-r"))
(defconst ergoemacs-move-cursor-previous-pane-key (kbd "M-R"))
;;; --------------------------------------------------
;;; OTHER SHORTCUTS
(defconst ergoemacs-switch-to-previous-frame-key (kbd "M-~"))
(defconst ergoemacs-switch-to-next-frame-key (kbd "M-`"))
(defconst ergoemacs-query-replace-key (kbd "M-5"))
(defconst ergoemacs-query-replace-regexp-key (kbd "M-%"))
(defconst ergoemacs-delete-other-windows-key (kbd "M-1"))
(defconst ergoemacs-delete-window-key (kbd "M-!"))
(defconst ergoemacs-split-window-vertically-key (kbd "M-2"))
(defconst ergoemacs-split-window-horizontally-key (kbd "M-@"))
(defconst ergoemacs-extend-selection-key (kbd "M-8"))
(defconst ergoemacs-select-text-in-quote-key (kbd "M-*"))

106
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-layout-dv.el Executable file
View file

@ -0,0 +1,106 @@
;-*- coding: utf-8 -*-
;; Shortcuts for ERGOEMACS_KEYBOARD_LAYOUT=dv | us_dvorak
;;; --------------------------------------------------
;;; CURSOR MOVEMENTS
;; Single char cursor movement
(defconst ergoemacs-backward-char-key (kbd "M-h"))
(defconst ergoemacs-forward-char-key (kbd "M-n"))
(defconst ergoemacs-previous-line-key (kbd "M-c"))
(defconst ergoemacs-next-line-key (kbd "M-t"))
;; Move by word
(defconst ergoemacs-backward-word-key (kbd "M-g"))
(defconst ergoemacs-forward-word-key (kbd "M-r"))
;; Move by paragraph
(defconst ergoemacs-backward-paragraph-key (kbd "M-G"))
(defconst ergoemacs-forward-paragraph-key (kbd "M-R"))
;; Move to beginning/ending of line
(defconst ergoemacs-move-beginning-of-line-key (kbd "M-d"))
(defconst ergoemacs-move-end-of-line-key (kbd "M-D"))
;; Move by screen (page up/down)
(defconst ergoemacs-scroll-down-key (kbd "M-C"))
(defconst ergoemacs-scroll-up-key (kbd "M-T"))
;; Move to beginning/ending of file
(defconst ergoemacs-beginning-of-buffer-key (kbd "M-H"))
(defconst ergoemacs-end-of-buffer-key (kbd "M-N"))
;; isearch
(defconst ergoemacs-isearch-forward-key (kbd "M-s"))
(defconst ergoemacs-isearch-backward-key (kbd "M-S"))
(defconst ergoemacs-recenter-key (kbd "M-l"))
;;; MAJOR EDITING COMMANDS
;; Delete previous/next char.
(defconst ergoemacs-delete-backward-char-key (kbd "M-e"))
(defconst ergoemacs-delete-char-key (kbd "M-u"))
; Delete previous/next word.
(defconst ergoemacs-backward-kill-word-key (kbd "M-."))
(defconst ergoemacs-kill-word-key (kbd "M-p"))
; Copy Cut Paste, Paste previous
(defconst ergoemacs-kill-region-key (kbd "M-q"))
(defconst ergoemacs-kill-ring-save-key (kbd "M-j"))
(defconst ergoemacs-yank-key (kbd "M-k"))
(defconst ergoemacs-yank-pop-key (kbd "M-K"))
(defconst ergoemacs-copy-all-key (kbd "M-J"))
(defconst ergoemacs-cut-all-key (kbd "M-Q"))
;; undo and redo
(defconst ergoemacs-redo-key (kbd "M-:"))
(defconst ergoemacs-undo-key (kbd "M-;"))
; Kill line
(defconst ergoemacs-kill-line-key (kbd "M-i"))
(defconst ergoemacs-kill-line-backward-key (kbd "M-I"))
;;; Textual Transformation
(defconst ergoemacs-mark-paragraph-key (kbd "M-S-SPC"))
(defconst ergoemacs-shrink-whitespaces-key (kbd "M-,"))
(defconst ergoemacs-comment-dwim-key (kbd "M--"))
(defconst ergoemacs-toggle-letter-case-key (kbd "M-z"))
; keyword completion, because Alt+Tab is used by OS
(defconst ergoemacs-call-keyword-completion-key (kbd "M-y"))
; Hard-wrap/un-hard-wrap paragraph
(defconst ergoemacs-compact-uncompact-block-key (kbd "M-'"))
;;; EMACS'S SPECIAL COMMANDS
; Mark point.
(defconst ergoemacs-set-mark-command-key (kbd "M-SPC"))
(defconst ergoemacs-execute-extended-command-key (kbd "M-a"))
(defconst ergoemacs-shell-command-key (kbd "M-A"))
;;; WINDOW SPLITING
(defconst ergoemacs-move-cursor-next-pane-key (kbd "M-o"))
(defconst ergoemacs-move-cursor-previous-pane-key (kbd "M-O"))
;;; --------------------------------------------------
;;; OTHER SHORTCUTS
(defconst ergoemacs-switch-to-previous-frame-key (kbd "M-~"))
(defconst ergoemacs-switch-to-next-frame-key (kbd "M-`"))
(defconst ergoemacs-query-replace-key (kbd "M-5"))
(defconst ergoemacs-query-replace-regexp-key (kbd "M-%"))
(defconst ergoemacs-delete-other-windows-key (kbd "M-1"))
(defconst ergoemacs-delete-window-key (kbd "M-!"))
(defconst ergoemacs-split-window-vertically-key (kbd "M-2"))
(defconst ergoemacs-split-window-horizontally-key (kbd "M-@"))
(defconst ergoemacs-extend-selection-key (kbd "M-8"))
(defconst ergoemacs-select-text-in-quote-key (kbd "M-*"))

106
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-layout-it.el Normal file
View file

@ -0,0 +1,106 @@
;-*- coding: utf-8 -*-
;; Shortcuts for ERGOEMACS_KEYBOARD_LAYOUT=it
;;; --------------------------------------------------
;;; CURSOR MOVEMENTS
;; Single char cursor movement
(defconst ergoemacs-backward-char-key (kbd "M-j"))
(defconst ergoemacs-forward-char-key (kbd "M-l"))
(defconst ergoemacs-previous-line-key (kbd "M-i"))
(defconst ergoemacs-next-line-key (kbd "M-k"))
;; Move by word
(defconst ergoemacs-backward-word-key (kbd "M-u"))
(defconst ergoemacs-forward-word-key (kbd "M-o"))
;; Move by paragraph
(defconst ergoemacs-backward-paragraph-key (kbd "M-U"))
(defconst ergoemacs-forward-paragraph-key (kbd "M-O"))
;; Move to beginning/ending of line
(defconst ergoemacs-move-beginning-of-line-key (kbd "M-h"))
(defconst ergoemacs-move-end-of-line-key (kbd "M-H"))
;; Move by screen (page up/down)
(defconst ergoemacs-scroll-down-key (kbd "M-I"))
(defconst ergoemacs-scroll-up-key (kbd "M-K"))
;; Move to beginning/ending of file
(defconst ergoemacs-beginning-of-buffer-key (kbd "M-J"))
(defconst ergoemacs-end-of-buffer-key (kbd "M-L"))
;; isearch
(defconst ergoemacs-isearch-forward-key (kbd "M-ò"))
(defconst ergoemacs-isearch-backward-key (kbd "M-ç"))
(defconst ergoemacs-recenter-key (kbd "M-p"))
;;; MAJOR EDITING COMMANDS
;; Delete previous/next char.
(defconst ergoemacs-delete-backward-char-key (kbd "M-d"))
(defconst ergoemacs-delete-char-key (kbd "M-f"))
; Delete previous/next word.
(defconst ergoemacs-backward-kill-word-key (kbd "M-e"))
(defconst ergoemacs-kill-word-key (kbd "M-r"))
; Copy Cut Paste, Paste previous
(defconst ergoemacs-kill-region-key (kbd "M-x"))
(defconst ergoemacs-kill-ring-save-key (kbd "M-c"))
(defconst ergoemacs-yank-key (kbd "M-v"))
(defconst ergoemacs-yank-pop-key (kbd "M-V"))
(defconst ergoemacs-copy-all-key (kbd "M-C"))
(defconst ergoemacs-cut-all-key (kbd "M-X"))
;; undo and redo
(defconst ergoemacs-redo-key (kbd "M-Z"))
(defconst ergoemacs-undo-key (kbd "M-z"))
; Kill line
(defconst ergoemacs-kill-line-key (kbd "M-g"))
(defconst ergoemacs-kill-line-backward-key (kbd "M-G"))
;;; Textual Transformation
(defconst ergoemacs-mark-paragraph-key (kbd "M-S-SPC"))
(defconst ergoemacs-shrink-whitespaces-key (kbd "M-w"))
(defconst ergoemacs-comment-dwim-key (kbd "M-à"))
(defconst ergoemacs-toggle-letter-case-key (kbd "M--"))
; keyword completion, because Alt+Tab is used by OS
(defconst ergoemacs-call-keyword-completion-key (kbd "M-t"))
; Hard-wrap/un-hard-wrap paragraph
(defconst ergoemacs-compact-uncompact-block-key (kbd "M-q"))
;;; EMACS'S SPECIAL COMMANDS
; Mark point.
(defconst ergoemacs-set-mark-command-key (kbd "M-SPC"))
(defconst ergoemacs-execute-extended-command-key (kbd "M-a"))
(defconst ergoemacs-shell-command-key (kbd "M-A"))
;;; WINDOW SPLITING
(defconst ergoemacs-move-cursor-next-pane-key (kbd "M-s"))
(defconst ergoemacs-move-cursor-previous-pane-key (kbd "M-S"))
;;; --------------------------------------------------
;;; OTHER SHORTCUTS
(defconst ergoemacs-switch-to-previous-frame-key (kbd "M-|"))
(defconst ergoemacs-switch-to-next-frame-key (kbd "M-\\"))
(defconst ergoemacs-query-replace-key (kbd "M-5"))
(defconst ergoemacs-query-replace-regexp-key (kbd "M-%"))
(defconst ergoemacs-delete-other-windows-key (kbd "M-1"))
(defconst ergoemacs-delete-window-key (kbd "M-!"))
(defconst ergoemacs-split-window-vertically-key (kbd "M-2"))
(defconst ergoemacs-split-window-horizontally-key (kbd "M-\""))
(defconst ergoemacs-extend-selection-key (kbd "M-8"))
(defconst ergoemacs-select-text-in-quote-key (kbd "M-("))

106
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-layout-sp.el Normal file
View file

@ -0,0 +1,106 @@
;-*- coding: utf-8 -*-
;; Shortcuts for ERGOEMACS_KEYBOARD_LAYOUT=sp
;;; --------------------------------------------------
;;; CURSOR MOVEMENTS
;; Single char cursor movement
(defconst ergoemacs-backward-char-key (kbd "M-j"))
(defconst ergoemacs-forward-char-key (kbd "M-l"))
(defconst ergoemacs-previous-line-key (kbd "M-i"))
(defconst ergoemacs-next-line-key (kbd "M-k"))
;; Move by word
(defconst ergoemacs-backward-word-key (kbd "M-u"))
(defconst ergoemacs-forward-word-key (kbd "M-o"))
;; Move by paragraph
(defconst ergoemacs-backward-paragraph-key (kbd "M-U"))
(defconst ergoemacs-forward-paragraph-key (kbd "M-O"))
;; Move to beginning/ending of line
(defconst ergoemacs-move-beginning-of-line-key (kbd "M-h"))
(defconst ergoemacs-move-end-of-line-key (kbd "M-H"))
;; Move by screen (page up/down)
(defconst ergoemacs-scroll-down-key (kbd "M-I"))
(defconst ergoemacs-scroll-up-key (kbd "M-K"))
;; Move to beginning/ending of file
(defconst ergoemacs-beginning-of-buffer-key (kbd "M-J"))
(defconst ergoemacs-end-of-buffer-key (kbd "M-L"))
;; isearch
(defconst ergoemacs-isearch-forward-key (kbd "M-ñ"))
(defconst ergoemacs-isearch-backward-key (kbd "M-Ñ"))
(defconst ergoemacs-recenter-key (kbd "M-p"))
;;; MAJOR EDITING COMMANDS
;; Delete previous/next char.
(defconst ergoemacs-delete-backward-char-key (kbd "M-d"))
(defconst ergoemacs-delete-char-key (kbd "M-f"))
; Delete previous/next word.
(defconst ergoemacs-backward-kill-word-key (kbd "M-e"))
(defconst ergoemacs-kill-word-key (kbd "M-r"))
; Copy Cut Paste, Paste previous
(defconst ergoemacs-kill-region-key (kbd "M-x"))
(defconst ergoemacs-kill-ring-save-key (kbd "M-c"))
(defconst ergoemacs-yank-key (kbd "M-v"))
(defconst ergoemacs-yank-pop-key (kbd "M-V"))
(defconst ergoemacs-copy-all-key (kbd "M-C"))
(defconst ergoemacs-cut-all-key (kbd "M-X"))
;; undo and redo
(defconst ergoemacs-redo-key (kbd "M-Z"))
(defconst ergoemacs-undo-key (kbd "M-z"))
; Kill line
(defconst ergoemacs-kill-line-key (kbd "M-g"))
(defconst ergoemacs-kill-line-backward-key (kbd "M-G"))
;;; Textual Transformation
(defconst ergoemacs-mark-paragraph-key (kbd "M-S-SPC"))
(defconst ergoemacs-shrink-whitespaces-key (kbd "M-w"))
(defconst ergoemacs-comment-dwim-key (kbd "M-´"))
(defconst ergoemacs-toggle-letter-case-key (kbd "M--"))
; keyword completion, because Alt+Tab is used by OS
(defconst ergoemacs-call-keyword-completion-key (kbd "M-t"))
; Hard-wrap/un-hard-wrap paragraph
(defconst ergoemacs-compact-uncompact-block-key (kbd "M-q"))
;;; EMACS'S SPECIAL COMMANDS
; Mark point.
(defconst ergoemacs-set-mark-command-key (kbd "M-SPC"))
(defconst ergoemacs-execute-extended-command-key (kbd "M-a"))
(defconst ergoemacs-shell-command-key (kbd "M-A"))
;;; WINDOW SPLITING
(defconst ergoemacs-move-cursor-next-pane-key (kbd "M-s"))
(defconst ergoemacs-move-cursor-previous-pane-key (kbd "M-S"))
;;; --------------------------------------------------
;;; OTHER SHORTCUTS
(defconst ergoemacs-switch-to-previous-frame-key (kbd "M-ª"))
(defconst ergoemacs-switch-to-next-frame-key (kbd "M-º"))
(defconst ergoemacs-query-replace-key (kbd "M-5"))
(defconst ergoemacs-query-replace-regexp-key (kbd "M-%"))
(defconst ergoemacs-delete-other-windows-key (kbd "M-1"))
(defconst ergoemacs-delete-window-key (kbd "M-!"))
(defconst ergoemacs-split-window-vertically-key (kbd "M-2"))
(defconst ergoemacs-split-window-horizontally-key (kbd "M-\""))
(defconst ergoemacs-extend-selection-key (kbd "M-8"))
(defconst ergoemacs-select-text-in-quote-key (kbd "M-("))

106
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-layout-us.el Executable file
View file

@ -0,0 +1,106 @@
;-*- coding: utf-8 -*-
;; Shortcuts for ERGOEMACS_KEYBOARD_LAYOUT=us
;;; --------------------------------------------------
;;; CURSOR MOVEMENTS
;; Single char cursor movement
(defconst ergoemacs-backward-char-key (kbd "M-j"))
(defconst ergoemacs-forward-char-key (kbd "M-l"))
(defconst ergoemacs-previous-line-key (kbd "M-i"))
(defconst ergoemacs-next-line-key (kbd "M-k"))
;; Move by word
(defconst ergoemacs-backward-word-key (kbd "M-u"))
(defconst ergoemacs-forward-word-key (kbd "M-o"))
;; Move by paragraph
(defconst ergoemacs-backward-paragraph-key (kbd "M-U"))
(defconst ergoemacs-forward-paragraph-key (kbd "M-O"))
;; Move to beginning/ending of line
(defconst ergoemacs-move-beginning-of-line-key (kbd "M-h"))
(defconst ergoemacs-move-end-of-line-key (kbd "M-H"))
;; Move by screen (page up/down)
(defconst ergoemacs-scroll-down-key (kbd "M-I"))
(defconst ergoemacs-scroll-up-key (kbd "M-K"))
;; Move to beginning/ending of file
(defconst ergoemacs-beginning-of-buffer-key (kbd "M-J"))
(defconst ergoemacs-end-of-buffer-key (kbd "M-L"))
;; isearch
(defconst ergoemacs-isearch-forward-key (kbd "M-;"))
(defconst ergoemacs-isearch-backward-key (kbd "M-:"))
(defconst ergoemacs-recenter-key (kbd "M-p"))
;;; MAJOR EDITING COMMANDS
;; Delete previous/next char.
(defconst ergoemacs-delete-backward-char-key (kbd "M-d"))
(defconst ergoemacs-delete-char-key (kbd "M-f"))
; Delete previous/next word.
(defconst ergoemacs-backward-kill-word-key (kbd "M-e"))
(defconst ergoemacs-kill-word-key (kbd "M-r"))
; Copy Cut Paste, Paste previous
(defconst ergoemacs-kill-region-key (kbd "M-x"))
(defconst ergoemacs-kill-ring-save-key (kbd "M-c"))
(defconst ergoemacs-yank-key (kbd "M-v"))
(defconst ergoemacs-yank-pop-key (kbd "M-V"))
(defconst ergoemacs-copy-all-key (kbd "M-C"))
(defconst ergoemacs-cut-all-key (kbd "M-X"))
;; undo and redo
(defconst ergoemacs-redo-key (kbd "M-Z"))
(defconst ergoemacs-undo-key (kbd "M-z"))
; Kill line
(defconst ergoemacs-kill-line-key (kbd "M-g"))
(defconst ergoemacs-kill-line-backward-key (kbd "M-G"))
;;; Textual Transformation
(defconst ergoemacs-mark-paragraph-key (kbd "M-S-SPC"))
(defconst ergoemacs-shrink-whitespaces-key (kbd "M-w"))
(defconst ergoemacs-comment-dwim-key (kbd "M-'"))
(defconst ergoemacs-toggle-letter-case-key (kbd "M-/"))
; keyword completion, because Alt+Tab is used by OS
(defconst ergoemacs-call-keyword-completion-key (kbd "M-t"))
; Hard-wrap/un-hard-wrap paragraph
(defconst ergoemacs-compact-uncompact-block-key (kbd "M-q"))
;;; EMACS'S SPECIAL COMMANDS
; Mark point.
(defconst ergoemacs-set-mark-command-key (kbd "M-SPC"))
(defconst ergoemacs-execute-extended-command-key (kbd "M-a"))
(defconst ergoemacs-shell-command-key (kbd "M-A"))
;;; WINDOW SPLITING
(defconst ergoemacs-move-cursor-next-pane-key (kbd "M-s"))
(defconst ergoemacs-move-cursor-previous-pane-key (kbd "M-S"))
;;; --------------------------------------------------
;;; OTHER SHORTCUTS
(defconst ergoemacs-switch-to-previous-frame-key (kbd "M-~"))
(defconst ergoemacs-switch-to-next-frame-key (kbd "M-`"))
(defconst ergoemacs-query-replace-key (kbd "M-5"))
(defconst ergoemacs-query-replace-regexp-key (kbd "M-%"))
(defconst ergoemacs-delete-other-windows-key (kbd "M-1"))
(defconst ergoemacs-delete-window-key (kbd "M-!"))
(defconst ergoemacs-split-window-vertically-key (kbd "M-2"))
(defconst ergoemacs-split-window-horizontally-key (kbd "M-@"))
(defconst ergoemacs-extend-selection-key (kbd "M-8"))
(defconst ergoemacs-select-text-in-quote-key (kbd "M-*"))

379
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-mode.el Executable file
View file

@ -0,0 +1,379 @@
;-*- coding: utf-8 -*-
;; ergoemacs-mode.el -- A emacs keybinding set based on ergonomics.
;; Copyright © 2007, 2008, 2009 by Xah Lee
;; Copyright © 2009 by David Capello
;; Author: Xah Lee ( http://xahlee.org/ ), David Capello ( http://www.davidcapello.com.ar/ )
;; Version: 5.1
;; Keywords: qwerty, dvorak, keybinding, ergonomic, colemak
;; You can redistribute this program and/or modify it under the terms
;; of the GNU General Public License as published by the Free Software
;; Foundation; either version 2, or (at your option) any later
;; version.
;;; DESCRIPTION
;; This keybinding set puts the most frequently used emacs keyboard
;; shortcuts into the most easy-to-type spots.
;;
;; For complete detail, see:
;; http://xahlee.org/emacs/ergonomic_emacs_keybinding.html
;;; INSTALL
;; See the file “_INSTALL.txt”.
;;; HISTORY
;; See the file “_HISTORY.txt”.
;;; ACKNOWLEDGMENT
;; Thanks to Nikolaj Schumacher for his implementation of extend-selection.
;; Thanks to Andreas Politz and Nikolaj Schumacher for correcting/improving implementation of toggle-letter-case.
;; Thanks to Lennart Borgman for several suggestions on code to prevent shortcuts involving shift key to start select text when CUA-mode is on.
;; Thanks to David Capello for contribution to shrink-whitespaces.
;; Thanks to marciomazza for spotting several default bindings that should have been unbound.
;; Thanks to those who have created and improved the version for Colemak layout. They are (by date): “vockets”, “postivan”, Graham Poulter.
;; Thanks to lwarxx for bug report on diff-mode
;; Thanks to many users who send in comments and appreciations on this.
;;; --------------------------------------------------
;; Add this same directory to load elisp files
(add-to-list 'load-path (file-name-directory (or load-file-name buffer-file-name)))
;; Ergoemacs-keybindings version
(defconst ergoemacs-mode-version "5.1"
"Ergoemacs-keybindings minor mode version number.")
;; Include extra files
(load "functions")
(load "ergoemacs-unbind")
;; Load the keyboard layout looking the ERGOEMACS_KEYBOARD_LAYOUT
;; enviroment variable (this variable is set by ErgoEmacs runner)
(defvar ergoemacs-keyboard-layout (getenv "ERGOEMACS_KEYBOARD_LAYOUT")
"It is set with the value of ERGOEMACS_KEYBOARD_LAYOUT
enviroment variable. The possible values are:
us = US English QWERTY keyboard layout
dv = US-Dvorak keyboard layout
sp = Spanish keyboard layout
it = Italian keyboard layout
colemak = Ergonomic Colemak keyboard layout")
(cond
((string= ergoemacs-keyboard-layout "us")
(load "ergoemacs-layout-us"))
((or (string= ergoemacs-keyboard-layout "us_dvorak")
(string= ergoemacs-keyboard-layout "dv"))
(load "ergoemacs-layout-dv"))
((string= ergoemacs-keyboard-layout "sp")
(load "ergoemacs-layout-sp"))
((or (string= ergoemacs-keyboard-layout "it")
(string= ergoemacs-keyboard-layout "it142"))
(load "ergoemacs-layout-it"))
((string= ergoemacs-keyboard-layout "colemak")
(load "ergoemacs-layout-colemak"))
(t ; US qwerty by default
(load "ergoemacs-layout-us"))
)
;;; --------------------------------------------------
;;; ergoemacs-keymap
(defvar ergoemacs-keymap (make-sparse-keymap)
"ErgoEmacs minor mode keymap.")
;; Single char cursor movement
(define-key ergoemacs-keymap ergoemacs-backward-char-key 'backward-char)
(define-key ergoemacs-keymap ergoemacs-forward-char-key 'forward-char)
(define-key ergoemacs-keymap ergoemacs-previous-line-key 'previous-line)
(define-key ergoemacs-keymap ergoemacs-next-line-key 'next-line)
;; Move by word
(define-key ergoemacs-keymap ergoemacs-backward-word-key 'backward-word)
(define-key ergoemacs-keymap ergoemacs-forward-word-key 'forward-word)
;; Move by paragraph
(define-key ergoemacs-keymap ergoemacs-backward-paragraph-key 'backward-paragraph)
(define-key ergoemacs-keymap ergoemacs-forward-paragraph-key 'forward-paragraph)
;; Move to beginning/ending of line
(define-key ergoemacs-keymap ergoemacs-move-beginning-of-line-key 'move-beginning-of-line)
(define-key ergoemacs-keymap ergoemacs-move-end-of-line-key 'move-end-of-line)
;; Move by screen (page up/down)
(define-key ergoemacs-keymap ergoemacs-scroll-down-key 'scroll-down)
(define-key ergoemacs-keymap ergoemacs-scroll-up-key 'scroll-up)
;; Move to beginning/ending of file
(define-key ergoemacs-keymap ergoemacs-beginning-of-buffer-key 'beginning-of-buffer)
(define-key ergoemacs-keymap ergoemacs-end-of-buffer-key 'end-of-buffer)
;; isearch
(define-key ergoemacs-keymap ergoemacs-isearch-forward-key 'isearch-forward)
(define-key ergoemacs-keymap ergoemacs-isearch-backward-key 'isearch-backward)
(define-key ergoemacs-keymap ergoemacs-recenter-key 'recenter)
;;; MAJOR EDITING COMMANDS
;; Delete previous/next char.
(define-key ergoemacs-keymap ergoemacs-delete-backward-char-key 'delete-backward-char)
(define-key ergoemacs-keymap ergoemacs-delete-char-key 'delete-char)
; Delete previous/next word.
(define-key ergoemacs-keymap ergoemacs-backward-kill-word-key 'backward-kill-word)
(define-key ergoemacs-keymap ergoemacs-kill-word-key 'kill-word)
; Copy Cut Paste, Paste previous
(define-key ergoemacs-keymap ergoemacs-kill-region-key 'kill-region)
(define-key ergoemacs-keymap ergoemacs-kill-ring-save-key 'kill-ring-save)
(define-key ergoemacs-keymap ergoemacs-yank-key 'yank)
(define-key ergoemacs-keymap ergoemacs-yank-pop-key 'yank-pop)
(define-key ergoemacs-keymap ergoemacs-copy-all-key 'copy-all)
(define-key ergoemacs-keymap ergoemacs-cut-all-key 'cut-all)
;; undo and redo
(define-key ergoemacs-keymap ergoemacs-redo-key 'redo)
(define-key ergoemacs-keymap ergoemacs-undo-key 'undo)
; Kill line
(define-key ergoemacs-keymap ergoemacs-kill-line-key 'kill-line)
(define-key ergoemacs-keymap ergoemacs-kill-line-backward-key 'kill-line-backward)
;;; Textual Transformation
(define-key ergoemacs-keymap ergoemacs-mark-paragraph-key 'mark-paragraph)
(define-key ergoemacs-keymap ergoemacs-shrink-whitespaces-key 'shrink-whitespaces)
(define-key ergoemacs-keymap ergoemacs-comment-dwim-key 'comment-dwim)
(define-key ergoemacs-keymap ergoemacs-toggle-letter-case-key 'toggle-letter-case)
; keyword completion, because Alt+Tab is used by OS
(define-key ergoemacs-keymap ergoemacs-call-keyword-completion-key 'call-keyword-completion)
; Hard-wrap/un-hard-wrap paragraph
(define-key ergoemacs-keymap ergoemacs-compact-uncompact-block-key 'compact-uncompact-block)
;;; EMACS'S SPECIAL COMMANDS
; Mark point.
(define-key ergoemacs-keymap ergoemacs-set-mark-command-key 'set-mark-command)
(define-key ergoemacs-keymap ergoemacs-execute-extended-command-key 'execute-extended-command)
(define-key ergoemacs-keymap ergoemacs-shell-command-key 'shell-command)
;;; WINDOW SPLITING
(define-key ergoemacs-keymap ergoemacs-move-cursor-next-pane-key 'move-cursor-next-pane)
(define-key ergoemacs-keymap ergoemacs-move-cursor-previous-pane-key 'move-cursor-previous-pane)
;;; --------------------------------------------------
;;; STANDARD SHORTCUTS
(define-key ergoemacs-keymap (kbd "C-n") 'new-empty-buffer)
(define-key ergoemacs-keymap (kbd "C-S-n") 'make-frame-command)
(define-key ergoemacs-keymap (kbd "C-o") 'find-file)
(define-key ergoemacs-keymap (kbd "C-w") 'close-current-buffer)
(define-key ergoemacs-keymap (kbd "C-s") 'save-buffer)
(define-key ergoemacs-keymap (kbd "C-S-s") 'write-file)
(define-key ergoemacs-keymap (kbd "C-p") 'print-buffer)
(define-key ergoemacs-keymap (kbd "C-a") 'mark-whole-buffer)
(define-key ergoemacs-keymap (kbd "C-S-w") 'delete-frame)
(define-key ergoemacs-keymap (kbd "C-f") 'search-forward)
(define-key ergoemacs-keymap (kbd "<delete>") 'delete-char) ; the Del key for forward delete. Needed if C-d is set to nil.
(define-key ergoemacs-keymap (kbd "C-<prior>") 'previous-user-buffer)
(define-key ergoemacs-keymap (kbd "C-<next>") 'next-user-buffer)
(define-key ergoemacs-keymap (kbd "C-S-<prior>") 'previous-emacs-buffer)
(define-key ergoemacs-keymap (kbd "C-S-<next>") 'next-emacs-buffer)
(define-key ergoemacs-keymap (kbd "M-S-<prior>") 'backward-page)
(define-key ergoemacs-keymap (kbd "M-S-<next>") 'forward-page)
(define-key ergoemacs-keymap (kbd "C-x C-b") 'ibuffer)
(define-key ergoemacs-keymap (kbd "C-h m") 'describe-major-mode)
(define-key ergoemacs-keymap (kbd "C-h o") 'where-is-old-binding)
;; Ctrl+Break is a common IDE shortcut to stop compilation/find/grep
(define-key ergoemacs-keymap (kbd "C-<pause>") 'kill-compilation)
;;; --------------------------------------------------
;;; OTHER SHORTCUTS
(define-key ergoemacs-keymap ergoemacs-switch-to-previous-frame-key 'switch-to-previous-frame)
(define-key ergoemacs-keymap ergoemacs-switch-to-next-frame-key 'switch-to-next-frame)
(define-key ergoemacs-keymap ergoemacs-query-replace-key 'query-replace)
(define-key ergoemacs-keymap ergoemacs-query-replace-regexp-key 'query-replace-regexp)
(define-key ergoemacs-keymap ergoemacs-delete-other-windows-key 'delete-other-windows)
(define-key ergoemacs-keymap ergoemacs-delete-window-key 'delete-window)
(define-key ergoemacs-keymap ergoemacs-split-window-vertically-key 'split-window-vertically)
(define-key ergoemacs-keymap ergoemacs-split-window-horizontally-key 'split-window-horizontally)
(define-key ergoemacs-keymap ergoemacs-extend-selection-key 'extend-selection)
(define-key ergoemacs-keymap ergoemacs-select-text-in-quote-key 'select-text-in-quote)
;;----------------------------------------------------------------------
;; ErgoEmacs hooks
(defun ergoemacs-cua-hook ()
"Prevent `cua-mode' from going into selection mode when commands with Shift key is used."
(put 'cua-scroll-down 'CUA nil)
(put 'cua-scroll-up 'CUA nil)
(put 'backward-paragraph 'CUA nil)
(put 'forward-paragraph 'CUA nil)
(put 'beginning-of-buffer 'CUA nil)
(put 'end-of-buffer 'CUA nil)
(put 'move-end-of-line 'CUA nil)
)
(defun ergoemacs-minibuffer-setup-hook ()
"Hook for minibuffer to move through history with previous-line and next-line keys."
(defvar ergoemacs-minibuffer-keymap (copy-keymap ergoemacs-keymap))
(define-key ergoemacs-minibuffer-keymap ergoemacs-previous-line-key 'previous-history-element)
(define-key ergoemacs-minibuffer-keymap ergoemacs-next-line-key 'next-history-element)
(define-key ergoemacs-minibuffer-keymap (kbd "<f11>") 'previous-history-element)
(define-key ergoemacs-minibuffer-keymap (kbd "<f12>") 'next-history-element)
(define-key ergoemacs-minibuffer-keymap (kbd "S-<f11>") 'previous-matching-history-element)
(define-key ergoemacs-minibuffer-keymap (kbd "S-<f12>") 'next-matching-history-element)
(add-to-list 'minor-mode-overriding-map-alist (cons 'ergoemacs-mode ergoemacs-minibuffer-keymap))
)
(defun ergoemacs-isearch-hook ()
"Hook for `isearch-mode-hook' so ergoemacs keybindings are not lost."
;; TODO restore these keys! (it is not necessary, when the
;; ergoemacs-isearch-hook is removed from isearch-mode-hook)
(define-key isearch-mode-map (kbd "M-p") 'nil) ; was isearch-ring-retreat
(define-key isearch-mode-map (kbd "M-n") 'nil) ; was isearch-ring-advance
(define-key isearch-mode-map (kbd "M-y") 'nil) ; was isearch-yank-kill
(define-key isearch-mode-map (kbd "M-c") 'nil) ; was isearch-toggle-case-fold
(define-key isearch-mode-map (kbd "M-r") 'nil) ; was isearch-toggle-regexp
(define-key isearch-mode-map (kbd "M-e") 'nil) ; was isearch-edit-string
(define-key isearch-mode-map ergoemacs-isearch-forward-key 'isearch-repeat-forward)
(define-key isearch-mode-map ergoemacs-isearch-backward-key 'isearch-repeat-backward)
(define-key isearch-mode-map ergoemacs-recenter-key 'recenter)
(define-key isearch-mode-map ergoemacs-yank-key 'isearch-yank-kill)
;; isearch-other-control-char sends the key to the original buffer and cancels isearch
(define-key isearch-mode-map ergoemacs-kill-ring-save-key 'isearch-other-control-char)
(define-key isearch-mode-map ergoemacs-kill-word-key 'isearch-other-control-char)
(define-key isearch-mode-map ergoemacs-backward-kill-word-key 'isearch-other-control-char)
(define-key isearch-mode-map (kbd "<f11>") 'isearch-ring-retreat)
(define-key isearch-mode-map (kbd "<f12>") 'isearch-ring-advance)
)
;; Hook for interpreters
(defun ergoemacs-comint-hook ()
"Hook for `comint-mode-hook'."
(define-key comint-mode-map (kbd "<f11>") 'comint-previous-input)
(define-key comint-mode-map (kbd "<f12>") 'comint-next-input)
(define-key comint-mode-map (kbd "S-<f11>") 'comint-previous-matching-input)
(define-key comint-mode-map (kbd "S-<f12>") 'comint-next-matching-input)
)
;; Log edit mode
(defun ergoemacs-log-edit-hook ()
"Hook for `log-edit-mode-hook'."
(define-key log-edit-mode-map (kbd "<f11>") 'log-edit-previous-comment)
(define-key log-edit-mode-map (kbd "<f12>") 'log-edit-next-comment)
(define-key log-edit-mode-map (kbd "S-<f11>") 'log-edit-previous-comment)
(define-key log-edit-mode-map (kbd "S-<f12>") 'log-edit-next-comment)
)
(defun ergoemacs-eshell-hook ()
"Hook for `eshell-mode-hook', to redefine some ErgoEmacs keys so they are more useful."
;; Redefining ergoemacs-move-beginning-of-line-key to eshell-bol in eshell-mode-map
;; does not work, we have to use minor-mode-overriding-map-alist in this case
(defvar ergoemacs-eshell-keymap (copy-keymap ergoemacs-keymap))
(define-key ergoemacs-eshell-keymap ergoemacs-move-beginning-of-line-key 'eshell-bol)
(define-key ergoemacs-eshell-keymap (kbd "<home>") 'eshell-bol)
(define-key ergoemacs-eshell-keymap (kbd "<f11>") 'eshell-previous-matching-input-from-input)
(define-key ergoemacs-eshell-keymap (kbd "<f12>") 'eshell-next-matching-input-from-input)
(define-key ergoemacs-eshell-keymap (kbd "S-<f11>") 'eshell-previous-matching-input-from-input)
(define-key ergoemacs-eshell-keymap (kbd "S-<f12>") 'eshell-next-matching-input-from-input)
(add-to-list 'minor-mode-overriding-map-alist (cons 'ergoemacs-mode ergoemacs-eshell-keymap))
)
(defun ergoemacs-iswitchb-hook ()
"Hooks for `iswitchb-minibuffer-setup-hook'."
(defvar ergoemacs-iswitchb-keymap (copy-keymap ergoemacs-keymap))
(define-key ergoemacs-iswitchb-keymap ergoemacs-isearch-backward-key 'iswitchb-prev-match)
(define-key ergoemacs-iswitchb-keymap ergoemacs-isearch-forward-key 'iswitchb-next-match)
(define-key ergoemacs-iswitchb-keymap (kbd "<f11>") 'iswitchb-prev-match)
(define-key ergoemacs-iswitchb-keymap (kbd "<f12>") 'iswitchb-next-match)
(define-key ergoemacs-iswitchb-keymap (kbd "S-<f11>") 'iswitchb-prev-match)
(define-key ergoemacs-iswitchb-keymap (kbd "S-<f12>") 'iswitchb-next-match)
(add-to-list 'minor-mode-overriding-map-alist (cons 'ergoemacs-mode ergoemacs-iswitchb-keymap))
)
(defun ergoemacs-hook-modes ()
"Installs/Removes ErgoEmacs minor mode hooks from major modes
depending the state of `ergoemacs-mode' variable. If the mode
is being initialized, some global keybindings in current-global-map
will change."
(let ((modify-hook (if ergoemacs-mode 'add-hook 'remove-hook)))
;; when ergoemacs-mode is on, activate hooks and unset global keys, else do inverse
(if (and ergoemacs-mode (not (equal ergoemacs-mode 0)))
(ergoemacs-unset-redundant-global-keys)
(ergoemacs-restore-global-keys))
(funcall modify-hook 'cua-mode-hook 'ergoemacs-cua-hook)
(funcall modify-hook 'isearch-mode-hook 'ergoemacs-isearch-hook)
(funcall modify-hook 'comint-mode-hook 'ergoemacs-comint-hook)
(funcall modify-hook 'log-edit-mode-hook 'ergoemacs-log-edit-hook)
(funcall modify-hook 'eshell-mode-hook 'ergoemacs-eshell-hook)
(funcall modify-hook 'minibuffer-setup-hook 'ergoemacs-minibuffer-setup-hook)
(funcall modify-hook 'iswitchb-minibuffer-setup-hook 'ergoemacs-iswitchb-hook)
)
)
;;----------------------------------------------------------------------
;; ErgoEmacs minor mode
(define-minor-mode ergoemacs-mode
"Toggle ergoemacs keybinding mode.
This minor mode changes your emacs keybindings.
Without argument, toggles the minor mode.
If optional argument is 1, turn it on.
If optional argument is 0, turn it off.
Argument of t or nil should not be used.
For full documentation, see:
URL `http://xahlee.org/emacs/ergonomic_emacs_keybinding.html'
If you turned on by mistake, the shortcut to call execute-extended-command is M-a."
nil
:lighter " ErgoEmacs" ;; TODO this should be nil (it is for testing purposes)
:global t
:keymap ergoemacs-keymap
(ergoemacs-hook-modes)
)
(provide 'ergoemacs-mode)

205
.emacs.d.backup/ergoemacs-keybindings-5.1/ergoemacs-unbind.el Normal file
View file

@ -0,0 +1,205 @@
;-*- coding: utf-8 -*-
;; this file define keys that we want to set/unset because they are already defined by ergoemacs minor mode
(eval-when-compile (require 'edmacro))
(defconst ergoemacs-redundant-keys
'( "C-/"
"C-0"
"C-1"
"C-2"
"C-3"
"C-4"
"C-5"
"C-6"
"C-7"
"C-8"
"C-9"
"C-<backspace>"
"C-<next>"
"C-<prior>"
"C-@"
"C-M-%"
"C-_"
"C-a"
"C-b"
"C-d"
"C-e"
"C-f"
"C-j"
"C-k"
"C-l"
"C-n"
"C-o"
"C-p"
"C-r"
"C-s"
"C-t"
"C-v"
"C-w"
"C-x 0"
"C-x 1"
"C-x 2"
"C-x 3"
"C-x 5 0"
"C-x 5 2"
"C-x C-d"
"C-x C-f"
"C-x C-s"
"C-x C-w"
"C-x d"
"C-x h"
"C-x o"
"C-y"
"C-z"
"M--"
"M-0"
"M-1"
"M-2"
"M-3"
"M-4"
"M-5"
"M-6"
"M-7"
"M-8"
"M-9"
"M-<"
"M->"
"M-@"
"M-\\"
"M-a"
"M-b"
"M-c"
"M-d"
"M-e"
"M-f"
"M-h"
"M-i"
"M-j"
"M-k"
"M-l"
"M-m"
"M-n"
"M-o"
"M-p"
"M-q"
"M-r"
"M-s"
"M-t"
"M-u"
"M-v"
"M-w"
"M-x"
"M-y"
"M-z"
"M-{"
"M-}"
)
)
;; Some exceptions we don't want to unset.
;; "C-g" 'keyboard-quit
;; "C-i" 'indent-for-tab-command
;; "C-m" 'newline-and-indent
;; "C-q" 'quote-insert
;; "C-u" 'universal-argument
;; "C-h" ; (help-map)
;; "C-x" ; (ctl-x-map)
;; "C-c" ; (prefix)
;; "M-g" ; (prefix)
(defvar ergoemacs-overridden-global-keys '()
"Alist to store overridden keyboard shortcuts in
`current-global-map' and other maps. Each item looks like '(MAP KEY OLD-COMMAND).")
(defun ergoemacs-unset-global-key (map key-s)
"Sets to nil the associated command for the specified key in specified map.
It is like:
\(define-key map (kbd key-s) nil))
But it saves the old command associated with the
specified key, so we can restore it when ergoemacs minor mode is
disabled at `ergoemacs-restore-global-keys'."
(let (key oldcmd)
(setq key (edmacro-parse-keys key-s))
;; get the old command associated with this key
(setq oldcmd (lookup-key map key))
;; save that shortcut in ergoemacs-overridden-global-keys
(if oldcmd
(add-to-list 'ergoemacs-overridden-global-keys (cons map (cons key-s (cons oldcmd nil)))))
;; redefine the key in the ergoemacs-keymap
(define-key map key nil)
)
)
(defun ergoemacs-unset-redundant-global-keys ()
"Unsets redundant keyboard shortcuts that should not be used in ErgoEmacs."
(mapc (lambda (x)
(ergoemacs-unset-global-key (current-global-map) x))
ergoemacs-redundant-keys)
)
(defun ergoemacs-restore-global-keys ()
"Restores all keyboard shortcuts that were overwritten by `ergoemacs-unbind-global-key'."
(mapc (lambda (x)
(define-key
(car x)
(edmacro-parse-keys (car (cdr x)))
(car (cdr (cdr x))))
)
ergoemacs-overridden-global-keys)
(setq ergoemacs-overridden-global-keys '()) ; clear the list
)
;; Based on describe-key-briefly
(defun where-is-old-binding (&optional key)
"Print the name of the function KEY invoked before to start ErgoEmacs minor mode."
(interactive
(let ((enable-disabled-menus-and-buttons t)
(cursor-in-echo-area t)
saved-yank-menu)
(unwind-protect
(let (key)
;; If yank-menu is empty, populate it temporarily, so that
;; "Select and Paste" menu can generate a complete event.
(when (null (cdr yank-menu))
(setq saved-yank-menu (copy-sequence yank-menu))
(menu-bar-update-yank-menu "(any string)" nil))
(setq key (read-key-sequence "Describe old key (or click or menu item): "))
;; If KEY is a down-event, read and discard the
;; corresponding up-event. Note that there are also
;; down-events on scroll bars and mode lines: the actual
;; event then is in the second element of the vector.
(and (vectorp key)
(let ((last-idx (1- (length key))))
(and (eventp (aref key last-idx))
(memq 'down (event-modifiers (aref key last-idx)))))
(read-event))
(list key))
;; Put yank-menu back as it was, if we changed it.
(when saved-yank-menu
(setq yank-menu (copy-sequence saved-yank-menu))
(fset 'yank-menu (cons 'keymap yank-menu))))))
(let (key-desc item-key item-cmd old-cmd)
(setq key-desc (key-description key))
(setq item ergoemacs-overridden-global-keys)
(while (and item (not old-cmd))
(setq item-key (car (cdr (car item))))
(setq item-cmd (car (cdr (cdr (car item)))))
(if (string= item-key key-desc)
(setq old-cmd item-cmd))
(setq item (cdr item))
)
(if old-cmd
(with-temp-buffer
(where-is old-cmd t)
(message "Key %s was bound to %s which is now invoked by %s"
key-desc old-cmd (buffer-string))
)
(message "Key %s was not bound to any command" key-desc)
)
)
)

385
.emacs.d.backup/ergoemacs-keybindings-5.1/functions.el Executable file
View file

@ -0,0 +1,385 @@
;-*- coding: utf-8 -*-
(require 'redo "redo.elc" t) ; for redo shortcut
(delete-selection-mode 1) ; turn on text selection highlighting and make typing override selected text (Note: when delete-selection-mode is on, then transient-mark-mode is automatically on too.)
(defun call-keyword-completion ()
"Call the command that has keyboard shortcut M-TAB."
(interactive)
(call-interactively (key-binding (kbd "M-TAB")))
)
(defun describe-major-mode ()
"Show inline doc for current major-mode."
;; code by Kevin Rodgers. 2009-02-25
(interactive)
(describe-function major-mode))
(defun copy-all ()
"Put the whole buffer content into the kill-ring.
If narrow-to-region is in effect, then copy that region only."
(interactive)
(kill-ring-save (point-min) (point-max))
(message "Buffer content copied")
)
(defun cut-all ()
"Cut the whole buffer content into the kill-ring.
If narrow-to-region is in effect, then cut that region only."
(interactive)
(kill-region (point-min) (point-max))
(message "Buffer content cut")
)
;;; TEXT SELECTION RELATED
(defun select-text-in-quote ()
"Select text between the nearest left and right delimiters.
Delimiters are paired characters: ()[]<>«»“”‘’「」【】, including \"\"."
(interactive)
(let (b1 b2)
(skip-chars-backward "^<>(“{[「«【\"‘")
(setq b1 (point))
(skip-chars-forward "^<>)”}]」】»\"’")
(setq b2 (point))
(set-mark b1)
)
)
;; by Nikolaj Schumacher, 2008-10-20. Released under GPL.
(defun semnav-up (arg)
(interactive "p")
(when (nth 3 (syntax-ppss))
(if (> arg 0)
(progn
(skip-syntax-forward "^\"")
(goto-char (1+ (point)))
(decf arg))
(skip-syntax-backward "^\"")
(goto-char (1- (point)))
(incf arg)))
(up-list arg))
;; by Nikolaj Schumacher, 2008-10-20. Released under GPL.
(defun extend-selection (arg &optional incremental)
"Select the current word.
Subsequent calls expands the selection to larger semantic unit."
(interactive (list (prefix-numeric-value current-prefix-arg)
(or (and transient-mark-mode mark-active)
(eq last-command this-command))))
(if incremental
(progn
(semnav-up (- arg))
(forward-sexp)
(mark-sexp -1))
(if (> arg 1)
(extend-selection (1- arg) t)
(if (looking-at "\\=\\(\\s_\\|\\sw\\)*\\_>")
(goto-char (match-end 0))
(unless (memq (char-before) '(?\) ?\"))
(forward-sexp)))
(mark-sexp -1))))
;;; TEXT TRANSFORMATION RELATED
(defun kill-line-backward ()
"Kill text between the beginning of the line to the cursor position.
If there's no text, delete the previous line ending."
(interactive)
(if (looking-back "\n")
(delete-char -1)
(kill-line 0)
)
)
(defun move-cursor-next-pane ()
"Move cursor to the next pane."
(interactive)
(other-window 1)
)
(defun move-cursor-previous-pane ()
"Move cursor to the previous pane."
(interactive)
(other-window -1)
)
(defun compact-uncompact-block ()
"Remove or add line endings on the current block of text.
This is similar to a toggle for fill-paragraph and unfill-paragraph
When there is a text selection, act on the region.
When in text mode, a paragraph is considerd a block. When in programing
language mode, the block is defined by between empty lines.
Todo: The programing language behavior is currently not done.
Right now, the code uses fill* functions, so does not work or work well
in programing lang modes. A proper implementation to compact is replacing
EOL chars by space when the EOL char is not inside string."
(interactive)
;; This command symbol has a property “'stateIsCompact-p”, the
;; possible values are t and nil. This property is used to easily
;; determine whether to compact or uncompact, when this command is
;; called again
(let (bds currentLineCharCount currentStateIsCompact
(bigFillColumnVal 4333999) (deactivate-mark nil))
(save-excursion
;; currentLineCharCount is used to determine whether current state
;; is compact or not, when the command is run for the first time
(setq currentLineCharCount
(progn
(setq bds (bounds-of-thing-at-point 'line))
(length (buffer-substring-no-properties (car bds) (cdr bds)))
;; Note: 'line includes eol if it is not buffer's last line
)
)
;; Determine whether the text is currently compact. when the last
;; command is this, then symbol property easily tells, but when
;; this command is used fresh, right now we use num of chars of
;; the cursor line as a way to define current compatness state
(setq currentStateIsCompact
(if (eq last-command this-command)
(get this-command 'stateIsCompact-p)
(if (> currentLineCharCount fill-column) t nil)
)
)
(if (and transient-mark-mode mark-active)
(if currentStateIsCompact
(fill-region (region-beginning) (region-end))
(let ((fill-column bigFillColumnVal))
(fill-region (region-beginning) (region-end)))
)
(if currentStateIsCompact
(fill-paragraph nil)
(let ((fill-column bigFillColumnVal))
(fill-paragraph nil))
)
)
(put this-command 'stateIsCompact-p (if currentStateIsCompact
nil t)) ) ) )
(defun shrink-whitespaces ()
"Remove white spaces around cursor to just one or none.
If current line does not contain non-white space chars, then remove blank lines to just one.
If current line contains non-white space chars, then shrink any whitespace char surrounding cursor to just one space.
If current line is a single space, remove that space.
Calling this command 3 times will always result in no whitespaces around cursor."
(interactive)
(let (
cursor-point
line-has-meat-p ; current line contains non-white space chars
spaceTabNeighbor-p
whitespace-begin whitespace-end
space-or-tab-begin space-or-tab-end
line-begin-pos line-end-pos
)
(save-excursion
;; todo: might consider whitespace as defined by syntax table, and also consider whitespace chars in unicode if syntax table doesn't already considered it.
(setq cursor-point (point))
(setq spaceTabNeighbor-p (if (or (looking-at " \\|\t") (looking-back " \\|\t")) t nil) )
(move-beginning-of-line 1) (setq line-begin-pos (point) )
(move-end-of-line 1) (setq line-end-pos (point) )
;; (re-search-backward "\n$") (setq line-begin-pos (point) )
;; (re-search-forward "\n$") (setq line-end-pos (point) )
(setq line-has-meat-p (if (< 0 (count-matches "[[:graph:]]" line-begin-pos line-end-pos)) t nil) )
(goto-char cursor-point)
(skip-chars-backward "\t ")
(setq space-or-tab-begin (point))
(skip-chars-backward "\t \n")
(setq whitespace-begin (point))
(goto-char cursor-point) (skip-chars-forward "\t ")
(setq space-or-tab-end (point))
(skip-chars-forward "\t \n")
(setq whitespace-end (point))
)
(if line-has-meat-p
(let (deleted-text)
(when spaceTabNeighbor-p
;; remove all whitespaces in the range
(setq deleted-text (delete-and-extract-region space-or-tab-begin space-or-tab-end))
;; insert a whitespace only if we have removed something
;; different that a simple whitespace
(if (not (string= deleted-text " "))
(insert " ") ) ) )
(progn
;; (delete-region whitespace-begin whitespace-end)
;; (insert "\n")
(delete-blank-lines)
)
;; todo: possibly code my own delete-blank-lines here for better efficiency, because delete-blank-lines seems complex.
)
)
)
(defun toggle-letter-case ()
"Toggle the letter case of current word or text selection.
Toggles from 3 cases: UPPER CASE, lower case, Title Case,
in that cyclic order."
(interactive)
(let (pos1 pos2 (deactivate-mark nil) (case-fold-search nil))
(if (and transient-mark-mode mark-active)
(setq pos1 (region-beginning)
pos2 (region-end))
(setq pos1 (car (bounds-of-thing-at-point 'word))
pos2 (cdr (bounds-of-thing-at-point 'word))))
(when (not (eq last-command this-command))
(save-excursion
(goto-char pos1)
(cond
((looking-at "[[:lower:]][[:lower:]]") (put this-command 'state "all lower"))
((looking-at "[[:upper:]][[:upper:]]") (put this-command 'state "all caps") )
((looking-at "[[:upper:]][[:lower:]]") (put this-command 'state "init caps") )
(t (put this-command 'state "all lower") )
)
)
)
(cond
((string= "all lower" (get this-command 'state))
(upcase-initials-region pos1 pos2) (put this-command 'state "init caps"))
((string= "init caps" (get this-command 'state))
(upcase-region pos1 pos2) (put this-command 'state "all caps"))
((string= "all caps" (get this-command 'state))
(downcase-region pos1 pos2) (put this-command 'state "all lower"))
)
)
)
;;; FRAME
(defun switch-to-next-frame ()
"Select the next frame on current display, and raise it."
(interactive)
(other-frame 1)
)
(defun switch-to-previous-frame ()
"Select the previous frame on current display, and raise it."
(interactive)
(other-frame -1)
)
;;; BUFFER RELATED
(defun next-user-buffer ()
"Switch to the next user buffer.
User buffers are those whose name does not start with *."
(interactive)
(next-buffer)
(let ((i 0))
(while (and (string-match "^*" (buffer-name)) (< i 50))
(setq i (1+ i)) (next-buffer) )))
(defun previous-user-buffer ()
"Switch to the previous user buffer.
User buffers are those whose name does not start with *."
(interactive)
(previous-buffer)
(let ((i 0))
(while (and (string-match "^*" (buffer-name)) (< i 50))
(setq i (1+ i)) (previous-buffer) )))
(defun next-emacs-buffer ()
"Switch to the next emacs buffer.
Emacs buffers are those whose name starts with *."
(interactive)
(next-buffer)
(let ((i 0))
(while (and (not (string-match "^*" (buffer-name))) (< i 50))
(setq i (1+ i)) (next-buffer) )))
(defun previous-emacs-buffer ()
"Switch to the previous emacs buffer.
Emacs buffers are those whose name starts with *."
(interactive)
(previous-buffer)
(let ((i 0))
(while (and (not (string-match "^*" (buffer-name))) (< i 50))
(setq i (1+ i)) (previous-buffer) )))
(defun new-empty-buffer ()
"Opens a new empty buffer."
(interactive)
(let ((buf (generate-new-buffer "untitled")))
(switch-to-buffer buf)
(funcall (and initial-major-mode))
(setq buffer-offer-save t)))
;; note: emacs won't offer to save a buffer that's
;; not associated with a file,
;; even if buffer-modified-p is true.
;; One work around is to define your own my-kill-buffer function
;; that wraps around kill-buffer, and check on the buffer modification
;; status to offer save
;; This custome kill buffer is close-current-buffer.
(defvar recently-closed-buffers (cons nil nil) "A list of recently closed buffers. The max number to track is controlled by the variable recently-closed-buffers-max.")
(defvar recently-closed-buffers-max 10 "The maximum length for recently-closed-buffers.")
(defun close-current-buffer ()
"Close the current buffer.
Similar to (kill-buffer (current-buffer)) with the following addition:
• prompt user to save if the buffer has been modified even if the buffer is not associated with a file.
• make sure the buffer shown after closing is a user buffer.
• if the buffer is a file, add the path to the list recently-closed-buffers.
A emacs buffer is one who's name starts with *.
Else it is a user buffer."
(interactive)
(let (emacsBuff-p isEmacsBufferAfter)
(if (string-match "^*" (buffer-name))
(setq emacsBuff-p t)
(setq emacsBuff-p nil))
;; offer to save buffers that are non-empty and modified, even for non-file visiting buffer. (because kill-buffer does not offer to save buffers that are not associated with files)
(when (and (buffer-modified-p)
(not emacsBuff-p)
(not (string-equal major-mode "dired-mode"))
(if (equal (buffer-file-name) nil)
(if (string-equal "" (save-restriction (widen) (buffer-string))) nil t)
t
)
)
(if (y-or-n-p
(concat "Buffer " (buffer-name) " modified; Do you want to save?"))
(save-buffer)
(set-buffer-modified-p nil)))
;; save to a list of closed buffer
(when (not (equal buffer-file-name nil))
(setq recently-closed-buffers
(cons (cons (buffer-name) (buffer-file-name)) recently-closed-buffers))
(when (> (length recently-closed-buffers) recently-closed-buffers-max)
(setq recently-closed-buffers (butlast recently-closed-buffers 1))
)
)
;; close
(kill-buffer (current-buffer))
;; if emacs buffer, switch to a user buffer
(if (string-match "^*" (buffer-name))
(setq isEmacsBufferAfter t)
(setq isEmacsBufferAfter nil))
(when isEmacsBufferAfter
(previous-user-buffer)
)
)
)

31
.emacs.d.backup/gentooish.el Normal file
View file

@ -0,0 +1,31 @@
(require 'color-theme)
(defun color-theme-gentooish ()
"Mostly green and purple color theme"
(interactive)
(color-theme-install
'(color-theme-gentooish
((foreground-color . "#c0c0c0")
(background-color . "#171717")
(border-color . "black")
(cursor-color . "green")
(background-mode . dark))
(bold ((t (:foreground "white" :weight normal))))
(font-lock-builtin-face ((((class color) (min-colors 88) (background dark)) (:foreground "#c476f1"))))
(font-lock-comment-face ((((class color) (min-colors 88) (background dark)) (:foreground "grey30" :slant italic))))
(font-lock-function-name-face ((((class color) (min-colors 88) (background dark)) (:foreground "#4cbbd1"))))
(font-lock-keyword-face ((((class color) (min-colors 88) (background dark)) (:foreground "#9a383a"))))
(font-lock-string-face ((((class color) (min-colors 88) (background dark)) (:background "#0f291a" :foreground "#5dff9e"))))
(hi-blue ((((background dark)) (:background "grey20"))))
(ido-first-match ((t (:background "#361d45" :foreground "#cf7dff" :weight bold))))
(ido-only-match ((((class color)) (:background "#361d45" :foreground "#cf7dff" :weight bold))))
(ido-subdir ((((min-colors 88) (class color)) (:foreground "#7dcfff"))))
(linum ((t (:inherit shadow :background "grey12"))))
(minibuffer-prompt ((((background dark)) (:foreground "#863335"))))
(mode-line ((((class color) (min-colors 88)) (:background "#333333" :foreground "#ffffff" :box (:line-width -1 :color "#333333")))))
(mode-line-highlight ((((class color) (min-colors 88)) nil)))
(mode-line-inactive ((default (:inherit mode-line)) (((class color) (min-colors 88) (background dark)) (:foreground "#8b8b8b" :weight light))))
(show-paren-match ((((class color) (background dark)) (:background "#005500"))))
(tool-bar ((default (:foreground "black")) (((type x w32 ns) (class color)) (:background "grey75")))))))
(provide 'gentooish)

1505
.emacs.d.backup/haskell-mode/ChangeLog Normal file
View file

File diff suppressed because it is too large Load diff

104
.emacs.d.backup/haskell-mode/NEWS Normal file
View file

@ -0,0 +1,104 @@
Changes since 2.5.1
* Parser corrections for haskell-indentation and haskell-decl-scan
* haskell-indentation: Pressing tab in the rightmost position now
moves to the leftmost, by default with a warning.
* Typo fix: One haskell-indentation variable had ended up in the
haskell-ntation customize group.
* haskell-hoogle aliased to hoogle, haskell-hayoo aliased to hayoo
* Courtesy of Alex Ott:
- Additional unicode symbols for font-lock-symbols: () == /= >= <= !! && || sqrt
- M-x haskell-hayoo search added, opens using browse-url
- Bug-fix for inferior-haskell-type
* If haskell-indentation errors out, it now fail-safes to inserting
a literal newline or deleting one character, for return and
backspace respectively.
Changes since 2.4:
* haskell-indentation, a new minor mode for indentation.
Changes since 2.3:
* Update license to GPLv3.
* New derived major mode for .hsc files.
* Removed the C-c C-r binding to reload a file. You can still call
inferior-haskell-reload-file (and/or bind it to your favorite key,
including C-c C-r) or you can now use C-u C-c C-l.
* C-c C-d looks up the symbol at point in the Haddock docs.
* Haddock comments are highlighted with font-lock-doc-face if it exists.
* Use `tex' rather than `latex' for haskell-literate.
* inf-haskell.el tries to find the root of the module hierarchy to determine
the root of a project (either by looking for a Cabal file or relying on
the `module' declaration line). If all works well, this will make C-c C-l
automatically switch to the root dir, so that dependencies in other
directories are automatically found. If it doesn't, complain and/or set
inferior-haskell-find-project-root to nil.
* The new command haskell-hoogle helps you query Hoogle from Emacs.
Changes since 2.2:
* Trivial support for Cabal package description files.
* Minor bug fixes.
Changes since 2.1:
* There are now commands to find type and info of identifiers by querying an
inferior haskell process. Available under C-c C-t, C-c C-i, and C-c M-.
* Indentation now looks back further, until a line that has no indentation.
To recover the earlier behavior of stopping at the first empty line
instead, configure haskell-indent-look-past-empty-line.
* inf-haskell can wait until a file load completes and jump directly to the
first error, like haskell-ghci and haskell-hugs used to do. See the var
inferior-haskell-wait-and-jump.
Changes since 2.0:
* inf-haskell uses ghci if hugs is absent.
* Fix up some binding conflicts (C-c C-o in haskell-doc)
* Many (hopefully minor) changes to the indentation.
* New symbols in haskell-font-lock-symbols-alist.
Changes since 1.45:
* keybindings C-c <char> have been replaced by C-c C-<char> so as not
to collide with minor modes.
* The following modules are now automatically activated without having to
add anything to haskell-mode-hook:
haskell-font-lock (just turn on global-font-lock-mode).
haskell-decl-scan (just bind `imenu' to some key).
* In recent Emacsen, haskell-doc hooks into eldoc-mode.
* haskell-hugs and haskell-ghci are superceded by inf-haskell.
* Indentation rules have been improved when using layout inside parens/braces.
* Symbols like -> and \ can be displayed as actual arrows and lambdas.
See haskell-font-lock-symbols.
* Tweaks to the font-lock settings. Among other things paren-matching
with things like \(x,y) should work correctly now.
* New maintainer <monnier@gnu.org>.
# arch-tag: e50204f2-98e4-438a-bcd1-a49afde5efa5

108
.emacs.d.backup/haskell-mode/README Normal file
View file

@ -0,0 +1,108 @@
Haskell Mode for Emacs
----------------------
Version number: v2.6.4.
This is the Haskell mode package for Emacs. Its use should be mostly
self-explanatory if you're accustomed to Emacs.
When Emacs is started up, it normally runs a file called ~/.emacs located in
your home directory. This file should contain all of your personal
customisations written as a series of Elisp commands. In order to install
the Haskell mode, you have to tell Emacs where to find it. This is done by
adding some commands to the init file.
Installation
------------
- If you are using XEmacs, the haskell-mode package may be available for
installation through the XEmacs package UI.
- If you are using Debian, you may be able to install the package
haskell-mode with a command like "apt-get install haskell-mode".
Otherwise:
- Download and unpack the basic mode and modules into a suitable directory,
e.g. ~/lib/emacs/haskell-mode/ where ~ stands for your home directory.
- Assuming you have placed the basic mode haskell-mode.el and the modules
you want to use in the directory ~/lib/emacs/haskell-mode/, add the
following command to your init file (~/.emacs):
(load "~/lib/emacs/haskell-mode/haskell-site-file")
This only loads the bare-bones haskell-mode. To make it useful, you
need additional modules; you can use the haskell customize-group
to edit the Haskell mode hook or, if you prefer manual setup, try
adding the following lines according to which modules you want to use:
(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
(add-hook 'haskell-mode-hook 'turn-on-haskell-indentation)
;;(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
;;(add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)
Note that the three indentation modules are mutually exclusive - add at
most one. Note that the line of code for simple indentation is commented
out (using a preceeding ;) in preference for the more advanced
indentation module. Installation is now complete!
The other modules are automatically loaded when needed in the following way:
- Font locking: just turn it on via `global-font-lock-mode' or do
(add-hook 'haskell-mode-hook 'font-lock-mode)
- Declaration scanning: just use M-x imenu or bind `imenu' to a key. E.g.
(global-set-key [(control meta down-mouse-3)] 'imenu) or you can also add
it to the menubar with (add-hook 'haskell-mode-hook 'imenu-add-menubar-index)
- Interaction with inferior Haskell interpreter: just hit C-c C-z or C-c C-l.
Setup
-----
Normally, inf-haskell automatically finds ghci or hugs in your PATH, but if
that's not the case (common under Windows), or if you need to specify your
preference, just tell Emacs which executable to use with:
(setq haskell-program-name "/some/where/ghci.exe")
If you want to use different settings when you use Cygwin Emacs and NTEmacs,
you can test the value of `system-type':
(setq haskell-program-name
(if (eq system-type 'cygwin)
"/cygdrive/c/ghc/ghc-6.8.1/bin/ghcii.sh"
"c:/ghc/ghc-6.8.1/bin/ghci.exe"))
Note that Cygwin binaries tend to interact poorly with NTEmacs, especially
w.r.t signal-handling.
Customization
-------------
Most customizations are on the functionality of a particular module.
See the documentation of that module for information on its
customisation.
Known problems
--------------
It seems that some version of XEmacs come without the fsf-compat package
(which provides functions such as `line-end-position') and it seems that
even if your XEmacs does have the fsf-compat package installed it does not
autoload its part. Thus you may have to install the fsf-compat package and
add (require 'goto-addr) in your .emacs.
Support
-------
Any problems, do mail me <svein.ove@aas.no> and I will try my best
to help you!
<!-- arch-tag: 25fc8494-611d-459f-9919-579c97f6313e -->

49
.emacs.d.backup/haskell-mode/fontlock.hs Normal file
View file

@ -0,0 +1,49 @@
-- Comments are coloured brightly and stand out clearly.
import qualified Foo as F hiding (toto)
import qualified Foo hiding (toto)
import qualified Foo as F (toto)
import Foo as F hiding (toto)
import Foo hiding (toto)
import Foo as F (toto)
hiding = 1
qualified = 3
as = 2
repeat :: a -> [a]
repeat xs = xs where xs = x:xs -- Keywords are also bright.
head :: [a] -> a
head (x:_) = x
head [] = error "PreludeList.head: empty list" -- Strings are coloured softly.
data Maybe a = Nothing | Just a -- Type constructors, data
deriving (Eq, Ord, Read, Show) -- constructors, class names
-- and module names are coloured
-- closer to ordinary code.
recognize +++ infix :: Operator Declarations
as `well` as = This Form
(+) and this one = as well
instance Show Toto where
fun1 arg1 = foo -- FIXME: `fun1' should be highlighted.
constStr = "hello \
\asdgfasgf\
\asf"
{-
map :: (a -> b) -> [a] -> [b] -- Commenting out large sections of
map f [] = [] -- code can be misleading. Coloured
map f (x:xs) = f x : map f xs -- comments reveal unused definitions.
-}
-- Note: the least significant bit is the first element of the list
bdigits :: Int -> [Int]
bdigits 0 = [0]
bdigits 1 = [1]
bdigits n | n>1 = n `mod` 2 :
-- arch-tag: a0d08cc2-4a81-4139-93bc-b3c6be0b5fb2

47
.emacs.d.backup/haskell-mode/haskell-c.el Normal file
View file

@ -0,0 +1,47 @@
;;; haskell-c.el --- Major mode for *.hsc files
;; Copyright (C) 2007 Stefan Monnier
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;;; Code:
(require 'haskell-mode)
(require 'haskell-font-lock)
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.hsc\\'" . haskell-c-mode))
(defvar haskell-c-font-lock-keywords
`(("^#[ \t]*[[:alnum:]]+" (0 font-lock-preprocessor-face))
,@haskell-font-lock-symbols))
;;;###autoload
(define-derived-mode haskell-c-mode haskell-mode "Haskell-C"
"Major mode for Haskell FFI files."
(set (make-local-variable 'font-lock-keywords)
(cons 'haskell-c-font-lock-keywords
(cdr font-lock-keywords))))
(provide 'haskell-c)
;; arch-tag: 51294c41-29f0-4599-9ce8-47fe2e7d3fd5
;;; haskell-c.el ends here

182
.emacs.d.backup/haskell-mode/haskell-cabal.el Normal file
View file

@ -0,0 +1,182 @@
;;; haskell-cabal.el --- Support for Cabal packages
;; Copyright (C) 2007, 2008 Stefan Monnier
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Todo:
;; - distinguish continued lines from indented lines.
;; - indent-line-function.
;; - outline-minor-mode.
;;; Code:
;; (defun haskell-cabal-extract-fields-from-doc ()
;; (require 'xml)
;; (require 'cl)
;; (let ((section (completing-read
;; "Section: "
;; '("general-fields" "library" "executable" "buildinfo"))))
;; (goto-char (point-min))
;; (search-forward (concat "<sect3 id=\"" section "\">")))
;; (let* ((xml (xml-parse-region
;; (progn (search-forward "<variablelist>") (match-beginning 0))
;; (progn (search-forward "</variablelist>") (point))))
;; (varlist (remove-if-not 'consp (cddar xml)))
;; (syms (mapcar (lambda (entry) (caddr (assq 'literal (assq 'term entry))))
;; varlist))
;; (fields (mapcar (lambda (sym) (substring-no-properties sym 0 -1)) syms)))
;; fields))
(eval-when-compile (require 'cl))
(defconst haskell-cabal-general-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "general-fields")
'("name" "version" "cabal-version" "license" "license-file" "copyright"
"author" "maintainer" "stability" "homepage" "package-url" "synopsis"
"description" "category" "tested-with" "build-depends" "data-files"
"extra-source-files" "extra-tmp-files"))
(defconst haskell-cabal-library-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "library")
'("exposed-modules"))
(defconst haskell-cabal-executable-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "executable")
'("executable" "main-is"))
(defconst haskell-cabal-buildinfo-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "buildinfo")
'("buildable" "other-modules" "hs-source-dirs" "extensions" "ghc-options"
"ghc-prof-options" "hugs-options" "nhc-options" "includes"
"install-includes" "include-dirs" "c-sources" "extra-libraries"
"extra-lib-dirs" "cc-options" "ld-options" "frameworks"))
(defvar haskell-cabal-mode-syntax-table
(let ((st (make-syntax-table)))
;; The comment syntax can't be described simply in syntax-table.
;; We could use font-lock-syntactic-keywords, but is it worth it?
;; (modify-syntax-entry ?- ". 12" st)
(modify-syntax-entry ?\n ">" st)
st))
(defvar haskell-cabal-font-lock-keywords
;; The comment syntax can't be described simply in syntax-table.
;; We could use font-lock-syntactic-keywords, but is it worth it?
'(("^[ \t]*--.*" . font-lock-comment-face)
("^ *\\([^ \t:]+\\):" (1 font-lock-keyword-face))
("^\\(Library\\)[ \t]*\\({\\|$\\)" (1 font-lock-keyword-face))
("^\\(Executable\\)[ \t]+\\([^\n \t]*\\)"
(1 font-lock-keyword-face) (2 font-lock-function-name-face))
("^\\(Flag\\)[ \t]+\\([^\n \t]*\\)"
(1 font-lock-keyword-face) (2 font-lock-constant-face))
("^ *\\(if\\)[ \t]+.*\\({\\|$\\)" (1 font-lock-keyword-face))
("^ *\\(}[ \t]*\\)?\\(else\\)[ \t]*\\({\\|$\\)"
(2 font-lock-keyword-face))))
(defvar haskell-cabal-buffers nil
"List of Cabal buffers.")
;; (defsubst* inferior-haskell-string-prefix-p (str1 str2)
;; "Return non-nil if STR1 is a prefix of STR2"
;; (eq t (compare-strings str2 nil (length str1) str1 nil nil)))
(defun haskell-cabal-find-file ()
"Return a buffer visiting the cabal file of the current directory, or nil."
(catch 'found
;; ;; First look for it in haskell-cabal-buffers.
;; (dolist (buf haskell-cabal-buffers)
;; (if (inferior-haskell-string-prefix-p
;; (with-current-buffer buf default-directory) default-directory)
;; (throw 'found buf)))
;; Then look up the directory hierarchy.
(let ((user (nth 2 (file-attributes default-directory)))
;; Abbreviate, so as to stop when we cross ~/.
(root (abbreviate-file-name default-directory))
files)
(while (and root (equal user (nth 2 (file-attributes root))))
(if (setq files (directory-files root 'full "\\.cabal\\'"))
;; Avoid the .cabal directory.
(dolist (file files (throw 'found nil))
(unless (file-directory-p file)
(throw 'found (find-file-noselect file))))
(if (equal root
(setq root (file-name-directory
(directory-file-name root))))
(setq root nil))))
nil)))
(defun haskell-cabal-buffers-clean (&optional buffer)
(let ((bufs ()))
(dolist (buf haskell-cabal-buffers)
(if (and (buffer-live-p buf) (not (eq buf buffer))
(with-current-buffer buf (derived-mode-p 'haskell-cabal-mode)))
(push buf bufs)))
(setq haskell-cabal-buffers bufs)))
(defun haskell-cabal-unregister-buffer ()
(haskell-cabal-buffers-clean (current-buffer)))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode))
;;;###autoload
(define-derived-mode haskell-cabal-mode fundamental-mode "Haskell-Cabal"
"Major mode for Cabal package description files."
(set (make-local-variable 'font-lock-defaults)
'(haskell-cabal-font-lock-keywords t t nil nil))
(add-to-list 'haskell-cabal-buffers (current-buffer))
(add-hook 'change-major-mode-hook 'haskell-cabal-unregister-buffer nil 'local)
(add-hook 'kill-buffer-hook 'haskell-cabal-unregister-buffer nil 'local)
(set (make-local-variable 'comment-start) "-- ")
(set (make-local-variable 'comment-start-skip) "\\(^[ \t]*\\)--[ \t]*")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-end-skip) "[ ]*\\(\\s>\\|\n\\)")
)
(defun haskell-cabal-get-setting (name)
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote name)
":[ \t]*\\(.*\\(\n[ \t]+[ \t\n].*\\)*\\)")
nil t)
(let ((val (match-string 1))
(start 1))
(when (match-end 2) ;Multiple lines.
;; The documentation is not very precise about what to do about
;; the \n and the indentation: are they part of the value or
;; the encoding? I take the point of view that \n is part of
;; the value (so that values can span multiple lines as well),
;; and that only the first char in the indentation is part of
;; the encoding, the rest is part of the value (otherwise, lines
;; in the value cannot start with spaces or tabs).
(while (string-match "^[ \t]\\(?:\\.$\\)?" val start)
(setq start (1+ (match-beginning 0)))
(setq val (replace-match "" t t val))))
val)))))
(provide 'haskell-cabal)
;; arch-tag: d455f920-5e4d-42b6-a2c7-4a7e84a05c29
;;; haskell-cabal.el ends here

698
.emacs.d.backup/haskell-mode/haskell-decl-scan.el Normal file
View file

@ -0,0 +1,698 @@
;;; haskell-decl-scan.el --- Declaration scanning module for Haskell Mode
;; Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc.
;; Copyright (C) 1997-1998 Graeme E Moss
;; Author: 1997-1998 Graeme E Moss <gem@cs.york.ac.uk>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
;; Keywords: declarations menu files Haskell
;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-decl-scan.el?rev=HEAD
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; Top-level declarations are scanned and placed in a menu. Supports
;; full Latin1 Haskell 1.4 as well as literate scripts.
;;
;;
;; Installation:
;;
;; To turn declaration scanning on for all Haskell buffers under the
;; Haskell mode of Moss&Thorn, add this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
;;
;; Otherwise, call `turn-on-haskell-decl-scan'.
;;
;;
;; Customisation:
;;
;; None available so far.
;;
;;
;; History:
;;
;; If you have any problems or suggestions, after consulting the list
;; below, email gem@cs.york.ac.uk quoting the version of the library
;; you are using, the version of Emacs you are using, and a small
;; example of the problem or suggestion. Note that this library
;; requires a reasonably recent version of Emacs.
;;
;; Uses `imenu' under Emacs, and `func-menu' under XEmacs.
;;
;; Version 1.2:
;; Added support for LaTeX-style literate scripts.
;;
;; Version 1.1:
;; Use own syntax table. Fixed bug for very small buffers. Use
;; markers instead of pointers (markers move with the text).
;;
;; Version 1.0:
;; Brought over from Haskell mode v1.1.
;;
;;
;; Present Limitations/Future Work (contributions are most welcome!):
;;
;; . Declarations requiring information extending beyond starting line
;; don't get scanned properly, eg.
;; > class Eq a =>
;; > Test a
;;
;; . Comments placed in the midst of the first few lexemes of a
;; declaration will cause havoc, eg.
;; > infixWithComments :: Int -> Int -> Int
;; > x {-nastyComment-} `infixWithComments` y = x + y
;; but are not worth worrying about.
;;
;; . Would be nice to scan other top-level declarations such as
;; methods of a class, datatype field labels... any more?
;;
;; . Support for GreenCard?
;;
;; . Re-running (literate-)haskell-imenu should not cause the problems
;; that it does. The ability to turn off scanning would also be
;; useful. (Note that re-running (literate-)haskell-mode seems to
;; cause no problems.)
;;
;; . Inconsistency: we define the start of a declaration in `imenu' as
;; the start of the line the declaration starts on, but in
;; `func-menu' as the start of the name that the declaration is
;; given (eg. "class Eq a => Ord a ..." starts at "class" in `imenu'
;; but at "Ord" in `func-menu'). This avoids rescanning of the
;; buffer by the goto functions of `func-menu' but allows `imenu' to
;; have the better definition of the start of the declaration (IMO).
;;
;; . `func-menu' cannot cope well with spaces in declaration names.
;; This is unavoidable in "instance Eq Int" (changing the spaces to
;; underscores would cause rescans of the buffer). Note though that
;; `fume-prompt-function-goto' (usually bound to "C-c g") does cope
;; with spaces okay.
;;
;; . Would like to extend the goto functions given by `func-menu'
;; under XEmacs to Emacs. Would have to implement these
;; ourselves as `imenu' does not provide them.
;;
;; . `func-menu' uses its own syntax table when grabbing a declaration
;; name to lookup (why doesn't it use the syntax table of the
;; buffer?) so some declaration names will not be grabbed correctly,
;; eg. "fib'" will be grabbed as "fib" since "'" is not a word or
;; symbol constituent under the syntax table `func-menu' uses.
;; All functions/variables start with
;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'.
;; The imenu support is based on code taken from `hugs-mode',
;; thanks go to Chris Van Humbeeck.
;; Version.
;;; Code:
(require 'haskell-mode)
;;###autoload
;; As `cl' defines macros that `imenu' uses, we must require them at
;; compile time.
(eval-when-compile
(require 'cl)
(condition-case nil
(require 'imenu)
(error nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; General declaration scanning functions.
(defalias 'haskell-ds-match-string
(if (fboundp 'match-string-no-properties)
'match-string-no-properties
(lambda (num)
"As `match-string' except that the string is stripped of properties."
(format "%s" (match-string num)))))
(defvar haskell-ds-start-keywords-re
(concat "\\(\\<"
"class\\|data\\|i\\(mport\\|n\\(fix\\(\\|[lr]\\)\\|stance\\)\\)\\|"
"module\\|primitive\\|type\\|newtype"
"\\)\\>")
"Keywords that may start a declaration.")
(defvar haskell-ds-syntax-table
(let ((table (copy-syntax-table haskell-mode-syntax-table)))
(modify-syntax-entry ?\' "w" table)
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?\\ "_" table)
table)
"Syntax table used for Haskell declaration scanning.")
(defun haskell-ds-get-variable (prefix)
"Return variable involved in value binding or type signature.
Assumes point is looking at the regexp PREFIX followed by the
start of a declaration (perhaps in the middle of a series of
declarations concerning a single variable). Otherwise return nil.
Point is not changed."
;; I think I can now handle all declarations bar those with comments
;; nested before the second lexeme.
(save-excursion
(with-syntax-table haskell-ds-syntax-table
(if (looking-at prefix) (goto-char (match-end 0)))
;; Keyword.
(if (looking-at haskell-ds-start-keywords-re)
nil
(or ;; Parenthesized symbolic variable.
(and (looking-at "(\\(\\s_+\\))") (haskell-ds-match-string 1))
;; General case.
(if (looking-at
(if (eq ?\( (char-after))
;; Skip paranthesised expression.
(progn
(forward-sexp)
;; Repeating this code and avoiding moving point if
;; possible speeds things up.
"\\(\\'\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)")
"\\(\\sw+\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)"))
(let ((match2 (haskell-ds-match-string 2)))
;; Weed out `::', `=' and `|' from potential infix
;; symbolic variable.
(if (member match2 '("::" "=" "|"))
;; Variable identifier.
(haskell-ds-match-string 1)
(if (eq (aref match2 0) ?\`)
;; Infix variable identifier.
(haskell-ds-match-string 3)
;; Infix symbolic variable.
match2))))
;; Variable identifier.
(and (looking-at "\\sw+") (haskell-ds-match-string 0)))))))
(defun haskell-ds-move-to-start-regexp (inc regexp)
"Move to beginning of line that succeeds/precedes (INC = 1/-1)
current line that starts with REGEXP and is not in `font-lock-comment-face'."
;; Making this defsubst instead of defun appears to have little or
;; no effect on efficiency. It is probably not called enough to do
;; so.
(while (and (= (forward-line inc) 0)
(or (not (looking-at regexp))
(eq (get-text-property (point) 'face)
'font-lock-comment-face)))))
(defun haskell-ds-move-to-start-regexp-skipping-comments (inc regexp)
"Like haskell-ds-move-to-start-regexp, but uses syntax-ppss to
skip comments"
(let (p)
(loop
do (setq p (point))
(haskell-ds-move-to-start-regexp inc regexp)
while (and (nth 4 (syntax-ppss))
(/= p (point))))))
(defvar literate-haskell-ds-line-prefix "> ?"
"Regexp matching start of a line of Bird-style literate code.
Current value is \"> \" as we assume top-level declarations start
at column 3. Must not contain the special \"^\" regexp as we may
not use the regexp at the start of a regexp string. Note this is
only for `imenu' support.")
(defvar haskell-ds-start-decl-re "\\(\\sw\\|(\\)"
"The regexp that starts a Haskell declaration.")
(defvar literate-haskell-ds-start-decl-re
(concat literate-haskell-ds-line-prefix haskell-ds-start-decl-re)
"The regexp that starts a Bird-style literate Haskell declaration.")
(defun haskell-ds-move-to-decl (direction bird-literate fix)
"General function for moving to the start of a declaration,
either forwards or backwards from point, with normal or with Bird-style
literate scripts. If DIRECTION is t, then forward, else backward. If
BIRD-LITERATE is t, then treat as Bird-style literate scripts, else
normal scripts. Returns point if point is left at the start of a
declaration, and nil otherwise, ie. because point is at the beginning
or end of the buffer and no declaration starts there. If FIX is t,
then point does not move if already at the start of a declaration."
;; As `haskell-ds-get-variable' cannot separate an infix variable
;; identifier out of a value binding with non-alphanumeric first
;; argument, this function will treat such value bindings as
;; separate from the declarations surrounding it.
(let ( ;; The variable typed or bound in the current series of
;; declarations.
name
;; The variable typed or bound in the new declaration.
newname
;; Hack to solve hard problem for Bird-style literate scripts
;; that start with a declaration. We are in the abyss if
;; point is before start of this declaration.
abyss
(line-prefix (if bird-literate literate-haskell-ds-line-prefix ""))
;; The regexp to match for the start of a declaration.
(start-decl-re (if bird-literate
literate-haskell-ds-start-decl-re
haskell-ds-start-decl-re))
(increment (if direction 1 -1))
(bound (if direction (point-max) (point-min))))
;; Change syntax table.
(with-syntax-table haskell-ds-syntax-table
;; move to beginning of line that starts the "current
;; declaration" (dependent on DIRECTION and FIX), and then get
;; the variable typed or bound by this declaration, if any.
(let ( ;; Where point was at call of function.
(here (point))
;; Where the declaration on this line (if any) starts.
(start (progn
(beginning-of-line)
;; Checking the face to ensure a declaration starts
;; here seems to be the only addition to make this
;; module support LaTeX-style literate scripts.
(if (and (looking-at start-decl-re)
(not (eq (get-text-property (point) 'face)
'font-lock-comment-face)))
(match-beginning 1)))))
(if (and start
;; This complicated boolean determines whether we
;; should include the declaration that starts on the
;; current line as the "current declaration" or not.
(or (and (or (and direction (not fix))
(and (not direction) fix))
(>= here start))
(and (or (and direction fix)
(and (not direction) (not fix)))
(> here start))))
;; If so, we are already at start of the current line, so
;; do nothing.
()
;; If point was before start of a declaration on the first
;; line of the buffer (possible for Bird-style literate
;; scripts) then we are in the abyss.
(if (and start (bobp))
(setq abyss t)
;; Otherwise we move to the start of the first declaration
;; on a line preceeding the current one, skipping comments
(haskell-ds-move-to-start-regexp-skipping-comments -1 start-decl-re))))
;; If we are in the abyss, position and return as appropriate.
(if abyss
(if (not direction)
nil
(re-search-forward (concat "\\=" line-prefix) nil t)
(point))
;; Get the variable typed or bound by this declaration, if any.
(setq name (haskell-ds-get-variable line-prefix))
(if (not name)
;; If no such variable, stop at the start of this
;; declaration if moving backward, or move to the next
;; declaration if moving forward.
(if direction
(haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re))
;; If there is a variable, find the first
;; succeeding/preceeding declaration that does not type or
;; bind it. Check for reaching start/end of buffer and
;; comments.
(haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re)
(while (and (/= (point) bound)
(and (setq newname (haskell-ds-get-variable line-prefix))
(string= name newname)))
(setq name newname)
(haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re))
;; If we are going backward, and have either reached a new
;; declaration or the beginning of a buffer that does not
;; start with a declaration, move forward to start of next
;; declaration (which must exist). Otherwise, we are done.
(if (and (not direction)
(or (and (looking-at start-decl-re)
(not (string= name
;; Note we must not use
;; newname here as this may
;; not have been set if we
;; have reached the beginning
;; of the buffer.
(haskell-ds-get-variable
line-prefix))))
(and (not (looking-at start-decl-re))
(bobp))))
(haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re)))
;; Store whether we are at the start of a declaration or not.
;; Used to calculate final result.
(let ((at-start-decl (looking-at start-decl-re)))
;; If we are at the beginning of a line, move over
;; line-prefix, if present at point.
(if (bolp)
(re-search-forward (concat "\\=" line-prefix) (point-max) t))
;; Return point if at the start of a declaration and nil
;; otherwise.
(if at-start-decl (point) nil))))))
(defun haskell-ds-bird-p ()
(and (boundp 'haskell-literate) (eq haskell-literate 'bird)))
(defun haskell-ds-backward-decl ()
"Move point backward to the first character preceding the current
point that starts a top-level declaration. A series of declarations
concerning one variable is treated as one declaration by this
function. So, if point is within a top-level declaration then move it
to the start of that declaration. If point is already at the start of
a top-level declaration, then move it to the start of the preceding
declaration. Returns point if point is left at the start of a
declaration, and nil otherwise, ie. because point is at the beginning
of the buffer and no declaration starts there."
(interactive)
(haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil))
(defun haskell-ds-forward-decl ()
"As `haskell-ds-backward-decl' but forward."
(interactive)
(haskell-ds-move-to-decl t (haskell-ds-bird-p) nil))
(defun haskell-ds-generic-find-next-decl (bird-literate)
"Find the name, position and type of the declaration at or after point.
Return ((NAME . (START-POSITION . NAME-POSITION)) . TYPE)
if one exists and nil otherwise. The start-position is at the start
of the declaration, and the name-position is at the start of the name
of the declaration. The name is a string, the positions are buffer
positions and the type is one of the symbols \"variable\", \"datatype\",
\"class\", \"import\" and \"instance\"."
(let (;; The name, type and name-position of the declaration to
;; return.
name
type
name-pos
;; Buffer positions marking the start and end of the space
;; containing a declaration.
start
end)
;; Change to declaration scanning syntax.
(with-syntax-table haskell-ds-syntax-table
;; Stop when we are at the end of the buffer or when a valid
;; declaration is grabbed.
(while (not (or (eobp) name))
;; Move forward to next declaration at or after point.
(haskell-ds-move-to-decl t bird-literate t)
;; Start and end of search space is currently just the starting
;; line of the declaration.
(setq start (point)
end (line-end-position))
(cond
;; If the start of the top-level declaration does not begin
;; with a starting keyword, then (if legal) must be a type
;; signature or value binding, and the variable concerned is
;; grabbed.
((not (looking-at haskell-ds-start-keywords-re))
(setq name (haskell-ds-get-variable ""))
(if name
(progn
(setq type 'variable)
(re-search-forward (regexp-quote name) end t)
(setq name-pos (match-beginning 0)))))
;; User-defined datatype declaration.
((re-search-forward "\\=\\(data\\|newtype\\|type\\)\\>" end t)
(re-search-forward "=>" end t)
(if (looking-at "[ \t]*\\(\\sw+\\)")
(progn
(setq name (haskell-ds-match-string 1))
(setq name-pos (match-beginning 1))
(setq type 'datatype))))
;; Class declaration.
((re-search-forward "\\=class\\>" end t)
(re-search-forward "=>" end t)
(if (looking-at "[ \t]*\\(\\sw+\\)")
(progn
(setq name (haskell-ds-match-string 1))
(setq name-pos (match-beginning 1))
(setq type 'class))))
;; Import declaration.
((looking-at "import[ \t]+\\(qualified[ \t]+\\)?\\(\\(?:\\sw\\|.\\)+\\)")
(setq name (haskell-ds-match-string 2))
(setq name-pos (match-beginning 2))
(setq type 'import))
;; Instance declaration.
((re-search-forward "\\=instance[ \t]+" end t)
(re-search-forward "=>[ \t]+" end t)
;; The instance "title" starts just after the `instance' (and
;; any context) and finishes just before the _first_ `where'
;; if one exists. This solution is ugly, but I can't find a
;; nicer one---a simple regexp will pick up the last `where',
;; which may be rare but nevertheless...
(setq name-pos (point))
(setq name (format "%s"
(buffer-substring
(point)
(progn
;; Look for a `where'.
(if (re-search-forward "\\<where\\>" end t)
;; Move back to just before the `where'.
(progn
(re-search-backward "\\s-where")
(point))
;; No `where' so move to last non-whitespace
;; before `end'.
(progn
(goto-char end)
(skip-chars-backward " \t")
(point)))))))
;; If we did not manage to extract a name, cancel this
;; declaration (eg. when line ends in "=> ").
(if (string-match "^[ \t]*$" name) (setq name nil))
(setq type 'instance)))
;; Move past start of current declaration.
(goto-char end))
;; If we have a valid declaration then return it, otherwise return
;; nil.
(if name
(cons (cons name (cons (copy-marker start t) (copy-marker name-pos t)))
type)
nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Declaration scanning via `imenu'.
(defun haskell-ds-create-imenu-index ()
"Function for finding `imenu' declarations in Haskell mode.
Finds all declarations (classes, variables, imports, instances and
datatypes) in a Haskell file for the `imenu' package."
;; Each list has elements of the form `(INDEX-NAME . INDEX-POSITION)'.
;; These lists are nested using `(INDEX-TITLE . INDEX-ALIST)'.
(let* ((bird-literate (haskell-ds-bird-p))
(index-alist '())
(index-class-alist '()) ;; Classes
(index-var-alist '()) ;; Variables
(index-imp-alist '()) ;; Imports
(index-inst-alist '()) ;; Instances
(index-type-alist '()) ;; Datatypes
;; Variables for showing progress.
(bufname (buffer-name))
(divisor-of-progress (max 1 (/ (buffer-size) 100)))
;; The result we wish to return.
result)
(goto-char (point-min))
;; Loop forwards from the beginning of the buffer through the
;; starts of the top-level declarations.
(while (< (point) (point-max))
(message "Scanning declarations in %s... (%3d%%)" bufname
(/ (- (point) (point-min)) divisor-of-progress))
;; Grab the next declaration.
(setq result (haskell-ds-generic-find-next-decl bird-literate))
(if result
;; If valid, extract the components of the result.
(let* ((name-posns (car result))
(name (car name-posns))
(posns (cdr name-posns))
(start-pos (car posns))
(type (cdr result))
;; Place `(name . start-pos)' in the correct alist.
(sym (cdr (assq type
'((variable . index-var-alist)
(datatype . index-type-alist)
(class . index-class-alist)
(import . index-imp-alist)
(instance . index-inst-alist))))))
(set sym (cons (cons name start-pos) (symbol-value sym))))))
;; Now sort all the lists, label them, and place them in one list.
(message "Sorting declarations in %s..." bufname)
(and index-type-alist
(push (cons "Datatypes"
(sort index-type-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(and index-inst-alist
(push (cons "Instances"
(sort index-inst-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(and index-imp-alist
(push (cons "Imports"
(sort index-imp-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(and index-var-alist
(push (cons "Variables"
(sort index-var-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(and index-class-alist
(push (cons "Classes"
(sort index-class-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(message "Sorting declarations in %s...done" bufname)
;; Return the alist.
index-alist))
(defun haskell-ds-imenu-label-cmp (el1 el2)
"Predicate to compare labels in lists from `haskell-ds-create-imenu-index'."
(string< (car el1) (car el2)))
(defun haskell-ds-imenu ()
"Install `imenu' for Haskell scripts."
(setq imenu-create-index-function 'haskell-ds-create-imenu-index)
(if (fboundp 'imenu-add-to-menubar)
(imenu-add-to-menubar "Declarations")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Declaration scanning via `func-menu'.
(defun haskell-ds-func-menu-next (buffer)
"Non-literate Haskell version of `haskell-ds-generic-func-menu-next'."
(haskell-ds-generic-func-menu-next (haskell-ds-bird-p) buffer))
(defun haskell-ds-generic-func-menu-next (bird-literate buffer)
"Return `(name . pos)' of next declaration."
(set-buffer buffer)
(let ((result (haskell-ds-generic-find-next-decl bird-literate)))
(if result
(let* ((name-posns (car result))
(name (car name-posns))
(posns (cdr name-posns))
(name-pos (cdr posns))
;;(type (cdr result))
)
(cons ;(concat
;; func-menu has problems with spaces, and adding a
;; qualifying keyword will not allow the "goto fn"
;; functions to work properly. Sigh.
;; (cond
;; ((eq type 'variable) "")
;; ((eq type 'datatype) "datatype ")
;; ((eq type 'class) "class ")
;; ((eq type 'import) "import ")
;; ((eq type 'instance) "instance "))
name;)
name-pos))
nil)))
(defvar haskell-ds-func-menu-regexp
(concat "^" haskell-ds-start-decl-re)
"Regexp to match the start of a possible declaration.")
(defvar literate-haskell-ds-func-menu-regexp
(concat "^" literate-haskell-ds-start-decl-re)
"As `haskell-ds-func-menu-regexp' but for Bird-style literate scripts.")
(defvar fume-menubar-menu-name)
(defvar fume-function-name-regexp-alist)
(defvar fume-find-function-name-method-alist)
(defun haskell-ds-func-menu ()
"Use `func-menu' to establish declaration scanning for Haskell scripts."
(require 'func-menu)
(set (make-local-variable 'fume-menubar-menu-name) "Declarations")
(set (make-local-variable 'fume-function-name-regexp-alist)
(if (haskell-ds-bird-p)
'((haskell-mode . literate-haskell-ds-func-menu-regexp))
'((haskell-mode . haskell-ds-func-menu-regexp))))
(set (make-local-variable 'fume-find-function-name-method-alist)
'((haskell-mode . haskell-ds-func-menu-next)))
(fume-add-menubar-entry)
(local-set-key "\C-cl" 'fume-list-functions)
(local-set-key "\C-cg" 'fume-prompt-function-goto)
(local-set-key [(meta button1)] 'fume-mouse-function-goto))
;; The main functions to turn on declaration scanning.
(defun turn-on-haskell-decl-scan ()
(interactive)
"Unconditionally activate `haskell-decl-scan-mode'."
(haskell-decl-scan-mode 1))
(defvar haskell-decl-scan-mode nil)
(make-variable-buffer-local 'haskell-decl-scan-mode)
;;;###autoload
(defun haskell-decl-scan-mode (&optional arg)
"Minor mode for declaration scanning for Haskell mode.
Top-level declarations are scanned and listed in the menu item \"Declarations\".
Selecting an item from this menu will take point to the start of the
declaration.
\\[haskell-ds-forward-decl] and \\[haskell-ds-backward-decl] move forward and backward to the start of a declaration.
Under XEmacs, the following keys are also defined:
\\[fume-list-functions] lists the declarations of the current buffer,
\\[fume-prompt-function-goto] prompts for a declaration to move to, and
\\[fume-mouse-function-goto] moves to the declaration whose name is at point.
This may link with `haskell-doc' (only for Emacs currently).
For non-literate and LaTeX-style literate scripts, we assume the
common convention that top-level declarations start at the first
column. For Bird-style literate scripts, we assume the common
convention that top-level declarations start at the third column,
ie. after \"> \".
Anything in `font-lock-comment-face' is not considered for a
declaration. Therefore, using Haskell font locking with comments
coloured in `font-lock-comment-face' improves declaration scanning.
To turn on declaration scanning for all Haskell buffers, add this to
.emacs:
(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
To turn declaration scanning on for the current buffer, call
`turn-on-haskell-decl-scan'.
Literate Haskell scripts are supported: If the value of
`haskell-literate' (automatically set by the Haskell mode of
Moss&Thorn) is `bird', a Bird-style literate script is assumed. If it
is nil or `tex', a non-literate or LaTeX-style literate script is
assumed, respectively.
Invokes `haskell-decl-scan-mode-hook'."
(interactive)
(if (boundp 'beginning-of-defun-function)
(if haskell-decl-scan-mode
(progn
(set (make-local-variable 'beginning-of-defun-function)
'haskell-ds-backward-decl)
(set (make-local-variable 'end-of-defun-function)
'haskell-ds-forward-decl))
(kill-local-variable 'beginning-of-defun-function)
(kill-local-variable 'end-of-defun-function))
(local-set-key "\M-\C-e"
(if haskell-decl-scan-mode 'haskell-ds-forward-decl))
(local-set-key "\M-\C-a"
(if haskell-decl-scan-mode 'haskell-ds-backward-decl)))
(if haskell-decl-scan-mode
(if (fboundp 'imenu)
(haskell-ds-imenu)
(haskell-ds-func-menu))
;; How can we cleanly remove that menus?
(local-set-key [menu-bar index] nil))
(run-hooks 'haskell-decl-scan-mode-hook))
;; Provide ourselves:
(provide 'haskell-decl-scan)
;; arch-tag: f4335fd8-4b6c-472e-9899-004d47d94818
;;; haskell-decl-scan.el ends here

1932
.emacs.d.backup/haskell-mode/haskell-doc.el Normal file
View file

File diff suppressed because it is too large Load diff

633
.emacs.d.backup/haskell-mode/haskell-font-lock.el Normal file
View file

@ -0,0 +1,633 @@
;;; haskell-font-lock.el --- Font locking module for Haskell Mode
;; Copyright 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright 1997-1998 Graeme E Moss, and Tommy Thorn
;; Authors: 1997-1998 Graeme E Moss <gem@cs.york.ac.uk> and
;; Tommy Thorn <thorn@irisa.fr>
;; 2003 Dave Love <fx@gnu.org>
;; Keywords: faces files Haskell
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; To support fontification of standard Haskell keywords, symbols,
;; functions, etc. Supports full Haskell 1.4 as well as LaTeX- and
;; Bird-style literate scripts.
;;
;; Installation:
;;
;; To turn font locking on for all Haskell buffers under the Haskell
;; mode of Moss&Thorn, add this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock)
;;
;; Otherwise, call `turn-on-haskell-font-lock'.
;;
;;
;; Customisation:
;;
;; The colours and level of font locking may be customised. See the
;; documentation on `turn-on-haskell-font-lock' for more details.
;;
;;
;; History:
;;
;; If you have any problems or suggestions, after consulting the list
;; below, email gem@cs.york.ac.uk and thorn@irisa.fr quoting the
;; version of the mode you are using, the version of Emacs you are
;; using, and a small example of the problem or suggestion. Note that
;; this module requires a reasonably recent version of Emacs. It
;; requires Emacs 21 to cope with Unicode characters and to do proper
;; syntactic fontification.
;;
;; Version 1.3:
;; From Dave Love:
;; Support for proper behaviour (including with Unicode identifiers)
;; in Emacs 21 only hacked in messily to avoid disturbing the old
;; stuff. Needs integrating more cleanly. Allow literate comment
;; face to be customized. Some support for fontifying definitions.
;; (I'm not convinced the faces should be customizable -- fontlock
;; faces are normally expected to be consistent.)
;;
;; Version 1.2:
;; Added support for LaTeX-style literate scripts. Allow whitespace
;; after backslash to end a line for string continuations.
;;
;; Version 1.1:
;; Use own syntax table. Use backquote (neater). Stop ''' being
;; highlighted as quoted character. Fixed `\"' fontification bug
;; in comments.
;;
;; Version 1.0:
;; Brought over from Haskell mode v1.1.
;;
;; Present Limitations/Future Work (contributions are most welcome!):
;;
;; . Debatable whether `()' `[]' `(->)' `(,)' `(,,)' etc. should be
;; highlighted as constructors or not. Should the `->' in
;; `id :: a -> a' be considered a constructor or a keyword? If so,
;; how do we distinguish this from `\x -> x'? What about the `\'?
;;
;; . XEmacs can support both `--' comments and `{- -}' comments
;; simultaneously. If XEmacs is detected, this should be used.
;;
;; . Support for GreenCard?
;;
;; All functions/variables start with
;; `(turn-(on/off)-)haskell-font-lock' or `haskell-fl-'.
;;; Code:
(eval-when-compile
(require 'haskell-mode)
(require 'cl))
(require 'font-lock)
(defcustom haskell-font-lock-symbols nil
"Display \\ and -> and such using symbols in fonts.
This may sound like a neat trick, but be extra careful: it changes the
alignment and can thus lead to nasty surprises w.r.t layout.
If t, try to use whichever font is available. Otherwise you can
set it to a particular font of your preference among `japanese-jisx0208'
and `unicode'."
:group 'haskell
:type '(choice (const nil)
(const t)
(const unicode)
(const japanese-jisx0208)))
(defconst haskell-font-lock-symbols-alist
(append
;; Prefer single-width Unicode font for lambda.
(and (fboundp 'decode-char)
(memq haskell-font-lock-symbols '(t unicode))
(list (cons "\\" (decode-char 'ucs 955))))
;; The symbols can come from a JIS0208 font.
(and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'japanese-jisx0208)
(memq haskell-font-lock-symbols '(t japanese-jisx0208))
(list (cons "not" (make-char 'japanese-jisx0208 34 76))
(cons "\\" (make-char 'japanese-jisx0208 38 75))
(cons "->" (make-char 'japanese-jisx0208 34 42))
(cons "<-" (make-char 'japanese-jisx0208 34 43))
(cons "=>" (make-char 'japanese-jisx0208 34 77))
;; FIXME: I'd like to either use ∀ or ∃ depending on how the
;; `forall' keyword is used, but currently the rest of the
;; code assumes that such ambiguity doesn't happen :-(
(cons "forall" (make-char 'japanese-jisx0208 34 79))))
;; Or a unicode font.
(and (fboundp 'decode-char)
(memq haskell-font-lock-symbols '(t unicode))
(list (cons "not" (decode-char 'ucs 172))
(cons "->" (decode-char 'ucs 8594))
(cons "<-" (decode-char 'ucs 8592))
(cons "=>" (decode-char 'ucs 8658))
(cons "()" (decode-char 'ucs #X2205))
(cons "==" (decode-char 'ucs #X2261))
(cons "/=" (decode-char 'ucs #X2262))
(cons ">=" (decode-char 'ucs #X2265))
(cons "<=" (decode-char 'ucs #X2264))
(cons "!!" (decode-char 'ucs #X203C))
(cons "&&" (decode-char 'ucs #X2227))
(cons "||" (decode-char 'ucs #X2228))
(cons "sqrt" (decode-char 'ucs #X221A))
(cons "undefined" (decode-char 'ucs #X22A5))
(cons "pi" (decode-char 'ucs #X3C0))
(cons "~>" (decode-char 'ucs 8669)) ;; Omega language
;; (cons "~>" (decode-char 'ucs 8605)) ;; less desirable
(cons "-<" (decode-char 'ucs 8610)) ;; Paterson's arrow syntax
;; (cons "-<" (decode-char 'ucs 10521)) ;; nicer but uncommon
(cons "::" (decode-char 'ucs 8759))
(list "." (decode-char 'ucs 8728) ; (decode-char 'ucs 9675)
;; Need a predicate here to distinguish the . used by
;; forall <foo> . <bar>.
'haskell-font-lock-dot-is-not-composition)
(cons "forall" (decode-char 'ucs 8704)))))
"Alist mapping Haskell symbols to chars.
Each element has the form (STRING . CHAR) or (STRING CHAR PREDICATE).
STRING is the Haskell symbol.
CHAR is the character with which to represent this symbol.
PREDICATE if present is a function of one argument (the start position
of the symbol) which should return non-nil if this mapping should be disabled
at that position.")
(defun haskell-font-lock-dot-is-not-composition (start)
"Return non-nil if the \".\" at START is not a composition operator.
This is the case if the \".\" is part of a \"forall <tvar> . <type>\"."
(save-excursion
(goto-char start)
(re-search-backward "\\<forall\\>[^.\"]*\\="
(line-beginning-position) t)))
;; Use new vars for the font-lock faces. The indirection allows people to
;; use different faces than in other modes, as before.
(defvar haskell-keyword-face 'font-lock-keyword-face)
(defvar haskell-constructor-face 'font-lock-type-face)
;; This used to be `font-lock-variable-name-face' but it doesn't result in
;; a highlighting that's consistent with other modes (it's mostly used
;; for function defintions).
(defvar haskell-definition-face 'font-lock-function-name-face)
;; This is probably just wrong, but it used to use
;; `font-lock-function-name-face' with a result that was not consistent with
;; other major modes, so I just exchanged with `haskell-definition-face'.
(defvar haskell-operator-face 'font-lock-variable-name-face)
(defvar haskell-default-face nil)
(defvar haskell-literate-comment-face 'font-lock-doc-face
"Face with which to fontify literate comments.
Set to `default' to avoid fontification of them.")
(defconst haskell-emacs21-features (string-match "[[:alpha:]]" "x")
"Non-nil if we have regexp char classes.
Assume this means we have other useful features from Emacs 21.")
(defun haskell-font-lock-compose-symbol (alist)
"Compose a sequence of ascii chars into a symbol.
Regexp match data 0 points to the chars."
;; Check that the chars should really be composed into a symbol.
(let* ((start (match-beginning 0))
(end (match-end 0))
(syntaxes (cond
((eq (char-syntax (char-after start)) ?w) '(?w))
;; Special case for the . used for qualified names.
((and (eq (char-after start) ?\.) (= end (1+ start)))
'(?_ ?\\ ?w))
(t '(?_ ?\\))))
sym-data)
(if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
(memq (char-syntax (or (char-after end) ?\ )) syntaxes)
(memq (get-text-property start 'face)
'(font-lock-doc-face font-lock-string-face
font-lock-comment-face))
(and (consp (setq sym-data (cdr (assoc (match-string 0) alist))))
(let ((pred (cadr sym-data)))
(setq sym-data (car sym-data))
(funcall pred start))))
;; No composition for you. Let's actually remove any composition
;; we may have added earlier and which is now incorrect.
(remove-text-properties start end '(composition))
;; That's a symbol alright, so add the composition.
(compose-region start end sym-data)))
;; Return nil because we're not adding any face property.
nil)
(defun haskell-font-lock-symbols-keywords ()
(when (fboundp 'compose-region)
(let ((alist nil))
(dolist (x haskell-font-lock-symbols-alist)
(when (and (if (fboundp 'char-displayable-p)
(char-displayable-p (if (consp (cdr x)) (cadr x) (cdr x)))
t)
(not (assoc (car x) alist))) ;Not yet in alist.
(push x alist)))
(when alist
`((,(regexp-opt (mapcar 'car alist) t)
(0 (haskell-font-lock-compose-symbol ',alist)
;; In Emacs-21, if the `override' field is nil, the face
;; expressions is only evaluated if the text has currently
;; no face. So force evaluation by using `keep'.
keep)))))))
;; The font lock regular expressions.
(defun haskell-font-lock-keywords-create (literate)
"Create fontification definitions for Haskell scripts.
Returns keywords suitable for `font-lock-keywords'."
(let* (;; Bird-style literate scripts start a line of code with
;; "^>", otherwise a line of code starts with "^".
(line-prefix (if (eq literate 'bird) "^> ?" "^"))
;; Most names are borrowed from the lexical syntax of the Haskell
;; report.
;; Some of these definitions have been superseded by using the
;; syntax table instead.
;; (ASCsymbol "-!#$%&*+./<=>?@\\\\^|~")
;; Put the minus first to make it work in ranges.
;; (ISOsymbol "\241-\277\327\367")
(ISOlarge "\300-\326\330-\337")
(ISOsmall "\340-\366\370-\377")
(small
(if haskell-emacs21-features "[:lower:]" (concat "a-z" ISOsmall)))
(large
(if haskell-emacs21-features "[:upper:]" (concat "A-Z" ISOlarge)))
(alnum
(if haskell-emacs21-features "[:alnum:]" (concat small large "0-9")))
;; (symbol
;; (concat ASCsymbol ISOsymbol))
;; We allow _ as the first char to fit GHC
(varid (concat "\\b[" small "_][" alnum "'_]*\\b"))
(conid (concat "\\b[" large "][" alnum "'_]*\\b"))
(modid (concat "\\b" conid "\\(\\." conid "\\)*\\b"))
(qvarid (concat modid "\\." varid))
(qconid (concat modid "\\." conid))
(sym
;; We used to use the below for non-Emacs21, but I think the
;; regexp based on syntax works for other emacsen as well. -- Stef
;; (concat "[" symbol ":]+")
;; Add backslash to the symbol-syntax chars. This seems to
;; be thrown for some reason by backslash's escape syntax.
"\\(\\s_\\|\\\\\\)+")
;; Reserved operations
(reservedsym
(concat "\\S_"
;; (regexp-opt '(".." "::" "=" "\\" "|" "<-" "->"
;; "@" "~" "=>") t)
"\\(->\\|\\.\\.\\|::\\|<-\\|=>\\|[=@\\|~]\\)"
"\\S_"))
;; Reserved identifiers
(reservedid
(concat "\\<"
;; `as', `hiding', and `qualified' are part of the import
;; spec syntax, but they are not reserved.
;; `_' can go in here since it has temporary word syntax.
;; (regexp-opt
;; '("case" "class" "data" "default" "deriving" "do"
;; "else" "if" "import" "in" "infix" "infixl"
;; "infixr" "instance" "let" "module" "newtype" "of"
;; "then" "type" "where" "_") t)
"\\(_\\|c\\(ase\\|lass\\)\\|d\\(ata\\|e\\(fault\\|riving\\)\\|o\\)\\|else\\|i\\(mport\\|n\\(fix[lr]?\\|stance\\)\\|[fn]\\)\\|let\\|module\\|newtype\\|of\\|t\\(hen\\|ype\\)\\|where\\)"
"\\>"))
;; This unreadable regexp matches strings and character
;; constants. We need to do this with one regexp to handle
;; stuff like '"':"'". The regexp is the composition of
;; "([^"\\]|\\.)*" for strings and '([^\\]|\\.[^']*)' for
;; characters, allowing for string continuations.
;; Could probably be improved...
(string-and-char
(concat "\\(\\(\"\\|" line-prefix "[ \t]*\\\\\\)\\([^\"\\\\\n]\\|\\\\.\\)*\\(\"\\|\\\\[ \t]*$\\)\\|'\\([^'\\\\\n]\\|\\\\.[^'\n]*\\)'\\)"))
;; Top-level declarations
(topdecl-var
(concat line-prefix "\\(" varid "\\)\\s-*\\("
;; A toplevel declaration can be followed by a definition
;; (=), a type (::), a guard, or a pattern which can
;; either be a variable, a constructor, a parenthesized
;; thingy, or an integer or a string.
varid "\\|" conid "\\|::\\|=\\||\\|\\s(\\|[0-9\"']\\)"))
(topdecl-var2
(concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*`\\(" varid "\\)`"))
(topdecl-sym
(concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*\\(" sym "\\)"))
(topdecl-sym2 (concat line-prefix "(\\(" sym "\\))"))
keywords)
(setq keywords
`(;; NOTICE the ordering below is significant
;;
("^#.*$" 0 'font-lock-warning-face t)
,@(unless haskell-emacs21-features ;Supports nested comments?
;; Expensive.
`((,string-and-char 1 font-lock-string-face)))
;; This was originally at the very end (and needs to be after
;; all the comment/string/doc highlighting) but it seemed to
;; trigger a bug in Emacs-21.3 which caused the compositions to
;; be "randomly" dropped. Moving it earlier seemed to reduce
;; the occurrence of the bug.
,@(haskell-font-lock-symbols-keywords)
(,reservedid 1 (symbol-value 'haskell-keyword-face))
(,reservedsym 1 (symbol-value 'haskell-operator-face))
;; Special case for `as', `hiding', and `qualified', which are
;; keywords in import statements but are not otherwise reserved.
("\\<import[ \t]+\\(?:\\(qualified\\>\\)[ \t]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\<as\\>\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\<hiding\\>\\)?"
(1 (symbol-value 'haskell-keyword-face) nil lax)
(2 (symbol-value 'haskell-keyword-face) nil lax)
(3 (symbol-value 'haskell-keyword-face) nil lax))
;; Toplevel Declarations.
;; Place them *before* generic id-and-op highlighting.
(,topdecl-var (1 (symbol-value 'haskell-definition-face)))
(,topdecl-var2 (2 (symbol-value 'haskell-definition-face)))
(,topdecl-sym (2 (symbol-value 'haskell-definition-face)))
(,topdecl-sym2 (1 (symbol-value 'haskell-definition-face)))
;; These four are debatable...
("(\\(,*\\|->\\))" 0 (symbol-value 'haskell-constructor-face))
("\\[\\]" 0 (symbol-value 'haskell-constructor-face))
;; Expensive.
(,qvarid 0 (symbol-value 'haskell-default-face))
(,qconid 0 (symbol-value 'haskell-constructor-face))
(,(concat "\`" varid "\`") 0 (symbol-value 'haskell-operator-face))
;; Expensive.
(,conid 0 (symbol-value 'haskell-constructor-face))
;; Very expensive.
(,sym 0 (if (eq (char-after (match-beginning 0)) ?:)
haskell-constructor-face
haskell-operator-face))))
(unless (boundp 'font-lock-syntactic-keywords)
(case literate
(bird
(setq keywords
`(("^[^>\n].*$" 0 haskell-comment-face t)
,@keywords
("^>" 0 haskell-default-face t))))
((latex tex)
(setq keywords
`((haskell-fl-latex-comments 0 'font-lock-comment-face t)
,@keywords)))))
keywords))
;; The next three aren't used in Emacs 21.
(defvar haskell-fl-latex-cache-pos nil
"Position of cache point used by `haskell-fl-latex-cache-in-comment'.
Should be at the start of a line.")
(defvar haskell-fl-latex-cache-in-comment nil
"If `haskell-fl-latex-cache-pos' is outside a
\\begin{code}..\\end{code} block (and therefore inside a comment),
this variable is set to t, otherwise nil.")
(defun haskell-fl-latex-comments (end)
"Sets `match-data' according to the region of the buffer before end
that should be commented under LaTeX-style literate scripts."
(let ((start (point)))
(if (= start end)
;; We're at the end. No more to fontify.
nil
(if (not (eq start haskell-fl-latex-cache-pos))
;; If the start position is not cached, calculate the state
;; of the start.
(progn
(setq haskell-fl-latex-cache-pos start)
;; If the previous \begin{code} or \end{code} is a
;; \begin{code}, then start is not in a comment, otherwise
;; it is in a comment.
(setq haskell-fl-latex-cache-in-comment
(if (and
(re-search-backward
"^\\(\\(\\\\begin{code}\\)\\|\\(\\\\end{code}\\)\\)$"
(point-min) t)
(match-end 2))
nil t))
;; Restore position.
(goto-char start)))
(if haskell-fl-latex-cache-in-comment
(progn
;; If start is inside a comment, search for next \begin{code}.
(re-search-forward "^\\\\begin{code}$" end 'move)
;; Mark start to end of \begin{code} (if present, till end
;; otherwise), as a comment.
(set-match-data (list start (point)))
;; Return point, as a normal regexp would.
(point))
;; If start is inside a code block, search for next \end{code}.
(if (re-search-forward "^\\\\end{code}$" end t)
;; If one found, mark it as a comment, otherwise finish.
(point))))))
(defconst haskell-basic-syntactic-keywords
'(;; Character constants (since apostrophe can't have string syntax).
;; Beware: do not match something like 's-}' or '\n"+' since the first '
;; might be inside a comment or a string.
;; This still gets fooled with "'"'"'"'"'"', but ... oh well.
("\\Sw\\('\\)\\([^\\'\n]\\|\\\\.[^\\'\n \"}]*\\)\\('\\)" (1 "|") (3 "|"))
;; The \ is not escaping in \(x,y) -> x + y.
("\\(\\\\\\)(" (1 "."))
;; The second \ in a gap does not quote the subsequent char.
;; It's probably not worth the trouble, tho.
;; ("^[ \t]*\\(\\\\\\)" (1 "."))
;; Deal with instances of `--' which don't form a comment.
("\\s_\\{3,\\}" (0 (if (string-match "\\`-*\\'" (match-string 0))
;; Sequence of hyphens. Do nothing in
;; case of things like `{---'.
nil
"_"))))) ; other symbol sequence
(defconst haskell-bird-syntactic-keywords
(cons '("^[^\n>]" (0 "<"))
haskell-basic-syntactic-keywords))
(defconst haskell-latex-syntactic-keywords
(append
'(("^\\\\begin{code}\\(\n\\)" 1 "!")
;; Note: buffer is widened during font-locking.
("\\`\\(.\\|\n\\)" (1 "!")) ; start comment at buffer start
("^\\(\\\\\\)end{code}$" 1 "!"))
haskell-basic-syntactic-keywords))
(defcustom haskell-font-lock-haddock (boundp 'font-lock-doc-face)
"If non-nil try to highlight Haddock comments specially."
:type 'boolean
:group 'haskell)
(defvar haskell-font-lock-seen-haddock nil)
(make-variable-buffer-local 'haskell-font-lock-seen-haddock)
(defun haskell-syntactic-face-function (state)
"`font-lock-syntactic-face-function' for Haskell."
(cond
((nth 3 state) font-lock-string-face) ; as normal
;; Else comment. If it's from syntax table, use default face.
((or (eq 'syntax-table (nth 7 state))
(and (eq haskell-literate 'bird)
(memq (char-before (nth 8 state)) '(nil ?\n))))
haskell-literate-comment-face)
;; Try and recognize Haddock comments. From what I gather from its
;; documentation, its comments can take the following forms:
;; a) {-| ... -}
;; b) {-^ ... -}
;; c) -- | ...
;; d) -- ^ ...
;; e) -- ...
;; Where `e' is the tricky one: it is only a Haddock comment if it
;; follows immediately another Haddock comment. Even an empty line
;; breaks such a sequence of Haddock comments. It is not clear if `e'
;; can follow any other case, so I interpreted it as following only cases
;; c,d,e (not a or b). In any case, this `e' is expensive since it
;; requires extra work for each and every non-Haddock comment, so I only
;; go through the more expensive check if we've already seen a Haddock
;; comment in the buffer.
((and haskell-font-lock-haddock
(save-excursion
(goto-char (nth 8 state))
(or (looking-at "\\(-- \\|{-\\)[|^]")
(and haskell-font-lock-seen-haddock
(looking-at "-- ")
(let ((doc nil)
pos)
(while (and (not doc)
(setq pos (line-beginning-position))
(forward-comment -1)
(eq (line-beginning-position 2) pos)
(looking-at "--\\( [|^]\\)?"))
(setq doc (match-beginning 1)))
doc)))))
(set (make-local-variable 'haskell-font-lock-seen-haddock) t)
font-lock-doc-face)
(t font-lock-comment-face)))
(defconst haskell-font-lock-keywords
(haskell-font-lock-keywords-create nil)
"Font lock definitions for non-literate Haskell.")
(defconst haskell-font-lock-bird-literate-keywords
(haskell-font-lock-keywords-create 'bird)
"Font lock definitions for Bird-style literate Haskell.")
(defconst haskell-font-lock-latex-literate-keywords
(haskell-font-lock-keywords-create 'latex)
"Font lock definitions for LaTeX-style literate Haskell.")
(defun haskell-font-lock-choose-keywords ()
(let ((literate (if (boundp 'haskell-literate) haskell-literate)))
(case literate
(bird haskell-font-lock-bird-literate-keywords)
((latex tex) haskell-font-lock-latex-literate-keywords)
(t haskell-font-lock-keywords))))
(defun haskell-font-lock-choose-syntactic-keywords ()
(let ((literate (if (boundp 'haskell-literate) haskell-literate)))
(case literate
(bird haskell-bird-syntactic-keywords)
((latex tex) haskell-latex-syntactic-keywords)
(t haskell-basic-syntactic-keywords))))
(defun haskell-font-lock-defaults-create ()
"Locally set `font-lock-defaults' for Haskell."
(set (make-local-variable 'font-lock-defaults)
'(haskell-font-lock-choose-keywords
nil nil ((?\' . "w") (?_ . "w")) nil
(font-lock-syntactic-keywords
. haskell-font-lock-choose-syntactic-keywords)
(font-lock-syntactic-face-function
. haskell-syntactic-face-function)
;; Get help from font-lock-syntactic-keywords.
(parse-sexp-lookup-properties . t))))
;; The main functions.
(defun turn-on-haskell-font-lock ()
"Turns on font locking in current buffer for Haskell 1.4 scripts.
Changes the current buffer's `font-lock-defaults', and adds the
following variables:
`haskell-keyword-face' for reserved keywords and syntax,
`haskell-constructor-face' for data- and type-constructors, class names,
and module names,
`haskell-operator-face' for symbolic and alphanumeric operators,
`haskell-default-face' for ordinary code.
The variables are initialised to the following font lock default faces:
`haskell-keyword-face' `font-lock-keyword-face'
`haskell-constructor-face' `font-lock-type-face'
`haskell-operator-face' `font-lock-function-name-face'
`haskell-default-face' <default face>
Two levels of fontification are defined: level one (the default)
and level two (more colour). The former does not colour operators.
Use the variable `font-lock-maximum-decoration' to choose
non-default levels of fontification. For example, adding this to
.emacs:
(setq font-lock-maximum-decoration '((haskell-mode . 2) (t . 0)))
uses level two fontification for `haskell-mode' and default level for
all other modes. See documentation on this variable for further
details.
To alter an attribute of a face, add a hook. For example, to change
the foreground colour of comments to brown, add the following line to
.emacs:
(add-hook 'haskell-font-lock-hook
(lambda ()
(set-face-foreground 'haskell-comment-face \"brown\")))
Note that the colours available vary from system to system. To see
what colours are available on your system, call
`list-colors-display' from emacs.
To turn font locking on for all Haskell buffers, add this to .emacs:
(add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock)
To turn font locking on for the current buffer, call
`turn-on-haskell-font-lock'. To turn font locking off in the current
buffer, call `turn-off-haskell-font-lock'.
Bird-style literate Haskell scripts are supported: If the value of
`haskell-literate-bird-style' (automatically set by the Haskell mode
of Moss&Thorn) is non-nil, a Bird-style literate script is assumed.
Invokes `haskell-font-lock-hook' if not nil."
(haskell-font-lock-defaults-create)
(run-hooks 'haskell-font-lock-hook)
(turn-on-font-lock))
(defun turn-off-haskell-font-lock ()
"Turns off font locking in current buffer."
(font-lock-mode -1))
;; Provide ourselves:
(provide 'haskell-font-lock)
;; arch-tag: 89fd122e-8378-4c7f-83a3-1f49a64e458d
;;; haskell-font-lock.el ends here

332
.emacs.d.backup/haskell-mode/haskell-ghci.el Normal file
View file

@ -0,0 +1,332 @@
;;; haskell-ghci.el --- A GHCi interaction mode
;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Copyright (C) 2001 Chris Webb
;; Copyright (C) 1998, 1999 Guy Lapalme
;; Keywords: inferior mode, GHCi interaction mode, Haskell
;;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; To send a Haskell buffer to another buffer running a GHCi
;; interpreter.
;;
;; This mode is derived from version 1.1 of Guy Lapalme's
;; haskell-hugs.el, which can be obtained from:
;;
;; http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html
;;
;; This in turn was adapted from Chris Van Humbeeck's hugs-mode.el,
;; which can be obtained from:
;;
;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el
;;
;;
;; Installation:
;;
;; To use with Moss and Thorn's haskell-mode.el
;;
;; http://www.haskell.org/haskell-mode
;;
;; add this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'turn-on-haskell-ghci)
;;
;;
;; Customisation:
;;
;; The name of the GHCi interpreter is in haskell-ghci-program-name.
;;
;; Arguments can be sent to the GHCi interpreter when it is started by
;; setting haskell-ghci-program-args (empty by default) to a list of
;; string args to pass it. This value can be set interactively by
;; calling C-c C-s with an argument (i.e. C-u C-c C-s).
;;
;; `haskell-ghci-hook' is invoked in the *ghci* buffer once GHCi is
;; started.
;;
;; All functions/variables start with `turn-{on,off}-haskell-ghci' or
;; `haskell-ghci-'.
;;; Code:
(defgroup haskell-ghci nil
"Major mode for interacting with an inferior GHCi session."
:group 'haskell
:prefix "haskell-ghci-")
(defun turn-on-haskell-ghci ()
"Turn on Haskell interaction mode with a GHCi interpreter running in an
another Emacs buffer named *ghci*.
Maps the following commands in the haskell keymap:
\\<haskell-mode-map>\\[haskell-ghci-start-process] to create the GHCi buffer and start a GHCi process in it.
\\[haskell-ghci-load-file] to save the current buffer and load it by sending the :load command to GHCi.
\\[haskell-ghci-reload-file] to send the :reload command to GHCi without saving the buffer.
\\[haskell-ghci-show-ghci-buffer] to show the GHCi buffer and go to it."
(local-set-key "\C-c\C-s" 'haskell-ghci-start-process)
(local-set-key "\C-c\C-l" 'haskell-ghci-load-file)
(local-set-key "\C-c\C-r" 'haskell-ghci-reload-file)
(local-set-key "\C-c\C-n" 'haskell-ghci-locate-next-error)
(local-set-key "\C-c\C-b" 'haskell-ghci-show-ghci-buffer))
(defun turn-off-haskell-ghci ()
"Turn off Haskell interaction mode with a GHCi interpreter within a buffer."
(local-unset-key "\C-c\C-s")
(local-unset-key "\C-c\C-l")
(local-unset-key "\C-c\C-r")
(local-unset-key "\C-c\C-b"))
(define-derived-mode haskell-ghci-mode comint-mode "Haskell GHCi"
"Major mode for interacting with an inferior GHCi session.
The commands available from within a Haskell script are:
\\<haskell-mode-map>\\[haskell-ghci-start-process] to create the GHCi buffer and start a GHCi process in it.
\\[haskell-ghci-load-file] to save the current buffer and load it by sending the :load command to GHCi.
\\[haskell-ghci-reload-file] to send the :reload command to GHCi without saving the buffer.
\\[haskell-ghci-show-ghci-buffer] to show the GHCi buffer and go to it.
\\<haskell-ghci-mode-map>Commands:
\\[comint-send-input] after end of GHCi output sends line as input to GHCi.
\\[comint-send-input] before end of GHCI output copies rest of line and sends it to GHCI as input.
\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
\\[comint-interrupt-subjob] interrupts the comint or its current subjob if any.
\\[comint-stop-subjob] stops, likewise. \\[comint-quit-subjob] sends quit signal.")
;; GHCi interface:
(require 'comint)
(require 'shell)
(defvar haskell-ghci-process nil
"The active GHCi subprocess corresponding to current buffer.")
(defvar haskell-ghci-process-buffer nil
"*Buffer used for communication with GHCi subprocess for current buffer.")
(defcustom haskell-ghci-program-name "ghci"
"*The name of the GHCi interpreter program."
:type 'string
:group 'haskell-ghci)
(defcustom haskell-ghci-program-args nil
"*A list of string args to pass when starting the GHCi interpreter."
:type '(repeat string)
:group 'haskell-ghci)
(defvar haskell-ghci-load-end nil
"Position of the end of the last load command.")
(defvar haskell-ghci-error-pos nil
"Position of the end of the last load command.")
(defvar haskell-ghci-send-end nil
"Position of the end of the last send command.")
(defun haskell-ghci-start-process (arg)
"Start a GHCi process and invoke `haskell-ghci-hook' if not nil.
Prompt for a list of args if called with an argument."
(interactive "P")
(if arg
;; XXX [CDW] Fix to use more natural 'string' version of the
;; XXX arguments rather than a sexp.
(setq haskell-ghci-program-args
(read-minibuffer (format "List of args for %s:"
haskell-ghci-program-name)
(prin1-to-string haskell-ghci-program-args))))
;; Start the GHCi process in a new comint buffer.
(message "Starting GHCi process `%s'." haskell-ghci-program-name)
(setq haskell-ghci-process-buffer
(apply 'make-comint
"ghci" haskell-ghci-program-name nil
haskell-ghci-program-args))
(setq haskell-ghci-process
(get-buffer-process haskell-ghci-process-buffer))
;; Select GHCi buffer temporarily.
(set-buffer haskell-ghci-process-buffer)
(haskell-ghci-mode)
(make-local-variable 'shell-cd-regexp)
(make-local-variable 'shell-dirtrackp)
;; Track directory changes using the `:cd' command.
(setq shell-cd-regexp ":cd")
(setq shell-dirtrackp t)
(add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local)
;; GHCi prompt should be of the form `ModuleName> '.
(setq comint-prompt-regexp "^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ")
;; History syntax of comint conflicts with Haskell, e.g. !!, so better
;; turn it off.
(setq comint-input-autoexpand nil)
(run-hooks 'haskell-ghci-hook)
;; Clear message area.
(message ""))
(defun haskell-ghci-wait-for-output ()
"Wait until output arrives and go to the last input."
(while (progn
(goto-char comint-last-input-end)
(not (re-search-forward comint-prompt-regexp nil t)))
(accept-process-output haskell-ghci-process)))
(defun haskell-ghci-send (&rest string)
"Send `haskell-ghci-process' the arguments (one or more strings).
A newline is sent after the strings and they are inserted into the
current buffer after the last output."
(haskell-ghci-wait-for-output) ; wait for prompt
(goto-char (point-max)) ; position for this input
(apply 'insert string)
(comint-send-input)
(setq haskell-ghci-send-end (marker-position comint-last-input-end)))
(defun haskell-ghci-go (load-command cd)
"Save the current buffer and load its file into the GHCi process.
The first argument LOAD-COMMAND specifies how the file should be
loaded: as a new file (\":load \") or as a reload (\":reload \").
If the second argument CD is non-nil, change directory in the GHCi
process to the current buffer's directory before loading the file.
If the variable `haskell-ghci-command' is set then its value will be
sent to the GHCi process after the load command. This can be used for a
top-level expression to evaluate."
(hack-local-variables) ; in case they've changed
(save-buffer)
(let ((file (if (string-equal load-command ":load ")
(concat "\"" buffer-file-name "\"")
""))
(dir (expand-file-name default-directory))
(cmd (and (boundp 'haskell-ghci-command)
haskell-ghci-command
(if (stringp haskell-ghci-command)
haskell-ghci-command
(symbol-name haskell-ghci-command)))))
(if (and haskell-ghci-process-buffer
(eq (process-status haskell-ghci-process) 'run))
;; Ensure the GHCi buffer is selected.
(set-buffer haskell-ghci-process-buffer)
;; Start Haskell-GHCi process.
(haskell-ghci-start-process nil))
(if cd (haskell-ghci-send (concat ":cd " dir)))
;; Wait until output arrives and go to the last input.
(haskell-ghci-wait-for-output)
(haskell-ghci-send load-command file)
;; Error message search starts from last load command.
(setq haskell-ghci-load-end (marker-position comint-last-input-end))
(setq haskell-ghci-error-pos haskell-ghci-load-end)
(if cmd (haskell-ghci-send cmd))
;; Wait until output arrives and go to the last input.
(haskell-ghci-wait-for-output)))
(defun haskell-ghci-load-file (cd)
"Save a ghci buffer file and load its file.
If CD (prefix argument if interactive) is non-nil, change directory in
the GHCi process to the current buffer's directory before loading the
file. If there is an error, set the cursor at the error line otherwise
show the *ghci* buffer."
(interactive "P")
(haskell-ghci-gen-load-file ":load " cd))
(defun haskell-ghci-reload-file (cd)
"Save a ghci buffer file and load its file.
If CD (prefix argument if interactive) is non-nil, change the GHCi
process to the current buffer's directory before loading the file.
If there is an error, set the cursor at the error line otherwise show
the *ghci* buffer."
(interactive "P")
(haskell-ghci-gen-load-file ":reload " cd))
(defun haskell-ghci-gen-load-file (cmd cd)
"Save a ghci buffer file and load its file or reload depending on CMD.
If CD is non-nil, change the process to the current buffer's directory
before loading the file. If there is an error, set the cursor at the
error line otherwise show the *ghci* buffer."
;; Execute (re)load command.
(save-excursion (haskell-ghci-go cmd cd))
;; Show *ghci* buffer.
(pop-to-buffer haskell-ghci-process-buffer)
(goto-char haskell-ghci-load-end)
;; Did we finish loading without error?
(if (re-search-forward
"^Ok, modules loaded" nil t)
(progn (goto-char (point-max))
(recenter 2)
(message "There were no errors."))
;; Something went wrong. If possible, be helpful and pinpoint the
;; first error in the file whilst leaving the error visible in the
;; *ghci* buffer.
(goto-char haskell-ghci-load-end)
(haskell-ghci-locate-next-error)))
(defun haskell-ghci-locate-next-error ()
"Go to the next error shown in the *ghci* buffer."
(interactive)
(if (buffer-live-p haskell-ghci-process-buffer)
(progn (pop-to-buffer haskell-ghci-process-buffer)
(goto-char haskell-ghci-error-pos)
(if (re-search-forward
"^[^\/]*\\([^:\n]+\\):\\([0-9]+\\)" nil t)
(let ((efile (buffer-substring (match-beginning 1)
(match-end 1)))
(eline (string-to-int
(buffer-substring (match-beginning 2)
(match-end 2)))))
(recenter 2)
(setq haskell-ghci-error-pos (point))
(message "GHCi error on line %d of %s."
eline (file-name-nondirectory efile))
(if (file-exists-p efile)
(progn (find-file-other-window efile)
(goto-line eline)
(recenter))))
;; We got an error without a file and line number, so put the
;; point at end of the *ghci* buffer ready to deal with it.
(goto-char (point-max))
(recenter -2)
(message "No more errors found.")))
(message "No *ghci* buffer found.")))
(defun haskell-ghci-show-ghci-buffer ()
"Go to the *ghci* buffer."
(interactive)
(if (or (not haskell-ghci-process-buffer)
(not (buffer-live-p haskell-ghci-process-buffer)))
(haskell-ghci-start-process nil))
(pop-to-buffer haskell-ghci-process-buffer))
(provide 'haskell-ghci)
;; arch-tag: f0bade4b-288d-4329-9791-98c1e24167ac
;;; haskell-ghci.el ends here

316
.emacs.d.backup/haskell-mode/haskell-hugs.el Normal file
View file

@ -0,0 +1,316 @@
;;; haskell-hugs.el --- simplistic interaction mode with a
;; Copyright 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Copyright 1998, 1999 Guy Lapalme
;; Hugs interpreter for Haskell developped by
;; The University of Nottingham and Yale University, 1994-1997.
;; Web: http://www.haskell.org/hugs.
;; In standard Emacs terminology, this would be called
;; inferior-hugs-mode
;; Keywords: Hugs inferior mode, Hugs interaction mode
;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-hugs.el?rev=HEAD
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; To send a Haskell buffer to another buffer running a Hugs interpreter
;; The functions are adapted from the Hugs Mode developed by
;; Chris Van Humbeeck <chris.vanhumbeeck@cs.kuleuven.ac.be>
;; which used to be available at:
;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el
;;
;; Installation:
;;
;; To use with the Haskell mode of
;; Moss&Thorn <http://www.haskell.org/haskell-mode>
;; add this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'turn-on-haskell-hugs)
;;
;; Customisation:
;; The name of the hugs interpreter is in variable
;; haskell-hugs-program-name
;; Arguments can be sent to the Hugs interpreter when it is called
;; by setting the value of the variable
;; haskell-hugs-program-args
;; which by default contains '("+.") so that the progress of the
;; interpreter is visible without any "^H" in the *hugs* Emacs buffer.
;;
;; This value can be interactively by calling C-cC-s with an
;; argument.
;;
;; If the command does not seem to respond, see the
;; content of the `comint-prompt-regexp' variable
;; to check that it waits for the appropriate Hugs prompt
;; the current value is appropriate for Hugs 1.3 and 1.4
;;
;;
;; `haskell-hugs-hook' is invoked in the *hugs* once it is started.
;;
;;; All functions/variables start with
;;; `(turn-(on/off)-)haskell-hugs' or `haskell-hugs-'.
(defgroup haskell-hugs nil
"Major mode for interacting with an inferior Hugs session."
:group 'haskell
:prefix "haskell-hugs-")
(defun turn-on-haskell-hugs ()
"Turn on Haskell interaction mode with a Hugs interpreter running in an
another Emacs buffer named *hugs*.
Maps the followind commands in the haskell keymap.
\\[haskell-hugs-load-file]
to save the current buffer and load it by sending the :load command
to Hugs.
\\[haskell-hugs-reload-file]
to send the :reload command to Hugs without saving the buffer.
\\[haskell-hugs-show-hugs-buffer]
to show the Hugs buffer and go to it."
(local-set-key "\C-c\C-s" 'haskell-hugs-start-process)
(local-set-key "\C-c\C-l" 'haskell-hugs-load-file)
(local-set-key "\C-c\C-r" 'haskell-hugs-reload-file)
(local-set-key "\C-c\C-b" 'haskell-hugs-show-hugs-buffer))
(defun turn-off-haskell-hugs ()
"Turn off Haskell interaction mode with a Hugs interpreter within a buffer."
(local-unset-key "\C-c\C-s")
(local-unset-key "\C-c\C-l")
(local-unset-key "\C-c\C-r")
(local-unset-key "\C-c\C-b"))
(define-derived-mode haskell-hugs-mode comint-mode "Haskell Hugs"
;; called by haskell-hugs-start-process,
;; itself called by haskell-hugs-load-file
;; only when the file is loaded the first time
"Major mode for interacting with an inferior Hugs session.
The commands available from within a Haskell script are:
\\<haskell-mode-map>\\[haskell-hugs-load-file]
to save the current buffer and load it by sending the :load command
to Hugs.
\\[haskell-hugs-reload-file]
to send the :reload command to Hugs without saving the buffer.
\\[haskell-hugs-show-hugs-buffer]
to show the Hugs buffer and go to it.
\\<haskell-hugs-mode-map>
Commands:
Return at end of buffer sends line as input.
Return not at end copies rest of line to end and sends it.
\\[comint-kill-input] and \\[backward-kill-word] are kill commands,
imitating normal Unix input editing.
\\[comint-interrupt-subjob] interrupts the comint or its current
subjob if any.
\\[comint-stop-subjob] stops, likewise.
\\[comint-quit-subjob] sends quit signal."
)
;; Hugs-interface
(require 'comint)
(require 'shell)
(defvar haskell-hugs-process nil
"The active Hugs subprocess corresponding to current buffer.")
(defvar haskell-hugs-process-buffer nil
"*Buffer used for communication with Hugs subprocess for current buffer.")
(defcustom haskell-hugs-program-name "hugs"
"*The name of the command to start the Hugs interpreter."
:type 'string
:group 'haskell-hugs)
(defcustom haskell-hugs-program-args '("+.")
"*A list of string args to send to the hugs process."
:type '(repeat string)
:group 'haskell-hugs)
(defvar haskell-hugs-load-end nil
"Position of the end of the last load command.")
(defvar haskell-hugs-send-end nil
"Position of the end of the last send command.")
(defalias 'run-hugs 'haskell-hugs-start-process)
(defun haskell-hugs-start-process (arg)
"Start a Hugs process and invokes `haskell-hugs-hook' if not nil.
Prompts for a list of args if called with an argument."
(interactive "P")
(message "Starting `hugs-process' %s" haskell-hugs-program-name)
(if arg
(setq haskell-hugs-program-args
(read-minibuffer "List of args for Hugs:"
(prin1-to-string haskell-hugs-program-args))))
(setq haskell-hugs-process-buffer
(apply 'make-comint
"hugs" haskell-hugs-program-name nil
haskell-hugs-program-args))
(setq haskell-hugs-process
(get-buffer-process haskell-hugs-process-buffer))
;; Select Hugs buffer temporarily
(set-buffer haskell-hugs-process-buffer)
(haskell-hugs-mode)
(make-local-variable 'shell-cd-regexp)
(make-local-variable 'shell-dirtrackp)
(setq shell-cd-regexp ":cd")
(setq shell-dirtrackp t)
(add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local)
; ? or module name in Hugs 1.4
(setq comint-prompt-regexp "^\? \\|^[A-Z][_a-zA-Z0-9\.]*> ")
;; comint's history syntax conflicts with Hugs syntax, eg. !!
(setq comint-input-autoexpand nil)
(run-hooks 'haskell-hugs-hook)
(message "")
)
(defun haskell-hugs-wait-for-output ()
"Wait until output arrives and go to the last input."
(while (progn
(goto-char comint-last-input-end)
(and
(not (re-search-forward comint-prompt-regexp nil t))
(accept-process-output haskell-hugs-process)))))
(defun haskell-hugs-send (&rest string)
"Send `haskell-hugs-process' the arguments (one or more strings).
A newline is sent after the strings and they are inserted into the
current buffer after the last output."
;; Wait until output arrives and go to the last input.
(haskell-hugs-wait-for-output)
;; Position for this input.
(goto-char (point-max))
(apply 'insert string)
(comint-send-input)
(setq haskell-hugs-send-end (marker-position comint-last-input-end)))
(defun haskell-hugs-go (load-command cd)
"Save the current buffer and load its file into the Hugs process.
The first argument LOAD-COMMAND specifies how the file should be
loaded: as a new file (\":load \") or as a reload (\":reload \").
If the second argument CD is non-nil, change the Haskell-Hugs process to the
current buffer's directory before loading the file.
If the variable `haskell-hugs-command' is set then its value will be sent to
the Hugs process after the load command. This can be used for a
top-level expression to evaluate."
(hack-local-variables) ;; In case they've changed
(save-buffer)
(let ((file (if (string-equal load-command ":load ")
(concat "\"" buffer-file-name "\"")
""))
(dir (expand-file-name default-directory))
(cmd (and (boundp 'haskell-hugs-command)
haskell-hugs-command
(if (stringp haskell-hugs-command)
haskell-hugs-command
(symbol-name haskell-hugs-command)))))
(if (and haskell-hugs-process-buffer
(eq (process-status haskell-hugs-process) 'run))
;; Ensure the Hugs buffer is selected.
(set-buffer haskell-hugs-process-buffer)
;; Start Haskell-Hugs process.
(haskell-hugs-start-process nil))
(if cd (haskell-hugs-send (concat ":cd " dir)))
;; Wait until output arrives and go to the last input.
(haskell-hugs-wait-for-output)
(haskell-hugs-send load-command file)
;; Error message search starts from last load command.
(setq haskell-hugs-load-end (marker-position comint-last-input-end))
(if cmd (haskell-hugs-send cmd))
;; Wait until output arrives and go to the last input.
(haskell-hugs-wait-for-output)))
(defun haskell-hugs-load-file (cd)
"Save a hugs buffer file and load its file.
If CD (prefix argument if interactive) is non-nil, change the Hugs
process to the current buffer's directory before loading the file.
If there is an error, set the cursor at the error line otherwise show
the Hugs buffer."
(interactive "P")
(haskell-hugs-gen-load-file ":load " cd)
)
(defun haskell-hugs-reload-file (cd)
"Save a hugs buffer file and load its file.
If CD (prefix argument if interactive) is non-nil, change the Hugs
process to the current buffer's directory before loading the file.
If there is an error, set the cursor at the error line otherwise show
the Hugs buffer."
(interactive "P")
(haskell-hugs-gen-load-file ":reload " cd)
)
(defun haskell-hugs-gen-load-file (cmd cd)
"Save a hugs buffer file and load its file or reload depending on CMD.
If CD is non-nil, change the process to the current buffer's directory
before loading the file. If there is an error, set the cursor at the
error line otherwise show the Hugs buffer."
(save-excursion (haskell-hugs-go cmd cd))
;; Ensure the Hugs buffer is selected.
(set-buffer haskell-hugs-process-buffer)
;; Error message search starts from last load command.
(goto-char haskell-hugs-load-end)
(if (re-search-forward
"^ERROR \"\\([^ ]*\\)\"\\( (line \\([0-9]*\\))\\|\\)" nil t)
(let ((efile (buffer-substring (match-beginning 1)
(match-end 1)))
(eline (if (match-beginning 3)
(string-to-int (buffer-substring (match-beginning 3)
(match-end 3)))))
(emesg (buffer-substring (1+ (point))
(save-excursion (end-of-line) (point)))))
(pop-to-buffer haskell-hugs-process-buffer) ; show *hugs* buffer
(goto-char (point-max))
(recenter)
(message "Hugs error %s %s"
(file-name-nondirectory efile) emesg)
(if (file-exists-p efile)
(progn (find-file-other-window efile)
(if eline (goto-line eline))
(recenter)))
)
(pop-to-buffer haskell-hugs-process-buffer) ; show *hugs* buffer
(goto-char (point-max))
(message "There were no errors.")
(recenter 2) ; show only the end...
)
)
(defun haskell-hugs-show-hugs-buffer ()
"Goes to the Hugs buffer."
(interactive)
(if (or (not haskell-hugs-process-buffer)
(not (buffer-live-p haskell-hugs-process-buffer)))
(haskell-hugs-start-process nil))
(pop-to-buffer haskell-hugs-process-buffer)
)
(provide 'haskell-hugs)
;; arch-tag: c2a621e9-d743-4361-a459-983fbf1d4589
;;; haskell-hugs.el ends here

1581
.emacs.d.backup/haskell-mode/haskell-indent.el Normal file
View file

File diff suppressed because it is too large Load diff

856
.emacs.d.backup/haskell-mode/haskell-indentation.el Normal file
View file

@ -0,0 +1,856 @@
;;; haskell-indentation.el -- indentation module for Haskell Mode
;; Copyright 2009 Kristof Bastiaensen
;; Author: 2009 Kristof Bastiaensen <kristof.bastiaensen@vleeuwen.org>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Installation:
;;
;; To turn indentation on for all Haskell buffers under Haskell mode
;; <http://www.haskell.org/haskell-mode/> add this to .emacs:
;;
;; (add-hook haskell-mode-hook 'turn-on-haskell-indentation)
;;
;; Otherwise, call `haskell-indentation-mode'.
;;
;;; Code:
(defgroup haskell-indentation nil
"Haskell indentation."
:group 'haskell
:prefix "haskell-indentation-")
(defcustom haskell-indentation-cycle-warn t
"Warn before moving to the leftmost indentation, if you tab at the rightmost one."
:type 'boolean
:group 'haskell-indentation)
(defcustom haskell-indentation-layout-offset 2
"Extra indentation to add before expressions in a haskell layout list."
:type 'integer
:group 'haskell-indentation)
(defcustom haskell-indentation-starter-offset 1
"Extra indentation after an opening keyword (e.g. let)."
:type 'integer
:group 'haskell-indentation)
(defcustom haskell-indentation-left-offset 2
"Extra indentation after an indentation to the left (e.g. after do)."
:type 'integer
:group 'haskell-indentation)
(defcustom haskell-indentation-ifte-offset 2
"Extra indentation after the keywords `if' `then' or `else'."
:type 'integer
:group 'haskell-indentation)
(when (featurep 'xemacs)
(defun syntax-ppss (&rest pos)
(parse-partial-sexp (point-min) (or pos (point)))))
(defconst haskell-indentation-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap [?\r] 'haskell-newline-and-indent)
(define-key keymap [backspace] 'haskell-indentation-delete-backward-char)
(define-key keymap [?\C-d] 'haskell-indentation-delete-char)
keymap))
;;;###autoload
(define-minor-mode haskell-indentation-mode
"Haskell indentation mode that deals with the layout rule.
It rebinds RET, DEL and BACKSPACE, so that indentations can be
set and deleted as if they were real tabs. It supports
autofill-mode."
:lighter " Ind"
:keymap haskell-indentation-mode-map
(kill-local-variable 'indent-line-function)
(kill-local-variable 'normal-auto-fill-function)
(when haskell-indentation-mode
(setq max-lisp-eval-depth (max max-lisp-eval-depth 600)) ;; set a higher limit for recursion
(set (make-local-variable 'indent-line-function)
'haskell-indentation-indent-line)
(set (make-local-variable 'normal-auto-fill-function)
'haskell-indentation-auto-fill-function)
(set (make-local-variable 'haskell-indent-last-position)
nil)))
(defun turn-on-haskell-indentation ()
"Turn on the haskell-indentation minor mode"
(interactive)
(haskell-indentation-mode t))
(put 'parse-error
'error-conditions
'(error parse-error))
(put 'parse-error 'error-message "Parse error")
(defun parse-error (&rest args)
(signal 'parse-error (apply 'format args)))
(defmacro on-parse-error (except &rest body)
`(condition-case parse-error-string
(progn ,@body)
(parse-error
,except
(message "%s" (cdr parse-error-string)))))
(defun kill-indented-line (&optional arg)
"`kill-line' for indented text.
Preserves indentation and removes extra whitespace"
(interactive "P")
(let ((col (current-column))
(old-point (point)))
(cond ((or (and (numberp arg) (< arg 0))
(and (not (looking-at "[ \t]*$"))
(or (not (numberp arg)) (zerop arg))))
;use default behavior when calling with a negative argument
;or killing (once) from the middle of a line
(kill-line arg))
((and (skip-chars-backward " \t") ;always true
(bolp)
(save-excursion
(forward-line arg)
(not (looking-at "[ \t]*$"))))
; killing from an empty line:
; preserve indentation of the next line
(kill-region (point)
(save-excursion
(forward-line arg)
(point)))
(skip-chars-forward " \t")
(if (> (current-column) col)
(move-to-column col)))
(t ; killing from not empty line:
; kill all indentation
(goto-char old-point)
(kill-region (point)
(save-excursion
(forward-line arg)
(skip-chars-forward " \t")
(point)))))))
(defun haskell-indentation-auto-fill-function ()
(when (> (current-column) fill-column)
(while (> (current-column) fill-column)
(skip-syntax-backward "-")
(skip-syntax-backward "^-"))
(let ((auto-fill-function nil)
(indent (car (last (haskell-indentation-find-indentations)))))
(newline)
(indent-to indent)
(end-of-line))))
(defun haskell-indentation-reindent (col)
(beginning-of-line)
(delete-region (point)
(progn (skip-syntax-forward "-")
(point)))
(indent-to col))
(defun haskell-newline-and-indent ()
(interactive)
(on-parse-error (newline)
(let* ((cc (current-column))
(ci (current-indentation))
(indentations (haskell-indentation-find-indentations)))
(skip-syntax-forward "-")
(if (prog1 (and (eolp)
(not (= (current-column) ci)))
(newline))
(haskell-indentation-reindent
(max (haskell-indentation-butlast indentations)
(haskell-indentation-matching-indentation
ci indentations)))
(haskell-indentation-reindent (haskell-indentation-matching-indentation
cc indentations))))))
(defun haskell-indentation-one-indentation (col indentations)
(let* ((last-pair (last indentations)))
(cond ((null indentations)
col)
((null (cdr indentations))
(car indentations))
((<= col (car last-pair))
col)
(t (car last-pair)))))
(defun haskell-indentation-butlast (indentations)
(when (consp (cdr indentations))
(while (cddr indentations)
(setq indentations (cdr indentations))))
(car indentations))
(defun haskell-indentation-next-indentation (col indentations)
"Find the lefmost indentation which is greater than COL."
(catch 'return
(while indentations
(if (or (< col (car indentations))
(null (cdr indentations)))
(throw 'return (car indentations))
(setq indentations (cdr indentations))))
col))
(defun haskell-indentation-previous-indentation (col indentations)
"Find the rightmost indentation which is less than COL."
(and indentations
(> col (car indentations))
(catch 'return
(while indentations
(if (or (null (cdr indentations))
(<= col (cadr indentations)))
(throw 'return (car indentations))
(setq indentations (cdr indentations))))
col)))
(defun haskell-indentation-matching-indentation (col indentations)
"Find the leftmost indentation which is greater than or equal to COL."
(catch 'return
(while indentations
(if (or (<= col (car indentations))
(null (cdr indentations)))
(throw 'return (car indentations))
(setq indentations (cdr indentations))))
col))
(defun haskell-indentation-indent-line ()
(when (save-excursion
(beginning-of-line)
(not (nth 8 (syntax-ppss))))
(let ((ci (current-indentation))
(start-column (current-column)))
(cond ((> (current-column) ci)
(save-excursion
(move-to-column ci)
(haskell-indentation-reindent
(haskell-indentation-one-indentation
ci (haskell-indentation-find-indentations)))))
((= (current-column) ci)
(haskell-indentation-reindent
(haskell-indentation-next-indentation
ci (haskell-indentation-find-indentations))))
(t (move-to-column ci)
(haskell-indentation-reindent
(haskell-indentation-matching-indentation
ci (haskell-indentation-find-indentations)))))
(cond ((not (= (current-column) start-column))
(setq haskell-indent-last-position nil))
((not haskell-indentation-cycle-warn)
(haskell-indentation-reindent
(haskell-indentation-next-indentation
-1
(haskell-indentation-find-indentations))))
((not (eql (point) haskell-indent-last-position))
(message "Press TAB again to go to the leftmost indentation")
(setq haskell-indent-last-position (point)))
(t
(haskell-indentation-reindent
(haskell-indentation-next-indentation
-1
(haskell-indentation-find-indentations))))))))
(defun haskell-indentation-delete-backward-char (n)
(interactive "p")
(on-parse-error (backward-delete-char 1)
(cond
((and delete-selection-mode
mark-active
(not (= (point) (mark))))
(delete-region (mark) (point)))
((or (= (current-column) 0)
(> (current-column) (current-indentation))
(nth 8 (syntax-ppss)))
(delete-backward-char n))
(t (let* ((ci (current-indentation))
(pi (haskell-indentation-previous-indentation
ci (haskell-indentation-find-indentations))))
(save-excursion
(cond (pi
(move-to-column pi)
(delete-region (point)
(progn (move-to-column ci)
(point))))
(t
(beginning-of-line)
(delete-region (max (point-min) (- (point) 1))
(progn (move-to-column ci)
(point)))))))))))
(defun haskell-indentation-delete-char (n)
(interactive "p")
(on-parse-error (delete-char 1)
(cond
((and delete-selection-mode
mark-active
(not (= (point) (mark))))
(delete-region (mark) (point)))
((or (eolp)
(>= (current-column) (current-indentation))
(nth 8 (syntax-ppss)))
(delete-char n))
(t
(let* ((ci (current-indentation))
(pi (haskell-indentation-previous-indentation
ci (haskell-indentation-find-indentations))))
(save-excursion
(if (and pi (> pi (current-column)))
(move-to-column pi))
(delete-region (point)
(progn (move-to-column ci)
(point)))))))))
(defun haskell-indentation-goto-least-indentation ()
(beginning-of-line)
(catch 'return
(while (not (bobp))
(forward-comment (- (buffer-size)))
(beginning-of-line)
(let ((ps (nth 8 (syntax-ppss))))
(when ps ;; inside comment or string
(goto-char ps)))
(when (= 0 (current-indentation))
(throw 'return nil))))
(beginning-of-line)
(when (bobp)
(forward-comment (buffer-size))))
;; Dynamically scoped variables.
(defvar following-token)
(defvar current-token)
(defvar left-indent)
(defvar starter-indent)
(defvar current-indent)
(defvar layout-indent)
(defvar parse-line-number)
(defvar possible-indentations)
(defvar indentation-point)
(defun haskell-indentation-parse-to-indentations ()
(save-excursion
(skip-syntax-forward "-")
(let ((indentation-point (point))
(layout-indent 0)
(parse-line-number 0)
(current-indent haskell-indentation-layout-offset)
(starter-indent haskell-indentation-layout-offset)
(left-indent haskell-indentation-layout-offset)
(case-fold-search nil)
current-token
following-token
possible-indentations)
(haskell-indentation-goto-least-indentation)
(if (<= indentation-point (point))
'(0)
(setq current-token (haskell-indentation-peek-token))
(catch 'parse-end
(haskell-indentation-toplevel)
(when (not (equal current-token 'end-tokens))
(parse-error "illegal token: %s" current-token)))
possible-indentations))))
(defun haskell-indentation-find-indentations ()
(let ((ppss (syntax-ppss)))
(cond
((nth 3 ppss) '(0))
((nth 4 ppss)
(if (save-excursion
(and (skip-syntax-forward "-")
(eolp)
(not (> (forward-line 1) 0))
(not (nth 4 (syntax-ppss)))))
(haskell-indentation-parse-to-indentations)
'(0)))
(t
(haskell-indentation-parse-to-indentations)))))
(defconst haskell-indentation-toplevel-list
'(("module" . haskell-indentation-module)
("data" . haskell-indentation-data)
("type" . haskell-indentation-data)
("newtype" . haskell-indentation-data)
("class" . haskell-indentation-class-declaration)
("instance" . haskell-indentation-class-declaration )))
(defconst haskell-indentation-type-list
'(("::" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-type)))
("(" . (lambda () (haskell-indentation-list #'haskell-indentation-type
")" "," nil)))
("[" . (lambda () (haskell-indentation-list #'haskell-indentation-type
"]" "," nil)))
("{" . (lambda () (haskell-indentation-list #'haskell-indentation-type
"}" "," nil)))))
(defconst haskell-indentation-expression-list
'(("data" . haskell-indentation-data)
("type" . haskell-indentation-data)
("newtype" . haskell-indentation-data)
("if" . (lambda () (haskell-indentation-phrase
'(haskell-indentation-expression
"then" haskell-indentation-expression
"else" haskell-indentation-expression))))
("let" . (lambda () (haskell-indentation-phrase
'(haskell-indentation-declaration-layout
"in" haskell-indentation-expression))))
("do" . (lambda () (haskell-indentation-with-starter
#'haskell-indentation-expression-layout nil)))
("case" . (lambda () (haskell-indentation-phrase
'(haskell-indentation-expression
"of" haskell-indentation-case-layout))))
("\\" . (lambda () (haskell-indentation-phrase
'(haskell-indentation-expression
"->" haskell-indentation-expression))))
("where" . (lambda () (haskell-indentation-with-starter
#'haskell-indentation-declaration-layout nil)))
("::" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-type)))
("=" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-expression)))
("<-" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-expression)))
("(" . (lambda () (haskell-indentation-list #'haskell-indentation-expression
")" '(list "," "->") nil)))
("[" . (lambda () (haskell-indentation-list #'haskell-indentation-expression
"]" "," "|")))
("{" . (lambda () (haskell-indentation-list #'haskell-indentation-expression
"}" "," nil)))))
(defun haskell-indentation-expression-layout ()
(haskell-indentation-layout #'haskell-indentation-expression))
(defun haskell-indentation-declaration-layout ()
(haskell-indentation-layout #'haskell-indentation-declaration))
(defun haskell-indentation-case-layout ()
(haskell-indentation-layout #'haskell-indentation-case))
(defun haskell-indentation-fundep ()
(haskell-indentation-with-starter
(lambda () (haskell-indentation-separated
#'haskell-indentation-fundep1 "," nil))
nil))
(defun haskell-indentation-fundep1 ()
(let ((current-indent (current-column)))
(while (member current-token '(value "->"))
(haskell-indentation-read-next-token))
(when (and (equal current-token 'end-tokens)
(member following-token '(value "->")))
(haskell-indentation-add-indentation current-indent))))
(defun haskell-indentation-toplevel ()
(haskell-indentation-layout
(lambda ()
(let ((parser (assoc current-token haskell-indentation-toplevel-list)))
(if parser
(funcall (cdr parser))
(haskell-indentation-declaration))))))
(defun haskell-indentation-type ()
(let ((current-indent (current-column)))
(catch 'return
(while t
(cond
((member current-token '(value operator "->"))
(haskell-indentation-read-next-token))
((equal current-token 'end-tokens)
(when (member following-token
'(value operator no-following-token
"->" "(" "[" "{" "::"))
(haskell-indentation-add-indentation current-indent))
(throw 'return nil))
(t (let ((parser (assoc current-token haskell-indentation-type-list)))
(if (not parser)
(throw 'return nil)
(funcall (cdr parser))))))))))
(defun haskell-indentation-data ()
(haskell-indentation-with-starter
(lambda ()
(when (equal current-token "instance")
(haskell-indentation-read-next-token))
(haskell-indentation-type)
(cond ((equal current-token "=")
(haskell-indentation-with-starter
(lambda () (haskell-indentation-separated #'haskell-indentation-type "|" "deriving"))
nil))
((equal current-token "where")
(haskell-indentation-with-starter
#'haskell-indentation-expression-layout nil))))
nil))
(defun haskell-indentation-class-declaration ()
(haskell-indentation-with-starter
(lambda ()
(haskell-indentation-type)
(when (equal current-token "|")
(haskell-indentation-fundep))
(when (equal current-token "where")
(haskell-indentation-with-starter
#'haskell-indentation-expression-layout nil)))
nil))
(defun haskell-indentation-module ()
(haskell-indentation-with-starter
(lambda ()
(let ((current-indent (current-column)))
(haskell-indentation-read-next-token)
(when (equal current-token "(")
(haskell-indentation-list
#'haskell-indentation-module-export
")" "," nil))
(when (equal current-token 'end-tokens)
(haskell-indentation-add-indentation current-indent)
(throw 'parse-end nil))
(when (equal current-token "where")
(haskell-indentation-read-next-token)
(when (equal current-token 'end-tokens)
(haskell-indentation-add-layout-indent)
(throw 'parse-end nil))
(haskell-indentation-layout #'haskell-indentation-toplevel))))
nil))
(defun haskell-indentation-module-export ()
(cond ((equal current-token "module")
(let ((current-indent (current-column)))
(haskell-indentation-read-next-token)
(cond ((equal current-token 'end-tokens)
(haskell-indentation-add-indentation current-indent))
((equal current-token 'value)
(haskell-indentation-read-next-token)))))
(t (haskell-indentation-type))))
(defun haskell-indentation-list (parser end sep stmt-sep)
(haskell-indentation-with-starter
`(lambda () (haskell-indentation-separated #',parser
,sep
,stmt-sep))
end))
(defun haskell-indentation-with-starter (parser end)
(let ((starter-column (current-column))
(current-indent current-indent)
(left-indent (if (= (current-column) (current-indentation))
(current-column) left-indent)))
(haskell-indentation-read-next-token)
(when (equal current-token 'end-tokens)
(if (equal following-token end)
(haskell-indentation-add-indentation starter-column)
(haskell-indentation-add-indentation
(+ left-indent haskell-indentation-left-offset)))
(throw 'parse-end nil))
(let* ((current-indent (current-column))
(starter-indent (min starter-column current-indent))
(left-indent (if end (+ current-indent haskell-indentation-starter-offset)
left-indent)))
(funcall parser)
(cond ((equal current-token 'end-tokens)
(when (equal following-token end)
(haskell-indentation-add-indentation starter-indent))
(when end (throw 'parse-end nil))) ;; add no indentations
((equal current-token end)
(haskell-indentation-read-next-token)) ;; continue
(end (parse-error "Illegal token: %s" current-token))))))
(defun haskell-indentation-case ()
(haskell-indentation-expression)
(cond ((equal current-token 'end-tokens)
(haskell-indentation-add-indentation current-indent))
((equal current-token "|")
(haskell-indentation-with-starter
(lambda () (haskell-indentation-separated #'haskell-indentation-case "|" nil))
nil))
((equal current-token "->")
(haskell-indentation-statement-right #'haskell-indentation-expression))
;; otherwise fallthrough
))
(defun haskell-indentation-statement-right (parser)
(haskell-indentation-read-next-token)
(when (equal current-token 'end-tokens)
(haskell-indentation-add-indentation
(+ left-indent haskell-indentation-left-offset))
(throw 'parse-end nil))
(let ((current-indent (current-column)))
(funcall parser)))
(defun haskell-indentation-simple-declaration ()
(haskell-indentation-expression)
(cond ((equal current-token "=")
(haskell-indentation-statement-right #'haskell-indentation-expression))
((equal current-token "::")
(haskell-indentation-statement-right #'haskell-indentation-type))
((and (equal current-token 'end-tokens)
(equal following-token "="))
(haskell-indentation-add-indentation current-indent)
(throw 'parse-end nil))))
(defun haskell-indentation-declaration ()
(haskell-indentation-expression)
(cond ((equal current-token "|")
(haskell-indentation-with-starter
(lambda () (haskell-indentation-separated #'haskell-indentation-expression "," "|"))
nil))
((equal current-token 'end-tokens)
(when (member following-token '("|" "=" "::" ","))
(haskell-indentation-add-indentation current-indent)
(throw 'parse-end nil)))))
(defun haskell-indentation-layout (parser)
(if (equal current-token "{")
(haskell-indentation-list parser "}" ";" nil)
(haskell-indentation-implicit-layout-list parser)))
(defun haskell-indentation-expression-token (token)
(member token '("if" "let" "do" "case" "\\" "(" "[" "::"
value operator no-following-token)))
(defun haskell-indentation-expression ()
(let ((current-indent (current-column)))
(catch 'return
(while t
(cond
((member current-token '(value operator))
(haskell-indentation-read-next-token))
((equal current-token 'end-tokens)
(cond ((equal following-token "where")
(haskell-indentation-add-indentation
(+ left-indent haskell-indentation-left-offset)))
((haskell-indentation-expression-token following-token)
(haskell-indentation-add-indentation
current-indent)))
(throw 'return nil))
(t (let ((parser (assoc current-token haskell-indentation-expression-list)))
(when (null parser)
(throw 'return nil))
(funcall (cdr parser))
(when (and (equal current-token 'end-tokens)
(equal (car parser) "let")
(= haskell-indentation-layout-offset current-indent)
(haskell-indentation-expression-token following-token))
;; inside a layout, after a let construct
(haskell-indentation-add-layout-indent)
(throw 'parse-end nil))
(unless (member (car parser) '("(" "[" "{" "do" "case"))
(throw 'return nil)))))))))
(defun haskell-indentation-test-indentations ()
(interactive)
(let ((indentations (save-excursion (haskell-indentation-find-indentations)))
(str "")
(pos 0))
(while indentations
(when (>= (car indentations) pos)
(setq str (concat str (make-string (- (car indentations) pos) ?\ )
"|"))
(setq pos (+ 1 (car indentations))))
(setq indentations (cdr indentations)))
(end-of-line)
(newline)
(insert str)))
(defun haskell-indentation-separated (parser separator stmt-separator)
(catch 'return
(while t
(funcall parser)
(cond ((if (listp separator) (member current-token separator) (equal current-token separator))
(haskell-indentation-at-separator))
((equal current-token stmt-separator)
(setq starter-indent (current-column))
(haskell-indentation-at-separator))
((equal current-token 'end-tokens)
(cond ((or (equal following-token separator)
(equal following-token stmt-separator))
(haskell-indentation-add-indentation starter-indent)
(throw 'parse-end nil)))
(throw 'return nil))
(t (throw 'return nil))))))
(defun haskell-indentation-at-separator ()
(let ((separator-column
(and (= (current-column) (current-indentation))
(current-column))))
(haskell-indentation-read-next-token)
(cond ((eq current-token 'end-tokens)
(haskell-indentation-add-indentation current-indent)
(throw 'return nil))
(separator-column ;; on the beginning of the line
(setq current-indent (current-column))
(setq starter-indent separator-column)))))
(defun haskell-indentation-implicit-layout-list (parser)
(let* ((layout-indent (current-column))
(current-indent (current-column))
(left-indent (current-column)))
(catch 'return
(while t
(let ((left-indent left-indent))
(funcall parser))
(cond ((member current-token '(layout-next ";"))
(haskell-indentation-read-next-token))
((equal current-token 'end-tokens)
(when (or (haskell-indentation-expression-token following-token)
(equal following-token ";"))
(haskell-indentation-add-layout-indent))
(throw 'return nil))
(t (throw 'return nil))))))
;; put haskell-indentation-read-next-token outside the current-indent definition
;; so it will not return 'layout-end again
(when (eq current-token 'layout-end)
(haskell-indentation-read-next-token))) ;; leave layout at 'layout-end or illegal token
(defun haskell-indentation-phrase (phrase)
(haskell-indentation-with-starter
`(lambda () (haskell-indentation-phrase-rest ',phrase))
nil))
(defun haskell-indentation-phrase-rest (phrase)
(let ((starter-line parse-line-number))
(let ((current-indent (current-column)))
(funcall (car phrase)))
(cond
((equal current-token 'end-tokens)
(cond ((null (cdr phrase))) ;; fallthrough
((equal following-token (cadr phrase))
(haskell-indentation-add-indentation starter-indent)
(throw 'parse-end nil))
((equal (cadr phrase) "in")
(when (= left-indent layout-indent)
(haskell-indentation-add-layout-indent)
(throw 'parse-end nil)))
(t (throw 'parse-end nil))))
((null (cdr phrase)))
((equal (cadr phrase) current-token)
(let* ((on-new-line (= (current-column) (current-indentation)))
(lines-between (- parse-line-number starter-line))
(left-indent (if (<= lines-between 0)
left-indent
starter-indent)))
(haskell-indentation-read-next-token)
(when (equal current-token 'end-tokens)
(haskell-indentation-add-indentation
(cond ((member (cadr phrase) '("then" "else"))
(+ starter-indent haskell-indentation-ifte-offset))
((member (cadr phrase) '("in" "->"))
;; expression ending in another expression
(if on-new-line
(+ left-indent haskell-indentation-starter-offset)
left-indent))
(t (+ left-indent haskell-indentation-left-offset))))
(throw 'parse-end nil))
(haskell-indentation-phrase-rest (cddr phrase))))
((equal (cadr phrase) "in")) ;; fallthrough
(t (parse-error "Expecting %s" (cadr phrase))))))
(defun haskell-indentation-add-indentation (indent)
(haskell-indentation-push-indentation
(if (<= indent layout-indent)
(+ layout-indent haskell-indentation-layout-offset)
indent)))
(defun haskell-indentation-add-layout-indent ()
(haskell-indentation-push-indentation layout-indent))
(defun haskell-indentation-push-indentation (indent)
(when (or (null possible-indentations)
(< indent (car possible-indentations)))
(setq possible-indentations
(cons indent possible-indentations))))
(defun haskell-indentation-token-test ()
(let ((current-token nil)
(following-token nil)
(layout-indent 0)
(indentation-point (mark)))
(haskell-indentation-read-next-token)))
(defun haskell-indentation-read-next-token ()
(cond ((eq current-token 'end-tokens)
'end-tokens)
((eq current-token 'layout-end)
(cond ((> layout-indent (current-column))
'layout-end)
((= layout-indent (current-column))
(setq current-token 'layout-next))
((< layout-indent (current-column))
(setq current-token (haskell-indentation-peek-token)))))
((eq current-token 'layout-next)
(setq current-token (haskell-indentation-peek-token)))
((> layout-indent (current-column))
(setq current-token 'layout-end))
(t
(haskell-indentation-skip-token)
(if (>= (point) indentation-point)
(progn
(setq following-token
(if (= (point) indentation-point)
(haskell-indentation-peek-token)
'no-following-token))
(setq current-token 'end-tokens))
(when (= (current-column) (current-indentation))
;; on a new line
(setq current-indent (current-column))
(setq left-indent (current-column))
(setq parse-line-number (+ parse-line-number 1)))
(cond ((> layout-indent (current-column))
(setq current-token 'layout-end))
((= layout-indent (current-column))
(setq current-token 'layout-next))
(t (setq current-token (haskell-indentation-peek-token))))))))
(defun haskell-indentation-peek-token ()
(cond ((looking-at "\\(if\\|then\\|else\\|let\\|in\\|do\\|case\\|of\\|where\\|module\\|deriving\\|data\\|type\\|newtype\\|class\\|instance\\)\\([^A-Za-z']\\|$\\)")
(match-string 1))
((looking-at "[][(){}[,;]")
(match-string 0))
((looking-at "\\(\\\\\\|->\\|<-\\|::\\|=\\||\\)\\([^-:!#$%&*+./<=>?@\\\\^|~]\\|$\\)")
(match-string 1))
((looking-at"[-:!#$%&*+./<=>?@\\\\^|~`]" )
'operator)
(t 'value)))
(defun haskell-indentation-skip-token ()
"Skip to the next token."
(if (or (looking-at "'\\([^\\']\\|\\\\.\\)*'")
(looking-at "\"\\([^\\\"]\\|\\\\.\\)*\"")
(looking-at "[A-Z][A-Z_a-z0-9']*\\(\\.[A-Z_a-z][A-Z_a-z0-9']*\\)*") ; Allows hierarchical modules
(looking-at "[A-Z_a-z][A-Z_a-z0-9']*") ; Only unqualified vars can start with lowercase
(looking-at "[0-9][0-9oOxXeE+-]*")
(looking-at "[-:!#$%&*+./<=>?@\\\\^|~]+")
(looking-at "[](){}[,;]")
(looking-at "`[A-Za-z0-9']*`"))
(goto-char (match-end 0))
;; otherwise skip until space found
(skip-syntax-forward "^-"))
(forward-comment (buffer-size)))
(provide 'haskell-indentation)
;;; haskell-indentation.el ends here

532
.emacs.d.backup/haskell-mode/haskell-mode.el Normal file
View file

@ -0,0 +1,532 @@
;;; haskell-mode.el --- A Haskell editing mode -*-coding: iso-8859-1;-*-
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc
;; Copyright (C) 1992, 1997-1998 Simon Marlow, Graeme E Moss, and Tommy Thorn
;; Authors: 1992 Simon Marlow
;; 1997-1998 Graeme E Moss <gem@cs.york.ac.uk> and
;; Tommy Thorn <thorn@irisa.fr>,
;; 2001-2002 Reuben Thomas (>=v1.4)
;; 2003 Dave Love <fx@gnu.org>
;; Keywords: faces files Haskell
;; Version: v2.6.4
;; URL: http://www.haskell.org/haskell-mode/
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; To provide a pleasant mode to browse and edit Haskell files, linking
;; into the following supported modules:
;;
;; `haskell-font-lock', Graeme E Moss and Tommy Thorn
;; Fontifies standard Haskell keywords, symbols, functions, etc.
;;
;; `haskell-decl-scan', Graeme E Moss
;; Scans top-level declarations, and places them in a menu.
;;
;; `haskell-doc', Hans-Wolfgang Loidl
;; Echoes types of functions or syntax of keywords when the cursor is idle.
;;
;; `haskell-indentation', Kristof Bastiaensen
;; Intelligent semi-automatic indentation, mark two.
;;
;; `haskell-indent', Guy Lapalme
;; Intelligent semi-automatic indentation.
;;
;; `haskell-simple-indent', Graeme E Moss and Heribert Schuetz
;; Simple indentation.
;;
;; `inf-haskell'
;; Interaction with an inferior Haskell process.
;; It replaces the previous two modules:
;; `haskell-hugs', Guy Lapalme
;; `haskell-ghci', Chris Web
;;
;;
;; This mode supports full Haskell 1.4 including literate scripts.
;; In some versions of (X)Emacs it may only support Latin-1, not Unicode.
;;
;; History:
;;
;; This mode is based on an editing mode by Simon Marlow 11/1/92
;; and heavily modified by Graeme E Moss and Tommy Thorn 7/11/98.
;;
;; If you have any problems or suggestions specific to a supported
;; module, consult that module for a list of known bugs, and an
;; author to contact via email. For general problems or suggestions,
;; consult the list below, then email gem@cs.york.ac.uk and
;; thorn@irisa.fr quoting the version of the mode you are using, the
;; version of Emacs you are using, and a small example of the problem
;; or suggestion.
;;
;; Version 1.5
;; Added autoload for haskell-indentation
;;
;; Version 1.43:
;; Various tweaks to doc strings and customization support from
;; Ville Skyttä <scop@xemacs.org>.
;;
;; Version 1.42:
;; Added autoload for GHCi inferior mode (thanks to Scott
;; Williams for the bug report and fix).
;;
;; Version 1.41:
;; Improved packaging, and made a couple more variables
;; interactively settable.
;;
;; Version 1.4:
;; Added GHCi mode from Chris Webb, and tidied up a little.
;;
;; Version 1.3:
;; The literate or non-literate style of a buffer is now indicated
;; by just the variable haskell-literate: nil, `bird', or `tex'.
;; For literate buffers with ambiguous style, the value of
;; haskell-literate-default is used.
;;
;; Version 1.2:
;; Separated off font locking, declaration scanning and simple
;; indentation, and made them separate modules. Modules can be
;; added easily now. Support for modules haskell-doc,
;; haskell-indent, and haskell-hugs. Literate and non-literate
;; modes integrated into one mode, and literate buffer indicated by
;; value of haskell-literate(-bird-style).
;;
;; Version 1.1:
;; Added support for declaration scanning under XEmacs via
;; func-menu. Moved operators to level two fontification.
;;
;; Version 1.0:
;; Added a nice indention support from Heribert Schuetz
;; <Heribert.Schuetz@informatik.uni-muenchen.de>:
;;
;; I have just hacked an Emacs Lisp function which you might prefer
;; to `indent-relative' in haskell-mode.el. See below. It is not
;; really Haskell-specific because it does not take into account
;; keywords like `do', `of', and `let' (where the layout rule
;; applies), but I already find it useful.
;;
;; Cleaned up the imenu support. Added support for literate scripts.
;;
;; Version 0.103 [HWL]:
;; From Hans Wolfgang Loidl <hwloidl@dcs.gla.ac.uk>:
;;
;; I (HWL) added imenu support by copying the appropriate functions
;; from hugs-mode. A menu-bar item "Declarations" is now added in
;; haskell mode. The new code, however, needs some clean-up.
;;
;; Version 0.102:
;;
;; Moved C-c C-c key binding to comment-region. Leave M-g M-g to do
;; the work. comment-start-skip is changed to comply with comment-start.
;;
;; Version 0.101:
;;
;; Altered indent-line-function to indent-relative.
;;
;; Version 0.100:
;;
;; First official release.
;; Present Limitations/Future Work (contributions are most welcome!):
;;
;; . Would like RET in Bird-style literate mode to add a ">" at the
;; start of a line when previous line starts with ">". Or would
;; "> " be better?
;;
;; . Support for GreenCard?
;;
;;; Code:
(eval-when-compile (require 'cl))
;; All functions/variables start with `(literate-)haskell-'.
;; Version of mode.
(defconst haskell-version "v2.6.4"
"`haskell-mode' version number.")
(defun haskell-version ()
"Echo the current version of `haskell-mode' in the minibuffer."
(interactive)
(message "Using haskell-mode version %s" haskell-version))
(defgroup haskell nil
"Major mode for editing Haskell programs."
:group 'languages
:prefix "haskell-")
;; Set load-path
;;;###autoload
(add-to-list 'load-path
(or (file-name-directory load-file-name) (car load-path)))
;; Set up autoloads for the modules we supply
(autoload 'turn-on-haskell-decl-scan "haskell-decl-scan"
"Turn on Haskell declaration scanning." t)
(autoload 'turn-on-haskell-doc-mode "haskell-doc"
"Turn on Haskell Doc minor mode." t)
(autoload 'turn-on-haskell-indentation "haskell-indentation"
"Turn on advanced Haskell indentation." t)
(autoload 'turn-on-haskell-indent "haskell-indent"
"Turn on Haskell indentation." t)
(autoload 'turn-on-haskell-simple-indent "haskell-simple-indent"
"Turn on simple Haskell indentation." t)
;; Functionality provided in other files.
(autoload 'haskell-ds-create-imenu-index "haskell-decl-scan")
(autoload 'haskell-font-lock-choose-keywords "haskell-font-lock")
(autoload 'haskell-doc-current-info "haskell-doc")
;; Obsolete functions.
(defun turn-on-haskell-font-lock ()
(turn-on-font-lock)
(message "turn-on-haskell-font-lock is obsolete. Use turn-on-font-lock instead."))
(defun turn-on-haskell-hugs () (message "haskell-hugs is obsolete."))
(defun turn-on-haskell-ghci () (message "haskell-ghci is obsolete."))
;; Are we looking at a literate script?
(defvar haskell-literate nil
"*If not nil, the current buffer contains a literate Haskell script.
Possible values are: `bird' and `tex', for Bird-style and LaTeX-style
literate scripts respectively. Set by `haskell-mode' and
`literate-haskell-mode'. For an ambiguous literate buffer -- ie. does
not contain either \"\\begin{code}\" or \"\\end{code}\" on a line on
its own, nor does it contain \">\" at the start of a line -- the value
of `haskell-literate-default' is used.")
(make-variable-buffer-local 'haskell-literate)
(put 'haskell-literate 'safe-local-variable 'symbolp)
;; Default literate style for ambiguous literate buffers.
(defcustom haskell-literate-default 'bird
"Default value for `haskell-literate'.
Used if the style of a literate buffer is ambiguous. This variable should
be set to the preferred literate style."
:type '(choice (const bird) (const tex) (const nil)))
;; Mode maps.
(defvar haskell-mode-map
(let ((map (make-sparse-keymap)))
;; Bindings for the inferior haskell process:
;; (define-key map [?\M-C-x] 'inferior-haskell-send-defun)
;; (define-key map [?\C-x ?\C-e] 'inferior-haskell-send-last-sexp)
;; (define-key map [?\C-c ?\C-r] 'inferior-haskell-send-region)
(define-key map [?\C-c ?\C-z] 'switch-to-haskell)
(define-key map [?\C-c ?\C-l] 'inferior-haskell-load-file)
;; I think it makes sense to bind inferior-haskell-load-and-run to C-c
;; C-r, but since it used to be bound to `reload' until june 2007, I'm
;; going to leave it out for now.
;; (define-key map [?\C-c ?\C-r] 'inferior-haskell-load-and-run)
(define-key map [?\C-c ?\C-b] 'switch-to-haskell)
;; (define-key map [?\C-c ?\C-s] 'inferior-haskell-start-process)
;; That's what M-; is for.
;; (define-key map "\C-c\C-c" 'comment-region)
(define-key map (kbd "C-c C-t") 'inferior-haskell-type)
(define-key map (kbd "C-c C-i") 'inferior-haskell-info)
(define-key map (kbd "C-c M-.") 'inferior-haskell-find-definition)
(define-key map (kbd "C-c C-d") 'inferior-haskell-find-haddock)
(define-key map [remap delete-indentation] 'haskell-delete-indentation)
map)
"Keymap used in Haskell mode.")
(easy-menu-define haskell-mode-menu haskell-mode-map
"Menu for the Haskell major mode."
;; Suggestions from Pupeno <pupeno@pupeno.com>:
;; - choose the underlying interpreter
;; - look up docs
`("Haskell"
["Indent line" indent-according-to-mode]
["Indent region" indent-region mark-active]
["(Un)Comment region" comment-region mark-active]
"---"
["Start interpreter" switch-to-haskell]
["Load file" inferior-haskell-load-file]
"---"
,(if (default-boundp 'eldoc-documentation-function)
["Doc mode" eldoc-mode
:style toggle :selected (bound-and-true-p eldoc-mode)]
["Doc mode" haskell-doc-mode
:style toggle :selected (and (boundp 'haskell-doc-mode) haskell-doc-mode)])
["Customize" (customize-group 'haskell)]
))
;; Syntax table.
(defvar haskell-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\ " " table)
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\" "\"" table)
(modify-syntax-entry ?\' "\'" table)
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?\( "()" table)
(modify-syntax-entry ?\) ")(" table)
(modify-syntax-entry ?\[ "(]" table)
(modify-syntax-entry ?\] ")[" table)
(cond ((featurep 'xemacs)
;; I don't know whether this is equivalent to the below
;; (modulo nesting). -- fx
(modify-syntax-entry ?{ "(}5" table)
(modify-syntax-entry ?} "){8" table)
(modify-syntax-entry ?- "_ 1267" table))
(t
;; In Emacs 21, the `n' indicates that they nest.
;; The `b' annotation is actually ignored because it's only
;; meaningful on the second char of a comment-starter, so
;; on Emacs 20 and before we get wrong results. --Stef
(modify-syntax-entry ?\{ "(}1nb" table)
(modify-syntax-entry ?\} "){4nb" table)
(modify-syntax-entry ?- "_ 123" table)))
(modify-syntax-entry ?\n ">" table)
(let (i lim)
(map-char-table
(lambda (k v)
(when (equal v '(1))
;; The current Emacs 22 codebase can pass either a char
;; or a char range.
(if (consp k)
(setq i (car k)
lim (cdr k))
(setq i k
lim k))
(while (<= i lim)
(when (> i 127)
(modify-syntax-entry i "_" table))
(setq i (1+ i)))))
(standard-syntax-table)))
(modify-syntax-entry ?\` "$`" table)
(modify-syntax-entry ?\\ "\\" table)
(mapc (lambda (x)
(modify-syntax-entry x "_" table))
;; Some of these are actually OK by default.
"!#$%&*+./:<=>?@^|~")
(unless (featurep 'mule)
;; Non-ASCII syntax should be OK, at least in Emacs.
(mapc (lambda (x)
(modify-syntax-entry x "_" table))
(concat "¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿"
"×÷"))
(mapc (lambda (x)
(modify-syntax-entry x "w" table))
(concat "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ"
"ØÙÚÛÜÝÞß"
"àáâãäåæçèéêëìíîïðñòóôõö"
"øùúûüýþÿ")))
table)
"Syntax table used in Haskell mode.")
(defun haskell-ident-at-point ()
"Return the identifier under point, or nil if none found.
May return a qualified name."
(save-excursion
(let ((case-fold-search nil))
(multiple-value-bind (start end)
(if (looking-at "\\s_")
(values (progn (skip-syntax-backward "_") (point))
(progn (skip-syntax-forward "_") (point)))
(values
(progn (skip-syntax-backward "w'")
(skip-syntax-forward "'") (point))
(progn (skip-syntax-forward "w'") (point))))
;; If we're looking at a module ID that qualifies further IDs, add
;; those IDs.
(goto-char start)
(while (and (looking-at "[[:upper:]]") (eq (char-after end) ?.)
;; It's a module ID that qualifies further IDs.
(goto-char (1+ end))
(save-excursion
(when (not (zerop (skip-syntax-forward
(if (looking-at "\\s_") "_" "w'"))))
(setq end (point))))))
;; If we're looking at an ID that's itself qualified by previous
;; module IDs, add those too.
(goto-char start)
(if (eq (char-after) ?.) (forward-char 1)) ;Special case for "."
(while (and (eq (char-before) ?.)
(progn (forward-char -1)
(not (zerop (skip-syntax-backward "w'"))))
(skip-syntax-forward "'")
(looking-at "[[:upper:]]"))
(setq start (point)))
;; This is it.
(buffer-substring-no-properties start end)))))
(defun haskell-delete-indentation (&optional arg)
"Like `delete-indentation' but ignoring Bird-stlye \">\"."
(interactive "*P")
(let ((fill-prefix (or fill-prefix (if (eq haskell-literate 'bird) ">"))))
(delete-indentation arg)))
;; Various mode variables.
(defcustom haskell-mode-hook nil
"Hook run after entering Haskell mode. Do not select more than one of the three indentation modes."
:type 'hook
:options '(turn-on-haskell-indent turn-on-haskell-indentation turn-on-font-lock turn-on-eldoc-mode
turn-on-simple-indent turn-on-haskell-doc-mode imenu-add-menubar-index))
(defvar eldoc-print-current-symbol-info-function)
;; The main mode functions
;;;###autoload
(define-derived-mode haskell-mode fundamental-mode "Haskell"
"Major mode for editing Haskell programs.
Blank lines separate paragraphs, comments start with `-- '.
\\<haskell-mode-map>
Literate scripts are supported via `literate-haskell-mode'.
The variable `haskell-literate' indicates the style of the script in the
current buffer. See the documentation on this variable for more details.
Modules can hook in via `haskell-mode-hook'. The following modules
are supported with an `autoload' command:
`haskell-decl-scan', Graeme E Moss
Scans top-level declarations, and places them in a menu.
`haskell-doc', Hans-Wolfgang Loidl
Echoes types of functions or syntax of keywords when the cursor is idle.
`haskell-indentation', Kristof Bastiaensen
Intelligent semi-automatic indentation Mk2
`haskell-indent', Guy Lapalme
Intelligent semi-automatic indentation.
`haskell-simple-indent', Graeme E Moss and Heribert Schuetz
Simple indentation.
Module X is activated using the command `turn-on-X'. For example,
`haskell-indent' is activated using `turn-on-haskell-indent'.
For more information on a module, see the help for its `X-mode'
function. Some modules can be deactivated using `turn-off-X'. (Note
that `haskell-doc' is irregular in using `turn-(on/off)-haskell-doc-mode'.)
Use `haskell-version' to find out what version this is.
Invokes `haskell-mode-hook'."
(set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'comment-start) "-- ")
(set (make-local-variable 'comment-padding) 0)
(set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)")
(set (make-local-variable 'parse-sexp-ignore-comments) t)
;; Set things up for eldoc-mode.
(set (make-local-variable 'eldoc-documentation-function)
'haskell-doc-current-info)
;; Set things up for imenu.
(set (make-local-variable 'imenu-create-index-function)
'haskell-ds-create-imenu-index)
;; Set things up for font-lock.
(set (make-local-variable 'font-lock-defaults)
'(haskell-font-lock-choose-keywords
nil nil ((?\' . "w") (?_ . "w")) nil
(font-lock-syntactic-keywords
. haskell-font-lock-choose-syntactic-keywords)
(font-lock-syntactic-face-function
. haskell-syntactic-face-function)
;; Get help from font-lock-syntactic-keywords.
(parse-sexp-lookup-properties . t)))
;; Haskell's layout rules mean that TABs have to be handled with extra care.
;; The safer option is to avoid TABs. The second best is to make sure
;; TABs stops are 8 chars apart, as mandated by the Haskell Report. --Stef
(set (make-local-variable 'indent-tabs-mode) nil)
(set (make-local-variable 'tab-width) 8)
(setq haskell-literate nil))
;;;###autoload
(define-derived-mode literate-haskell-mode haskell-mode "LitHaskell"
"As `haskell-mode' but for literate scripts."
(setq haskell-literate
(save-excursion
(goto-char (point-min))
(cond
((re-search-forward "^\\\\\\(begin\\|end\\){code}$" nil t) 'tex)
((re-search-forward "^>" nil t) 'bird)
(t haskell-literate-default))))
(if (eq haskell-literate 'bird)
;; fill-comment-paragraph isn't much use there, and even gets confused
;; by the syntax-table text-properties we add to mark the first char
;; of each line as a comment-starter.
(set (make-local-variable 'fill-paragraph-handle-comment) nil))
(set (make-local-variable 'mode-line-process)
'("/" (:eval (symbol-name haskell-literate)))))
;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:[gh]s\\|hi\\)\\'" . haskell-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("\\.l[gh]s\\'" . literate-haskell-mode))
(defcustom haskell-hoogle-command
(if (executable-find "hoogle") "hoogle")
"Name of the command to use to query Hoogle.
If nil, use the Hoogle web-site."
:type '(choice (const :tag "Use Web-site" nil)
string))
;;;###autoload
(defun haskell-hoogle (query)
"Do a Hoogle search for QUERY."
(interactive
(let ((def (haskell-ident-at-point)))
(if (and def (symbolp def)) (setq def (symbol-name def)))
(list (read-string (if def
(format "Hoogle query (default %s): " def)
"Hoogle query: ")
nil nil def))))
(if (null haskell-hoogle-command)
(browse-url (format "http://haskell.org/hoogle/?q=%s" query))
(if (fboundp 'help-setup-xref)
(help-setup-xref (list 'haskell-hoogle query) (interactive-p)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(with-current-buffer standard-output
(start-process "hoogle" (current-buffer) haskell-hoogle-command
query)))))
;;;###autoload
(defalias 'hoogle 'haskell-hoogle)
;;;###autoload
(defun haskell-hayoo (query)
"Do a Hayoo search for QUERY."
(interactive
(let ((def (haskell-ident-at-point)))
(if (and def (symbolp def)) (setq def (symbol-name def)))
(list (read-string (if def
(format "Hayoo query (default %s): " def)
"Hayoo query: ")
nil nil def))))
(browse-url (format "http://holumbus.fh-wedel.de/hayoo/hayoo.html?query=%s" query)))
;;;###autoload
(defalias 'hayoo 'haskell-hayoo)
;; Provide ourselves:
(provide 'haskell-mode)
;; arch-tag: b2237ec0-ddb0-4c86-9339-52d410264980
;;; haskell-mode.el ends here

154
.emacs.d.backup/haskell-mode/haskell-simple-indent.el Normal file
View file

@ -0,0 +1,154 @@
;;; haskell-simple-indent.el --- Simple indentation module for Haskell Mode
;; Copyright (C) 1998 Heribert Schuetz, Graeme E Moss
;; Authors:
;; 1998 Heribert Schuetz <Heribert.Schuetz@informatik.uni-muenchen.de> and
;; Graeme E Moss <gem@cs.york.ac.uk>
;; Keywords: indentation files Haskell
;; Version: 1.0
;; URL: http://www.cs.york.ac.uk/~gem/haskell-mode/simple-indent.html
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; To support simple indentation of Haskell scripts.
;;
;;
;; Installation:
;;
;; To bind TAB to the indentation command for all Haskell buffers, add
;; this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)
;;
;; Otherwise, call `turn-on-haskell-simple-indent'.
;;
;;
;; Customisation:
;;
;; None supported.
;;
;;
;; History:
;;
;; If you have any problems or suggestions, after consulting the list
;; below, email gem@cs.york.ac.uk quoting the version of you are
;; using, the version of Emacs you are using, and a small example of
;; the problem or suggestion.
;;
;; Version 1.0:
;; Brought over from Haskell mode v1.1.
;;
;; Present Limitations/Future Work (contributions are most welcome!):
;;
;; (None so far.)
;;; Code:
;; All functions/variables start with
;; `(turn-(on/off)-)haskell-simple-indent'.
;; Version.
(defconst haskell-simple-indent-version "1.2"
"`haskell-simple-indent' version number.")
(defun haskell-simple-indent-version ()
"Echo the current version of `haskell-simple-indent' in the minibuffer."
(interactive)
(message "Using haskell-simple-indent version %s"
haskell-simple-indent-version))
;; Partly stolen from `indent-relative' in indent.el:
(defun haskell-simple-indent ()
"Space out to under next visible indent point.
Indent points are positions of non-whitespace following whitespace in
lines preceeding point. A position is visible if it is to the left of
the first non-whitespace of every nonblank line between the position and
the current line. If there is no visible indent point beyond the current
column, `tab-to-tab-stop' is done instead."
(interactive)
(let* ((start-column (current-column))
(invisible-from nil) ; `nil' means infinity here
(indent
(catch 'haskell-simple-indent-break
(save-excursion
(while (progn (beginning-of-line)
(not (bobp)))
(forward-line -1)
(if (not (looking-at "[ \t]*\n"))
(let ((this-indentation (current-indentation)))
(if (or (not invisible-from)
(< this-indentation invisible-from))
(if (> this-indentation start-column)
(setq invisible-from this-indentation)
(let ((end (line-beginning-position 2)))
(move-to-column start-column)
;; Is start-column inside a tab on this line?
(if (> (current-column) start-column)
(backward-char 1))
(or (looking-at "[ \t]")
(skip-chars-forward "^ \t" end))
(skip-chars-forward " \t" end)
(let ((col (current-column)))
(throw 'haskell-simple-indent-break
(if (or (= (point) end)
(and invisible-from
(> col invisible-from)))
invisible-from
col)))))))))))))
(if indent
(let ((opoint (point-marker)))
(indent-line-to indent)
(if (> opoint (point))
(goto-char opoint))
(set-marker opoint nil))
(tab-to-tab-stop))))
(defvar haskell-simple-indent-old)
;; The main functions.
(defun turn-on-haskell-simple-indent ()
"Set `indent-line-function' to a simple indentation function.
TAB will now move the cursor to the next indent point in the previous
nonblank line. An indent point is a non-whitespace character following
whitespace.
Runs `haskell-simple-indent-hook'.
Use `haskell-simple-indent-version' to find out what version this is."
(set (make-local-variable 'haskell-simple-indent-old) indent-line-function)
(set (make-local-variable 'indent-line-function) 'haskell-simple-indent)
(run-hooks 'haskell-simple-indent-hook))
(defun turn-off-haskell-simple-indent ()
"Return `indent-line-function' to original value.
I.e. the value before `turn-on-haskell-simple-indent' was called."
(when (local-variable-p 'haskell-simple-indent-old)
(setq indent-line-function haskell-simple-indent-old)
(kill-local-variable 'haskell-simple-indent-old)))
;; Provide ourselves:
(provide 'haskell-simple-indent)
;; arch-tag: 18a08122-723b-485e-b958-e1cf8218b816
;;; haskell-simple-indent.el ends here

274
.emacs.d.backup/haskell-mode/haskell-site-file.el Normal file
View file

@ -0,0 +1,274 @@
;;;### (autoloads (haskell-c-mode) "haskell-c" "haskell-c.el" (19189
;;;;;; 21847))
;;; Generated autoloads from haskell-c.el
(add-to-list 'auto-mode-alist '("\\.hsc\\'" . haskell-c-mode))
(autoload 'haskell-c-mode "haskell-c" "\
Major mode for Haskell FFI files.
\(fn)" t nil)
;;;***
;;;### (autoloads (haskell-cabal-mode) "haskell-cabal" "haskell-cabal.el"
;;;;;; (19189 21847))
;;; Generated autoloads from haskell-cabal.el
(add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode))
(autoload 'haskell-cabal-mode "haskell-cabal" "\
Major mode for Cabal package description files.
\(fn)" t nil)
;;;***
;;;### (autoloads (haskell-decl-scan-mode) "haskell-decl-scan" "haskell-decl-scan.el"
;;;;;; (19189 21847))
;;; Generated autoloads from haskell-decl-scan.el
(autoload 'haskell-decl-scan-mode "haskell-decl-scan" "\
Minor mode for declaration scanning for Haskell mode.
Top-level declarations are scanned and listed in the menu item \"Declarations\".
Selecting an item from this menu will take point to the start of the
declaration.
\\[haskell-ds-forward-decl] and \\[haskell-ds-backward-decl] move forward and backward to the start of a declaration.
Under XEmacs, the following keys are also defined:
\\[fume-list-functions] lists the declarations of the current buffer,
\\[fume-prompt-function-goto] prompts for a declaration to move to, and
\\[fume-mouse-function-goto] moves to the declaration whose name is at point.
This may link with `haskell-doc' (only for Emacs currently).
For non-literate and LaTeX-style literate scripts, we assume the
common convention that top-level declarations start at the first
column. For Bird-style literate scripts, we assume the common
convention that top-level declarations start at the third column,
ie. after \"> \".
Anything in `font-lock-comment-face' is not considered for a
declaration. Therefore, using Haskell font locking with comments
coloured in `font-lock-comment-face' improves declaration scanning.
To turn on declaration scanning for all Haskell buffers, add this to
.emacs:
(add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
To turn declaration scanning on for the current buffer, call
`turn-on-haskell-decl-scan'.
Literate Haskell scripts are supported: If the value of
`haskell-literate' (automatically set by the Haskell mode of
Moss&Thorn) is `bird', a Bird-style literate script is assumed. If it
is nil or `tex', a non-literate or LaTeX-style literate script is
assumed, respectively.
Invokes `haskell-decl-scan-mode-hook'.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (haskell-doc-show-type haskell-doc-mode) "haskell-doc"
;;;;;; "haskell-doc.el" (19189 21847))
;;; Generated autoloads from haskell-doc.el
(autoload 'haskell-doc-mode "haskell-doc" "\
Enter `haskell-doc-mode' for showing fct types in the echo area.
See variable docstring.
\(fn &optional ARG)" t nil)
(defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode)
(autoload 'haskell-doc-show-type "haskell-doc" "\
Show the type of the function near point.
For the function under point, show the type in the echo area.
This information is extracted from the `haskell-doc-prelude-types' alist
of prelude functions and their types, or from the local functions in the
current buffer.
\(fn &optional SYM)" t nil)
;;;***
;;;### (autoloads (haskell-indent-mode) "haskell-indent" "haskell-indent.el"
;;;;;; (19189 21847))
;;; Generated autoloads from haskell-indent.el
(autoload 'haskell-indent-mode "haskell-indent" "\
``intelligent'' Haskell indentation mode that deals with
the layout rule of Haskell. \\[haskell-indent-cycle] starts the cycle
which proposes new possibilities as long as the TAB key is pressed.
Any other key or mouse click terminates the cycle and is interpreted
except for RET which merely exits the cycle.
Other special keys are:
\\[haskell-indent-insert-equal]
inserts an =
\\[haskell-indent-insert-guard]
inserts an |
\\[haskell-indent-insert-otherwise]
inserts an | otherwise =
these functions also align the guards and rhs of the current definition
\\[haskell-indent-insert-where]
inserts a where keyword
\\[haskell-indent-align-guards-and-rhs]
aligns the guards and rhs of the region
\\[haskell-indent-put-region-in-literate]
makes the region a piece of literate code in a literate script
Invokes `haskell-indent-hook' if not nil.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (haskell-indentation-mode) "haskell-indentation"
;;;;;; "haskell-indentation.el" (19189 21847))
;;; Generated autoloads from haskell-indentation.el
(autoload 'haskell-indentation-mode "haskell-indentation" "\
Haskell indentation mode that deals with the layout rule.
It rebinds RET, DEL and BACKSPACE, so that indentations can be
set and deleted as if they were real tabs. It supports
autofill-mode.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads (haskell-hayoo haskell-hoogle literate-haskell-mode
;;;;;; haskell-mode) "haskell-mode" "haskell-mode.el" (19189 21847))
;;; Generated autoloads from haskell-mode.el
(add-to-list 'load-path (or (file-name-directory load-file-name) (car load-path)))
(autoload 'haskell-mode "haskell-mode" "\
Major mode for editing Haskell programs.
Blank lines separate paragraphs, comments start with `-- '.
\\<haskell-mode-map>
Literate scripts are supported via `literate-haskell-mode'.
The variable `haskell-literate' indicates the style of the script in the
current buffer. See the documentation on this variable for more details.
Modules can hook in via `haskell-mode-hook'. The following modules
are supported with an `autoload' command:
`haskell-decl-scan', Graeme E Moss
Scans top-level declarations, and places them in a menu.
`haskell-doc', Hans-Wolfgang Loidl
Echoes types of functions or syntax of keywords when the cursor is idle.
`haskell-indentation', Kristof Bastiaensen
Intelligent semi-automatic indentation Mk2
`haskell-indent', Guy Lapalme
Intelligent semi-automatic indentation.
`haskell-simple-indent', Graeme E Moss and Heribert Schuetz
Simple indentation.
Module X is activated using the command `turn-on-X'. For example,
`haskell-indent' is activated using `turn-on-haskell-indent'.
For more information on a module, see the help for its `X-mode'
function. Some modules can be deactivated using `turn-off-X'. (Note
that `haskell-doc' is irregular in using `turn-(on/off)-haskell-doc-mode'.)
Use `haskell-version' to find out what version this is.
Invokes `haskell-mode-hook'.
\(fn)" t nil)
(autoload 'literate-haskell-mode "haskell-mode" "\
As `haskell-mode' but for literate scripts.
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.\\(?:[gh]s\\|hi\\)\\'" . haskell-mode))
(add-to-list 'auto-mode-alist '("\\.l[gh]s\\'" . literate-haskell-mode))
(autoload 'haskell-hoogle "haskell-mode" "\
Do a Hoogle search for QUERY.
\(fn QUERY)" t nil)
(defalias 'hoogle 'haskell-hoogle)
(autoload 'haskell-hayoo "haskell-mode" "\
Do a Hayoo search for QUERY.
\(fn QUERY)" t nil)
(defalias 'hayoo 'haskell-hayoo)
;;;***
;;;### (autoloads (inferior-haskell-find-haddock inferior-haskell-find-definition
;;;;;; inferior-haskell-info inferior-haskell-type inferior-haskell-load-file
;;;;;; switch-to-haskell) "inf-haskell" "inf-haskell.el" (19189
;;;;;; 21847))
;;; Generated autoloads from inf-haskell.el
(defalias 'run-haskell 'switch-to-haskell)
(autoload 'switch-to-haskell "inf-haskell" "\
Show the inferior-haskell buffer. Start the process if needed.
\(fn &optional ARG)" t nil)
(autoload 'inferior-haskell-load-file "inf-haskell" "\
Pass the current buffer's file to the inferior haskell process.
If prefix arg \\[universal-argument] is given, just reload the previous file.
\(fn &optional RELOAD)" t nil)
(autoload 'inferior-haskell-type "inf-haskell" "\
Query the haskell process for the type of the given expression.
If optional argument `insert-value' is non-nil, insert the type above point
in the buffer. This can be done interactively with the \\[universal-argument] prefix.
The returned info is cached for reuse by `haskell-doc-mode'.
\(fn EXPR &optional INSERT-VALUE)" t nil)
(autoload 'inferior-haskell-info "inf-haskell" "\
Query the haskell process for the info of the given expression.
\(fn SYM)" t nil)
(autoload 'inferior-haskell-find-definition "inf-haskell" "\
Attempt to locate and jump to the definition of the given expression.
\(fn SYM)" t nil)
(autoload 'inferior-haskell-find-haddock "inf-haskell" "\
Find and open the Haddock documentation of SYM.
Make sure to load the file into GHCi or Hugs first by using C-c C-l.
Only works for functions in a package installed with ghc-pkg, or
whatever the value of `haskell-package-manager-name' is.
This function needs to find which package a given module belongs
to. In order to do this, it computes a module-to-package lookup
alist, which is expensive to compute (it takes upwards of five
seconds with more than about thirty installed packages). As a
result, we cache it across sessions using the cache file
referenced by `inferior-haskell-module-alist-file'. We test to
see if this is newer than `haskell-package-conf-file' every time
we load it.
\(fn SYM)" t nil)
;;;***
;;;### (autoloads nil nil ("haskell-font-lock.el" "haskell-ghci.el"
;;;;;; "haskell-hugs.el" "haskell-simple-indent.el") (19189 21847
;;;;;; 934450))
;;;***

157
.emacs.d.backup/haskell-mode/indent.hs Normal file
View file

@ -0,0 +1,157 @@
-------------------------------------------------------------------------
-- Comments with allcaps `FIXME' indicate places where the indentation --
-- fails to find the correct indentation, whereas comments with --
-- lowercase `fixme' indicate places where impossible indentations --
-- are uselessly proposed. --
-------------------------------------------------------------------------
-- compute the list of binary digits corresponding to an integer
-- Note: the least significant bit is the first element of the list
bdigits :: Int -> [Int]
bdigits 0 = [0]
bdigits 1 = [1]
bdigits n | n>1 = n `mod` 2 :
bdigits (n `div` 2)
| otherwise = error "bdigits of a negative number"
-- compute the value of an integer given its list of binary digits
-- Note: the least significant bit is the first element of the list
bvalue :: [Int]->Int
bvalue [] = error "bvalue of []"
bvalue s = bval 1 s
where
bval e [] = 0
bval e [] = 0 -- fixme: can't align with `where'.
bval e (b:bs) | b==0 || b=="dd of " = b*e + bval (2*e) bs
| otherwise = error "ill digit" -- Spurious 3rd step.
foo
-- fixme: tab on the line above should insert `bvalue' at some point.
{- text
indentation
inside comments
-}
toto a = ( hello
, there -- indentation of leading , and ;
-- indentation of this comment.
, my friends )
lili x = do let ofs x = 1
print x
titi b =
let -- fixme: can't indent at column 0
x = let toto = 1
tata = 2 -- fixme: can't indent lower than `toto'.
in
toto in
do expr1
{- text
- indentation
- inside comments
-}
let foo s = let fro = 1
fri = 2 -- fixme: can't indent lower than `fro'.
in
hello
foo2 = bar2 -- fixme: can't align with arg `s' in foo.
foo1 = bar2 -- fixme: Can't be column 0.
expr2
tata c =
let bar = case foo -- fixme: can't be col 0.
of 1 -> blabla
2 -> blibli -- fixme: only one possible indentation here.
bar = case foo of
_ -> blabla
bar' = case foo
of _ -> blabla
toto -> plulu
turlu d = if test
then
ifturl
else
adfaf
turlu d = if test then
ifturl
else
sg
turly fg = toto
where
hello = 2
-- test from John Goerzen
x myVariableThing = case myVariablething of
Just z -> z
Nothing -> 0 -- fixme: "spurious" additional indents.
foo = let x = 1 in toto
titi -- FIXME
foo = let foo x y = toto
where
toto = 2
instance Show Toto where
foo x 4 = 50
data Toto = Foo
| Bar
deriving (Show) -- FIXME
foo = let toto x = do let bar = 2
return 1
in 3
eval env (Llambda x e) = -- FIXME: sole indentation is self???
Vfun (\v -> eval (\y -> if (x == y) then v else env y) -- FIXME
e) -- FIXME
foo = case findprop attr props of
Just x -> x
data T = T { granularity :: (Int, Int, Int, Int) -- FIXME: self indentation?
, items :: Map (Int, Int, Int, Int) [Item] }
foo = case foo of
[] ->
case bar of
[] ->
return ()
(x:xs) -> -- FIXME
bar = do toto
if titi
then tutu -- FIXME
else tata -- FIXME
insert :: Ord a => a -> b -> TreeMap a b -> TreeMap a b
insert x v Empty = Node 0 x v Empty Empty
insert x v (Node d x' v' t1 t2)
| x == x' = Node d x v t1 t2
| x < x' = Node ? x' v' (insert x v t1 Empty) t2
| -- FIXME: wrong indent *if at EOB*
tinsertb x v (Node x' v' d1 t1 d2 t2)
| x == x' = (1 + max d1 d2, Node x v d1 t1 d2 t2)
| x < x' =
case () of
_ | d1' <= d2 + 1 => (1 + max d1' d2, Node x' v' d1' t1' d2 t2)
-- d1' == d2 + 2: Need to rotate to rebalance. FIXME CRASH
else let (Node x'' v'' d1'' t1'' d2'' t2'') = t1'
test = if True then
toto
else if False then
tata -- FIXME
else -- FIXME
titi
-- arch-tag: de0069e3-c0a0-495c-b441-d4ff6e0509b1

720
.emacs.d.backup/haskell-mode/inf-haskell.el Normal file
View file

@ -0,0 +1,720 @@
;;; inf-haskell.el --- Interaction with an inferior Haskell process.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: Haskell
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; The code is made of 2 parts: a major mode for the buffer that holds the
;; inferior process's session and a minor mode for use in source buffers.
;; Todo:
;; - Check out Shim for ideas.
;; - i-h-load-buffer and i-h-send-region.
;;; Code:
(require 'comint)
(require 'shell) ;For directory tracking.
(require 'compile)
(require 'haskell-mode)
(eval-when-compile (require 'cl))
;; XEmacs compatibility.
(unless (fboundp 'subst-char-in-string)
(defun subst-char-in-string (fromchar tochar string &optional inplace)
;; This is Haskell-mode, we don't want no stinkin' `aset'.
(apply 'string (mapcar (lambda (c) (if (eq c fromchar) tochar c)) string))))
(unless (fboundp 'make-temp-file)
(defun make-temp-file (prefix &optional dir-flag)
(catch 'done
(while t
(let ((f (make-temp-name (expand-file-name prefix (temp-directory)))))
(condition-case ()
(progn
(if dir-flag (make-directory f)
(write-region "" nil f nil 'silent nil))
(throw 'done f))
(file-already-exists t)))))))
(unless (fboundp 'replace-regexp-in-string)
(defun replace-regexp-in-string (regexp rep string)
(replace-in-string string regexp rep)))
;; Here I depart from the inferior-haskell- prefix.
;; Not sure if it's a good idea.
(defcustom haskell-program-name
;; Arbitrarily give preference to hugs over ghci.
(or (cond
((not (fboundp 'executable-find)) nil)
((executable-find "hugs") "hugs \"+.\"")
((executable-find "ghci") "ghci"))
"hugs \"+.\"")
"The name of the command to start the inferior Haskell process.
The command can include arguments."
;; Custom only supports the :options keyword for a few types, e.g. not
;; for string.
;; :options '("hugs \"+.\"" "ghci")
:group 'haskell
:type '(choice string (repeat string)))
(defconst inferior-haskell-info-xref-re
"\t-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)\\(?:-\\([0-9]+\\)\\)?$")
(defconst inferior-haskell-module-re
"\t-- Defined in \\(.+\\)$"
"Regular expression for matching module names in :info.")
(defconst inferior-haskell-error-regexp-alist
;; The format of error messages used by Hugs.
`(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3)
;; Format of error messages used by GHCi.
("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n *\\)\\(Warning\\)?"
1 2 4 ,@(if (fboundp 'compilation-fake-loc)
'((6) nil (5 '(face nil font-lock-multiline t)))))
;; Runtime exceptions, from ghci.
("^\\*\\*\\* Exception: \\(.+?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\)): .*"
1 ,@(if (fboundp 'compilation-fake-loc) '((2 . 4) (3 . 5)) '(2 3)))
;; GHCi uses two different forms for line/col ranges, depending on
;; whether it's all on the same line or not :-( In Emacs-23, I could use
;; explicitly numbered subgroups to merge the two patterns.
("^\\*\\*\\* Exception: \\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): .*"
1 2 ,(if (fboundp 'compilation-fake-loc) '(3 . 4) 3))
;; Info messages. Not errors per se.
,@(when (fboundp 'compilation-fake-loc)
`(;; Other GHCi patterns used in type errors.
("^[ \t]+at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$"
1 2 (3 . 4) 0)
;; Foo.hs:318:80:
;; Ambiguous occurrence `Bar'
;; It could refer to either `Bar', defined at Zork.hs:311:5
;; or `Bar', imported from Bars at Frob.hs:32:0-16
;; (defined at Location.hs:97:5)
("[ (]defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\))?$" 1 2 3 0)
("imported from .* at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$"
1 2 (3 . 4) 0)
;; Info xrefs.
(,inferior-haskell-info-xref-re 1 2 (3 . 4) 0))))
"Regexps for error messages generated by inferior Haskell processes.
The format should be the same as for `compilation-error-regexp-alist'.")
(defcustom inferior-haskell-find-project-root t
"If non-nil, try and find the project root directory of this file.
This will either look for a Cabal file or a \"module\" statement in the file."
:type 'boolean)
(define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell"
"Major mode for interacting with an inferior Haskell process."
(set (make-local-variable 'comint-prompt-regexp)
"^\\*?[A-Z][\\._a-zA-Z0-9]*\\( \\*?[A-Z][\\._a-zA-Z0-9]*\\)*> ")
(set (make-local-variable 'comint-input-autoexpand) nil)
(add-hook 'comint-output-filter-functions 'inferior-haskell-spot-prompt nil t)
;; Setup directory tracking.
(set (make-local-variable 'shell-cd-regexp) ":cd")
(condition-case nil
(shell-dirtrack-mode 1)
(error ;The minor mode function may not exist or not accept an arg.
(set (make-local-variable 'shell-dirtrackp) t)
(add-hook 'comint-input-filter-functions 'shell-directory-tracker
nil 'local)))
;; Setup `compile' support so you can just use C-x ` and friends.
(set (make-local-variable 'compilation-error-regexp-alist)
inferior-haskell-error-regexp-alist)
(set (make-local-variable 'compilation-first-column) 0) ;GHCI counts from 0.
(if (and (not (boundp 'minor-mode-overriding-map-alist))
(fboundp 'compilation-shell-minor-mode))
;; If we can't remove compilation-minor-mode bindings, at least try to
;; use compilation-shell-minor-mode, so there are fewer
;; annoying bindings.
(compilation-shell-minor-mode 1)
;; Else just use compilation-minor-mode but without its bindings because
;; things like mouse-2 are simply too annoying.
(compilation-minor-mode 1)
(let ((map (make-sparse-keymap)))
(dolist (keys '([menu-bar] [follow-link]))
;; Preserve some of the bindings.
(define-key map keys (lookup-key compilation-minor-mode-map keys)))
(add-to-list 'minor-mode-overriding-map-alist
(cons 'compilation-minor-mode map)))))
(defun inferior-haskell-string-to-strings (string)
"Split the STRING into a list of strings."
(let ((i (string-match "[\"]" string)))
(if (null i) (split-string string) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i)))
(let ((rfs (read-from-string string i)))
(cons (car rfs)
(inferior-haskell-string-to-strings
(substring string (cdr rfs)))))))))
(defun inferior-haskell-command (arg)
(inferior-haskell-string-to-strings
(if (null arg) haskell-program-name
(read-string "Command to run haskell: " haskell-program-name))))
(defvar inferior-haskell-buffer nil
"The buffer in which the inferior process is running.")
(defun inferior-haskell-start-process (command)
"Start an inferior haskell process.
With universal prefix \\[universal-argument], prompts for a COMMAND,
otherwise uses `haskell-program-name'.
It runs the hook `inferior-haskell-hook' after starting the process and
setting up the inferior-haskell buffer."
(interactive (list (inferior-haskell-command current-prefix-arg)))
(setq inferior-haskell-buffer
(apply 'make-comint "haskell" (car command) nil (cdr command)))
(with-current-buffer inferior-haskell-buffer
(inferior-haskell-mode)
(run-hooks 'inferior-haskell-hook)))
(defun inferior-haskell-process (&optional arg)
(or (if (buffer-live-p inferior-haskell-buffer)
(get-buffer-process inferior-haskell-buffer))
(progn
(let ((current-prefix-arg arg))
(call-interactively 'inferior-haskell-start-process))
;; Try again.
(inferior-haskell-process arg))))
;;;###autoload
(defalias 'run-haskell 'switch-to-haskell)
;;;###autoload
(defun switch-to-haskell (&optional arg)
"Show the inferior-haskell buffer. Start the process if needed."
(interactive "P")
(let ((proc (inferior-haskell-process arg)))
(pop-to-buffer (process-buffer proc))))
(eval-when-compile
(unless (fboundp 'with-selected-window)
(defmacro with-selected-window (win &rest body)
`(save-selected-window
(select-window ,win)
,@body))))
(defcustom inferior-haskell-wait-and-jump nil
"If non-nil, wait for file loading to terminate and jump to the error."
:type 'boolean
:group 'haskell)
(defvar inferior-haskell-seen-prompt nil)
(make-variable-buffer-local 'inferior-haskell-seen-prompt)
(defun inferior-haskell-spot-prompt (string)
(let ((proc (get-buffer-process (current-buffer))))
(when proc
(save-excursion
(goto-char (process-mark proc))
(if (re-search-backward comint-prompt-regexp
(line-beginning-position) t)
(setq inferior-haskell-seen-prompt t))))))
(defun inferior-haskell-wait-for-prompt (proc &optional timeout)
"Wait until PROC sends us a prompt.
The process PROC should be associated to a comint buffer."
(with-current-buffer (process-buffer proc)
(while (progn
(goto-char comint-last-input-end)
(not (or inferior-haskell-seen-prompt
(setq inferior-haskell-seen-prompt
(re-search-forward comint-prompt-regexp nil t))
(not (accept-process-output proc timeout))))))
(unless inferior-haskell-seen-prompt
(error "Can't find the prompt."))))
(defvar inferior-haskell-cabal-buffer nil)
(defun inferior-haskell-cabal-of-buf (buf)
(require 'haskell-cabal)
(with-current-buffer buf
(or (and (buffer-live-p inferior-haskell-cabal-buffer)
inferior-haskell-cabal-buffer)
(and (not (local-variable-p 'inferior-haskell-cabal-buffer
;; XEmacs needs this argument.
(current-buffer)))
(set (make-local-variable 'inferior-haskell-cabal-buffer)
(haskell-cabal-find-file))))))
(defun inferior-haskell-find-project-root (buf)
(with-current-buffer buf
(let ((cabal (inferior-haskell-cabal-of-buf buf)))
(or (when cabal
(with-current-buffer cabal
(let ((hsd (haskell-cabal-get-setting "hs-source-dirs")))
(if (null hsd)
;; If there's a Cabal file with no Hs-Source-Dirs, then
;; just use the Cabal file's directory.
default-directory
;; If there is an HSD, then check that it's an existing
;; dir (otherwise, it may be a list of dirs and we don't
;; know what to do with those). If it doesn't exist, then
;; give up.
(if (file-directory-p hsd) (expand-file-name hsd))))))
;; If there's no Cabal file or it's not helpful, try to look for
;; a "module" statement and count the number of "." in the
;; module name.
(save-excursion
(goto-char (point-min))
(let ((case-fold-search nil))
(when (re-search-forward
"^module[ \t]+\\([^- \t\n]+\\.[^- \t\n]+\\)[ \t]+where\\>" nil t)
(let* ((dir default-directory)
(module (match-string 1))
(pos 0))
(while (string-match "\\." module pos)
(setq pos (match-end 0))
(setq dir (expand-file-name ".." dir)))
;; Let's check that the module name matches the file name,
;; otherwise the project root is probably not what we think.
(if (eq t (compare-strings
(file-name-sans-extension buffer-file-name)
nil nil
(expand-file-name
(replace-regexp-in-string "\\." "/" module)
dir)
nil nil t))
dir
;; If they're not equal, it means the local directory
;; hierarchy doesn't match the module name. This seems
;; odd, so let's warn the user about it. May help us
;; debug this code as well.
(message "Ignoring inconsistent `module' info: %s in %s"
module buffer-file-name)
nil)))))))))
;;;###autoload
(defun inferior-haskell-load-file (&optional reload)
"Pass the current buffer's file to the inferior haskell process.
If prefix arg \\[universal-argument] is given, just reload the previous file."
(interactive "P")
;; Save first, so we're sure that `buffer-file-name' is non-nil afterward.
(save-buffer)
(let ((buf (current-buffer))
(file buffer-file-name)
(proc (inferior-haskell-process)))
(with-current-buffer (process-buffer proc)
(compilation-forget-errors)
(let ((parsing-end (marker-position (process-mark proc)))
root)
;; Go to the root of the Cabal project, if applicable.
(when (and inferior-haskell-find-project-root
(setq root (inferior-haskell-find-project-root buf)))
;; Not sure if it's useful/needed and if it actually works.
(unless (equal default-directory root)
(setq default-directory root)
(inferior-haskell-send-command
proc (concat ":cd " default-directory)))
(setq file (file-relative-name file)))
(inferior-haskell-send-command
proc (if reload ":reload"
(concat ":load \""
;; Espace the backslashes that may occur in file names.
(replace-regexp-in-string "[\\\"]" "\\\\\&" file)
"\"")))
;; Move the parsing-end marker *after* sending the command so
;; that it doesn't point just to the insertion point.
;; Otherwise insertion may move the marker (if done with
;; insert-before-markers) and we'd then miss some errors.
(if (boundp 'compilation-parsing-end)
(if (markerp compilation-parsing-end)
(set-marker compilation-parsing-end parsing-end)
(setq compilation-parsing-end parsing-end))))
(with-selected-window (display-buffer (current-buffer))
(goto-char (point-max)))
;; Use compilation-auto-jump-to-first-error if available.
;; (if (and (boundp 'compilation-auto-jump-to-first-error)
;; compilation-auto-jump-to-first-error
;; (boundp 'compilation-auto-jump-to-next))
;; (setq compilation-auto-jump-to-next t)
(when inferior-haskell-wait-and-jump
(inferior-haskell-wait-for-prompt proc)
(ignore-errors ;Don't beep if there were no errors.
(next-error)))))) ;; )
(defvar inferior-haskell-run-command ":main")
(defun inferior-haskell-load-and-run (command)
"Pass the current buffer's file to haskell and then run a COMMAND."
(interactive
(list
(if (and inferior-haskell-run-command (not current-prefix-arg))
inferior-haskell-run-command
(read-string "Command to run: " nil nil inferior-haskell-run-command))))
(setq inferior-haskell-run-command command)
(let* ((inferior-haskell-errors nil)
(neh (lambda () (setq inferior-haskell-errors t))))
(unwind-protect
(let ((inferior-haskell-wait-and-jump t))
(add-hook 'next-error-hook neh)
(inferior-haskell-load-file))
(remove-hook 'next-error-hook neh))
(unless inferior-haskell-errors
(inferior-haskell-send-command (inferior-haskell-process) command)
(switch-to-haskell))))
(defun inferior-haskell-send-command (proc str)
(setq str (concat str "\n"))
(with-current-buffer (process-buffer proc)
(inferior-haskell-wait-for-prompt proc)
(goto-char (process-mark proc))
(insert-before-markers str)
(move-marker comint-last-input-end (point))
(setq inferior-haskell-seen-prompt nil)
(comint-send-string proc str)))
(defun inferior-haskell-reload-file ()
"Tell the inferior haskell process to reread the current buffer's file."
(interactive)
(inferior-haskell-load-file 'reload))
;;;###autoload
(defun inferior-haskell-type (expr &optional insert-value)
"Query the haskell process for the type of the given expression.
If optional argument `insert-value' is non-nil, insert the type above point
in the buffer. This can be done interactively with the \\[universal-argument] prefix.
The returned info is cached for reuse by `haskell-doc-mode'."
(interactive
(let ((sym (haskell-ident-at-point)))
(list (read-string (if (> (length sym) 0)
(format "Show type of (default %s): " sym)
"Show type of: ")
nil nil sym)
current-prefix-arg)))
(if (string-match "\\`\\s_+\\'" expr) (setq expr (concat "(" expr ")")))
(let* ((proc (inferior-haskell-process))
(type
(with-current-buffer (process-buffer proc)
(let ((parsing-end ; Remember previous spot.
(marker-position (process-mark proc))))
(inferior-haskell-send-command proc (concat ":type " expr))
;; Find new point.
(inferior-haskell-wait-for-prompt proc)
(goto-char (point-max))
;; Back up to the previous end-of-line.
(end-of-line 0)
;; Extract the type output
(buffer-substring-no-properties
(save-excursion (goto-char parsing-end)
(line-beginning-position 2))
(point))))))
(if (not (string-match (concat "^\\(" (regexp-quote expr) "[ \t\n]+::[ \t\n]*\\(.\\|\n\\)*\\)")
type))
(error "No type info: %s" type)
(progn
(setf type (match-string 1 type))
;; Cache for reuse by haskell-doc.
(when (and (boundp 'haskell-doc-mode) haskell-doc-mode
(boundp 'haskell-doc-user-defined-ids)
;; Haskell-doc only works for idents, not arbitrary expr.
(string-match "\\`(?\\(\\s_+\\|\\(\\sw\\|\\s'\\)+\\)?[ \t]*::[ \t]*"
type))
(let ((sym (match-string 1 type)))
(setq haskell-doc-user-defined-ids
(cons (cons sym (substring type (match-end 0)))
(delq (assoc sym haskell-doc-user-defined-ids)
haskell-doc-user-defined-ids)))))
(if (interactive-p) (message "%s" type))
(when insert-value
(beginning-of-line)
(insert type "\n"))
type))))
;;;###autoload
(defun inferior-haskell-info (sym)
"Query the haskell process for the info of the given expression."
(interactive
(let ((sym (haskell-ident-at-point)))
(list (read-string (if (> (length sym) 0)
(format "Show info of (default %s): " sym)
"Show info of: ")
nil nil sym))))
(let ((proc (inferior-haskell-process)))
(with-current-buffer (process-buffer proc)
(let ((parsing-end ; Remember previous spot.
(marker-position (process-mark proc))))
(inferior-haskell-send-command proc (concat ":info " sym))
;; Find new point.
(inferior-haskell-wait-for-prompt proc)
(goto-char (point-max))
;; Move to previous end-of-line
(end-of-line 0)
(let ((result
(buffer-substring-no-properties
(save-excursion (goto-char parsing-end)
(line-beginning-position 2))
(point))))
;; Move back to end of process buffer
(goto-char (point-max))
(if (interactive-p) (message "%s" result))
result)))))
;;;###autoload
(defun inferior-haskell-find-definition (sym)
"Attempt to locate and jump to the definition of the given expression."
(interactive
(let ((sym (haskell-ident-at-point)))
(list (read-string (if (> (length sym) 0)
(format "Find definition of (default %s): " sym)
"Find definition of: ")
nil nil sym))))
(let ((info (inferior-haskell-info sym)))
(if (not (string-match inferior-haskell-info-xref-re info))
(error "No source information available")
(let ((file (match-string-no-properties 1 info))
(line (string-to-number
(match-string-no-properties 2 info)))
(col (string-to-number
(match-string-no-properties 3 info))))
(when file
(with-current-buffer (process-buffer (inferior-haskell-process))
;; The file name is relative to the process's cwd.
(setq file (expand-file-name file)))
;; Push current location marker on the ring used by `find-tag'
(require 'etags)
(ring-insert find-tag-marker-ring (point-marker))
(pop-to-buffer (find-file-noselect file))
(when line
(goto-line line)
(when col (move-to-column col))))))))
;;; Functions to find the documentation of a given function.
;;
;; TODO for this section:
;;
;; * Support fetching of local Haddock docs pulled directly from source files.
;; * Display docs locally? w3m?
(defcustom inferior-haskell-use-web-docs
'fallback
"Whether to use the online documentation. Possible values:
`never', meaning always use local documentation, unless the local
file doesn't exist, when do nothing, `fallback', which means only
use the online documentation when the local file doesn't exist,
or `always', meaning always use the online documentation,
regardless of existance of local files. Default is `fallback'."
:group 'haskell
:type '(choice (const :tag "Never" never)
(const :tag "As fallback" fallback)
(const :tag "Always" always)))
(defcustom inferior-haskell-web-docs-base
"http://haskell.org/ghc/docs/latest/html/libraries/"
"The base URL of the online libraries documentation. This will
only be used if the value of `inferior-haskell-use-web-docs' is
`always' or `fallback'."
:group 'haskell
:type 'string)
(defcustom haskell-package-manager-name "ghc-pkg"
"Name of the program to consult regarding package details."
:group 'haskell
:type 'string)
(defcustom haskell-package-conf-file
(condition-case nil
(with-temp-buffer
(call-process "ghc" nil t nil "--print-libdir")
(expand-file-name "package.conf"
(buffer-substring (point-min) (1- (point-max)))))
;; Don't use `ignore-errors' because this form is not byte-compiled :-(
(error nil))
"Where the package configuration file for the package manager resides.
By default this is set to `ghc --print-libdir`/package.conf."
:group 'haskell
:type 'string)
(defun inferior-haskell-get-module (sym)
"Fetch the module in which SYM is defined."
(let ((info (inferior-haskell-info sym)))
(unless (string-match inferior-haskell-module-re info)
(error
"No documentation information available. Did you forget to C-c C-l?"))
(match-string-no-properties 1 info)))
(defun inferior-haskell-query-ghc-pkg (&rest args)
"Send ARGS to ghc-pkg, or whatever the value of
`haskell-package-manager' is. Insert the output into the current
buffer."
(apply 'call-process haskell-package-manager-name nil t nil args))
(defun inferior-haskell-get-package-list ()
"Get the list of packages from ghc-pkg, or whatever
`haskell-package-manager-name' is."
(with-temp-buffer
(inferior-haskell-query-ghc-pkg "--simple-output" "list")
(split-string (buffer-substring (point-min) (point-max)))))
(defun inferior-haskell-compute-module-alist ()
"Compute a list mapping modules to package names and haddock URLs using ghc-pkg."
(message "Generating module alist...")
(let ((module-alist ()))
(with-temp-buffer
(dolist (package (inferior-haskell-get-package-list))
(erase-buffer)
(inferior-haskell-query-ghc-pkg "describe" package)
(let ((package-w/o-version
(replace-regexp-in-string "[-.0-9]*\\'" "" package))
;; Find the Haddock documentation URL for this package
(haddock
(progn
(goto-char (point-min))
(when (re-search-forward "haddock-html:[ \t]+\\(.*[^ \t\n]\\)"
nil t)
(match-string 1)))))
;; Fetch the list of exposed modules for this package
(goto-char (point-min))
(when (re-search-forward "^exposed-modules:\\(.*\\(\n[ \t].*\\)*\\)"
nil t)
(dolist (module (split-string (match-string 1)))
(push (list module package-w/o-version haddock)
module-alist)))))
(message "Generating module alist... done")
module-alist)))
(defcustom inferior-haskell-module-alist-file
;; (expand-file-name "~/.inf-haskell-module-alist")
(expand-file-name (concat "inf-haskell-module-alist-"
(number-to-string (user-uid)))
(if (fboundp 'temp-directory)
(temp-directory)
temporary-file-directory))
"Where to save the module -> package lookup table.
Set this to `nil' to never cache to a file."
:group 'haskell
:type '(choice (const :tag "Don't cache to file" nil) string))
(defvar inferior-haskell-module-alist nil
"Association list of modules to their packages.
Each element is of the form (MODULE PACKAGE HADDOCK), where
MODULE is the name of a module,
PACKAGE is the package it belongs to, and
HADDOCK is the path to that package's Haddock documentation.
This is calculated on-demand using `inferior-haskell-compute-module-alist'.
It's also cached in the file `inferior-haskell-module-alist-file',
so that it can be obtained more quickly next time.")
(defun inferior-haskell-module-alist ()
"Get the module alist from cache or ghc-pkg's info."
(or
;; If we already have computed the alist, use it...
inferior-haskell-module-alist
(setq inferior-haskell-module-alist
(or
;; ...otherwise try to read it from the cache file...
(and
inferior-haskell-module-alist-file
(file-readable-p inferior-haskell-module-alist-file)
(file-newer-than-file-p inferior-haskell-module-alist-file
haskell-package-conf-file)
(with-temp-buffer
(insert-file-contents inferior-haskell-module-alist-file)
(goto-char (point-min))
(prog1 (read (current-buffer))
(message "Read module alist from file cache."))))
;; ...or generate it again and save it in a file for later.
(let ((alist (inferior-haskell-compute-module-alist)))
(when inferior-haskell-module-alist-file
(with-temp-buffer
(print alist (current-buffer))
;; Do the write to a temp file first, then rename it.
;; This makes it more atomic, and suffers from fewer security
;; holes related to race conditions if the file is in /tmp.
(let ((tmp (make-temp-file inferior-haskell-module-alist-file)))
(write-region (point-min) (point-max) tmp)
(rename-file tmp inferior-haskell-module-alist-file
'ok-if-already-exists))))
alist)))))
(defvar inferior-haskell-ghc-internal-ident-alist
;; FIXME: Fill this table, ideally semi-automatically.
'(("GHC.Base.return" . "Control.Monad.return")
("GHC.List" . "Data.List")))
(defun inferior-haskell-map-internal-ghc-ident (ident)
"Try to translate some internal GHC identifier to its alter ego in haskell docs."
(let ((head ident)
(tail "")
remapped)
(while (and (not
(setq remapped
(cdr (assoc head
inferior-haskell-ghc-internal-ident-alist))))
(string-match "\\.[^.]+\\'" head))
(setq tail (concat (match-string 0 head) tail))
(setq head (substring head 0 (match-beginning 0))))
(concat (or remapped head) tail)))
;;;###autoload
(defun inferior-haskell-find-haddock (sym)
"Find and open the Haddock documentation of SYM.
Make sure to load the file into GHCi or Hugs first by using C-c C-l.
Only works for functions in a package installed with ghc-pkg, or
whatever the value of `haskell-package-manager-name' is.
This function needs to find which package a given module belongs
to. In order to do this, it computes a module-to-package lookup
alist, which is expensive to compute (it takes upwards of five
seconds with more than about thirty installed packages). As a
result, we cache it across sessions using the cache file
referenced by `inferior-haskell-module-alist-file'. We test to
see if this is newer than `haskell-package-conf-file' every time
we load it."
(interactive
(let ((sym (haskell-ident-at-point)))
(list (read-string (if (> (length sym) 0)
(format "Find documentation of (default %s): " sym)
"Find documentation of: ")
nil nil sym))))
(setq sym (inferior-haskell-map-internal-ghc-ident sym))
(let* (;; Find the module and look it up in the alist
(module (inferior-haskell-get-module sym))
(alist-record (assoc module (inferior-haskell-module-alist)))
(package (nth 1 alist-record))
(file-name (concat (subst-char-in-string ?. ?- module) ".html"))
(local-path (concat (nth 2 alist-record) "/" file-name))
(url (if (or (eq inferior-haskell-use-web-docs 'always)
(and (not (file-exists-p local-path))
(eq inferior-haskell-use-web-docs 'fallback)))
(concat inferior-haskell-web-docs-base package "/" file-name
;; Jump to the symbol anchor within Haddock.
"#v:" sym)
(and (file-exists-p local-path)
(concat "file://" local-path)))))
(if url (browse-url url) (error "Local file doesn't exist."))))
(provide 'inf-haskell)
;; arch-tag: 61804287-63dd-4052-bc0e-90f691b34b40
;;; inf-haskell.el ends here

157
.emacs.d.backup/highlight-parenthesis.el Normal file
View file

@ -0,0 +1,157 @@
;;; highlight-parentheses.el --- highlight surrounding parentheses
;;
;; Copyright (C) 2007, 2009 Nikolaj Schumacher
;;
;; Author: Nikolaj Schumacher <bugs * nschum de>
;; Version: 1.0.1
;; Keywords: faces, matching
;; URL: http://nschum.de/src/emacs/highlight-parentheses/
;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
;;
;; This file is NOT part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;; Add the following to your .emacs file:
;; (require 'highlight-parentheses)
;;
;; Enable `highlight-parentheses-mode'.
;;
;;; Change Log:
;;
;; 2009-03-19 (1.0.1)
;; Added setter for color variables.
;;
;; 2007-07-30 (1.0)
;; Added background highlighting and faces.
;;
;; 2007-05-15 (0.9.1)
;; Support for defcustom.
;;
;; 2007-04-26 (0.9)
;; Initial Release.
;;
;;; Code:
(eval-when-compile (require 'cl))
(defgroup highlight-parentheses nil
"Highlight surrounding parentheses"
:group 'faces
:group 'matching)
(defun hl-paren-set (variable value)
(set variable value)
(when (fboundp 'hl-paren-color-update)
(hl-paren-color-update)))
(defcustom hl-paren-colors
'("firebrick1" "IndianRed1" "IndianRed3" "IndianRed4")
"*List of colors for the highlighted parentheses.
The list starts with the the inside parentheses and moves outwards."
:type '(repeat color)
:set 'hl-paren-set
:group 'highlight-parentheses)
(defcustom hl-paren-background-colors nil
"*List of colors for the background highlighted parentheses.
The list starts with the the inside parentheses and moves outwards."
:type '(repeat color)
:set 'hl-paren-set
:group 'highlight-parentheses)
(defface hl-paren-face nil
"*Face used for highlighting parentheses.
Color attributes might be overriden by `hl-paren-colors' and
`hl-paren-background-colors'."
:group 'highlight-parentheses)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar hl-paren-overlays nil
"This buffers currently active overlays.")
(make-variable-buffer-local 'hl-paren-overlays)
(defvar hl-paren-last-point 0
"The last point for which parentheses were highlighted.
This is used to prevent analyzing the same context over and over.")
(make-variable-buffer-local 'hl-paren-last-point)
(defun hl-paren-highlight ()
"Highlight the parentheses around point."
(unless (= (point) hl-paren-last-point)
(setq hl-paren-last-point (point))
(let ((overlays hl-paren-overlays)
pos1 pos2
(pos (point)))
(save-excursion
(condition-case err
(while (and (setq pos1 (cadr (syntax-ppss pos1)))
(cddr overlays))
(move-overlay (pop overlays) pos1 (1+ pos1))
(when (setq pos2 (scan-sexps pos1 1))
(move-overlay (pop overlays) (1- pos2) pos2)
))
(error nil))
(goto-char pos))
(dolist (ov overlays)
(move-overlay ov 1 1)))))
;;;###autoload
(define-minor-mode highlight-parentheses-mode
"Minor mode to highlight the surrounding parentheses."
nil " hl-p" nil
(if highlight-parentheses-mode
(progn
(hl-paren-create-overlays)
(add-hook 'post-command-hook 'hl-paren-highlight nil t))
(mapc 'delete-overlay hl-paren-overlays)
(kill-local-variable 'hl-paren-overlays)
(kill-local-variable 'hl-paren-point)
(remove-hook 'post-command-hook 'hl-paren-highlight t)))
;;; overlays ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hl-paren-create-overlays ()
(let ((fg hl-paren-colors)
(bg hl-paren-background-colors)
attributes)
(while (or fg bg)
(setq attributes (face-attr-construct 'hl-paren-face))
(when (car fg)
(setq attributes (plist-put attributes :foreground (car fg))))
(pop fg)
(when (car bg)
(setq attributes (plist-put attributes :background (car bg))))
(pop bg)
(dotimes (i 2) ;; front and back
(push (make-overlay 0 0) hl-paren-overlays)
(overlay-put (car hl-paren-overlays) 'face attributes)))
(setq hl-paren-overlays (nreverse hl-paren-overlays))))
(defun hl-paren-color-update ()
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when hl-paren-overlays
(mapc 'delete-overlay hl-paren-overlays)
(setq hl-paren-overlays nil)
(hl-paren-create-overlays)
(let ((hl-paren-last-point -1)) ;; force update
(hl-paren-highlight))))))
(provide 'highlight-parentheses)
;;; highlight-parentheses.el ends here

118
.emacs.d.backup/irblack.el Normal file
View file

@ -0,0 +1,118 @@
;; IR_Black Color Theme for Emacs.
;;
;; David Zhou
;;
;; The IR_Black theme is originally from:
;;
;; http://blog.infinitered.com/entries/show/8
;;
(require 'color-theme)
;; White #EEEEEE #FFFFFF
;; Black #4E4E4E #7C7C7C ? / dim gray
;; Blue #96CBFE #FFFFCB slate blue
;; Green #A8FF60 #CEFFAB DarkOliveGreen2
;; Cyan #C6C5FE #DFDFFE steel blue
;; Red #FF6C60 #FFB6B0
;; Magenta #FF73FD #FF9CFE
;; Yellow #FFFFB6 #FFFFCB pale goldenrod
(defun color-theme-irblack ()
"IR_black theme taken from Vim"
(interactive)
(color-theme-install
'(color-theme-irblack
((background-color . "black")
(background-mode . dark)
(border-color . "gray10")
(cursor-color . "DarkOliveGreen2")
(foreground-color . "#F6F3E8")
(mouse-color . "DarkOliveGreen2"))
(default ((t (:foreground "#F6F3E8"))))
(vertical-border ((t (:background "gray20"))))
(blue ((t (:foreground "blue"))))
(border-glyph ((t (nil))))
(buffers-tab ((t (:background "#141414" :foreground "#cacaca"))))
(font-lock-comment-face ((t (:foreground "dim gray"))))
(font-lock-constant-face ((t (:foreground "light green"))))
(font-lock-doc-string-face ((t (:foreground "DarkOliveGreen2"))))
(font-lock-function-name-face ((t (:foreground "burlywood"))))
(font-lock-builtin-face ((t (:foreground "slate blue"))))
(font-lock-keyword-face ((t (:foreground "slate blue"))))
(font-lock-preprocessor-face ((t (:foreground "slate blue"))))
(font-lock-reference-face ((t (:foreground "steel blue"))))
(font-lock-regexp-grouping-backslash ((t (:foreground "#E9C062"))))
(font-lock-regexp-grouping-construct ((t (:foreground "red"))))
(linum ((t (:background "black" :foreground "dim gray"))))
(minibuffer-prompt ((t (:foreground "#888888"))))
(ido-subdir ((t (:foreground "#CF6A4C"))))
(ido-first-match ((t (:foreground "#8F9D6A"))))
(ido-only-match ((t (:foreground "#8F9D6A"))))
(font-lock-string-face ((t (:foreground "DarkOliveGreen2"))))
(font-lock-type-face ((t (:foreground "pale goldenrod"))))
(font-lock-variable-name-face ((t (:foreground "steel blue"))))
(font-lock-warning-face ((t (:background "#CC1503" :foreground "#FFFFFF"))))
(gui-element ((t (:background "#D4D0C8" :foreground "black"))))
(fringe ((t (:background "grey10"))))
(region ((t (:background "dark red"))))
(mode-line ((t (:background "dim gray" :foreground "dark gray"))))
(mode-line-buffer-id ((t (:bold t :background "dim gray" : foreground "dark gray" :weight bold))))
(highlight ((t (:background "#111111"))))
(highline-face ((t (:background "SeaGreen"))))
(left-margin ((t (nil))))
(text-cursor ((t (:background "yellow" :foreground "black"))))
(toolbar ((t (nil))))
(show-paren-mismatch ((t (:background "#FF1100"))))
(underline ((nil (:underline nil))))
;; whitespace
(trailing-whitespace ((t (:background "gray22"))))
;; mumamo
;(mumamo-background-chunk-major ((t (:background "#000000"))))
;(mumamo-background-chunk-submode ((t (:background "#222222"))))
;(mumamo-background-chunk-submode1 ((t (:background "#0A0A0A"))))
;(mumamo-background-chunk-submode2 ((t (:background "#0A0A0A"))))
;(mumamo-background-chunk-submode3 ((t (:background "#0A0A0A"))))
;(mumamo-background-chunk-submode4 ((t (:background "#0A0A0A"))))
;; diff-mode
(diff-added ((t (:background "#253B22" :foreground "#F8F8F8"))))
(diff-removed ((t (:background "#420E09" :foreground "#F8F8F8"))))
(diff-content ((t nil)))
(diff-header ((t (:background "#0E2231" :foreground "#F8F8F8"))))
;; nxml
;(nxml-delimiter ((t (:foreground "#96CBFE"))))
;(nxml-name ((t (:foreground "#96CBFE"))))
;(nxml-element-local-name ((t (:foreground "#96CBFE"))))
;(nxml-attribute-local-name ((t (:foreground "#FFD7B1"))))
;; erc
;(erc-default-face ((t (nil))))
;(erc-direct-msg-face ((t (:foreground "#007998"))))
;(erc-input-face ((t (:foreground "#feffff"))))
;(erc-bold-face ((t (:bold t :weight bold))))
;(erc-inverse-face ((t (:background "Black" :foreground "White"))))
;(erc-underline-face ((t (:underline t))))
;(erc-prompt-face ((t (:foreground "#c3c6c8"))))
;(erc-notice-face ((t (:foreground "#7c7c7c"))))
;(erc-action-face ((t (:bold t :weight bold))))
;(erc-error-face ((t (:foreground "#007998"))))
;(erc-timestamp-face ((t (:foreground "#7c7c7c"))))
;(erc-nick-default-face ((t (:foreground "#feffff"))))
;(erc-nick-msg-face ((t (:bold t :foreground "#007998" :weight bold))))
;; erc-dangerous-host-face
;; erc-keyword-face
(erc-current-nick-face ((t (:foreground "#007998"))))
;; (erc-command-indicator-face ((t (:bold t :weight bold))))
;; (erc-header-line ((t (:background "grey90" :foreground "grey20"))))
;; (erc-my-nick-face ((t (:bold t :foreground "brown" :weight bold))))
)))
(provide 'irblack)

38
.emacs.d.backup/parenface.el Normal file
View file

@ -0,0 +1,38 @@
;;; parenface.el --- Provide a face for parens in lisp modes.
;; By Dave Pearson <davep@davep.org>
;; $Revision: 1.1 $
;; Add a paren-face to emacs and add support for it to the various lisp modes.
;;
;; Based on some code that Boris Schaefer <boris@uncommon-sense.net> posted
;; to comp.lang.scheme in message <87hf8g9nw5.fsf@qiwi.uncommon-sense.net>.
(defvar paren-face 'paren-face)
(defface paren-face
'((((class color))
(:foreground "DimGray")))
"Face for displaying a paren."
:group 'faces)
(defmacro paren-face-add-support (keywords)
"Generate a lambda expression for use in a hook."
`(lambda ()
(let* ((regexp "(\\|)")
(match (assoc regexp ,keywords)))
(unless (eq (cdr match) paren-face)
(setq ,keywords (append (list (cons regexp paren-face)) ,keywords))))))
;; Keep the compiler quiet.
(eval-when-compile
(defvar scheme-font-lock-keywords-2 nil)
(defvar lisp-font-lock-keywords-2 nil))
(add-hook 'scheme-mode-hook (paren-face-add-support scheme-font-lock-keywords-2))
(add-hook 'lisp-mode-hook (paren-face-add-support lisp-font-lock-keywords-2))
(add-hook 'emacs-lisp-mode-hook (paren-face-add-support lisp-font-lock-keywords-2))
(add-hook 'lisp-interaction-mode-hook (paren-face-add-support lisp-font-lock-keywords-2))
(provide 'parenface)
;; parenface.el ends here

22
.emacs.d.backup/themes/color-theme-example.el Normal file
View file

@ -0,0 +1,22 @@
(eval-when-compile
(require 'color-theme))
(defun color-theme-example ()
"Example theme. Carbon copy of color-theme-gnome contributed by Jonadab."
(interactive)
(color-theme-install
'(color-theme-example
((foreground-color . "wheat")
(background-color . "darkslategrey")
(background-mode . dark))
(default ((t (nil))))
(region ((t (:foreground "cyan" :background "dark cyan"))))
(underline ((t (:foreground "yellow" :underline t))))
(modeline ((t (:foreground "dark cyan" :background "wheat"))))
(modeline-buffer-id ((t (:foreground "dark cyan" :background "wheat"))))
(modeline-mousable ((t (:foreground "dark cyan" :background "wheat"))))
(modeline-mousable-minor-mode ((t (:foreground "dark cyan" :background "wheat"))))
(italic ((t (:foreground "dark red" :italic t))))
(bold-italic ((t (:foreground "dark red" :bold t :italic t))))
(font-lock-comment-face ((t (:foreground "Firebrick"))))
(bold ((t (:bold)))))))

13539
.emacs.d.backup/themes/color-theme-library.el Normal file
View file

File diff suppressed because it is too large Load diff