From d749c5905d504df32c094d404a3dc23a0d852f14 Mon Sep 17 00:00:00 2001 From: michener Date: Thu, 24 Mar 2011 00:42:34 +0000 Subject: [PATCH] More emacs fixups git-svn-id: http://photonzero.com/dotfiles/trunk@87 23f722f6-122a-0410-8cef-c75bd312dd78 --- .emacs.d/haskell-mode/fontlock.hs | 49 + .emacs.d/haskell-mode/haskell-c.el | 47 + .emacs.d/haskell-mode/haskell-cabal.el | 183 +++ .emacs.d/haskell-mode/haskell-decl-scan.el | 719 +++++++++ .emacs.d/haskell-mode/haskell-doc.el | 1972 ++++++++++++++++++++++++ .emacs.d/haskell-mode/haskell-font-lock.el | 633 ++++++++ .emacs.d/haskell-mode/haskell-ghci.el | 334 ++++ .emacs.d/haskell-mode/haskell-hugs.el | 316 ++++ .emacs.d/haskell-mode/haskell-indent.el | 1581 +++++++++++++++++++ .emacs.d/haskell-mode/haskell-indentation.el | 882 +++++++++++ .emacs.d/haskell-mode/haskell-mode.el | 624 ++++++++ .emacs.d/haskell-mode/haskell-simple-indent.el | 154 ++ .emacs.d/haskell-mode/haskell-site-file.el | 277 ++++ .emacs.d/haskell-mode/indent.hs | 170 ++ .emacs.d/haskell-mode/inf-haskell.el | 722 +++++++++ .emacs.d/highlight-parentheses.el | 157 ++ .emacs.d/init.el | 25 +- .emacs.d/themes/color-theme-barak.el | 4 +- 18 files changed, 8844 insertions(+), 5 deletions(-) create mode 100644 .emacs.d/haskell-mode/fontlock.hs create mode 100644 .emacs.d/haskell-mode/haskell-c.el create mode 100644 .emacs.d/haskell-mode/haskell-cabal.el create mode 100644 .emacs.d/haskell-mode/haskell-decl-scan.el create mode 100644 .emacs.d/haskell-mode/haskell-doc.el create mode 100644 .emacs.d/haskell-mode/haskell-font-lock.el create mode 100644 .emacs.d/haskell-mode/haskell-ghci.el create mode 100644 .emacs.d/haskell-mode/haskell-hugs.el create mode 100644 .emacs.d/haskell-mode/haskell-indent.el create mode 100644 .emacs.d/haskell-mode/haskell-indentation.el create mode 100644 .emacs.d/haskell-mode/haskell-mode.el create mode 100644 .emacs.d/haskell-mode/haskell-simple-indent.el create mode 100644 .emacs.d/haskell-mode/haskell-site-file.el create mode 100644 .emacs.d/haskell-mode/indent.hs create mode 100644 .emacs.d/haskell-mode/inf-haskell.el create mode 100644 .emacs.d/highlight-parentheses.el diff --git a/.emacs.d/haskell-mode/fontlock.hs b/.emacs.d/haskell-mode/fontlock.hs new file mode 100644 index 0000000..ddd9adb --- /dev/null +++ b/.emacs.d/haskell-mode/fontlock.hs @@ -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 diff --git a/.emacs.d/haskell-mode/haskell-c.el b/.emacs.d/haskell-mode/haskell-c.el new file mode 100644 index 0000000..a213844 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-c.el @@ -0,0 +1,47 @@ +;;; haskell-c.el --- Major mode for *.hsc files + +;; Copyright (C) 2007 Stefan Monnier + +;; Author: Stefan Monnier + +;; 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 diff --git a/.emacs.d/haskell-mode/haskell-cabal.el b/.emacs.d/haskell-mode/haskell-cabal.el new file mode 100644 index 0000000..b66635d --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-cabal.el @@ -0,0 +1,183 @@ +;;; haskell-cabal.el --- Support for Cabal packages + +;; Copyright (C) 2007, 2008 Stefan Monnier + +;; Author: Stefan Monnier + +;; 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 ""))) +;; (let* ((xml (xml-parse-region +;; (progn (search-forward "") (match-beginning 0)) +;; (progn (search-forward "") (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))) + +(autoload 'derived-mode-p "derived") ; Emacs 21 + +(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 diff --git a/.emacs.d/haskell-mode/haskell-decl-scan.el b/.emacs.d/haskell-mode/haskell-decl-scan.el new file mode 100644 index 0000000..1ad71e0 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-decl-scan.el @@ -0,0 +1,719 @@ +;;; 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 +;; Maintainer: Stefan Monnier +;; 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) +(require 'syntax nil t) ; Emacs 21 add-on + +;;###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)) + ;; It makes a big difference if we don't copy the syntax table here, + ;; as Emacs 21 does, but Emacs 22 doesn't. + (unless (eq (syntax-table) + (with-syntax-table (syntax-table) (syntax-table))) + (defmacro with-syntax-table (table &rest body) + "Evaluate BODY with syntax table of current buffer set to a copy of TABLE. +The syntax table of the current buffer is saved, BODY is evaluated, and the +saved table is restored, even in case of an abnormal exit. +Value is what BODY returns." + (let ((old-table (make-symbol "table")) + (old-buffer (make-symbol "buffer"))) + `(let ((,old-table (syntax-table)) + (,old-buffer (current-buffer))) + (unwind-protect + (progn + (set-syntax-table ,table) + ,@body) + (save-current-buffer + (set-buffer ,old-buffer) + (set-syntax-table ,old-table)))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 preceding 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/preceding 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 backward to the first character 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 "\\" 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 diff --git a/.emacs.d/haskell-mode/haskell-doc.el b/.emacs.d/haskell-mode/haskell-doc.el new file mode 100644 index 0000000..75f90e8 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-doc.el @@ -0,0 +1,1972 @@ +;;; haskell-doc.el --- show function types in echo area -*- coding: iso-8859-1 -*- + +;; Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1997 Hans-Wolfgang Loidl + +;; Author: Hans-Wolfgang Loidl +;; Temporary Maintainer and Hacker: Graeme E Moss +;; Keywords: extensions, minor mode, language mode, Haskell +;; Created: 1997-06-17 +;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-doc.el?rev=HEAD + +;;; Copyright: +;; ========== + +;; 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 3, 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, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; =========== + +;; This program shows the type of the Haskell function under the cursor in the +;; minibuffer. It acts as a kind of "Emacs background process", by regularly +;; checking the word under the cursor and matching it against a list of +;; prelude, library, local and global functions. + +;; To show types of global functions, i.e. functions defined in a module +;; imported by the current module, call the function +;; `turn-on-haskell-doc-global-types'. This automatically loads all modules +;; and builds `imenu' tables to get the types of all functions. +;; Note: The modules are loaded recursively, so you might pull in +;; many modules by just turning on global function support. +;; This features is currently not very well supported. + +;; This program was inspired by the `eldoc.el' package by Noah Friedman. + +;;; Installation: +;; ============= + +;; One useful way to enable this minor mode is to put the following in your +;; .emacs: +;; +;; (autoload 'turn-on-haskell-doc-mode "haskell-doc" nil t) + +;; and depending on the major mode you use for your Haskell programs: +;; (add-hook 'hugs-mode-hook 'turn-on-haskell-doc-mode) ; hugs-mode +;; or +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) ; haskell-mode + +;;; Customisation: +;; ============== + +;; You can control what exactly is shown by setting the following variables to +;; either t or nil: +;; `haskell-doc-show-global-types' (default: nil) +;; `haskell-doc-show-reserved' (default: t) +;; `haskell-doc-show-prelude' (default: t) +;; `haskell-doc-show-strategy' (default: t) +;; `haskell-doc-show-user-defined' (default: t) + +;; If you want to define your own strings for some identifiers define an +;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. +;; E.g: +;; +;; (setq haskell-doc-show-user-defined t) +;; (setq haskell-doc-user-defined-ids +;; (list +;; '("main" . "just another pathetic main function") +;; '("foo" . "a very dummy name") +;; '("bar" . "another dummy name"))) + +;; The following two variables are useful to make the type fit on one line: +;; If `haskell-doc-chop-off-context' is non-nil the context part of the type +;; of a local fct will be eliminated (default: t). +;; If `haskell-doc-chop-off-fctname' is non-nil the function name is not +;; shown together with the type (default: nil). + +;;; Internals: +;; ========== + +;; `haskell-doc-mode' is implemented as a minor-mode. So, you can combine it +;; with any other mode. To enable it just type +;; M-x turn-on-haskell-doc-mode + +;; These are the names of the functions that can be called directly by the +;; user (with keybindings in `haskell-hugs-mode' and `haskell-mode'): +;; `haskell-doc-mode' ... toggle haskell-doc-mode; with prefix turn it on +;; unconditionally if the prefix is greater 0 otherwise +;; turn it off +;; Key: CTRL-c CTRL-o (CTRL-u CTRL-c CTRL-o) +;; `haskell-doc-ask-mouse-for-type' ... show the type of the id under the mouse +;; Key: C-S-M-mouse-3 +;; `haskell-doc-show-reserved' ... toggle echoing of reserved id's types +;; `haskell-doc-show-prelude' ... toggle echoing of prelude id's types +;; `haskell-doc-show-strategy' ... toggle echoing of strategy id's types +;; `haskell-doc-show-user-defined' ... toggle echoing of user def id's types +;; `haskell-doc-check-active' ... check whether haskell-doc is active; +;; Key: CTRL-c ESC-/ + +;;; ToDo: +;; ===== + +;; - Fix byte-compile problems in `haskell-doc-prelude-types' for getArgs etc +;; - Write a parser for .hi files and make haskell-doc independent from +;; hugs-mode. Read library interfaces via this parser. +;; - Indicate kind of object with colours +;; - Handle multi-line types +;; - Encode i-am-fct info in the alist of ids and types. + +;;; Bugs: +;; ===== + +;; - Some prelude fcts aren't displayed properly. This might be due to a +;; name clash of Haskell and Elisp functions (e.g. length) which +;; confuses Emacs when reading `haskell-doc-prelude-types' + +;;; Changelog: +;; ========== +;; $Log: haskell-doc.el,v $ +;; Revision 1.30 2009/02/02 21:00:33 monnier +;; (haskell-doc-imported-list): Don't add current buffer +;; to the imported file list if it is not (yet?) visiting a file. +;; +;; Revision 1.29 2007-12-12 04:04:19 monnier +;; (haskell-doc-in-code-p): New function. +;; (haskell-doc-show-type): Use it. +;; +;; Revision 1.28 2007/08/30 03:10:08 monnier +;; Comment/docs fixes. +;; +;; Revision 1.27 2007/07/30 17:36:50 monnier +;; (displayed-month): Remove declaration since it's not used here. +;; +;; Revision 1.26 2007/02/10 06:28:55 monnier +;; (haskell-doc-get-current-word): Remove. +;; Change all refs to it, to use haskell-ident-at-point instead. +;; +;; Revision 1.25 2007/02/09 21:53:42 monnier +;; (haskell-doc-get-current-word): Correctly distinguish +;; variable identifiers and infix identifiers. +;; (haskell-doc-rescan-files): Avoid switch-to-buffer. +;; (haskell-doc-imported-list): Operate on current buffer. +;; (haskell-doc-make-global-fct-index): Adjust call. +;; +;; Revision 1.24 2006/11/20 20:18:24 monnier +;; (haskell-doc-mode-print-current-symbol-info): Fix thinko. +;; +;; Revision 1.23 2006/10/20 03:12:31 monnier +;; Drop post-command-idle-hook in favor of run-with-idle-timer. +;; (haskell-doc-timer, haskell-doc-buffers): New vars. +;; (haskell-doc-mode): Use them. +;; (haskell-doc-check-active): Update the check. +;; (haskell-doc-mode-print-current-symbol-info): Remove the interactive spec. +;; Don't sit-for unless it's really needed. +;; +;; Revision 1.22 2006/09/20 18:42:35 monnier +;; Doc fix. +;; +;; Revision 1.21 2005/11/21 21:48:52 monnier +;; * haskell-doc.el (haskell-doc-extract-types): Get labelled data working. +;; (haskell-doc-prelude-types): Update via auto-generation. +;; +;; * haskell-doc.el (haskell-doc-extract-types): Get it partly working. +;; (haskell-doc-fetch-lib-urls): Don't use a literal if we apply +;; `nreverse' on it later on. +;; (haskell-doc-prelude-types): Update some parts by auto-generation. +;; (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. +;; +;; * haskell-doc.el (haskell-doc-maintainer, haskell-doc-varlist) +;; (haskell-doc-submit-bug-report, haskell-doc-ftp-site) +;; (haskell-doc-visit-home): Remove. +;; (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) +;; (haskell-doc-extract-and-insert-types): New funs. +;; (haskell-doc-reserved-ids): Fix type of `map'. +;; +;; Revision 1.20 2005/11/21 21:27:57 monnier +;; (haskell-doc-extract-types): Get labelled data working. +;; (haskell-doc-prelude-types): Update via auto-generation. +;; +;; Revision 1.19 2005/11/21 20:44:13 monnier +;; (haskell-doc-extract-types): Get it partly working. +;; (haskell-doc-fetch-lib-urls): Don't use a literal if we apply +;; `nreverse' on it later on. +;; (haskell-doc-prelude-types): Update some parts by auto-generation. +;; (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. +;; +;; Revision 1.18 2005/11/21 18:02:15 monnier +;; (haskell-doc-maintainer, haskell-doc-varlist) +;; (haskell-doc-submit-bug-report, haskell-doc-ftp-site) +;; (haskell-doc-visit-home): Remove. +;; (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) +;; (haskell-doc-extract-and-insert-types): New funs. +;; (haskell-doc-reserved-ids): Fix type of `map'. +;; +;; Revision 1.17 2005/11/20 23:55:09 monnier +;; Add coding cookie. +;; +;; Revision 1.16 2005/11/07 01:28:16 monnier +;; (haskell-doc-xemacs-p, haskell-doc-emacs-p) +;; (haskell-doc-message): Remove. +;; (haskell-doc-is-id-char-at): Remove. +;; (haskell-doc-get-current-word): Rewrite. +;; +;; Revision 1.15 2005/11/04 17:11:12 monnier +;; Add arch-tag. +;; +;; Revision 1.14 2005/08/24 11:36:32 monnier +;; (haskell-doc-message): Paren typo. +;; +;; Revision 1.13 2005/08/23 19:23:27 monnier +;; (haskell-doc-show-type): Assume that the availability +;; of display-message won't change at runtime. +;; +;; Revision 1.12 2005/07/18 21:04:14 monnier +;; (haskell-doc-message): Remove. +;; (haskell-doc-show-type): inline it. Do nothing for if there's no doc to show. +;; +;; Revision 1.11 2004/12/10 17:33:18 monnier +;; (haskell-doc-minor-mode-string): Make it dynamic. +;; (haskell-doc-install-keymap): Remove conflicting C-c C-o binding. +;; (haskell-doc-mode): Make a nil arg turn the mode ON. +;; (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode. +;; (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string. +;; (haskell-doc-show-global-types): Don't touch +;; haskell-doc-minor-mode-string. Call haskell-doc-make-global-fct-index. +;; (haskell-doc-check-active): Fix message. +;; (define-key-after): Don't define. +;; (haskell-doc-install-keymap): Check existence of define-key-after. +;; +;; Revision 1.10 2004/11/25 23:03:23 monnier +;; (haskell-doc-sym-doc): Make even the last char bold. +;; +;; Revision 1.9 2004/11/24 22:14:36 monnier +;; (haskell-doc-install-keymap): Don't blindly assume there's a Hugs menu. +;; +;; Revision 1.8 2004/11/22 10:45:35 simonmar +;; Fix type of getLine +;; +;; Revision 1.7 2004/10/14 22:27:47 monnier +;; (turn-off-haskell-doc-mode, haskell-doc-current-info): Don't autoload. +;; +;; Revision 1.6 2004/10/13 22:45:22 monnier +;; (haskell-doc): New group. +;; (haskell-doc-show-reserved, haskell-doc-show-prelude) +;; (haskell-doc-show-strategy, haskell-doc-show-user-defined) +;; (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname): +;; Make them custom vars. +;; (haskell-doc-keymap): Declare and fill it right there. +;; (haskell-doc-mode): Simplify. +;; (haskell-doc-toggle-var): Make it into what it was supposed to be. +;; (haskell-doc-mode-print-current-symbol-info): Simplify. +;; (haskell-doc-current-info): New autoloaded function. +;; (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type. +;; (haskell-doc-show-type): Use it. +;; (haskell-doc-wrapped-type-p): Remove unused var `lim'. +;; (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): Remove. Unused. +;; (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded. +;; (haskell-doc-install-keymap): Simplify. +;; +;; Revision 1.5 2003/01/09 11:56:26 simonmar +;; Patches from Ville Skyttä , the XEmacs maintainer of +;; the haskell-mode: +;; +;; - Make the auto-mode-alist modifications autoload-only. +;; +;; Revision 1.4 2002/10/14 09:55:03 simonmar +;; Patch to update the Prelude/libraries function names and to remove +;; support for older versions of Haskell. +;; +;; Submitted by: Anders Lau Olsen +;; +;; Revision 1.3 2002/04/30 09:34:37 rrt +;; Remove supporting Haskell 1.4 and 1.2 from the ToDo list. It's Far Too Late. +;; +;; Add (require 'imenu). Thanks to N. Y. Kwok. +;; +;; Revision 1.2 2002/04/23 14:45:10 simonmar +;; Tweaks to the doc strings and support for customization, from +;; Ville Skyttä . +;; +;; Revision 1.1 2001/07/19 16:17:36 rrt +;; Add the current version of the Moss/Thorn/Marlow Emacs mode, along with its +;; web pages and sample files. This is now the preferred mode, and the +;; haskell.org pages are being changed to reflect that. Also includes the new +;; GHCi mode from Chris Webb. +;; +;; Revision 1.6 1998/12/10 16:27:25 hwloidl +;; Minor changes ("Doc" as modeline string, mouse-3 moved to C-S-M-mouse-3) +;; +;; Revision 1.5 1998/09/24 14:25:46 gem +;; Fixed minor compatibility bugs with Haskell mode of Moss&Thorn. +;; Disabled M-/ binding. +;; +;; Revision 1.4 1997/11/12 23:51:19 hwloidl +;; Fixed start-up problem under emacs-19.34. +;; Added support for wrapped (multi-line) types and 2 vars to control the +;; behaviour with long fct types +;; +;; Revision 1.3 1997/11/03 00:48:03 hwloidl +;; Major revision for first release. +;; Added alists for showing prelude fcts, haskell syntax, and strategies +;; Added mouse interface to show type under mouse +;; Fixed bug which causes demon to fall over +;; Works now with hugs-mode and haskell-mode under emacs 19.34,20 and xemacs 19.15 +;; + +;;; Code: +;; ===== + +;;@menu +;;* Constants and Variables:: +;;* Install as minor mode:: +;;* Menubar Support:: +;;* Haskell Doc Mode:: +;;* Switch it on or off:: +;;* Check:: +;;* Top level function:: +;;* Mouse interface:: +;;* Print fctsym:: +;;* Movement:: +;;* Bug Reports:: +;;* Visit home site:: +;;* Index:: +;;* Token:: +;;@end menu + +;;@node top, Constants and Variables, (dir), (dir) +;;@top + +;;@node Constants and Variables, Install as minor mode, top, top +;;@section Constants and Variables + +;;@menu +;;* Emacs portability:: +;;* Maintenance stuff:: +;;* Mode Variable:: +;;* Variables:: +;;* Prelude types:: +;;* Test membership:: +;;@end menu + +;;@node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables +;;@subsection Emacs portability + +(require 'haskell-mode) +(eval-when-compile (require 'cl)) + +(defgroup haskell-doc nil + "Show Haskell function types in echo area." + :group 'haskell + :prefix "haskell-doc-") + +;;@node Mode Variable, Variables, Maintenance stuff, Constants and Variables +;;@subsection Mode Variable + +(defvar haskell-doc-mode nil + "*If non-nil, show the type of the function near point or a related comment. + +If the identifier near point is a Haskell keyword and the variable +`haskell-doc-show-reserved' is non-nil show a one line summary +of the syntax. + +If the identifier near point is a Prelude or one of the standard library +functions and `haskell-doc-show-prelude' is non-nil show its type. + +If the identifier near point is local \(i.e. defined in this module\) check +the `imenu' list of functions for the type. This obviously requires that +your language mode uses `imenu'. + +If the identifier near point is global \(i.e. defined in an imported module\) +and the variable `haskell-doc-show-global-types' is non-nil show the type of its +function. + +If the identifier near point is a standard strategy or a function, type related +related to strategies and `haskell-doc-show-strategy' is non-nil show the type +of the function. Strategies are special to the parallel execution of Haskell. +If you're not interested in that just turn it off. + +If the identifier near point is a user defined function that occurs as key +in the alist `haskell-doc-user-defined-ids' and the variable +`haskell-doc-show-user-defined' is non-nil show the type of the function. + +This variable is buffer-local.") +(make-variable-buffer-local 'haskell-doc-mode) + +(defvar haskell-doc-mode-hook nil + "Hook invoked when entering `haskell-doc-mode'.") + +(defvar haskell-doc-index nil + "Variable holding an alist matching file names to fct-type alists. +The function `haskell-doc-make-global-fct-index' rebuilds this variables +\(similar to an `imenu' rescan\). +This variable is buffer-local.") +(make-variable-buffer-local 'haskell-doc-index) + +(defcustom haskell-doc-show-global-types nil + "If non-nil, search for the types of global functions by loading the files. +This variable is buffer-local." + :group 'haskell-doc + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-global-types) + +(defcustom haskell-doc-show-reserved t + "If non-nil, show a documentation string for reserved ids. +This variable is buffer-local." + :group 'haskell-doc + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-reserved) + +(defcustom haskell-doc-show-prelude t + "If non-nil, show a documentation string for prelude functions. +This variable is buffer-local." + :group 'haskell-doc + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-prelude) + +(defcustom haskell-doc-show-strategy t + "If non-nil, show a documentation string for strategies. +This variable is buffer-local." + :group 'haskell-doc + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-strategy) + +(defcustom haskell-doc-show-user-defined t + "If non-nil, show a documentation string for user defined ids. +This variable is buffer-local." + :group 'haskell-doc + :type 'boolean) +(make-variable-buffer-local 'haskell-doc-show-user-defined) + +(defcustom haskell-doc-chop-off-context t + "If non-nil eliminate the context part in a Haskell type." + :group 'haskell-doc + :type 'boolean) + +(defcustom haskell-doc-chop-off-fctname nil + "If non-nil omit the function name and show only the type." + :group 'haskell-doc + :type 'boolean) + +(defvar haskell-doc-search-distance 40 ; distance in characters + "*How far to search when looking for the type declaration of fct under cursor.") + +;;@node Variables, Prelude types, Mode Variable, Constants and Variables +;;@subsection Variables + +(defvar haskell-doc-idle-delay 0.50 + "*Number of seconds of idle time to wait before printing. +If user input arrives before this interval of time has elapsed after the +last input, no documentation will be printed. + +If this variable is set to 0, no idle time is required.") + +(defvar haskell-doc-argument-case 'identity ; 'upcase + "Case to display argument names of functions, as a symbol. +This has two preferred values: `upcase' or `downcase'. +Actually, any name of a function which takes a string as an argument and +returns another string is acceptable.") + +(defvar haskell-doc-mode-message-commands nil + "*Obarray of command names where it is appropriate to print in the echo area. + +This is not done for all commands since some print their own +messages in the echo area, and these functions would instantly overwrite +them. But `self-insert-command' as well as most motion commands are good +candidates. + +It is probably best to manipulate this data structure with the commands +`haskell-doc-add-command' and `haskell-doc-remove-command'.") + +;;(cond ((null haskell-doc-mode-message-commands) +;; ;; If you increase the number of buckets, keep it a prime number. +;; (setq haskell-doc-mode-message-commands (make-vector 31 0)) +;; (let ((list '("self-insert-command" +;; "next-" "previous-" +;; "forward-" "backward-" +;; "beginning-of-" "end-of-" +;; "goto-" +;; "recenter" +;; "scroll-")) +;; (syms nil)) +;; (while list +;; (setq syms (all-completions (car list) obarray 'fboundp)) +;; (setq list (cdr list)) +;; (while syms +;; (set (intern (car syms) haskell-doc-mode-message-commands) t) +;; (setq syms (cdr syms))))))) + +;; Bookkeeping; the car contains the last symbol read from the buffer. +;; The cdr contains the string last displayed in the echo area, so it can +;; be printed again if necessary without reconsing. +(defvar haskell-doc-last-data '(nil . nil)) + +(defvar haskell-doc-minor-mode-string + '(haskell-doc-show-global-types " DOC" " Doc") + "*String to display in mode line when Haskell-Doc Mode is enabled.") + + +;;@node Prelude types, Test membership, Variables, Constants and Variables +;;@subsection Prelude types + +;;@cindex haskell-doc-reserved-ids + +(defvar haskell-doc-reserved-ids + '(("case" . "case exp of { alts [;] }") + ("class" . "class [context =>] simpleclass [where { cbody [;] }]") + ("data" . "data [context =>] simpletype = constrs [deriving]") + ("default" . "default (type1 , ... , typen)") + ("deriving" . "deriving (dclass | (dclass1, ... , dclassn))") ; used with data or newtype + ("do" . "do { stmts [;] } stmts -> exp [; stmts] | pat <- exp ; stmts | let decllist ; stmts") + ("else" . "if exp then exp else exp") + ("if" . "if exp then exp else exp") + ("import" . "import [qualified] modid [as modid] [impspec]") + ("in" . "let decllist in exp") + ("infix" . "infix [digit] ops") + ("infixl" . "infixl [digit] ops") + ("infixr" . "infixr [digit] ops") + ("instance" . "instance [context =>] qtycls inst [where { valdefs [;] }]") + ("let" . "let { decl; ...; decl [;] } in exp") + ("module" . "module modid [exports] where body") + ("newtype" . "newtype [context =>] simpletype = con atype [deriving]") + ("of" . "case exp of { alts [;] }") + ("then" . "if exp then exp else exp") + ("type" . "type simpletype = type") + ("where" . "exp where { decl; ...; decl [;] }") ; check that ; see also class, instance, module + ("as" . "import [qualified] modid [as modid] [impspec]") + ("qualified" . "import [qualified] modid [as modid] [impspec]") + ("hiding" . "hiding ( import1 , ... , importn [ , ] )")) + "An alist of reserved identifiers. +Each element is of the form (ID . DOC) where both ID and DOC are strings. +DOC should be a concise single-line string describing the construct in which +the keyword is used.") + +(eval-and-compile +(defalias 'haskell-doc-split-string + (if (condition-case () + (split-string "" nil t) + (wrong-number-of-arguments nil)) + 'split-string + ;; copied from Emacs 22 + (lambda (string &optional separators omit-nulls) + (let ((keep-nulls (not (if separators omit-nulls t))) + (rexp (or separators "[ \f\t\n\r\v]+")) + (start 0) + notfirst + (list nil)) + (while (and (string-match rexp string + (if (and notfirst + (= start (match-beginning 0)) + (< start (length string))) + (1+ start) start)) + (< start (length string))) + (setq notfirst t) + (if (or keep-nulls (< start (match-beginning 0))) + (setq list + (cons (substring string start (match-beginning 0)) + list))) + (setq start (match-end 0))) + (if (or keep-nulls (< start (length string))) + (setq list + (cons (substring string start) + list))) + (nreverse list)))))) + +;;@cindex haskell-doc-prelude-types + +(defun haskell-doc-extract-types (url) + (with-temp-buffer + (insert-file-contents url) + (goto-char (point-min)) + (while (search-forward " " nil t) (replace-match " " t t)) + + ;; First, focus on the actual code, removing the surrounding HTML text. + (goto-char (point-min)) + (let ((last (point-min)) + (modules nil)) + (while (re-search-forward "^module +\\([[:alnum:]]+\\)" nil t) + (let ((module (match-string 1))) + (if (member module modules) + ;; The library nodes of the HTML doc contain modules twice: + ;; once at the top, with only type declarations, and once at + ;; the bottom with an actual sample implementation which may + ;; include declaration of non-exported values. + ;; We're now at this second occurrence is the implementation + ;; which should thus be ignored. + nil + (push module modules) + (delete-region last (point)) + (search-forward "") + ;; Some of the blocks of code are split. + (while (looking-at "\\(<[^<>]+>[ \t\n]*\\)*") + (goto-char (match-end 0)) + (search-forward "")) + (setq last (point))))) + (delete-region last (point-max)) + + ;; Then process the HTML encoding to get back to pure ASCII. + (goto-char (point-min)) + (while (search-forward "
" nil t) (replace-match "\n" t t)) + ;; (goto-char (point-min)) + ;; (while (re-search-forward "<[^<>]+>" nil t) (replace-match "" t t)) + (goto-char (point-min)) + (while (search-forward ">" nil t) (replace-match ">" t t)) + (goto-char (point-min)) + (while (search-forward "<" nil t) (replace-match "<" t t)) + (goto-char (point-min)) + (while (search-forward "&" nil t) (replace-match "&" t t)) + (goto-char (point-min)) + (if (re-search-forward "&[a-z]+;" nil t) + (error "Unexpected charref %s" (match-string 0))) + ;; Remove TABS. + (goto-char (point-min)) + (while (search-forward "\t" nil t) (replace-match " " t t)) + + ;; Finally, extract the actual data. + (goto-char (point-min)) + (let* ((elems nil) + (space-re "[ \t\n]*\\(?:--.*\n[ \t\n]*\\)*") + (comma-re (concat " *," space-re)) + ;; A list of identifiers. We have to be careful to weed out + ;; entries like "ratPrec = 7 :: Int". Also ignore entries + ;; which start with a < since they're actually in the HTML text + ;; part. And the list may be spread over several lines, cut + ;; after a comma. + (idlist-re + (concat "\\([^< \t\n][^ \t\n]*" + "\\(?:" comma-re "[^ \t\n]+\\)*\\)")) + ;; A type. A few types are spread over 2 lines, + ;; cut after the "=>", so we have to handle these as well. + (type-re "\\(.*[^\n>]\\(?:>[ \t\n]+.*[^\n>]\\)*\\) *$") + ;; A decl of a list of values, possibly indented. + (val-decl-re + (concat "^\\( +\\)?" idlist-re "[ \t\n]*::[ \t\n]*" type-re)) + (re (concat + ;; 3 possibilities: a class decl, a data decl, or val decl. + ;; First, let's match a class decl. + "^class \\(?:.*=>\\)? *\\(.*[^ \t\n]\\)[ \t\n]*where" + + ;; Or a value decl: + "\\|" val-decl-re + + "\\|" ;; Or a data decl. We only handle single-arm + ;; datatypes with labels. + "^data +\\([[:alnum:]][[:alnum:] ]*[[:alnum:]]\\)" + " *=.*{\\([^}]+\\)}" + )) + (re-class (concat "^[^ \t\n]\\|" re)) + curclass) + (while (re-search-forward (if curclass re-class re) nil t) + (cond + ;; A class decl. + ((match-end 1) (setq curclass (match-string 1))) + ;; A value decl. + ((match-end 4) + (let ((type (match-string 4)) + (vars (match-string 3)) + (indented (match-end 2))) + (if (string-match "[ \t\n][ \t\n]+" type) + (setq type (replace-match " " t t type))) + (if (string-match " *\\(--.*\\)?\\'" type) + (setq type (substring type 0 (match-beginning 0)))) + (if indented + (if curclass + (if (string-match "\\`\\(.*[^ \t\n]\\) *=> *" type) + (let ((classes (match-string 1 type))) + (setq type (substring type (match-end 0))) + (if (string-match "\\`(.*)\\'" classes) + (setq classes (substring classes 1 -1))) + (setq type (concat "(" curclass ", " classes + ") => " type))) + (setq type (concat curclass " => " type))) + ;; It's actually not an error: just a type annotation on + ;; some local variable. + ;; (error "Indentation outside a class in %s: %s" + ;; module vars) + nil) + (setq curclass nil)) + (dolist (var (haskell-doc-split-string vars comma-re t)) + (if (string-match "(.*)" var) (setq var (substring var 1 -1))) + (push (cons var type) elems)))) + ;; A datatype decl. + ((match-end 5) + (setq curclass nil) + (let ((name (match-string 5))) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 6) (match-end 6)) + (goto-char (point-min)) + (while (re-search-forward val-decl-re nil t) + (let ((vars (match-string 2)) + (type (match-string 3))) + (if (string-match "[ \t\n][ \t\n]+" type) + (setq type (replace-match " " t t type))) + (if (string-match " *\\(--.*\\)?\\'" type) + (setq type (substring type 0 (match-beginning 0)))) + (if (string-match ",\\'" type) + (setq type (substring type 0 -1))) + (setq type (concat name " -> " type)) + (dolist (var (haskell-doc-split-string vars comma-re t)) + (if (string-match "(.*)" var) + (setq var (substring var 1 -1))) + (push (cons var type) elems)))))))) + + ;; The end of a class declaration. + (t (setq curclass nil) (beginning-of-line)))) + (cons (car (last modules)) elems))))) + +(defun haskell-doc-fetch-lib-urls (base-url) + (with-temp-buffer + (insert-file-contents base-url) + (goto-char (point-min)) + (search-forward "Part II: Libraries") + (delete-region (point-min) (point)) + (search-forward "") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (let ((libs (list "standard-prelude.html"))) + (while (re-search-forward "" nil t) + (push (match-string 1) libs)) + (mapcar (lambda (s) (expand-file-name s (file-name-directory base-url))) + (nreverse libs))))) + +(defun haskell-doc-extract-and-insert-types (url) + "Fetch the types from the online doc and insert them at point. +URL is the URL of the online doc." + (interactive (if current-prefix-arg + (read-file-name "URL: ") + (list "http://www.haskell.org/onlinereport/"))) + (let ((urls (haskell-doc-fetch-lib-urls url))) + (dolist (url urls) + (let ((data (haskell-doc-extract-types url))) + (insert ";; " (pop data)) (indent-according-to-mode) (newline) + (dolist (elem (sort data (lambda (x y) (string-lessp (car x) (car y))))) + (prin1 elem (current-buffer)) + (indent-according-to-mode) (newline)))))) + +(defvar haskell-doc-prelude-types + ;; This list was auto generated by `haskell-doc-extract-and-insert-types'. + '( + ;; Prelude + ("!!" . "[a] -> Int -> a") + ("$" . "(a -> b) -> a -> b") + ("$!" . "(a -> b) -> a -> b") + ("&&" . "Bool -> Bool -> Bool") + ("*" . "Num a => a -> a -> a") + ("**" . "Floating a => a -> a -> a") + ("+" . "Num a => a -> a -> a") + ("++" . "[a] -> [a] -> [a]") + ("-" . "Num a => a -> a -> a") + ("." . "(b -> c) -> (a -> b) -> a -> c") + ("/" . "Fractional a => a -> a -> a") + ("/=" . "Eq a => a -> a -> Bool") + ("<" . "Ord a => a -> a -> Bool") + ("<=" . "Ord a => a -> a -> Bool") + ("=<<" . "Monad m => (a -> m b) -> m a -> m b") + ("==" . "Eq a => a -> a -> Bool") + (">" . "Ord a => a -> a -> Bool") + (">=" . "Ord a => a -> a -> Bool") + (">>" . "Monad m => m a -> m b -> m b") + (">>=" . "Monad m => m a -> (a -> m b) -> m b") + ("^" . "(Num a, Integral b) => a -> b -> a") + ("^^" . "(Fractional a, Integral b) => a -> b -> a") + ("abs" . "Num a => a -> a") + ("acos" . "Floating a => a -> a") + ("acosh" . "Floating a => a -> a") + ("all" . "(a -> Bool) -> [a] -> Bool") + ("and" . "[Bool] -> Bool") + ("any" . "(a -> Bool) -> [a] -> Bool") + ("appendFile" . "FilePath -> String -> IO ()") + ("asTypeOf" . "a -> a -> a") + ("asin" . "Floating a => a -> a") + ("asinh" . "Floating a => a -> a") + ("atan" . "Floating a => a -> a") + ("atan2" . "RealFloat a => a -> a -> a") + ("atanh" . "Floating a => a -> a") + ("break" . "(a -> Bool) -> [a] -> ([a],[a])") + ("catch" . "IO a -> (IOError -> IO a) -> IO a") + ("ceiling" . "(RealFrac a, Integral b) => a -> b") + ("compare" . "Ord a => a -> a -> Ordering") + ("concat" . "[[a]] -> [a]") + ("concatMap" . "(a -> [b]) -> [a] -> [b]") + ("const" . "a -> b -> a") + ("cos" . "Floating a => a -> a") + ("cosh" . "Floating a => a -> a") + ("curry" . "((a, b) -> c) -> a -> b -> c") + ("cycle" . "[a] -> [a]") + ("decodeFloat" . "RealFloat a => a -> (Integer,Int)") + ("div" . "Integral a => a -> a -> a") + ("divMod" . "Integral a => a -> a -> (a,a)") + ("drop" . "Int -> [a] -> [a]") + ("dropWhile" . "(a -> Bool) -> [a] -> [a]") + ("either" . "(a -> c) -> (b -> c) -> Either a b -> c") + ("elem" . "(Eq a) => a -> [a] -> Bool") + ("encodeFloat" . "RealFloat a => Integer -> Int -> a") + ("enumFrom" . "Enum a => a -> [a]") + ("enumFromThen" . "Enum a => a -> a -> [a]") + ("enumFromThenTo" . "Enum a => a -> a -> a -> [a]") + ("enumFromTo" . "Enum a => a -> a -> [a]") + ("error" . "String -> a") + ("even" . "(Integral a) => a -> Bool") + ("exp" . "Floating a => a -> a") + ("exponent" . "RealFloat a => a -> Int") + ("fail" . "Monad m => String -> m a") + ("filter" . "(a -> Bool) -> [a] -> [a]") + ("flip" . "(a -> b -> c) -> b -> a -> c") + ("floatDigits" . "RealFloat a => a -> Int") + ("floatRadix" . "RealFloat a => a -> Integer") + ("floatRange" . "RealFloat a => a -> (Int,Int)") + ("floor" . "(RealFrac a, Integral b) => a -> b") + ("fmap" . "Functor f => (a -> b) -> f a -> f b") + ("foldl" . "(a -> b -> a) -> a -> [b] -> a") + ("foldl1" . "(a -> a -> a) -> [a] -> a") + ("foldr" . "(a -> b -> b) -> b -> [a] -> b") + ("foldr1" . "(a -> a -> a) -> [a] -> a") + ("fromEnum" . "Enum a => a -> Int") + ("fromInteger" . "Num a => Integer -> a") + ("fromIntegral" . "(Integral a, Num b) => a -> b") + ("fromRational" . "Fractional a => Rational -> a") + ("fst" . "(a,b) -> a") + ("gcd" . "(Integral a) => a -> a -> a") + ("getChar" . "IO Char") + ("getContents" . "IO String") + ("getLine" . "IO String") + ("head" . "[a] -> a") + ("id" . "a -> a") + ("init" . "[a] -> [a]") + ("interact" . "(String -> String) -> IO ()") + ("ioError" . "IOError -> IO a") + ("isDenormalized" . "RealFloat a => a -> Bool") + ("isIEEE" . "RealFloat a => a -> Bool") + ("isInfinite" . "RealFloat a => a -> Bool") + ("isNaN" . "RealFloat a => a -> Bool") + ("isNegativeZero" . "RealFloat a => a -> Bool") + ("iterate" . "(a -> a) -> a -> [a]") + ("last" . "[a] -> a") + ("lcm" . "(Integral a) => a -> a -> a") + ("length" . "[a] -> Int") + ("lex" . "ReadS String") + ("lines" . "String -> [String]") + ("log" . "Floating a => a -> a") + ("logBase" . "Floating a => a -> a -> a") + ("lookup" . "(Eq a) => a -> [(a,b)] -> Maybe b") + ("map" . "(a -> b) -> [a] -> [b]") + ("mapM" . "Monad m => (a -> m b) -> [a] -> m [b]") + ("mapM_" . "Monad m => (a -> m b) -> [a] -> m ()") + ("max" . "Ord a => a -> a -> a") + ("maxBound" . "Bounded a => a") + ("maximum" . "(Ord a) => [a] -> a") + ("maybe" . "b -> (a -> b) -> Maybe a -> b") + ("min" . "Ord a => a -> a -> a") + ("minBound" . "Bounded a => a") + ("minimum" . "(Ord a) => [a] -> a") + ("mod" . "Integral a => a -> a -> a") + ("negate" . "Num a => a -> a") + ("not" . "Bool -> Bool") + ("notElem" . "(Eq a) => a -> [a] -> Bool") + ("null" . "[a] -> Bool") + ("numericEnumFrom" . "(Fractional a) => a -> [a]") + ("numericEnumFromThen" . "(Fractional a) => a -> a -> [a]") + ("numericEnumFromThenTo" . "(Fractional a, Ord a) => a -> a -> a -> [a]") + ("numericEnumFromTo" . "(Fractional a, Ord a) => a -> a -> [a]") + ("odd" . "(Integral a) => a -> Bool") + ("or" . "[Bool] -> Bool") + ("otherwise" . "Bool") + ("pi" . "Floating a => a") + ("pred" . "Enum a => a -> a") + ("print" . "Show a => a -> IO ()") + ("product" . "(Num a) => [a] -> a") + ("properFraction" . "(RealFrac a, Integral b) => a -> (b,a)") + ("putChar" . "Char -> IO ()") + ("putStr" . "String -> IO ()") + ("putStrLn" . "String -> IO ()") + ("quot" . "Integral a => a -> a -> a") + ("quotRem" . "Integral a => a -> a -> (a,a)") + ("read" . "(Read a) => String -> a") + ("readFile" . "FilePath -> IO String") + ("readIO" . "Read a => String -> IO a") + ("readList" . "Read a => ReadS [a]") + ("readLn" . "Read a => IO a") + ("readParen" . "Bool -> ReadS a -> ReadS a") + ("reads" . "(Read a) => ReadS a") + ("readsPrec" . "Read a => Int -> ReadS a") + ("realToFrac" . "(Real a, Fractional b) => a -> b") + ("recip" . "Fractional a => a -> a") + ("rem" . "Integral a => a -> a -> a") + ("repeat" . "a -> [a]") + ("replicate" . "Int -> a -> [a]") + ("return" . "Monad m => a -> m a") + ("reverse" . "[a] -> [a]") + ("round" . "(RealFrac a, Integral b) => a -> b") + ("scaleFloat" . "RealFloat a => Int -> a -> a") + ("scanl" . "(a -> b -> a) -> a -> [b] -> [a]") + ("scanl1" . "(a -> a -> a) -> [a] -> [a]") + ("scanr" . "(a -> b -> b) -> b -> [a] -> [b]") + ("scanr1" . "(a -> a -> a) -> [a] -> [a]") + ("seq" . "a -> b -> b") + ("sequence" . "Monad m => [m a] -> m [a]") + ("sequence_" . "Monad m => [m a] -> m ()") + ("show" . "Show a => a -> String") + ("showChar" . "Char -> ShowS") + ("showList" . "Show a => [a] -> ShowS") + ("showParen" . "Bool -> ShowS -> ShowS") + ("showString" . "String -> ShowS") + ("shows" . "(Show a) => a -> ShowS") + ("showsPrec" . "Show a => Int -> a -> ShowS") + ("significand" . "RealFloat a => a -> a") + ("signum" . "Num a => a -> a") + ("sin" . "Floating a => a -> a") + ("sinh" . "Floating a => a -> a") + ("snd" . "(a,b) -> b") + ("span" . "(a -> Bool) -> [a] -> ([a],[a])") + ("splitAt" . "Int -> [a] -> ([a],[a])") + ("sqrt" . "Floating a => a -> a") + ("subtract" . "(Num a) => a -> a -> a") + ("succ" . "Enum a => a -> a") + ("sum" . "(Num a) => [a] -> a") + ("tail" . "[a] -> [a]") + ("take" . "Int -> [a] -> [a]") + ("takeWhile" . "(a -> Bool) -> [a] -> [a]") + ("tan" . "Floating a => a -> a") + ("tanh" . "Floating a => a -> a") + ("toEnum" . "Enum a => Int -> a") + ("toInteger" . "Integral a => a -> Integer") + ("toRational" . "Real a => a -> Rational") + ("truncate" . "(RealFrac a, Integral b) => a -> b") + ("uncurry" . "(a -> b -> c) -> ((a, b) -> c)") + ("undefined" . "a") + ("unlines" . "[String] -> String") + ("until" . "(a -> Bool) -> (a -> a) -> a -> a") + ("unwords" . "[String] -> String") + ("unzip" . "[(a,b)] -> ([a],[b])") + ("unzip3" . "[(a,b,c)] -> ([a],[b],[c])") + ("userError" . "String -> IOError") + ("words" . "String -> [String]") + ("writeFile" . "FilePath -> String -> IO ()") + ("zip" . "[a] -> [b] -> [(a,b)]") + ("zip3" . "[a] -> [b] -> [c] -> [(a,b,c)]") + ("zipWith" . "(a->b->c) -> [a]->[b]->[c]") + ("zipWith3" . "(a->b->c->d) -> [a]->[b]->[c]->[d]") + ("||" . "Bool -> Bool -> Bool") + ;; Ratio + ("%" . "(Integral a) => a -> a -> Ratio a") + ("approxRational" . "(RealFrac a) => a -> a -> Rational") + ("denominator" . "(Integral a) => Ratio a -> a") + ("numerator" . "(Integral a) => Ratio a -> a") + ;; Complex + ("cis" . "(RealFloat a) => a -> Complex a") + ("conjugate" . "(RealFloat a) => Complex a -> Complex a") + ("imagPart" . "(RealFloat a) => Complex a -> a") + ("magnitude" . "(RealFloat a) => Complex a -> a") + ("mkPolar" . "(RealFloat a) => a -> a -> Complex a") + ("phase" . "(RealFloat a) => Complex a -> a") + ("polar" . "(RealFloat a) => Complex a -> (a,a)") + ("realPart" . "(RealFloat a) => Complex a -> a") + ;; Numeric + ("floatToDigits" . "(RealFloat a) => Integer -> a -> ([Int], Int)") + ("fromRat" . "(RealFloat a) => Rational -> a") + ("lexDigits" . "ReadS String") + ("readDec" . "(Integral a) => ReadS a") + ("readFloat" . "(RealFrac a) => ReadS a") + ("readHex" . "(Integral a) => ReadS a") + ("readInt" . "(Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a") + ("readOct" . "(Integral a) => ReadS a") + ("readSigned" . "(Real a) => ReadS a -> ReadS a") + ("showEFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") + ("showFFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") + ("showFloat" . "(RealFloat a) => a -> ShowS") + ("showGFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") + ("showHex" . "Integral a => a -> ShowS") + ("showInt" . "Integral a => a -> ShowS") + ("showIntAtBase" . "Integral a => a -> (Int -> Char) -> a -> ShowS") + ("showOct" . "Integral a => a -> ShowS") + ("showSigned" . "(Real a) => (a -> ShowS) -> Int -> a -> ShowS") + ;; Ix + ("inRange" . "Ix a => (a,a) -> a -> Bool") + ("index" . "Ix a => (a,a) -> a -> Int") + ("range" . "Ix a => (a,a) -> [a]") + ("rangeSize" . "Ix a => (a,a) -> Int") + ;; Array + ("!" . "(Ix a) => Array a b -> a -> b") + ("//" . "(Ix a) => Array a b -> [(a,b)] -> Array a b") + ("accum" . "(Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]") + ("accumArray" . "(Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]") + ("array" . "(Ix a) => (a,a) -> [(a,b)] -> Array a b") + ("assocs" . "(Ix a) => Array a b -> [(a,b)]") + ("bounds" . "(Ix a) => Array a b -> (a,a)") + ("elems" . "(Ix a) => Array a b -> [b]") + ("indices" . "(Ix a) => Array a b -> [a]") + ("ixmap" . "(Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c") + ("listArray" . "(Ix a) => (a,a) -> [b] -> Array a b") + ;; List + ("\\\\" . "Eq a => [a] -> [a] -> [a]") + ("delete" . "Eq a => a -> [a] -> [a]") + ("deleteBy" . "(a -> a -> Bool) -> a -> [a] -> [a]") + ("deleteFirstsBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") + ("elemIndex" . "Eq a => a -> [a] -> Maybe Int") + ("elemIndices" . "Eq a => a -> [a] -> [Int]") + ("find" . "(a -> Bool) -> [a] -> Maybe a") + ("findIndex" . "(a -> Bool) -> [a] -> Maybe Int") + ("findIndices" . "(a -> Bool) -> [a] -> [Int]") + ("genericDrop" . "Integral a => a -> [b] -> [b]") + ("genericIndex" . "Integral a => [b] -> a -> b") + ("genericLength" . "Integral a => [b] -> a") + ("genericReplicate" . "Integral a => a -> b -> [b]") + ("genericSplitAt" . "Integral a => a -> [b] -> ([b],[b])") + ("genericTake" . "Integral a => a -> [b] -> [b]") + ("group" . "Eq a => [a] -> [[a]]") + ("groupBy" . "(a -> a -> Bool) -> [a] -> [[a]]") + ("inits" . "[a] -> [[a]]") + ("insert" . "Ord a => a -> [a] -> [a]") + ("insertBy" . "(a -> a -> Ordering) -> a -> [a] -> [a]") + ("intersect" . "Eq a => [a] -> [a] -> [a]") + ("intersectBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") + ("intersperse" . "a -> [a] -> [a]") + ("isPrefixOf" . "Eq a => [a] -> [a] -> Bool") + ("isSuffixOf" . "Eq a => [a] -> [a] -> Bool") + ("mapAccumL" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])") + ("mapAccumR" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])") + ("maximumBy" . "(a -> a -> Ordering) -> [a] -> a") + ("minimumBy" . "(a -> a -> Ordering) -> [a] -> a") + ("nub" . "Eq a => [a] -> [a]") + ("nubBy" . "(a -> a -> Bool) -> [a] -> [a]") + ("partition" . "(a -> Bool) -> [a] -> ([a],[a])") + ("sort" . "Ord a => [a] -> [a]") + ("sortBy" . "(a -> a -> Ordering) -> [a] -> [a]") + ("tails" . "[a] -> [[a]]") + ("transpose" . "[[a]] -> [[a]]") + ("unfoldr" . "(b -> Maybe (a,b)) -> b -> [a]") + ("union" . "Eq a => [a] -> [a] -> [a]") + ("unionBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") + ("unzip4" . "[(a,b,c,d)] -> ([a],[b],[c],[d])") + ("unzip5" . "[(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])") + ("unzip6" . "[(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])") + ("unzip7" . "[(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])") + ("zip4" . "[a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]") + ("zip5" . "[a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]") + ("zip6" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f]") + ("zip7" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]") + ("zipWith4" . "(a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]") + ("zipWith5" . "(a->b->c->d->e->f) ->") + ("zipWith6" . "(a->b->c->d->e->f->g) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]") + ("zipWith7" . "(a->b->c->d->e->f->g->h) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]") + ;; Maybe + ("catMaybes" . "[Maybe a] -> [a]") + ("fromJust" . "Maybe a -> a") + ("fromMaybe" . "a -> Maybe a -> a") + ("isJust" . "Maybe a -> Bool") + ("isNothing" . "Maybe a -> Bool") + ("listToMaybe" . "[a] -> Maybe a") + ("mapMaybe" . "(a -> Maybe b) -> [a] -> [b]") + ("maybeToList" . "Maybe a -> [a]") + ;; Char + ("chr" . "Int -> Char") + ("digitToInt" . "Char -> Int") + ("intToDigit" . "Int -> Char") + ("isAlpha" . "Char -> Bool") + ("isAlphaNum" . "Char -> Bool") + ("isAscii" . "Char -> Bool") + ("isControl" . "Char -> Bool") + ("isDigit" . "Char -> Bool") + ("isHexDigit" . "Char -> Bool") + ("isLatin1" . "Char -> Bool") + ("isLower" . "Char -> Bool") + ("isOctDigit" . "Char -> Bool") + ("isPrint" . "Char -> Bool") + ("isSpace" . "Char -> Bool") + ("isUpper" . "Char -> Bool") + ("lexLitChar" . "ReadS String") + ("ord" . "Char -> Int") + ("readLitChar" . "ReadS Char") + ("showLitChar" . "Char -> ShowS") + ("toLower" . "Char -> Char") + ("toUpper" . "Char -> Char") + ;; Monad + ("ap" . "Monad m => m (a -> b) -> m a -> m b") + ("filterM" . "Monad m => (a -> m Bool) -> [a] -> m [a]") + ("foldM" . "Monad m => (a -> b -> m a) -> a -> [b] -> m a") + ("guard" . "MonadPlus m => Bool -> m ()") + ("join" . "Monad m => m (m a) -> m a") + ("liftM" . "Monad m => (a -> b) -> (m a -> m b)") + ("liftM2" . "Monad m => (a -> b -> c) -> (m a -> m b -> m c)") + ("liftM3" . "Monad m => (a -> b -> c -> d) -> (m a -> m b -> m c -> m d)") + ("liftM4" . "Monad m => (a -> b -> c -> d -> e) -> (m a -> m b -> m c -> m d -> m e)") + ("liftM5" . "Monad m => (a -> b -> c -> d -> e -> f) -> (m a -> m b -> m c -> m d -> m e -> m f)") + ("mapAndUnzipM" . "Monad m => (a -> m (b,c)) -> [a] -> m ([b], [c])") + ("mplus" . "MonadPlus m => m a -> m a -> m a") + ("msum" . "MonadPlus m => [m a] -> m a") + ("mzero" . "MonadPlus m => m a") + ("unless" . "Monad m => Bool -> m () -> m ()") + ("when" . "Monad m => Bool -> m () -> m ()") + ("zipWithM" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]") + ("zipWithM_" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()") + ;; IO + ("bracket" . "IO a -> (a -> IO b) -> (a -> IO c) -> IO c") + ("bracket_" . "IO a -> (a -> IO b) -> IO c -> IO c") + ("hClose" . "Handle -> IO ()") + ("hFileSize" . "Handle -> IO Integer") + ("hFlush" . "Handle -> IO ()") + ("hGetBuffering" . "Handle -> IO BufferMode") + ("hGetChar" . "Handle -> IO Char") + ("hGetContents" . "Handle -> IO String") + ("hGetLine" . "Handle -> IO String") + ("hGetPosn" . "Handle -> IO HandlePosn") + ("hIsClosed" . "Handle -> IO Bool") + ("hIsEOF" . "Handle -> IO Bool") + ("hIsOpen" . "Handle -> IO Bool") + ("hIsReadable" . "Handle -> IO Bool") + ("hIsSeekable" . "Handle -> IO Bool") + ("hIsWritable" . "Handle -> IO Bool") + ("hLookAhead" . "Handle -> IO Char") + ("hPrint" . "Show a => Handle -> a -> IO ()") + ("hPutChar" . "Handle -> Char -> IO ()") + ("hPutStr" . "Handle -> String -> IO ()") + ("hPutStrLn" . "Handle -> String -> IO ()") + ("hReady" . "Handle -> IO Bool") + ("hSeek" . "Handle -> SeekMode -> Integer -> IO ()") + ("hSetBuffering" . "Handle -> BufferMode -> IO ()") + ("hSetPosn" . "HandlePosn -> IO ()") + ("hWaitForInput" . "Handle -> Int -> IO Bool") + ("ioeGetErrorString" . "IOError -> String") + ("ioeGetFileName" . "IOError -> Maybe FilePath") + ("ioeGetHandle" . "IOError -> Maybe Handle") + ("isAlreadyExistsError" . "IOError -> Bool") + ("isAlreadyInUseError" . "IOError -> Bool") + ("isDoesNotExistError" . "IOError -> Bool") + ("isEOF" . "IO Bool") + ("isEOFError" . "IOError -> Bool") + ("isFullError" . "IOError -> Bool") + ("isIllegalOperation" . "IOError -> Bool") + ("isPermissionError" . "IOError -> Bool") + ("isUserError" . "IOError -> Bool") + ("openFile" . "FilePath -> IOMode -> IO Handle") + ("stderr" . "Handle") + ("stdin" . "Handle") + ("stdout" . "Handle") + ("try" . "IO a -> IO (Either IOError a)") + ;; Directory + ("createDirectory" . "FilePath -> IO ()") + ("doesDirectoryExist" . "FilePath -> IO Bool") + ("doesFileExist" . "FilePath -> IO Bool") + ("executable" . "Permissions -> Bool") + ("getCurrentDirectory" . "IO FilePath") + ("getDirectoryContents" . "FilePath -> IO [FilePath]") + ("getModificationTime" . "FilePath -> IO ClockTime") + ("getPermissions" . "FilePath -> IO Permissions") + ("readable" . "Permissions -> Bool") + ("removeDirectory" . "FilePath -> IO ()") + ("removeFile" . "FilePath -> IO ()") + ("renameDirectory" . "FilePath -> FilePath -> IO ()") + ("renameFile" . "FilePath -> FilePath -> IO ()") + ("searchable" . "Permissions -> Bool") + ("setCurrentDirectory" . "FilePath -> IO ()") + ("setPermissions" . "FilePath -> Permissions -> IO ()") + ("writable" . "Permissions -> Bool") + ;; System + ("exitFailure" . "IO a") + ("exitWith" . "ExitCode -> IO a") + ("getArgs" . "IO [String]") + ("getEnv" . "String -> IO String") + ("getProgName" . "IO String") + ("system" . "String -> IO ExitCode") + ;; Time + ("addToClockTime" . "TimeDiff -> ClockTime -> ClockTime") + ("calendarTimeToString" . "CalendarTime -> String") + ("ctDay" . "CalendarTime -> Int") + ("ctHour" . "CalendarTime -> Int") + ("ctIsDST" . "CalendarTime -> Bool") + ("ctMin" . "CalendarTime -> Int") + ("ctMonth" . "CalendarTime -> Month") + ("ctPicosec" . "CalendarTime -> Integer") + ("ctSec" . "CalendarTime -> Int") + ("ctTZ" . "CalendarTime -> Int") + ("ctTZName" . "CalendarTime -> String") + ("ctWDay" . "CalendarTime -> Day") + ("ctYDay" . "CalendarTime -> Int") + ("ctYear" . "CalendarTime -> Int") + ("diffClockTimes" . "ClockTime -> ClockTime -> TimeDiff") + ("formatCalendarTime" . "TimeLocale -> String -> CalendarTime -> String") + ("getClockTime" . "IO ClockTime") + ("tdDay" . "TimeDiff -> Int") + ("tdHour" . "TimeDiff -> Int") + ("tdMin" . "TimeDiff -> Int") + ("tdMonth" . "TimeDiff -> Int") + ("tdPicosec" . "TimeDiff -> Integer") + ("tdSec" . "TimeDiff -> Int") + ("tdYear" . "TimeDiff -> Int") + ("toCalendarTime" . "ClockTime -> IO CalendarTime") + ("toClockTime" . "CalendarTime -> ClockTime") + ("toUTCTime" . "ClockTime -> CalendarTime") + ;; Locale + ("amPm" . "TimeLocale -> (String, String)") + ("dateFmt" . "TimeLocale -> String") + ("dateTimeFmt" . "TimeLocale -> String") + ("defaultTimeLocale" . "TimeLocale") + ("months" . "TimeLocale -> [(String, String)]") + ("time12Fmt" . "TimeLocale -> String") + ("timeFmt" . "TimeLocale -> String") + ("wDays" . "TimeLocale -> [(String, String)]") + ;; CPUTime + ("cpuTimePrecision" . "Integer") + ("getCPUTime" . "IO Integer") + ;; Random + ("genRange" . "RandomGen g => g -> (Int, Int)") + ("getStdGen" . "IO StdGen") + ("getStdRandom" . "(StdGen -> (a, StdGen)) -> IO a") + ("mkStdGen" . "Int -> StdGen") + ("newStdGen" . "IO StdGen") + ("next" . "RandomGen g => g -> (Int, g)") + ("random" . "(Random a, RandomGen g) => g -> (a, g)") + ("randomIO" . "Random a => IO a") + ("randomR" . "(Random a, RandomGen g) => (a, a) -> g -> (a, g)") + ("randomRIO" . "Random a => (a,a) -> IO a") + ("randomRs" . "(Random a, RandomGen g) => (a, a) -> g -> [a]") + ("randoms" . "(Random a, RandomGen g) => g -> [a]") + ("setStdGen" . "StdGen -> IO ()") + ("split" . "RandomGen g => g -> (g, g)") + ) + "Alist of prelude functions and their types.") + +;;@cindex haskell-doc-strategy-ids + +(defvar haskell-doc-strategy-ids + (list + '("par" . "Done -> Done -> Done ; [infixr 0]") + '("seq" . "Done -> Done -> Done ; [infixr 1]") + + '("using" . "a -> Strategy a -> a ; [infixl 0]") + '("demanding" . "a -> Done -> a ; [infixl 0]") + '("sparking" . "a -> Done -> a ; [infixl 0]") + + '(">||" . "Done -> Done -> Done ; [infixr 2]") + '(">|" . "Done -> Done -> Done ; [infixr 3]") + '("$||" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]") + '("$|" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]") + '(".|" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]") + '(".||" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]") + '("-|" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]") + '("-||" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]") + + '("Done" . "type Done = ()") + '("Strategy" . "type Strategy a = a -> Done") + + '("r0" . "Strategy a") + '("rwhnf" . "Eval a => Strategy a") + '("rnf" . "Strategy a") + '("NFData" . "class Eval a => NFData a where rnf :: Strategy a") + '("NFDataIntegral" ."class (NFData a, Integral a) => NFDataIntegral a") + '("NFDataOrd" . "class (NFData a, Ord a) => NFDataOrd a") + + '("markStrat" . "Int -> Strategy a -> Strategy a") + + '("seqPair" . "Strategy a -> Strategy b -> Strategy (a,b)") + '("parPair" . "Strategy a -> Strategy b -> Strategy (a,b)") + '("seqTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)") + '("parTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)") + + '("parList" . "Strategy a -> Strategy [a]") + '("parListN" . "(Integral b) => b -> Strategy a -> Strategy [a]") + '("parListNth" . "Int -> Strategy a -> Strategy [a]") + '("parListChunk" . "Int -> Strategy a -> Strategy [a]") + '("parMap" . "Strategy b -> (a -> b) -> [a] -> [b]") + '("parFlatMap" . "Strategy [b] -> (a -> [b]) -> [a] -> [b]") + '("parZipWith" . "Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c]") + '("seqList" . "Strategy a -> Strategy [a]") + '("seqListN" . "(Integral a) => a -> Strategy b -> Strategy [b]") + '("seqListNth" . "Int -> Strategy b -> Strategy [b]") + + '("parBuffer" . "Int -> Strategy a -> [a] -> [a]") + + '("seqArr" . "(Ix b) => Strategy a -> Strategy (Array b a)") + '("parArr" . "(Ix b) => Strategy a -> Strategy (Array b a)") + + '("fstPairFstList" . "(NFData a) => Strategy [(a,b)]") + '("force" . "(NFData a) => a -> a ") + '("sforce" . "(NFData a) => a -> b -> b") + ) + "Alist of strategy functions and their types as defined in Strategies.lhs.") + +(defvar haskell-doc-user-defined-ids nil + "Alist of functions and strings defined by the user.") + +;;@node Test membership, , Prelude types, Constants and Variables +;;@subsection Test membership + +;;@cindex haskell-doc-is-of +(defsubst haskell-doc-is-of (fn types) + "Check whether FN is one of the functions in the alist TYPES and return the type." + (assoc fn types) ) + +;;@node Install as minor mode, Menubar Support, Constants and Variables, top +;;@section Install as minor mode + +;; Put this minor mode on the global minor-mode-alist. +(or (assq 'haskell-doc-mode (default-value 'minor-mode-alist)) + (setq-default minor-mode-alist + (append (default-value 'minor-mode-alist) + '((haskell-doc-mode haskell-doc-minor-mode-string))))) + + +;;@node Menubar Support, Haskell Doc Mode, Install as minor mode, top +;;@section Menubar Support + +;; get imenu +(require 'imenu) + +;; a dummy definition needed for XEmacs (I know, it's horrible :-( + +;;@cindex haskell-doc-install-keymap + +(defvar haskell-doc-keymap + (let ((map (make-sparse-keymap))) + (define-key map [visit] + '("Visit FTP home site" . haskell-doc-visit-home)) + (define-key map [submit] + '("Submit bug report" . haskell-doc-submit-bug-report)) + (define-key map [dummy] '("---" . nil)) + (define-key map [make-index] + '("Make global fct index" . haskell-doc-make-global-fct-index)) + (define-key map [global-types-on] + '("Toggle display of global types" . haskell-doc-show-global-types)) + (define-key map [strategy-on] + '("Toggle display of strategy ids" . haskell-doc-show-strategy)) + (define-key map [user-defined-on] + '("Toggle display of user defined ids" . haskell-doc-show-user-defined)) + (define-key map [prelude-on] + '("Toggle display of prelude functions" . haskell-doc-show-prelude)) + (define-key map [reserved-ids-on] + '("Toggle display of reserved ids" . haskell-doc-show-reserved)) + (define-key map [haskell-doc-on] + '("Toggle haskell-doc mode" . haskell-doc-mode)) + map)) + +(defun haskell-doc-install-keymap () + "Install a menu for `haskell-doc-mode' as a submenu of \"Hugs\"." + (interactive) + ;; Add the menu to the hugs menu as last entry. + (let ((hugsmap (lookup-key (current-local-map) [menu-bar Hugs]))) + (if (not (or (featurep 'xemacs) ; XEmacs has problems here + (not (keymapp hugsmap)) + (lookup-key hugsmap [haskell-doc]))) + (if (functionp 'define-key-after) + (define-key-after hugsmap [haskell-doc] + (cons "Haskell-doc" haskell-doc-keymap) + [Haskell-doc mode])))) + ;; Add shortcuts for these commands. + (local-set-key "\C-c\e/" 'haskell-doc-check-active) + ;; Conflicts with the binding of haskell-insert-otherwise. + ;; (local-set-key "\C-c\C-o" 'haskell-doc-mode) + (local-set-key [(control shift meta mouse-3)] + 'haskell-doc-ask-mouse-for-type)) + + +;;@node Haskell Doc Mode, Switch it on or off, Menubar Support, top +;;@section Haskell Doc Mode + +;;@cindex haskell-doc-mode + +(defvar haskell-doc-timer nil) +(defvar haskell-doc-buffers nil) + +;;;###autoload +(defun haskell-doc-mode (&optional arg) + "Enter `haskell-doc-mode' for showing fct types in the echo area. +See variable docstring." + (interactive (list (or current-prefix-arg 'toggle))) + + (setq haskell-doc-mode + (cond + ((eq arg 'toggle) (not haskell-doc-mode)) + (arg (> (prefix-numeric-value arg) 0)) + (t))) + + ;; First, unconditionally turn the mode OFF. + + (setq haskell-doc-buffers (delq (current-buffer) haskell-doc-buffers)) + ;; Refresh the buffers list. + (dolist (buf haskell-doc-buffers) + (unless (and (buffer-live-p buf) + (with-current-buffer buf haskell-doc-mode)) + (setq haskell-doc-buffers (delq buf haskell-doc-buffers)))) + ;; Turn off the idle timer (or idle post-command-hook). + (when (and haskell-doc-timer (null haskell-doc-buffers)) + (cancel-timer haskell-doc-timer) + (setq haskell-doc-timer nil)) + (remove-hook 'post-command-hook + 'haskell-doc-mode-print-current-symbol-info 'local) + + (when haskell-doc-mode + ;; Turning the mode ON. + (push (current-buffer) haskell-doc-buffers) + + (if (fboundp 'run-with-idle-timer) + (unless haskell-doc-timer + (setq haskell-doc-timer + (run-with-idle-timer + haskell-doc-idle-delay t + 'haskell-doc-mode-print-current-symbol-info))) + (add-hook 'post-command-hook + 'haskell-doc-mode-print-current-symbol-info nil 'local)) + (and haskell-doc-show-global-types + (haskell-doc-make-global-fct-index)) ; build type index for global fcts + + (haskell-doc-install-keymap) + + (run-hooks 'haskell-doc-mode-hook)) + + (and (interactive-p) + (message "haskell-doc-mode is %s" + (if haskell-doc-mode "enabled" "disabled"))) + haskell-doc-mode) + +(defmacro haskell-doc-toggle-var (id prefix) + ;; toggle variable or set it based on prefix value + `(setq ,id + (if ,prefix + (>= (prefix-numeric-value ,prefix) 0) + (not ,id))) ) + +;;@cindex haskell-doc-show-global-types +(defun haskell-doc-show-global-types (&optional prefix) + "Turn on global types information in `haskell-doc-mode'." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-global-types prefix) + (if haskell-doc-show-global-types + (haskell-doc-make-global-fct-index))) + +;;@cindex haskell-doc-show-reserved +(defun haskell-doc-show-reserved (&optional prefix) + "Toggle the automatic display of a doc string for reserved ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-reserved prefix)) + +;;@cindex haskell-doc-show-prelude +(defun haskell-doc-show-prelude (&optional prefix) + "Toggle the automatic display of a doc string for reserved ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-prelude prefix)) + +;;@cindex haskell-doc-show-strategy +(defun haskell-doc-show-strategy (&optional prefix) + "Toggle the automatic display of a doc string for strategy ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-strategy prefix)) + +;;@cindex haskell-doc-show-user-defined +(defun haskell-doc-show-user-defined (&optional prefix) + "Toggle the automatic display of a doc string for user defined ids." + (interactive "P") + (haskell-doc-toggle-var haskell-doc-show-user-defined prefix)) + +;;@node Switch it on or off, Check, Haskell Doc Mode, top +;;@section Switch it on or off + +;;@cindex turn-on-haskell-doc-mode + +;;;###autoload +(defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode) + +;;@cindex turn-off-haskell-doc-mode + +(defun turn-off-haskell-doc-mode () + "Unequivocally turn off `haskell-doc-mode' (which see)." + (haskell-doc-mode 0)) + +;;@node Check, Top level function, Switch it on or off, top +;;@section Check + +;;@cindex haskell-doc-check-active + +(defun haskell-doc-check-active () + "Check whether the print function is hooked in. +Should be the same as the value of `haskell-doc-mode' but alas currently it +is not." + (interactive) + (message "%s" + (if (or (and haskell-doc-mode haskell-doc-timer) + (memq 'haskell-doc-mode-print-current-symbol-info + post-command-hook)) + "haskell-doc is ACTIVE" + (substitute-command-keys + "haskell-doc is not ACTIVE \(Use \\[haskell-doc-mode] to turn it on\)")))) + +;;@node Top level function, Mouse interface, Check, top +;;@section Top level function + +;;@cindex haskell-doc-mode-print-current-symbol-info +;; This is the function hooked into the elisp command engine +(defun haskell-doc-mode-print-current-symbol-info () + "Print the type of the symbol under the cursor. + +This function is run by an idle timer to print the type + automatically if `haskell-doc-mode' is turned on." + (and haskell-doc-mode + (not executing-kbd-macro) + ;; Having this mode operate in the minibuffer makes it impossible to + ;; see what you're doing. + (not (eq (selected-window) (minibuffer-window))) + ;; take a nap, if run straight from post-command-hook. + (if (fboundp 'run-with-idle-timer) t + (sit-for haskell-doc-idle-delay)) + ;; good morning! read the word under the cursor for breakfast + (haskell-doc-show-type))) + ;; ;; ToDo: find surrounding fct + ;; (cond ((eq current-symbol current-fnsym) + ;; (haskell-doc-show-type current-fnsym)) + ;; (t + ;; (or nil ; (haskell-doc-print-var-docstring current-symbol) + ;; (haskell-doc-show-type current-fnsym))))))) + +(defun haskell-doc-current-info () + "Return the info about symbol at point. +Meant for `eldoc-documentation-function'." + (haskell-doc-sym-doc (haskell-ident-at-point))) + + +;;@node Mouse interface, Print fctsym, Top level function, top +;;@section Mouse interface for interactive query + +;;@cindex haskell-doc-ask-mouse-for-type +(defun haskell-doc-ask-mouse-for-type (event) + "Read the identifier under the mouse and echo its type. +This uses the same underlying function `haskell-doc-show-type' as the hooked +function. Only the user interface is different." + (interactive "e") + (save-excursion + (select-window (posn-window (event-end event))) + (goto-char (posn-point (event-end event))) + (haskell-doc-show-type))) + + +;;@node Print fctsym, Movement, Mouse interface, top +;;@section Print fctsym + +;;@menu +;;* Show type:: +;;* Aux:: +;;* Global fct type:: +;;* Local fct type:: +;;@end menu + +;;@node Show type, Aux, Print fctsym, Print fctsym +;;@subsection Show type + +;;@cindex haskell-doc-show-type + +(require 'syntax-ppss nil t) ; possible add-on in Emacs 21 + +(defun haskell-doc-in-code-p () + (not (or (and (eq haskell-literate 'bird) + ;; Copied from haskell-indent-bolp. + (<= (current-column) 2) + (eq (char-after (line-beginning-position)) ?\>)) + (if (fboundp 'syntax-ppss) + (nth 8 (syntax-ppss)))))) + +;;;###autoload +(defun haskell-doc-show-type (&optional sym) + "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." + (interactive) + (unless sym (setq sym (haskell-ident-at-point))) + ;; if printed before do not print it again + (unless (string= sym (car haskell-doc-last-data)) + (let ((doc (haskell-doc-sym-doc sym))) + (when (and doc (haskell-doc-in-code-p)) + ;; In Emacs 19.29 and later, and XEmacs 19.13 and later, all + ;; messages are recorded in a log. Do not put haskell-doc messages + ;; in that log since they are legion. + (if (eval-when-compile (fboundp 'display-message)) + ;; XEmacs 19.13 way of preventing log messages. + ;;(display-message 'no-log (format )) + ;; XEmacs 19.15 seems to be a bit different. + (display-message 'message (format "%s" doc)) + (let ((message-log-max nil)) + (message "%s" doc))))))) + + +(defun haskell-doc-sym-doc (sym) + "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." + (let ((i-am-prelude nil) + (i-am-fct nil) + (type nil) + (is-reserved (haskell-doc-is-of sym haskell-doc-reserved-ids)) + (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types)) + (is-strategy (haskell-doc-is-of sym haskell-doc-strategy-ids)) + (is-user-defined (haskell-doc-is-of sym haskell-doc-user-defined-ids)) + (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types))) + (cond + ;; if reserved id (i.e. Haskell keyword + ((and haskell-doc-show-reserved + is-reserved) + (setq type (cdr is-reserved)) + (setcdr haskell-doc-last-data type)) + ;; if built-in function get type from docstring + ((and (not (null haskell-doc-show-prelude)) + is-prelude) + (setq type (cdr is-prelude)) ; (cdr (assoc sym haskell-doc-prelude-types))) + (if (= 2 (length type)) ; horrible hack to remove bad formatting + (setq type (car (cdr type)))) + (setq i-am-prelude t) + (setq i-am-fct t) + (setcdr haskell-doc-last-data type)) + ((and haskell-doc-show-strategy + is-strategy) + (setq i-am-fct t) + (setq type (cdr is-strategy)) + (setcdr haskell-doc-last-data type)) + ((and haskell-doc-show-user-defined + is-user-defined) + ;; (setq i-am-fct t) + (setq type (cdr is-user-defined)) + (setcdr haskell-doc-last-data type)) + (t + (let ( (x (haskell-doc-get-and-format-fct-type sym)) ) + (if (null x) + (setcdr haskell-doc-last-data nil) ; if not found reset last data + (setq type (car x)) + (setq i-am-fct (string= "Variables" (cdr x))) + (if (and haskell-doc-show-global-types (null type)) + (setq type (haskell-doc-get-global-fct-type sym))) + (setcdr haskell-doc-last-data type)))) ) + ;; ToDo: encode i-am-fct info into alist of types + (and type + ;; drop `::' if it's not a fct + (let ( (str (cond ((and i-am-fct (not haskell-doc-chop-off-fctname)) + (format "%s :: %s" sym type)) + (t + (format "%s" type)))) ) + (if i-am-prelude + (add-text-properties 0 (length str) '(face bold) str)) + str)))) + + +;; ToDo: define your own notion of `near' to find surrounding fct +;;(defun haskell-doc-fnsym-in-current-sexp () +;; (let* ((p (point)) +;; (sym (progn +;; (forward-word -1) +;; (while (and (forward-word -1) ; (haskell-doc-forward-sexp-safe -1) +;; (> (point) (point-min)))) +;; (cond ((or (= (point) (point-min)) +;; (memq (or (char-after (point)) 0) +;; '(?\( ?\")) +;; ;; If we hit a quotation mark before a paren, we +;; ;; are inside a specific string, not a list of +;; ;; symbols. +;; (eq (or (char-after (1- (point))) 0) ?\")) +;; nil) +;; (t (condition-case nil +;; (read (current-buffer)) +;; (error nil))))))) +;; (goto-char p) +;; (if sym +;; (format "%s" sym) +;; sym))) + +;; (and (symbolp sym) +;; sym))) + +;;@node Aux, Global fct type, Show type, Print fctsym +;;@subsection Aux + +;; ToDo: handle open brackets to decide if it's a wrapped type + +;;@cindex haskell-doc-grab-line +(defun haskell-doc-grab-line (fct-and-pos) + "Get the type of an \(FCT POSITION\) pair from the current buffer." + ;; (if (null fct-and-pos) + ;; "" ; fn is not a local fct + (let ( (str "")) + (goto-char (cdr fct-and-pos)) + (beginning-of-line) + ;; search for start of type (phsp give better bound?) + (if (null (search-forward "::" (+ (point) haskell-doc-search-distance) t)) + "" + (setq str (haskell-doc-grab)) ; leaves point at end of line + (while (haskell-doc-wrapped-type-p) ; while in a multi-line type expr + (forward-line 1) + (beginning-of-line) + (skip-chars-forward " \t") + (setq str (concat str (haskell-doc-grab)))) + (haskell-doc-string-nub-ws ; squeeze string + (if haskell-doc-chop-off-context ; no context + (haskell-doc-chop-off-context str) + str))))) + ;; (concat (car fct-and-pos) "::" (haskell-doc-string-nub-ws str)))) + +;;@cindex haskell-doc-wrapped-type-p +(defun haskell-doc-wrapped-type-p () + "Check whether the type under the cursor is wrapped over several lines. +The cursor must be at the end of a line, which contains the type. +Currently, only the following is checked: +If this line ends with a `->' or the next starts with an `->' it is a +multi-line type \(same for `=>'\). +`--' comments are ignored. +ToDo: Check for matching parenthesis!." + (save-excursion + (let ( (here (point)) + (lim (progn (beginning-of-line) (point))) + ;; (foo "") + (res nil) + ) + (goto-char here) + (search-backward "--" lim t) ; skip over `--' comment + (skip-chars-backward " \t") + (if (bolp) ; skip empty lines + (progn + (forward-line 1) + (end-of-line) + (setq res (haskell-doc-wrapped-type-p))) + (forward-char -1) + ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) + (if (or (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) + (char-equal (following-char) ?>)) ; (or -!> =!> + (char-equal (following-char) ?,)) ; !,) + (setq res t) + (forward-line) + (let ((here (point))) + (goto-char here) + (skip-chars-forward " \t") + (if (looking-at "--") ; it is a comment line + (progn + (forward-line 1) + (end-of-line) + (setq res (haskell-doc-wrapped-type-p))) + (forward-char 1) + ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) + ;; (message "|%s|" foo) + (if (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) + (char-equal (following-char) ?>)) ; -!> or =!> + (setq res t)))))) + res))) + +;;@cindex haskell-doc-grab +(defun haskell-doc-grab () + "Return the text from point to the end of the line, chopping off comments. +Leaves point at end of line." + (let ((str (buffer-substring-no-properties + (point) (progn (end-of-line) (point))))) + (if (string-match "--" str) + (substring str 0 (match-beginning 0)) + str))) + +;;@cindex haskell-doc-string-nub-ws +(defun haskell-doc-string-nub-ws (str) + "Replace all sequences of whitespace in STR by just one space. +ToDo: Also eliminate leading and trailing whitespace." + (let ((i -1)) + (while (setq i (string-match " [ \t\n]+\\|[\t\n]+" str (1+ i))) + (setq str (replace-match " " t t str))) + str)) + +;; ToDo: make this more efficient!! +;;(defun haskell-doc-string-nub-ws (str) +;; "Replace all sequences of whitespaces in STR by just one whitespace." +;; (let ( (res "") +;; (l (length str)) +;; (i 0) +;; (j 0) +;; (in-ws nil)) +;; (while (< i l) +;; (let* ( (c (string-to-char (substring str i (1+ i)))) +;; (is-ws (eq (char-syntax c) ? )) ) +;; (if (not (and in-ws is-ws)) +;; (setq res (concat res (char-to-string c)))) +;; (setq in-ws is-ws) +;; (setq i (1+ i)))) +;; res)) + +;;@cindex haskell-doc-chop-off-context +(defun haskell-doc-chop-off-context (str) + "Eliminate the context in a type represented by the string STR." + (let ((i (string-match "=>" str)) ) + (if (null i) + str + (substring str (+ i 2))))) + +;;@cindex haskell-doc-get-imenu-info +(defun haskell-doc-get-imenu-info (obj kind) + "Return a string describing OBJ of KIND \(Variables, Types, Data\)." + (cond ((or (eq major-mode 'haskell-hugs-mode) + ;; GEM: Haskell Mode does not work with Haskell Doc + ;; under XEmacs 20.x + (and (eq major-mode 'haskell-mode) + (not (and (featurep 'xemacs) + (string-match "^20" emacs-version))))) + (let* ((imenu-info-alist (cdr (assoc kind imenu--index-alist))) + ;; (names (mapcar 'car imenu-info-alist)) + (x (assoc obj imenu-info-alist))) + (if x + (haskell-doc-grab-line x) + nil))) + (t + ;; (error "Cannot get local functions in %s mode, sorry" major-mode))) ) + nil))) + +;;@node Global fct type, Local fct type, Aux, Print fctsym +;;@subsection Global fct type + +;; ToDo: +;; - modular way of defining a mapping of module name to file +;; - use a path to search for file (not just current directory) + +;;@cindex haskell-doc-imported-list + +(defun haskell-doc-imported-list () + "Return a list of the imported modules in current buffer." + (interactive "fName of outer `include' file: ") ; (buffer-file-name)) + ;; Don't add current buffer to the imported file list if it is not (yet?) + ;; visiting a file since it leads to errors further down. + (let ((imported-file-list (and buffer-file-name (list buffer-file-name)))) + (widen) + (goto-char (point-min)) + (while (re-search-forward "^\\s-*import\\s-+\\([^ \t\n]+\\)" nil t) + (let ((basename (match-string 1))) + (dolist (ext '(".hs" ".lhs")) + (let ((file (concat basename ext))) + (if (file-exists-p file) + (push file imported-file-list)))))) + (nreverse imported-file-list) + ;;(message imported-file-list) + )) + +;; ToDo: generalise this to "Types" etc (not just "Variables") + +;;@cindex haskell-doc-rescan-files + +(defun haskell-doc-rescan-files (filelist) + "Do an `imenu' rescan on every file in FILELIST and return the fct-list. +This function switches to and potentially loads many buffers." + (save-current-buffer + (mapcar (lambda (f) + (set-buffer (find-file-noselect f)) + (imenu--make-index-alist) + (cons f + (mapcar (lambda (x) + `(,(car x) . ,(haskell-doc-grab-line x))) + (cdr (assoc "Variables" imenu--index-alist))))) + filelist))) + +;;@cindex haskell-doc-make-global-fct-index + +(defun haskell-doc-make-global-fct-index () + "Scan imported files for types of global fcts and update `haskell-doc-index'." + (interactive) + (setq haskell-doc-index + (haskell-doc-rescan-files (haskell-doc-imported-list)))) + +;; ToDo: use a separate munge-type function to format type concisely + +;;@cindex haskell-doc-get-global-fct-type + +(defun haskell-doc-get-global-fct-type (&optional sym) + "Get type for function symbol SYM by examining `haskell-doc-index'." + (interactive) ; "fName of outer `include' file: \nsFct:") + (save-excursion + ;; (switch-to-buffer "*scratch*") + ;; (goto-char (point-max)) + ;; ;; Produces a list of fct-type alists + ;; (if (null sym) + ;; (setq sym (progn (forward-word -1) (read (current-buffer))))) + (or sym + (current-word)) + (let* ( (fn sym) ; (format "%s" sym)) + (fal haskell-doc-index) + (res "") ) + (while (not (null fal)) + (let* ( (l (car fal)) + (f (car l)) + (x (assoc fn (cdr l))) ) + (if (not (null x)) + (let* ( (ty (cdr x)) ; the type as string + (idx (string-match "::" ty)) + (str (if (null idx) + ty + (substring ty (+ idx 2)))) ) + (setq res (format "[%s] %s" f str)))) + (setq fal (cdr fal)))) + res))) ; (message res)) ) + +;;@node Local fct type, , Global fct type, Print fctsym +;;@subsection Local fct type + +;;@cindex haskell-doc-get-and-format-fct-type + +(defun haskell-doc-get-and-format-fct-type (fn) + "Get the type and kind of FN by checking local and global functions." + (save-excursion + (save-match-data + (let ((docstring "") + (doc nil) + ) + ;; is it a local function? + (setq docstring (haskell-doc-get-imenu-info fn "Variables")) + (if (not (null docstring)) + ;; (string-match (format "^%s\\s-+::\\s-+\\(.*\\)$" fn) docstring)) + (setq doc `(,docstring . "Variables"))) ; `(,(match-string 1 docstring) . "Variables") )) + ;; is it a type declaration? + (setq docstring (haskell-doc-get-imenu-info fn "Types")) + (if (not (null docstring)) + ;; (string-match (format "^\\s-*type\\s-+%s.*$" fn) docstring)) + (setq doc `(,docstring . "Types"))) ; `(,(match-string 0 docstring) . "Types")) ) + (if (not (null docstring)) + ;; (string-match (format "^\\s-*data.*%s.*$" fn) docstring)) + (setq doc `(,docstring . "Data"))) ; (setq doc `(,(match-string 0 docstring) . "Data")) ) + ;; return the result + doc )))) + + +;;@appendix + +;;@node Index, Token, Visit home site, top +;;@section Index + +;;@index +;;* haskell-doc-ask-mouse-for-type:: +;;* haskell-doc-check-active:: +;;* haskell-doc-chop-off-context:: +;;* haskell-doc-get-and-format-fct-type:: +;;* haskell-doc-get-global-fct-type:: +;;* haskell-doc-get-imenu-info:: +;;* haskell-doc-grab:: +;;* haskell-doc-grab-line:: +;;* haskell-doc-imported-list:: +;;* haskell-doc-install-keymap:: +;;* haskell-doc-is-of:: +;;* haskell-doc-make-global-fct-index:: +;;* haskell-doc-mode:: +;;* haskell-doc-mode-print-current-symbol-info:: +;;* haskell-doc-prelude-types:: +;;* haskell-doc-rescan-files:: +;;* haskell-doc-reserved-ids:: +;;* haskell-doc-show-global-types:: +;;* haskell-doc-show-prelude:: +;;* haskell-doc-show-reserved:: +;;* haskell-doc-show-strategy:: +;;* haskell-doc-show-type:: +;;* haskell-doc-show-user-defined:: +;;* haskell-doc-strategy-ids:: +;;* haskell-doc-string-nub-ws:: +;;* haskell-doc-submit-bug-report:: +;;* haskell-doc-visit-home:: +;;* haskell-doc-wrapped-type-p:: +;;* turn-off-haskell-doc-mode:: +;;* turn-on-haskell-doc-mode:: +;;@end index + +;;@node Token, , Index, top +;;@section Token + +(provide 'haskell-doc) + +;; arch-tag: 6492eb7e-7048-47ac-a331-da09e1eb6254 +;;; haskell-doc.el ends here diff --git a/.emacs.d/haskell-mode/haskell-font-lock.el b/.emacs.d/haskell-mode/haskell-font-lock.el new file mode 100644 index 0000000..857e0d9 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-font-lock.el @@ -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 and +;; Tommy Thorn +;; 2003 Dave Love +;; 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 . . + '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 . \"." + (save-excursion + (goto-char start) + (re-search-backward "\\[^.\"]*\\=" + (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) + +(unless (fboundp 'char-displayable-p) + (require 'latin1-disp nil t)) + +(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))) + (if (fboundp 'latin1-char-displayable-p) + (latin1-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. + + ;; We allow _ as the first char to fit GHC + (varid "\\b[[:lower:]_][[:alnum:]'_]*\\b") + (conid "\\b[[:upper:]][[: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 (::) or (∷), 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. + ("\\\\)[ \t]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\\\)?" + (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 (cond ((numberp (nth 4 (syntax-ppss))) + ;; There are no such instances inside nestable comments + nil) + ((string-match "\\`-*\\'" (match-string 0)) + ;; Sequence of hyphens. Do nothing in + ;; case of things like `{---'. + nil) + (t "_")))) ; 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' + +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 diff --git a/.emacs.d/haskell-mode/haskell-ghci.el b/.emacs.d/haskell-mode/haskell-ghci.el new file mode 100644 index 0000000..eb056cb --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-ghci.el @@ -0,0 +1,334 @@ +;;; 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-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-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. + +\\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 + "^\\*?[[:upper:]][\\._[:alnum:]]*\\( \\*?[[:upper:]][\\._[:alnum:]]*\\)*> ") + + ;; History syntax of comint conflicts with Haskell, e.g. !!, so better + ;; turn it off. + (setq comint-input-autoexpand nil) + (setq comint-process-echoes 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 diff --git a/.emacs.d/haskell-mode/haskell-hugs.el b/.emacs.d/haskell-mode/haskell-hugs.el new file mode 100644 index 0000000..42df4ce --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-hugs.el @@ -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 +;; 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 +;; 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-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. + +\\ +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 "^\? \\|^[[:upper:]][_[:alnum:]\.]*> ") + ;; 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 diff --git a/.emacs.d/haskell-mode/haskell-indent.el b/.emacs.d/haskell-mode/haskell-indent.el new file mode 100644 index 0000000..fde6f15 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-indent.el @@ -0,0 +1,1581 @@ +;;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode + +;; Copyright 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright 1997-1998 Guy Lapalme + +;; Author: 1997-1998 Guy Lapalme + +;; Keywords: indentation Haskell layout-rule +;; Version: 1.2 +;; URL: http://www.iro.umontreal.ca/~lapalme/layout/index.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 automatic indentation of Haskell programs using +;; the layout rule described in section 1.5 and appendix B.3 of the +;; the Haskell report. The rationale and the implementation principles +;; are described in an article to appear in Journal of Functional Programming. +;; "Dynamic tabbing for automatic indentation with the layout rule" +;; +;; It supports literate scripts. +;; Haskell indentation is performed +;; within \begin{code}...\end{code} sections of a literate script +;; and in lines beginning with > with Bird style literate script +;; TAB aligns to the left column outside of these sections. +;; +;; Installation: +;; +;; To turn indentation on for all Haskell buffers under the Haskell +;; mode of Moss&Thorn +;; add this to .emacs: +;; +;; (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) +;; +;; Otherwise, call `turn-on-haskell-indent'. +;; +;; +;; Customisation: +;; The "standard" offset for statements is 4 spaces. +;; It can be changed by setting the variable "haskell-indent-offset" to +;; another value +;; +;; The default number of blanks after > in a Bird style literate script +;; is 1; it can be changed by setting the variable +;; "haskell-indent-literate-Bird-default-offset" +;; +;; `haskell-indent-hook' is invoked if not nil. +;; +;; All functions/variables start with +;; `(turn-(on/off)-)haskell-indent' or `haskell-indent-'. + +;; This file can also be used as a hook for the Hugs Mode developed by +;; Chris Van Humbeeck +;; It can be obtained at: +;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el +;; +;; For the Hugs mode put the following in your .emacs +;; +;;(setq auto-mode-alist (append auto-mode-alist '(("\\.hs\\'" . hugs-mode)))) +;;(autoload 'hugs-mode "hugs-mode" "Go into hugs mode" t) +;; +;; If only the indentation mode is used then replace the two +;; preceding lines with +;;(setq auto-mode-alist (append auto-mode-alist +;; '(("\\.hs\\'" . turn-on-haskell-indent)))) +;;(autoload 'turn-on-haskell-indent "hindent" "Indentation mode for Haskell" t) +;; +;; For indentation in both cases then add the following to your .emacs +;;(add-hook 'hugs-mode-hook 'turn-on-haskell-indent) +;;(autoload 'haskell-indent-cycle "hindent" "Indentation cycle for Haskell" t) +;; + +;;; Code: + +(eval-when-compile (require 'cl)) ;need defs of push and pop +(defvar haskell-literate) + +(defgroup haskell-indent nil + "Haskell indentation." + :group 'haskell + :prefix "haskell-indent-") + +(defcustom haskell-indent-offset 4 + "Indentation of Haskell statements with respect to containing block." + :type 'integer + :group 'haskell-indent) + +(defcustom haskell-indent-literate-Bird-default-offset 1 + "Default number of blanks after > in a Bird style literate script." + :type 'integer + :group 'haskell-indent) + +(defcustom haskell-indent-rhs-align-column 0 + "Column on which to align right-hand sides (use 0 for ad-hoc alignment)." + :type 'integer + :group 'haskell-indent) + +(defun haskell-indent-point-to-col (apoint) + "Return the column number of APOINT." + (save-excursion + (goto-char apoint) + (current-column))) + +(defconst haskell-indent-start-keywords-re + (concat "\\<" + (regexp-opt '("class" "data" "import" "infix" "infixl" "infixr" + "instance" "module" "newtype" "primitive" "type") t) + "\\>") + "Regexp for keywords to complete when standing at the first word of a line.") + + +;; Customizations for different kinds of environments +;; in which dealing with low-level events are different. +(defun haskell-indent-mark-active () + (if (featurep 'xemacs) + (if zmacs-regions + zmacs-region-active-p + t) + mark-active)) + +;; for pushing indentation information + +(defvar haskell-indent-info) ;Used with dynamic scoping. + +(defun haskell-indent-push-col (col &optional name) + "Push indentation information for the column COL. +The info is followed by NAME (if present). +Makes sure that the same indentation info is not pushed twice. +Uses free var `haskell-indent-info'." + (let ((tmp (cons col name))) + (if (member tmp haskell-indent-info) + haskell-indent-info + (push tmp haskell-indent-info)))) + +(defun haskell-indent-push-pos (pos &optional name) + "Push indentation information for POS followed by NAME (if present)." + (haskell-indent-push-col (haskell-indent-point-to-col pos) name)) + +;; (defvar haskell-indent-tab-align nil +;; "Align all indentations on TAB stops.") + +(defun haskell-indent-column+offset (column offset) + (unless offset (setq offset haskell-indent-offset)) + (setq column (+ column offset)) + ;; (if (and haskell-indent-tab-align (> offset 0)) + ;; (* 8 (/ (+ column 7) 8)) + column) ;; ) + +(defun haskell-indent-push-pos-offset (pos &optional offset) + "Pushes indentation information for the column corresponding to POS +followed by an OFFSET (if present use its value otherwise use +`haskell-indent-offset')." + (haskell-indent-push-col (haskell-indent-column+offset + (haskell-indent-point-to-col pos) + offset))) + +;; redefinition of some Emacs function for dealing with +;; Bird Style literate scripts + +(defun haskell-indent-bolp () + "`bolp' but dealing with Bird-style literate scripts." + (or (bolp) + (and (eq haskell-literate 'bird) + (<= (current-column) (1+ haskell-indent-literate-Bird-default-offset)) + (eq (char-after (line-beginning-position)) ?\>)))) + +(defun haskell-indent-empty-line-p () + "Checks if the current line is empty; deals with Bird style scripts." + (save-excursion + (beginning-of-line) + (if (and (eq haskell-literate 'bird) + (eq (following-char) ?\>)) + (forward-char 1)) + (looking-at "[ \t]*$"))) + +(defun haskell-indent-back-to-indentation () + "`back-to-indentation' function but dealing with Bird-style literate scripts." + (if (and (eq haskell-literate 'bird) + (progn (beginning-of-line) (eq (following-char) ?\>))) + (progn + (forward-char 1) + (skip-chars-forward " \t")) + (back-to-indentation))) + +(defun haskell-indent-current-indentation () + "`current-indentation' function dealing with Bird-style literate scripts." + (if (eq haskell-literate 'bird) + (save-excursion + (haskell-indent-back-to-indentation) + (current-column)) + (current-indentation))) + +(defun haskell-indent-backward-to-indentation (n) + "`backward-to-indentation' function dealing with Bird-style literate scripts." + (if (eq haskell-literate 'bird) + (progn + (forward-line (- n)) + (haskell-indent-back-to-indentation)) + (backward-to-indentation n))) + +(defun haskell-indent-forward-line (&optional n) + "`forward-line' function but dealing with Bird-style literate scripts." + (prog1 + (forward-line n) + (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>)) + (progn (forward-char 1) ; skip > and initial blanks... + (skip-chars-forward " \t"))))) + +(defun haskell-indent-line-to (n) + "`indent-line-to' function but dealing with Bird-style literate scripts." + (if (eq haskell-literate 'bird) + (progn + (beginning-of-line) + (if (eq (following-char) ?\>) + (delete-char 1)) + (delete-horizontal-space) ; remove any starting TABs so + (indent-line-to n) ; that indent-line only adds spaces + (save-excursion + (beginning-of-line) + (if (> n 0) (delete-char 1)) ; delete the first space before + (insert ?\>))) ; inserting a > + (indent-line-to n))) + +(defun haskell-indent-skip-blanks-and-newlines-forward (end) + "Skip forward blanks, tabs and newlines until END. +Take account of Bird-style literate scripts." + (skip-chars-forward " \t\n" end) + (if (eq haskell-literate 'bird) + (while (and (bolp) (eq (following-char) ?\>)) + (forward-char 1) ; skip > + (skip-chars-forward " \t\n" end)))) + +(defun haskell-indent-skip-blanks-and-newlines-backward (start) + "Skip backward blanks, tabs and newlines up to START. +Take account of Bird-style literate scripts." + (skip-chars-backward " \t\n" start) + (if (eq haskell-literate 'bird) + (while (and (eq (current-column) 1) + (eq (preceding-char) ?\>)) + (forward-char -1) ; skip back > + (skip-chars-backward " \t\n" start)))) + +;; specific functions for literate code + +(defun haskell-indent-within-literate-code () + "Check if point is within a part of literate Haskell code. +If so, return its start; otherwise return nil: +If it is Bird-style, then return the position of the >; +otherwise return the ending position of \\begin{code}." + (save-excursion + (case haskell-literate + (bird + (beginning-of-line) + (if (or (eq (following-char) ?\>) + (and (bolp) (forward-line -1) (eq (following-char) ?\>))) + (progn + (while (and (zerop (forward-line -1)) + (eq (following-char) ?\>))) + (if (not (eq (following-char) ?\>)) + (forward-line)) + (point)))) + ;; Look for a \begin{code} or \end{code} line. + ((latex tex) + (if (re-search-backward + "^\\(\\\\begin{code}$\\)\\|\\(\\\\end{code}$\\)" nil t) + ;; within a literate code part if it was a \\begin{code}. + (match-end 1))) + (t (error "haskell-indent-within-literate-code: should not happen!"))))) + +(defun haskell-indent-put-region-in-literate (beg end &optional arg) + "Put lines of the region as a piece of literate code. +With prefix arg, remove indication that the region is literate code. +It deals with both Bird style and non Bird-style scripts." + (interactive "r\nP") + (unless haskell-literate + (error "Cannot put a region in literate in a non literate script")) + (if (eq haskell-literate 'bird) + (let ((comment-start "> ") ; Change dynamic bindings for + (comment-start-skip "^> ?") ; comment-region. + (comment-end "") + (comment-end-skip "\n") + (comment-style 'plain)) + (comment-region beg end arg)) + ;; Not Bird style. + (if arg ; Remove the literate indication. + (save-excursion + (goto-char end) ; Remove end. + (if (re-search-backward "^\\\\end{code}[ \t\n]*\\=" + (line-beginning-position -2) t) + (delete-region (point) (line-beginning-position 2))) + (goto-char beg) ; Remove end. + (beginning-of-line) + (if (looking-at "\\\\begin{code}") + (kill-line 1))) + (save-excursion ; Add the literate indication. + (goto-char end) + (unless (bolp) (newline)) + (insert "\\end{code}\n") + (goto-char beg) + (unless (bolp) (newline)) + (insert "\\begin{code}\n"))))) + + ;;; Start of indentation code + +(defcustom haskell-indent-look-past-empty-line t + "If nil, indentation engine will not look past an empty line for layout points." + :group 'haskell-indent + :type 'boolean) + +(defun haskell-indent-start-of-def () + "Return the position of the start of a definition. +The start of a def is expected to be recognizable by starting in column 0, +unless `haskell-indent-look-past-empty-line' is nil, in which case we +take a coarser approximation and stop at the first empty line." + (save-excursion + (let ((start-code (and haskell-literate + (haskell-indent-within-literate-code))) + (top-col (if (eq haskell-literate 'bird) 2 0)) + (save-point (point))) + ;; determine the starting point of the current piece of code + (setq start-code (if start-code (1+ start-code) (point-min))) + ;; go backward until the first preceding empty line + (haskell-indent-forward-line -1) + (while (and (if haskell-indent-look-past-empty-line + (or (> (haskell-indent-current-indentation) top-col) + (haskell-indent-empty-line-p)) + (and (> (haskell-indent-current-indentation) top-col) + (not (haskell-indent-empty-line-p)))) + (> (point) start-code) + (= 0 (haskell-indent-forward-line -1)))) + ;; go forward after the empty line + (if (haskell-indent-empty-line-p) + (haskell-indent-forward-line 1)) + (setq start-code (point)) + ;; find the first line of code which is not a comment + (forward-comment (point-max)) + (if (> (point) save-point) + start-code + (point))))) + +(defun haskell-indent-open-structure (start end) + "If any structure (list or tuple) is not closed, between START and END, +returns the location of the opening symbol, nil otherwise." + (save-excursion + (nth 1 (parse-partial-sexp start end)))) + +(defun haskell-indent-in-string (start end) + "If a string is not closed , between START and END, returns the +location of the opening symbol, nil otherwise." + (save-excursion + (let ((pps (parse-partial-sexp start end))) + (if (nth 3 pps) (nth 8 pps))))) + +(defun haskell-indent-in-comment (start end) + "Check, starting from START, if END is at or within a comment. +Returns the location of the start of the comment, nil otherwise." + (let (pps) + (assert (<= start end)) + (cond ((= start end) nil) + ((nth 4 (save-excursion (setq pps (parse-partial-sexp start end)))) + (nth 8 pps)) + ;; We also want to say that we are *at* the beginning of a comment. + ((and (not (nth 8 pps)) + (>= (point-max) (+ end 2)) + (nth 4 (save-excursion + (setq pps (parse-partial-sexp end (+ end 2)))))) + (nth 8 pps))))) + +(defvar haskell-indent-off-side-keywords-re + "\\<\\(do\\|let\\|of\\|where\\)\\>[ \t]*") + +(defun haskell-indent-type-at-point () + "Return the type of the line (also puts information in `match-data')." + (cond + ((haskell-indent-empty-line-p) 'empty) + ((haskell-indent-in-comment (point-min) (point)) 'comment) + ((looking-at "\\(\\([[:alpha:]]\\(\\sw\\|'\\)*\\)\\|_\\)[ \t\n]*") + 'ident) + ((looking-at "\\(|[^|]\\)[ \t\n]*") 'guard) + ((looking-at "\\(=[^>=]\\|::\\|->\\|<-\\)[ \t\n]*") 'rhs) + (t 'other))) + +(defvar haskell-indent-current-line-first-ident "" + "Global variable that keeps track of the first ident of the line to indent.") + + +(defun haskell-indent-contour-line (start end) + "Generate contour information between START and END points." + (if (< start end) + (save-excursion + (goto-char end) + (haskell-indent-skip-blanks-and-newlines-backward start) + (let ((cur-col (current-column)) ; maximum column number + (fl 0) ; number of lines that forward-line could not advance + contour) + (while (and (> cur-col 0) (= fl 0) (>= (point) start)) + (haskell-indent-back-to-indentation) + (if (< (point) start) (goto-char start)) + (and (not (member (haskell-indent-type-at-point) + '(empty comment))) ; skip empty and comment lines + (< (current-column) cur-col) ; less indented column found + (push (point) contour) ; new contour point found + (setq cur-col (current-column))) + (setq fl (haskell-indent-forward-line -1))) + contour)))) + +(defun haskell-indent-next-symbol (end) + "Move point to the next symbol." + (skip-syntax-forward ")" end) + (if (< (point) end) + (progn + (forward-sexp 1) + (haskell-indent-skip-blanks-and-newlines-forward end)))) + +(defun haskell-indent-next-symbol-safe (end) + "Puts point to the next following symbol, or to end if there are no more symbols in the sexp." + (condition-case errlist (haskell-indent-next-symbol end) + (error (goto-char end)))) + +(defun haskell-indent-separate-valdef (start end) + "Return a list of positions for important parts of a valdef." + (save-excursion + (let (valname valname-string aft-valname + guard aft-guard + rhs-sign aft-rhs-sign + type) + ;; "parse" a valdef separating important parts + (goto-char start) + (setq type (haskell-indent-type-at-point)) + (if (or (memq type '(ident other))) ; possible start of a value def + (progn + (if (eq type 'ident) + (progn + (setq valname (match-beginning 0)) + (setq valname-string (match-string 0)) + (goto-char (match-end 0))) + (skip-chars-forward " \t" end) + (setq valname (point)) ; type = other + (haskell-indent-next-symbol-safe end)) + (while (and (< (point) end) + (setq type (haskell-indent-type-at-point)) + (or (memq type '(ident other)))) + (if (null aft-valname) + (setq aft-valname (point))) + (haskell-indent-next-symbol-safe end)))) + (if (and (< (point) end) (eq type 'guard)) ; start of a guard + (progn + (setq guard (match-beginning 0)) + (goto-char (match-end 0)) + (while (and (< (point) end) + (setq type (haskell-indent-type-at-point)) + (not (eq type 'rhs))) + (if (null aft-guard) + (setq aft-guard (point))) + (haskell-indent-next-symbol-safe end)))) + (if (and (< (point) end) (eq type 'rhs)) ; start of a rhs + (progn + (setq rhs-sign (match-beginning 0)) + (goto-char (match-end 0)) + (if (< (point) end) + (setq aft-rhs-sign (point))))) + (list valname valname-string aft-valname + guard aft-guard rhs-sign aft-rhs-sign)))) + +(defsubst haskell-indent-no-otherwise (guard) + "Check if there is no otherwise at GUARD." + (save-excursion + (goto-char guard) + (not (looking-at "|[ \t]*otherwise\\>")))) + + +(defun haskell-indent-guard (start end end-visible indent-info) + "Find indentation information for a line starting with a guard." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (nth 0 sep)) + (guard (nth 3 sep)) + (rhs-sign (nth 5 sep))) + ;; push information indentation for the visible part + (if (and guard (< guard end-visible) (haskell-indent-no-otherwise guard)) + (haskell-indent-push-pos guard) + (if rhs-sign + (haskell-indent-push-pos rhs-sign) ; probably within a data definition... + (if valname + (haskell-indent-push-pos-offset valname)))) + haskell-indent-info))) + +(defun haskell-indent-rhs (start end end-visible indent-info) + "Find indentation information for a line starting with a rhs." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (nth 0 sep)) + (guard (nth 3 sep)) + (rhs-sign (nth 5 sep))) + ;; push information indentation for the visible part + (if (and rhs-sign (< rhs-sign end-visible)) + (haskell-indent-push-pos rhs-sign) + (if (and guard (< guard end-visible)) + (haskell-indent-push-pos-offset guard) + (if valname ; always visible !! + (haskell-indent-push-pos-offset valname)))) + haskell-indent-info))) + +(defconst haskell-indent-decision-table + (let ((or "\\)\\|\\(")) + (concat "\\(" + "1.1.11" or ; 1= vn gd rh arh + "1.1.10" or ; 2= vn gd rh + "1.1100" or ; 3= vn gd agd + "1.1000" or ; 4= vn gd + "1.0011" or ; 5= vn rh arh + "1.0010" or ; 6= vn rh + "110000" or ; 7= vn avn + "100000" or ; 8= vn + "001.11" or ; 9= gd rh arh + "001.10" or ;10= gd rh + "001100" or ;11= gd agd + "001000" or ;12= gd + "000011" or ;13= rh arh + "000010" or ;14= rh + "000000" ;15= + "\\)"))) + +(defun haskell-indent-find-case (test) + "Find the index that matches TEST in the decision table." + (if (string-match haskell-indent-decision-table test) + ;; use the fact that the resulting match-data is a list of the form + ;; (0 6 [2*(n-1) nil] 0 6) where n is the number of the matching regexp + ;; so n= ((length match-data)/2)-1 + (- (/ (length (match-data 'integers)) 2) 1) + (error "haskell-indent-find-case: impossible case: %s" test))) + +(defun haskell-indent-empty (start end end-visible indent-info) + "Find indentation points for an empty line." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) + (if (and valname-string ; special case for start keywords + (string-match haskell-indent-start-keywords-re valname-string)) + (progn + (haskell-indent-push-pos valname) + ;; very special for data keyword + (if (string-match "\\" valname-string) + (if rhs-sign (haskell-indent-push-pos rhs-sign) + (haskell-indent-push-pos-offset valname)) + (haskell-indent-push-pos-offset valname))) + (case ; general case + (haskell-indent-find-case test) + ;; "1.1.11" 1= vn gd rh arh + (1 (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname valname-string) + (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.1.10" 2= vn gd rh + (2 (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname valname-string) + (if last-line + (haskell-indent-push-pos-offset guard) + (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")))) + ;; "1.1100" 3= vn gd agd + (3 (haskell-indent-push-pos valname) + (haskell-indent-push-pos aft-guard) + (if last-line (haskell-indent-push-pos-offset valname))) + ;; "1.1000" 4= vn gd + (4 (haskell-indent-push-pos valname) + (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "1.0011" 5= vn rh arh + (5 (haskell-indent-push-pos valname) + (if (or (and aft-valname (= (char-after rhs-sign) ?\=)) + (= (char-after rhs-sign) ?\:)) + (haskell-indent-push-pos valname valname-string)) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.0010" 6= vn rh + (6 (haskell-indent-push-pos valname) + (haskell-indent-push-pos valname valname-string) + (if last-line (haskell-indent-push-pos-offset valname))) + ;; "110000" 7= vn avn + (7 (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos aft-valname) + (haskell-indent-push-pos valname valname-string))) + ;; "100000" 8= vn + (8 (haskell-indent-push-pos valname)) + ;; "001.11" 9= gd rh arh + (9 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "001.10" 10= gd rh + (10 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (if last-line (haskell-indent-push-pos-offset guard))) + ;; "001100" 11= gd agd + (11 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (haskell-indent-push-pos aft-guard)) + ;; "001000" 12= gd + (12 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) + (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "000011" 13= rh arh + (13 (haskell-indent-push-pos aft-rhs-sign)) + ;; "000010" 14= rh + (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2 ))) + ;; "000000" 15= + (t (error "haskell-indent-empty: %s impossible case" test )))) + haskell-indent-info))) + +(defun haskell-indent-ident (start end end-visible indent-info) + "Find indentation points for a line starting with an identifier." + (save-excursion + (let* + ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (is-where + (string-match "where[ \t]*" haskell-indent-current-line-first-ident)) + (diff-first ; not a function def with the same name + (not(string= valname-string haskell-indent-current-line-first-ident))) + ;; (is-type-def + ;; (and rhs-sign (eq (char-after rhs-sign) ?\:))) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) + (if (and valname-string ; special case for start keywords + (string-match haskell-indent-start-keywords-re valname-string)) + (progn + (haskell-indent-push-pos valname) + (if (string-match "\\" valname-string) + ;; very special for data keyword + (if aft-rhs-sign (haskell-indent-push-pos aft-rhs-sign) + (haskell-indent-push-pos-offset valname)) + (if (not (string-match + haskell-indent-start-keywords-re + haskell-indent-current-line-first-ident)) + (haskell-indent-push-pos-offset valname)))) + (if (string= haskell-indent-current-line-first-ident "::") + (if valname (haskell-indent-push-pos valname)) + (case ; general case + (haskell-indent-find-case test) + ;; "1.1.11" 1= vn gd rh arh + (1 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos valname) + (if diff-first (haskell-indent-push-pos aft-rhs-sign)))) + ;; "1.1.10" 2= vn gd rh + (2 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos-offset guard)))) + ;; "1.1100" 3= vn gd agd + (3 (if is-where + (haskell-indent-push-pos-offset guard) + (haskell-indent-push-pos valname) + (if diff-first + (haskell-indent-push-pos aft-guard)))) + ;; "1.1000" 4= vn gd + (4 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos-offset guard 2)))) + ;; "1.0011" 5= vn rh arh + (5 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname) + (if diff-first + (haskell-indent-push-pos aft-rhs-sign)))) + ;; "1.0010" 6= vn rh + (6 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos-offset valname)))) + ;; "110000" 7= vn avn + (7 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname) + (if last-line + (haskell-indent-push-pos aft-valname)))) + ;; "100000" 8= vn + (8 (if is-where + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos valname))) + ;; "001.11" 9= gd rh arh + (9 (if is-where + (haskell-indent-push-pos guard) + (haskell-indent-push-pos aft-rhs-sign))) + ;; "001.10" 10= gd rh + (10 (if is-where + (haskell-indent-push-pos guard) + (if last-line + (haskell-indent-push-pos-offset guard)))) + ;; "001100" 11= gd agd + (11 (if is-where + (haskell-indent-push-pos guard) + (if (haskell-indent-no-otherwise guard) + (haskell-indent-push-pos aft-guard)))) + ;; "001000" 12= gd + (12 (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "000011" 13= rh arh + (13 (haskell-indent-push-pos aft-rhs-sign)) + ;; "000010" 14= rh + (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "000000" 15= + (t (error "haskell-indent-ident: %s impossible case" test ))))) + haskell-indent-info))) + +(defun haskell-indent-other (start end end-visible indent-info) + "Find indentation points for a non-empty line starting with something other +than an identifier, a guard or rhs." + (save-excursion + (let* ((haskell-indent-info indent-info) + (sep (haskell-indent-separate-valdef start end)) + (valname (pop sep)) + (valname-string (pop sep)) + (aft-valname (pop sep)) + (guard (pop sep)) + (aft-guard (pop sep)) + (rhs-sign (pop sep)) + (aft-rhs-sign (pop sep)) + (last-line (= end end-visible)) + (test (string + (if valname ?1 ?0) + (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) + (if (and guard (< guard end-visible)) ?1 ?0) + (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) + (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) + (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) + (if (and valname-string ; special case for start keywords + (string-match haskell-indent-start-keywords-re valname-string)) + (haskell-indent-push-pos-offset valname) + (case ; general case + (haskell-indent-find-case test) + ;; "1.1.11" 1= vn gd rh arh + (1 (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.1.10" 2= vn gd rh + (2 (if last-line + (haskell-indent-push-pos-offset guard) + (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "1.1100" 3= vn gd agd + (3 (haskell-indent-push-pos aft-guard)) + ;; "1.1000" 4= vn gd + (4 (haskell-indent-push-pos-offset guard 2)) + ;; "1.0011" 5= vn rh arh + (5 (haskell-indent-push-pos valname) + (haskell-indent-push-pos aft-rhs-sign)) + ;; "1.0010" 6= vn rh + (6 (if last-line + (haskell-indent-push-pos-offset valname) + (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "110000" 7= vn avn + (7 (haskell-indent-push-pos-offset aft-valname)) + ;; "100000" 8= vn + (8 (haskell-indent-push-pos valname)) + ;; "001.11" 9= gd rh arh + (9 (haskell-indent-push-pos aft-rhs-sign)) + ;; "001.10" 10= gd rh + (10 (if last-line + (haskell-indent-push-pos-offset guard) + (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "001100" 11= gd agd + (11 (if (haskell-indent-no-otherwise guard) + (haskell-indent-push-pos aft-guard))) + ;; "001000" 12= gd + (12 (if last-line (haskell-indent-push-pos-offset guard 2))) + ;; "000011" 13= rh arh + (13 (haskell-indent-push-pos aft-rhs-sign)) + ;; "000010" 14= rh + (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) + ;; "000000" 15= + (t (error "haskell-indent-other: %s impossible case" test )))) + haskell-indent-info))) + +(defun haskell-indent-valdef-indentation (start end end-visible curr-line-type + indent-info) + "Find indentation information for a value definition." + (let ((haskell-indent-info indent-info)) + (if (< start end-visible) + (case curr-line-type + (empty (haskell-indent-empty start end end-visible indent-info)) + (ident (haskell-indent-ident start end end-visible indent-info)) + (guard (haskell-indent-guard start end end-visible indent-info)) + (rhs (haskell-indent-rhs start end end-visible indent-info)) + (comment (error "Comment indent should never happen")) + (other (haskell-indent-other start end end-visible indent-info))) + haskell-indent-info))) + +(defun haskell-indent-line-indentation (line-start line-end end-visible + curr-line-type indent-info) + "Compute indentation info between LINE-START and END-VISIBLE. +Separate a line of program into valdefs between offside keywords +and find indentation info for each part." + (save-excursion + ;; point is (already) at line-start + (assert (eq (point) line-start)) + (let ((haskell-indent-info indent-info) + (start (or (haskell-indent-in-comment line-start line-end) + (haskell-indent-in-string line-start line-end)))) + (if start ; if comment at the end + (setq line-end start)) ; end line before it + ;; loop on all parts separated by off-side-keywords + (while (and (re-search-forward haskell-indent-off-side-keywords-re + line-end t) + (not (or (haskell-indent-in-comment line-start (point)) + (haskell-indent-in-string line-start (point))))) + (let ((beg-match (match-beginning 0)) ; save beginning of match + (end-match (match-end 0))) ; save end of match + ;; Do not try to find indentation points if off-side-keyword at + ;; the start... + (if (or (< line-start beg-match) + ;; Actually, if we're looking at a "let" inside a "do", we + ;; should add the corresponding indentation point. + (eq (char-after beg-match) ?l)) + (setq haskell-indent-info + (haskell-indent-valdef-indentation line-start beg-match + end-visible + curr-line-type + haskell-indent-info))) + ;; ...but keep the start of the line if keyword alone on the line + (if (= line-end end-match) + (haskell-indent-push-pos beg-match)) + (setq line-start end-match) + (goto-char line-start))) + (haskell-indent-valdef-indentation line-start line-end end-visible + curr-line-type haskell-indent-info)))) + + +(defun haskell-indent-layout-indent-info (start contour-line) + (let ((haskell-indent-info nil) + (curr-line-type (haskell-indent-type-at-point)) + line-start line-end end-visible) + (save-excursion + (if (eq curr-line-type 'ident) + (let ; guess the type of line + ((sep + (haskell-indent-separate-valdef + (point) (line-end-position)))) + ;; if the first ident is where or the start of a def + ;; keep it in a global variable + (setq haskell-indent-current-line-first-ident + (if (string-match "where[ \t]*" (nth 1 sep)) + (nth 1 sep) + (if (nth 5 sep) ; is there a rhs-sign + (if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef + "::" (nth 1 sep)) + ""))))) + (while contour-line ; explore the contour points + (setq line-start (pop contour-line)) + (goto-char line-start) + (setq line-end (line-end-position)) + (setq end-visible ; visible until the column of the + (if contour-line ; next contour point + (save-excursion + (move-to-column + (haskell-indent-point-to-col (car contour-line))) + (point)) + line-end)) + (unless (or (haskell-indent-open-structure start line-start) + (haskell-indent-in-comment start line-start)) + (setq haskell-indent-info + (haskell-indent-line-indentation line-start line-end + end-visible curr-line-type + haskell-indent-info))))) + haskell-indent-info)) + +(defun haskell-indent-find-matching-start (regexp limit &optional pred start) + (let ((open (haskell-indent-open-structure limit (point)))) + (if open (setq limit (1+ open)))) + (unless start (setq start (point))) + (when (re-search-backward regexp limit t) + (let ((nestedcase (match-end 1)) + (outer (or (haskell-indent-in-string limit (point)) + (haskell-indent-in-comment limit (point)) + (haskell-indent-open-structure limit (point)) + (if (and pred (funcall pred start)) (point))))) + (cond + (outer + (goto-char outer) + (haskell-indent-find-matching-start regexp limit pred start)) + (nestedcase + ;; Nested case. + (and (haskell-indent-find-matching-start regexp limit pred) + (haskell-indent-find-matching-start regexp limit pred start))) + (t (point)))))) + +(defun haskell-indent-filter-let-no-in (start) + "Return non-nil if point is in front of a `let' that has no `in'. +START is the position of the presumed `in'." + ;; We're looking at either `in' or `let'. + (when (looking-at "let") + (ignore-errors + (save-excursion + (forward-word 1) + (forward-comment (point-max)) + (if (looking-at "{") + (progn + (forward-sexp 1) + (forward-comment (point-max)) + (< (point) start)) + ;; Use the layout rule to see whether this let is already closed + ;; without an `in'. + (let ((col (current-column))) + (while (progn (forward-line 1) (haskell-indent-back-to-indentation) + (< (point) start)) + (when (< (current-column) col) + (setq col nil) + (goto-char start))) + (null col))))))) + +(defun haskell-indent-comment (open start) + "Compute indent info for comments and text inside comments. +OPEN is the start position of the comment in which point is." + ;; Ideally we'd want to guess whether it's commented out code or + ;; whether it's text. Instead, we'll assume it's text. + (save-excursion + (if (= open (point)) + ;; We're actually just in front of a comment: align with following + ;; code or with comment on previous line. + (let ((prev-line-info + (cond + ((eq (char-after) ?\{) nil) ;Align as if it were code. + ((and (forward-comment -1) + (> (line-beginning-position 3) open)) + ;; We're after another comment and there's no empty line + ;; between us. + (list (list (haskell-indent-point-to-col (point))))) + (t nil)))) ;Else align as if it were code + ;; Align with following code. + (forward-comment (point-max)) + ;; There are several possible indentation points for this code-line, + ;; but the only valid indentation point for the comment is the one + ;; that the user will select for the code-line. Obviously we can't + ;; know that, so we just assume that the code-line is already at its + ;; proper place. + ;; Strictly speaking "assume it's at its proper place" would mean + ;; we'd just use (current-column), but since this is using info from + ;; lines further down and it's common to reindent line-by-line, + ;; we'll align not with the current indentation, but with the + ;; one that auto-indentation "will" select. + (append + prev-line-info + (let ((indent-info (save-excursion + (haskell-indent-indentation-info start))) + (col (current-column))) + ;; Sort the indent-info so that the current indentation comes + ;; out first. + (setq indent-info + (sort indent-info + (lambda (x y) + (<= (abs (- col (car x))) (abs (- col (car y))))))) + indent-info))) + + ;; We really are inside a comment. + (if (looking-at "-}") + (progn + (forward-char 2) + (forward-comment -1) + (list (list (1+ (haskell-indent-point-to-col (point)))))) + (let ((offset (if (looking-at "--?") + (- (match-beginning 0) (match-end 0))))) + (forward-line -1) ;Go to previous line. + (haskell-indent-back-to-indentation) + (if (< (point) start) (goto-char start)) + + (list (list (if (looking-at comment-start-skip) + (if offset + (+ 2 offset (haskell-indent-point-to-col (point))) + (haskell-indent-point-to-col (match-end 0))) + (haskell-indent-point-to-col (point)))))))))) + +(defcustom haskell-indent-thenelse 0 + "If non-nil, \"then\" and \"else\" are indented. +This is necessary in the \"do\" layout under Haskell-98. +See http://hackage.haskell.org/trac/haskell-prime/wiki/DoAndIfThenElse" + :group 'haskell-indent + :type 'integer) + +(defun haskell-indent-closing-keyword (start) + (let ((open (save-excursion + (haskell-indent-find-matching-start + (case (char-after) + (?i "\\<\\(?:\\(in\\)\\|let\\)\\>") + (?o "\\<\\(?:\\(of\\)\\|case\\)\\>") + (?t "\\<\\(?:\\(then\\)\\|if\\)\\>") + (?e "\\<\\(?:\\(else\\)\\|if\\)\\>")) + start + (if (eq (char-after) ?i) + ;; Filter out the `let's that have no `in'. + 'haskell-indent-filter-let-no-in))))) + ;; For a "hanging let/case/if at EOL" we should use a different + ;; indentation scheme. + (save-excursion + (goto-char open) + (if (haskell-indent-hanging-p) + (setq open (haskell-indent-virtual-indentation start)))) + ;; FIXME: we should try and figure out if the `if' is in a `do' layout + ;; before using haskell-indent-thenelse. + (list (list (+ (if (memq (char-after) '(?t ?e)) haskell-indent-thenelse 0) + (haskell-indent-point-to-col open)))))) + +(defcustom haskell-indent-after-keywords + '(("where" 2 0) + ("of" 2) + ("do" 2) + ("in" 2 0) + ("{" 2) + "if" + "then" + "else" + "let") + "Keywords after which indentation should be indented by some offset. +Each keyword info can have the following forms: + + KEYWORD | (KEYWORD OFFSET [OFFSET-HANGING]) + +If absent OFFSET-HANGING defaults to OFFSET. +If absent OFFSET defaults to `haskell-indent-offset'. + +OFFSET-HANGING is the offset to use in the case where the keyword +is at the end of an otherwise-non-empty line." + :group 'haskell-indent + :type '(repeat (choice string + (cons :tag "" (string :tag "keyword:") + (cons :tag "" (integer :tag "offset") + (choice (const nil) + (list :tag "" + (integer :tag "offset-pending")))))))) + +(defun haskell-indent-skip-lexeme-forward () + (and (zerop (skip-syntax-forward "w")) + (skip-syntax-forward "_") + (skip-syntax-forward "(") + (skip-syntax-forward ")"))) + +(defvar haskell-indent-inhibit-after-offset nil) + +(defun haskell-indent-offset-after-info () + "Return the info from `haskell-indent-after-keywords' for keyword at point." + (let ((id (buffer-substring + (point) + (save-excursion + (haskell-indent-skip-lexeme-forward) + (point))))) + (or (assoc id haskell-indent-after-keywords) + (car (member id haskell-indent-after-keywords))))) + +(defcustom haskell-indent-dont-hang '("(") + "Lexemes that should never be considered as hanging." + :group 'haskell-indent + :type '(repeat string)) + +(defun haskell-indent-hanging-p () + ;; A Hanging keyword is one that's at the end of a line except it's not at + ;; the beginning of a line. + (not (or (= (current-column) (haskell-indent-current-indentation)) + (save-excursion + (let ((lexeme + (buffer-substring + (point) + (progn (haskell-indent-skip-lexeme-forward) (point))))) + (or (member lexeme haskell-indent-dont-hang) + (> (line-end-position) + (progn (forward-comment (point-max)) (point))))))))) + +(defun haskell-indent-after-keyword-column (offset-info start &optional default) + (unless offset-info + (setq offset-info (haskell-indent-offset-after-info))) + (unless default (setq default haskell-indent-offset)) + (setq offset-info + (if haskell-indent-inhibit-after-offset '(0) (cdr-safe offset-info))) + (if (not (haskell-indent-hanging-p)) + (haskell-indent-column+offset (current-column) + (or (car offset-info) default)) + ;; The keyword is hanging at the end of the line. + (haskell-indent-column+offset + (haskell-indent-virtual-indentation start) + (or (cadr offset-info) (car offset-info) default)))) + +(defun haskell-indent-inside-paren (open) + ;; there is an open structure to complete + (if (looking-at "\\s)\\|[;,]") + ;; A close-paren or a , or ; can only correspond syntactically to + ;; the open-paren at `open'. So there is no ambiguity. + (progn + (if (or (and (eq (char-after) ?\;) (eq (char-after open) ?\()) + (and (eq (char-after) ?\,) (eq (char-after open) ?\{))) + (message "Mismatched punctuation: `%c' in %c...%c" + (char-after) (char-after open) + (if (eq (char-after open) ?\() ?\) ?\}))) + (save-excursion + (goto-char open) + (list (list + (if (haskell-indent-hanging-p) + (haskell-indent-virtual-indentation nil) + (haskell-indent-point-to-col open)))))) + ;; There might still be layout within the open structure. + (let* ((end (point)) + (basic-indent-info + ;; Anything else than a ) is subject to layout. + (if (looking-at "\\s.\\|\\$ ") + (haskell-indent-point-to-col open) ; align a punct with ( + (let ((follow (save-excursion + (goto-char (1+ open)) + (haskell-indent-skip-blanks-and-newlines-forward end) + (point)))) + (if (= follow end) + (save-excursion + (goto-char open) + (haskell-indent-after-keyword-column nil nil 1)) + (haskell-indent-point-to-col follow))))) + (open-column (haskell-indent-point-to-col open)) + (contour-line (haskell-indent-contour-line (1+ open) end))) + (if (null contour-line) + (list (list basic-indent-info)) + (let ((indent-info + (haskell-indent-layout-indent-info + (1+ open) contour-line))) + ;; Fix up indent info. + (let ((base-elem (assoc open-column indent-info))) + (if base-elem + (progn (setcar base-elem basic-indent-info) + (setcdr base-elem nil)) + (setq indent-info + (append indent-info (list (list basic-indent-info))))) + indent-info)))))) + +(defun haskell-indent-virtual-indentation (start) + "Compute the \"virtual indentation\" of text at point. +The \"virtual indentation\" is the indentation that text at point would have +had, if it had been placed on its own line." + (let ((col (current-column)) + (haskell-indent-inhibit-after-offset (haskell-indent-hanging-p))) + (if (save-excursion (skip-chars-backward " \t") (bolp)) + ;; If the text is indeed on its own line, than the virtual indent is + ;; the current indentation. + col + ;; Else, compute the indentation that it would have had. + (let ((info (haskell-indent-indentation-info start)) + (max -1)) + ;; `info' is a list of possible indent points. Each indent point is + ;; assumed to correspond to a different parse. So we need to find + ;; the parse that corresponds to the case at hand (where there's no + ;; line break), which is assumed to always be the + ;; deepest indentation. + (dolist (x info) + (setq x (car x)) + ;; Sometimes `info' includes the current indentation (or yet + ;; deeper) by mistake, because haskell-indent-indentation-info + ;; wasn't designed to be called on a piece of text that is not at + ;; BOL. So ignore points past `col'. + (if (and (> x max) (not (>= x col))) + (setq max x))) + ;; In case all the indent points are past `col', just use `col'. + (if (>= max 0) max col))))) + +(defun haskell-indent-indentation-info (&optional start) + "Return a list of possible indentations for the current line. +These are then used by `haskell-indent-cycle'. +START if non-nil is a presumed start pos of the current definition." + (unless start (setq start (haskell-indent-start-of-def))) + (let (open contour-line) + (cond + ;; in string? + ((setq open (haskell-indent-in-string start (point))) + (list (list (+ (haskell-indent-point-to-col open) + (if (looking-at "\\\\") 0 1))))) + + ;; in comment ? + ((setq open (haskell-indent-in-comment start (point))) + (haskell-indent-comment open start)) + + ;; Closing the declaration part of a `let' or the test exp part of a case. + ((looking-at "\\(?:in\\|of\\|then\\|else\\)\\>") + (haskell-indent-closing-keyword start)) + + ;; Right after a special keyword. + ((save-excursion + (forward-comment (- (point-max))) + (when (and (not (zerop (skip-syntax-backward "w"))) + (setq open (haskell-indent-offset-after-info))) + (list (list (haskell-indent-after-keyword-column open start)))))) + + ;; open structure? ie ( { [ + ((setq open (haskell-indent-open-structure start (point))) + (haskell-indent-inside-paren open)) + + ;; full indentation + ((setq contour-line (haskell-indent-contour-line start (point))) + (haskell-indent-layout-indent-info start contour-line)) + + (t + ;; simple contour just one indentation at start + (list (list (if (and (eq haskell-literate 'bird) + (eq (haskell-indent-point-to-col start) 1)) + ;; for a Bird style literate script put default offset + ;; in the case of no indentation + (1+ haskell-indent-literate-Bird-default-offset) + (haskell-indent-point-to-col start)))))))) + +(defvar haskell-indent-last-info nil) + + +(defun haskell-indent-cycle () + "Indentation cycle. +We stay in the cycle as long as the TAB key is pressed." + (interactive "*") + (if (and haskell-literate + (not (haskell-indent-within-literate-code))) + ;; use the ordinary tab for text... + (funcall (default-value 'indent-line-function)) + (let ((marker (if (> (current-column) (haskell-indent-current-indentation)) + (point-marker))) + (bol (progn (beginning-of-line) (point)))) + (haskell-indent-back-to-indentation) + (unless (and (eq last-command this-command) + (eq bol (car haskell-indent-last-info))) + (save-excursion + (setq haskell-indent-last-info + (list bol (haskell-indent-indentation-info) 0 0)))) + + (let* ((il (nth 1 haskell-indent-last-info)) + (index (nth 2 haskell-indent-last-info)) + (last-insert-length (nth 3 haskell-indent-last-info)) + (indent-info (nth index il))) + + (haskell-indent-line-to (car indent-info)) ; insert indentation + (delete-char last-insert-length) + (setq last-insert-length 0) + (let ((text (cdr indent-info))) + (if text + (progn + (insert text) + (setq last-insert-length (length text))))) + + (setq haskell-indent-last-info + (list bol il (% (1+ index) (length il)) last-insert-length)) + + (if (= (length il) 1) + (message "Sole indentation") + (message "Indent cycle (%d)..." (length il))) + + (if marker + (goto-char (marker-position marker))))))) + +(defun haskell-indent-region (start end) + (error "Auto-reindentation of a region is not supported")) + +;;; alignment functions + +(defun haskell-indent-shift-columns (dest-column region-stack) + "Shift columns in REGION-STACK to go to DEST-COLUMN. +Elements of the stack are pairs of points giving the start and end +of the regions to move." + (let (reg col diffcol reg-end) + (while (setq reg (pop region-stack)) + (setq reg-end (copy-marker (cdr reg))) + (goto-char (car reg)) + (setq col (current-column)) + (setq diffcol (- dest-column col)) + (if (not (zerop diffcol)) + (catch 'end-of-buffer + (while (<= (point) (marker-position reg-end)) + (if (< diffcol 0) + (backward-delete-char-untabify (- diffcol) nil) + (insert-char ?\ diffcol)) + (end-of-line 2) ; should be (forward-line 1) + (if (eobp) ; but it adds line at the end... + (throw 'end-of-buffer nil)) + (move-to-column col))))))) + +(defun haskell-indent-align-def (p-arg type) + "Align guards or rhs within the current definition before point. +If P-ARG is t align all defs up to the mark. +TYPE is either 'guard or 'rhs." + (save-excursion + (let (start-block end-block + (maxcol (if (eq type 'rhs) haskell-indent-rhs-align-column 0)) + contour sep defname defnamepos + defcol pos lastpos + regstack eqns-start start-found) + ;; find the starting and ending boundary points for alignment + (if p-arg + (if (mark) ; aligning everything in the region + (progn + (when (> (mark) (point)) (exchange-point-and-mark)) + (setq start-block + (save-excursion + (goto-char (mark)) + (line-beginning-position))) + (setq end-block + (progn (if (haskell-indent-bolp) + (haskell-indent-forward-line -1)) + (line-end-position)))) + (error "The mark is not set for aligning definitions")) + ;; aligning the current definition + (setq start-block (haskell-indent-start-of-def)) + (setq end-block (line-end-position))) + ;; find the start of the current valdef using the contour line + ;; in reverse order because we need the nearest one from the end + (setq contour + (reverse (haskell-indent-contour-line start-block end-block))) + (setq pos (car contour)) ; keep the start of the first contour + ;; find the nearest start of a definition + (while (and (not defname) contour) + (goto-char (pop contour)) + (if (haskell-indent-open-structure start-block (point)) + nil + (setq sep (haskell-indent-separate-valdef (point) end-block)) + (if (nth 5 sep) ; is there a rhs? + (progn (setq defnamepos (nth 0 sep)) + (setq defname (nth 1 sep)))))) + ;; start building the region stack + (if defnamepos + (progn ; there is a valdef + ;; find the start of each equation or guard + (if p-arg ; when indenting a region + ;; accept any start of id or pattern as def name + (setq defname "\\<\\|(")) + (setq defcol (haskell-indent-point-to-col defnamepos)) + (goto-char pos) + (setq end-block (line-end-position)) + (catch 'top-of-buffer + (while (and (not start-found) + (>= (point) start-block)) + (if (<= (haskell-indent-current-indentation) defcol) + (progn + (move-to-column defcol) + (if (and (looking-at defname) ; start of equation + (not (haskell-indent-open-structure start-block (point)))) + (push (cons (point) 'eqn) eqns-start) + ;; found a less indented point not starting an equation + (setq start-found t))) + ;; more indented line + (haskell-indent-back-to-indentation) + (if (and (eq (haskell-indent-type-at-point) 'guard) ; start of a guard + (not (haskell-indent-open-structure start-block (point)))) + (push (cons (point) 'gd) eqns-start))) + (if (bobp) + (throw 'top-of-buffer nil) + (haskell-indent-backward-to-indentation 1)))) + ;; remove the spurious guards before the first equation + (while (and eqns-start (eq (cdar eqns-start) 'gd)) + (pop eqns-start)) + ;; go through each equation to find the region to indent + (while eqns-start + (let ((eqn (caar eqns-start))) + (setq lastpos (if (cdr eqns-start) + (save-excursion + (goto-char (caadr eqns-start)) + (haskell-indent-forward-line -1) + (line-end-position)) + end-block)) + (setq sep (haskell-indent-separate-valdef eqn lastpos))) + (if (eq type 'guard) + (setq pos (nth 3 sep)) + ;; check if what follows a rhs sign is more indented or not + (let ((rhs (nth 5 sep)) + (aft-rhs (nth 6 sep))) + (if (and rhs aft-rhs + (> (haskell-indent-point-to-col rhs) + (haskell-indent-point-to-col aft-rhs))) + (setq pos aft-rhs) + (setq pos rhs)))) + (if pos + (progn ; update region stack + (push (cons pos (or lastpos pos)) regstack) + (setq maxcol ; find the highest column number + (max maxcol + (progn ;find the previous non-empty column + (goto-char pos) + (skip-chars-backward + " \t" + (line-beginning-position)) + (if (haskell-indent-bolp) + ;;if on an empty prefix + (haskell-indent-point-to-col pos) ;keep original indent + (1+ (haskell-indent-point-to-col (point))))))))) + (pop eqns-start)) + ;; now shift according to the region stack + (if regstack + (haskell-indent-shift-columns maxcol regstack))))))) + +(defun haskell-indent-align-guards-and-rhs (start end) + "Align the guards and rhs of functions in the region, which must be active." + ;; The `start' and `end' args are dummys right now: they're just there so + ;; we can use the "r" interactive spec which properly signals an error. + (interactive "*r") + (haskell-indent-align-def t 'guard) + (haskell-indent-align-def t 'rhs)) + +;;; insertion functions + +(defun haskell-indent-insert-equal () + "Insert an = sign and align the previous rhs of the current function." + (interactive "*") + (if (or (haskell-indent-bolp) + (/= (preceding-char) ?\ )) + (insert ?\ )) + (insert "= ") + (haskell-indent-align-def (haskell-indent-mark-active) 'rhs)) + +(defun haskell-indent-insert-guard (&optional text) + "Insert and align a guard sign (|) followed by optional TEXT. +Alignment works only if all guards are to the south-east of their |." + (interactive "*") + (let ((pc (if (haskell-indent-bolp) ?\012 + (preceding-char))) + (pc1 (or (char-after (- (point) 2)) 0))) + ;; check what guard to insert depending on the previous context + (if (= pc ?\ ) ; x = any char other than blank or | + (if (/= pc1 ?\|) + (insert "| ") ; after " x" + ()) ; after " |" + (if (= pc ?\|) + (if (= pc1 ?\|) + (insert " | ") ; after "||" + (insert " ")) ; after "x|" + (insert " | "))) ; general case + (if text (insert text)) + (haskell-indent-align-def (haskell-indent-mark-active) 'guard))) + +(defun haskell-indent-insert-otherwise () + "Insert a guard sign (|) followed by `otherwise'. +Also align the previous guards of the current function." + (interactive "*") + (haskell-indent-insert-guard "otherwise") + (haskell-indent-insert-equal)) + +(defun haskell-indent-insert-where () + "Insert a where keyword at point and indent resulting line. +One indentation cycle is used." + (interactive "*") + (insert "where ") + (haskell-indent-cycle)) + + +;;; haskell-indent-mode + +(defvar haskell-indent-mode nil + "Non-nil if the semi-intelligent Haskell indentation mode is in effect.") +(make-variable-buffer-local 'haskell-indent-mode) + +(defvar haskell-indent-map + (let ((map (make-sparse-keymap))) + ;; Removed: remapping DEL seems a bit naughty --SDM + ;; (define-key map "\177" 'backward-delete-char-untabify) + ;; The binding to TAB is already handled by indent-line-function. --Stef + ;; (define-key map "\t" 'haskell-indent-cycle) + (define-key map [?\C-c ?\C-=] 'haskell-indent-insert-equal) + (define-key map [?\C-c ?\C-|] 'haskell-indent-insert-guard) + ;; Alternate binding, in case C-c C-| is too inconvenient to type. + ;; Duh, C-g is a special key, let's not use it here. + ;; (define-key map [?\C-c ?\C-g] 'haskell-indent-insert-guard) + (define-key map [?\C-c ?\C-o] 'haskell-indent-insert-otherwise) + (define-key map [?\C-c ?\C-w] 'haskell-indent-insert-where) + (define-key map [?\C-c ?\C-.] 'haskell-indent-align-guards-and-rhs) + (define-key map [?\C-c ?\C->] 'haskell-indent-put-region-in-literate) + map)) + +(defun turn-on-haskell-indent () + "Turn on ``intelligent'' Haskell indentation mode." + (set (make-local-variable 'indent-line-function) 'haskell-indent-cycle) + (set (make-local-variable 'indent-region-function) 'haskell-indent-region) + (setq haskell-indent-mode t) + ;; Activate our keymap. + (let ((map (current-local-map))) + (while (and map (not (eq map haskell-indent-map))) + (setq map (keymap-parent map))) + (if map + ;; haskell-indent-map is already active: nothing to do. + nil + ;; Put our keymap on top of the others. We could also put it in + ;; second place, or in a minor-mode. The minor-mode approach would be + ;; easier, but it's harder for the user to override it. This approach + ;; is the closest in behavior compared to the previous code that just + ;; used a bunch of local-set-key. + (set-keymap-parent haskell-indent-map (current-local-map)) + ;; Protect our keymap. + (setq map (make-sparse-keymap)) + (set-keymap-parent map haskell-indent-map) + (use-local-map map))) + (run-hooks 'haskell-indent-hook)) + +(defun turn-off-haskell-indent () + "Turn off ``intelligent'' Haskell indentation mode." + (kill-local-variable 'indent-line-function) + ;; Remove haskell-indent-map from the local map. + (let ((map (current-local-map))) + (while map + (let ((parent (keymap-parent map))) + (if (eq haskell-indent-map parent) + (set-keymap-parent map (keymap-parent parent)) + (setq map parent))))) + (setq haskell-indent-mode nil)) + +;; Put this minor mode on the global minor-mode-alist. +(or (assq 'haskell-indent-mode (default-value 'minor-mode-alist)) + (setq-default minor-mode-alist + (append (default-value 'minor-mode-alist) + '((haskell-indent-mode " Ind"))))) + +;;;###autoload +(defun haskell-indent-mode (&optional arg) + "``Intelligent'' Haskell indentation mode. +This 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." + (interactive "P") + (setq haskell-indent-mode + (if (null arg) (not haskell-indent-mode) + (> (prefix-numeric-value arg) 0))) + (if haskell-indent-mode + (turn-on-haskell-indent) + (turn-off-haskell-indent))) + +(provide 'haskell-indent) + +;; arch-tag: e4e5e90a-12e2-4002-b5cb-7b2375710013 +;;; haskell-indent.el ends here diff --git a/.emacs.d/haskell-mode/haskell-indentation.el b/.emacs.d/haskell-mode/haskell-indentation.el new file mode 100644 index 0000000..29650a6 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-indentation.el @@ -0,0 +1,882 @@ +;;; haskell-indentation.el -- indentation module for Haskell Mode + +;; Copyright 2009 Kristof Bastiaensen + +;; Author: 2009 Kristof Bastiaensen + +;; 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 +;; add this to .emacs: +;; +;; (add-hook haskell-mode-hook 'turn-on-haskell-indentation) +;; +;; Otherwise, call `haskell-indentation-mode'. +;; + +;;; Code: + +(require 'syntax nil t) ; Emacs 21 add-on + +(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) + +;; Avoid a global bogus definition (which the original run-time +;; `defun' made), and support Emacs 21 without the syntax.el add-on. +(eval-when-compile + (unless (fboundp 'syntax-ppss) + (defsubst 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 haskell-current-column () + "Compute current column according to haskell syntax rules, + correctly ignoring composition." + (save-excursion + (let ((start (point)) + (cc 0)) + (beginning-of-line) + (while (< (point) start) + (if (= (char-after) ?\t) + (setq cc (* 8 (+ 1 (/ cc 8)))) + (incf cc)) + (forward-char)) + cc))) + +(defun kill-indented-line (&optional arg) + "`kill-line' for indented text. +Preserves indentation and removes extra whitespace" + (interactive "P") + (let ((col (haskell-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 (> (haskell-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 (> (haskell-current-column) fill-column) + (while (> (haskell-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 (haskell-current-column)) + (ci (current-indentation)) + (indentations (haskell-indentation-find-indentations))) + (skip-syntax-forward "-") + (if (prog1 (and (eolp) + (not (= (haskell-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 (haskell-current-column))) + (cond ((> (haskell-current-column) ci) + (save-excursion + (move-to-column ci) + (haskell-indentation-reindent + (haskell-indentation-one-indentation + ci (haskell-indentation-find-indentations))))) + + ((= (haskell-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 (= (haskell-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 (equal (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 (= (haskell-current-column) 0) + (> (haskell-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) + (>= (haskell-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 (haskell-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))) + ("mdo" . (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)))) + ("proc" . (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 (haskell-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 (haskell-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 (haskell-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 (haskell-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 (haskell-current-column)) + (current-indent current-indent) + (left-indent (if (= (haskell-current-column) (current-indentation)) + (haskell-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 (haskell-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 (haskell-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 (haskell-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 (haskell-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 (= (haskell-current-column) (current-indentation)) + (haskell-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 (haskell-current-column)) + (setq starter-indent separator-column))))) + +(defun haskell-indentation-implicit-layout-list (parser) + (let* ((layout-indent (haskell-current-column)) + (current-indent (haskell-current-column)) + (left-indent (haskell-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 (haskell-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 (= (haskell-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 (haskell-current-column)) + 'layout-end) + ((= layout-indent (haskell-current-column)) + (setq current-token 'layout-next)) + ((< layout-indent (haskell-current-column)) + (setq current-token (haskell-indentation-peek-token))))) + ((eq current-token 'layout-next) + (setq current-token (haskell-indentation-peek-token))) + ((> layout-indent (haskell-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 (= (haskell-current-column) (current-indentation)) + ;; on a new line + (setq current-indent (haskell-current-column)) + (setq left-indent (haskell-current-column)) + (setq parse-line-number (+ parse-line-number 1))) + (cond ((> layout-indent (haskell-current-column)) + (setq current-token 'layout-end)) + ((= layout-indent (haskell-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\\|mdo\\|do\\|proc\\|case\\|of\\|where\\|module\\|deriving\\|data\\|type\\|newtype\\|class\\|instance\\)\\([^[:alpha:]']\\|$\\)") + (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." + (let ((case-fold-search nil)) + (if (or (looking-at "'\\([^\\']\\|\\\\.\\)*'") + (looking-at "\"\\([^\\\"]\\|\\\\.\\)*\"") + (looking-at ; Hierarchical names always start with uppercase + "[[:upper:]]\\(\\sw\\|'\\)*\\(\\.\\(\\sw\\|'\\)+\\)*") + (looking-at "\\sw\\(\\sw\\|'\\)*") ; Only unqualified vars can start with lowercase + (looking-at "[0-9][0-9oOxXeE+-]*") + (looking-at "[-:!#$%&*+./<=>?@\\\\^|~]+") + (looking-at "[](){}[,;]") + (looking-at "`[[:alnum:]']*`")) + (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 diff --git a/.emacs.d/haskell-mode/haskell-mode.el b/.emacs.d/haskell-mode/haskell-mode.el new file mode 100644 index 0000000..8a30a1e --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-mode.el @@ -0,0 +1,624 @@ +;;; 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 and +;; Tommy Thorn , +;; 2001-2002 Reuben Thomas (>=v1.4) +;; 2003 Dave Love +;; Keywords: faces files Haskell +;; Version: $Name: $ +;; 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ä . +;; +;; 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 +;; : +;; +;; 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 : +;; +;; 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)) +(eval-when-compile + ;; Emacs 21 defines `values' as a (run-time) alias for list. + ;; Don't maerge this with the pervious clause. + (if (string-match "values" + (pp (byte-compile (lambda () (values t))))) + (defsubst values (&rest values) + values))) + +;; All functions/variables start with `(literate-)haskell-'. + +;; Version of mode. +(defconst haskell-version "$Name: $" + "`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 -- i.e. 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." + :group 'haskell + :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 [?\C-c ?\C-v] 'haskell-check) + + (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 : + ;; - 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-style \">\"." + (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 + :group 'haskell + :options `(turn-on-haskell-indent turn-on-haskell-indentation + turn-on-font-lock + ,(if (boundp 'eldoc-documentation-function) + 'turn-on-eldoc-mode + 'turn-on-haskell-doc-mode) ; Emacs 21 + ,@(if (fboundp 'capitalized-words-mode) + '(capitalized-words-mode)) + turn-on-simple-indent turn-on-haskell-doc-mode + turn-on-haskell-decl-scan 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 `-- '. +\\ +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 'fill-paragraph-function) 'haskell-fill-paragraph) + ;; (set (make-local-variable 'adaptive-fill-function) 'haskell-adaptive-fill) + (set (make-local-variable 'adaptive-fill-mode) nil) + (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) nil) + ;; 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)) + +(defun in-comment () (nth 4 (syntax-ppss))) + +(defun haskell-fill-paragraph (justify) + (save-excursion + ;; We don't want to reflow code. + (unless (in-comment) + (end-of-line)) ; Try to get inside a comment + (if (in-comment) nil t))) + +;; (defun haskell-adaptive-fill () +;; ;; We want to use "-- " as the prefix of "-- |", etc. +;; (let* ((line-end (save-excursion (end-of-line) (point))) +;; (line-start (point))) +;; (save-excursion +;; (unless (in-comment) +;; ;; Try to find the start of a comment. We only fill comments. +;; (search-forward-regexp comment-start-skip line-end t)) +;; (when (in-comment) +;; (let ();(prefix-start (point))) +;; (skip-syntax-forward "^w") +;; (make-string (- (point) line-start) ?\s)))))) + + + +;;;###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)) +;;;###autoload(add-to-list 'interpreter-mode-alist '("runghc" . haskell-mode)) +;;;###autoload(add-to-list 'interpreter-mode-alist '("runhaskell" . 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." + :group 'haskell + :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) + +(defcustom haskell-check-command "hlint" + "*Command used to check a Haskell file." + :group 'haskell + :type '(choice (const "hlint") + (const "ghc -fno-code") + (string :tag "Other command"))) + +(defvar haskell-saved-check-command nil + "Internal use.") + +;; Like Python. Should be abstracted, sigh. +(defun haskell-check (command) + "Check a Haskell file (default current buffer's file). +Runs COMMAND, a shell command, as if by `compile'. +See `haskell-check-command' for the default." + (interactive + (list (read-string "Checker command: " + (or haskell-saved-check-command + (concat haskell-check-command " " + (let ((name (buffer-file-name))) + (if name + (file-name-nondirectory name)))))))) + (setq haskell-saved-check-command command) + (require 'compile) + (save-some-buffers (not compilation-ask-about-save) nil) + (if (fboundp 'compilation-start) + (compilation-start command) + (compile-internal command "No more errors"))) + +(autoload 'flymake-init-create-temp-buffer-copy "flymake") + +(defun haskell-flymake-init () + "Flymake init function for Haskell. +To be added to `flymake-init-create-temp-buffer-copy'." + (let ((checker-elts (split-string haskell-saved-check-command))) + (list (car checker-elts) + (append (cdr checker-elts) + (list (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)))))) + +(eval-after-load "flymake" + '(add-to-list 'flymake-allowed-file-name-masks + '("\\.l?hs\\'" haskell-flymake-init))) + +;; Provide ourselves: + +(provide 'haskell-mode) + +;; arch-tag: b2237ec0-ddb0-4c86-9339-52d410264980 +;;; haskell-mode.el ends here diff --git a/.emacs.d/haskell-mode/haskell-simple-indent.el b/.emacs.d/haskell-mode/haskell-simple-indent.el new file mode 100644 index 0000000..708ccf1 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-simple-indent.el @@ -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 and +;; Graeme E Moss +;; 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 diff --git a/.emacs.d/haskell-mode/haskell-site-file.el b/.emacs.d/haskell-mode/haskell-site-file.el new file mode 100644 index 0000000..0fe0650 --- /dev/null +++ b/.emacs.d/haskell-mode/haskell-site-file.el @@ -0,0 +1,277 @@ + +;;;### (autoloads (haskell-c-mode) "haskell-c" "haskell-c.el" (18170 +;;;;;; 47169)) +;;; 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" +;;;;;; (19222 37798)) +;;; 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" +;;;;;; (19222 37798)) +;;; 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" (19222 37798)) +;;; 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" +;;;;;; (19222 37798)) +;;; Generated autoloads from haskell-indent.el + +(autoload 'haskell-indent-mode "haskell-indent" "\ +``Intelligent'' Haskell indentation mode. +This 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" (19222 37798)) +;;; 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" (19222 37798)) +;;; 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 `-- '. +\\ +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)) +(add-to-list 'interpreter-mode-alist '("runghc" . haskell-mode)) +(add-to-list 'interpreter-mode-alist '("runhaskell" . 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" (19222 +;;;;;; 37798)) +;;; 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" "test.el") (19222 +;;;;;; 37817 315467)) + +;;;*** + diff --git a/.emacs.d/haskell-mode/indent.hs b/.emacs.d/haskell-mode/indent.hs new file mode 100644 index 0000000..3f713bf --- /dev/null +++ b/.emacs.d/haskell-mode/indent.hs @@ -0,0 +1,170 @@ +------------------------------------------------------------------------- +-- 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. -- +------------------------------------------------------------------------- + +-- | Fill-paragraph should avoid inserting an | on the following lines. + + -- | However, indented comments should still be indented. For great justice. + +-- * Foo bar bazFoo bar bazFoo bar bazFoo bar bazFoo bar bazFoo bar baz + +{- Here's +a more complex comment. Of doom. There is, indeed, great doom here. #-} + +-- And a +-- multi-line +-- comment + +-- 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] -- | commented to oblivion and back and forth and so forth +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 diff --git a/.emacs.d/haskell-mode/inf-haskell.el b/.emacs.d/haskell-mode/inf-haskell.el new file mode 100644 index 0000000..e3c039e --- /dev/null +++ b/.emacs.d/haskell-mode/inf-haskell.el @@ -0,0 +1,722 @@ +;;; inf-haskell.el --- Interaction with an inferior Haskell process. + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; 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." + :group 'haskell + :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) + ;; Whay the backslash in [\\._[:alnum:]]? + "^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*> ") + (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]+" 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))) + (if file + (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) nil 'visible) + (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)))) + (error "No file associated with buffer")))) + +(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 `haskell-package-manager-name'. +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 `haskell-package-manager-name'." + (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 diff --git a/.emacs.d/highlight-parentheses.el b/.emacs.d/highlight-parentheses.el new file mode 100644 index 0000000..8df50ab --- /dev/null +++ b/.emacs.d/highlight-parentheses.el @@ -0,0 +1,157 @@ +;;; highlight-parentheses.el --- highlight surrounding parentheses +;; +;; Copyright (C) 2007, 2009 Nikolaj Schumacher +;; +;; Author: Nikolaj Schumacher +;; 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 . +;; +;;; 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 diff --git a/.emacs.d/init.el b/.emacs.d/init.el index ed42567..cb49bb1 100644 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -7,6 +7,7 @@ (add-to-list 'load-path "~/.emacs.d/icicles") (add-to-list 'load-path "~/.emacs.d/tabbar") + (fset 'yes-or-no-p 'y-or-n-p) (require 'icicles) @@ -20,6 +21,7 @@ ;(require 'highlight-symbol) (require 'auto-complete-config) + ;; Hack to get *Messages* in viper-mode. ;; ;; (must be done after loading viper) ;; ;; Futzing with fundamental-mode doesn't seem to help. @@ -28,7 +30,6 @@ (viper-change-state-to-vi)) - (add-to-list 'ac-dictionary-directories "~/.emacs.d/auto-complete/dict") (ac-config-default) (setq ac-dwim t) @@ -39,6 +40,7 @@ (setq viper-translate-all-ESC-keysequences nil) (setq viper-always t) (setq viper-vi-style-in-minibuffer nil) +(setq-default indent-tabs-mode nil) ;(define-key ac-completing-map "\t" 'ac-fuzzy-complete) ;(define-key ac-completing-map "\r" nil) (define-key ac-completing-map (kbd "") 'ac-stop) @@ -87,7 +89,7 @@ ; Basic frame defaults (let ((background-color "#2F2F2F") (foreground-color "LightGrey") - (fname "Inconsolata-18") + (fname "Inconsolata-13") (fheight 45) (fwidth 115)) @@ -96,7 +98,7 @@ ; (set-background-color background-color) ; (add-to-list 'default-frame-alist (cons 'background-color background-color)) ; (set-foreground-color foreground-color) - (add-to-list 'default-frame-alist (cons 'foreground-color foreground-color)) +; (add-to-list 'default-frame-alist (cons 'foreground-color foreground-color)) (add-to-list 'default-frame-alist (cons 'height fheight)) (add-to-list 'default-frame-alist (cons 'width fwidth)) ) @@ -106,6 +108,23 @@ (color-theme-initialize) (color-theme-barak) (color-theme-barak-extras) +(setq font-lock-maximum-decoration 3) + +(load "~/.emacs.d/haskell-mode/haskell-site-file") +(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) + +(require 'highlight-parentheses) + +(setq hl-paren-colors + '(;"#8f8f8f" ; this comes from Zenburn + ; and I guess I'll try to make the far-outer parens look like this + "orange1" "yellow1" "greenyellow" "green1" + "springgreen1" "cyan1" "slateblue1" "magenta1" "purple")) + +(add-hook 'emacs-lisp-mode-hook (lambda () (highlight-parentheses-mode))) (defadvice viper-maybe-checkout (around viper-svn-checkin-fix activate) "Advise viper-maybe-checkout to ignore svn files." diff --git a/.emacs.d/themes/color-theme-barak.el b/.emacs.d/themes/color-theme-barak.el index 9364518..9a2abfb 100644 --- a/.emacs.d/themes/color-theme-barak.el +++ b/.emacs.d/themes/color-theme-barak.el @@ -40,9 +40,9 @@ (text-cursor ((t (:background "yellow" :foreground "black")))) (toolbar ((t (nil)))) (tabbar-default ((t (:background "black" :foreground "grey75")))) - (tabbar-selected (( (:background "grey75" :foreground "black")))) + (tabbar-selected ((t (:background "grey75" :foreground "black")))) + (tabbar-highlight ((t (:bold t)))) (underline ((nil (:underline nil)))) - (zmacs-region ((t (:background "snow" :foreground "ble"))))))) (defun color-theme-barak-extras () ; Highlight numbers