diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-indent.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-indent.el | 1596 |
1 files changed, 1596 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-indent.el b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-indent.el new file mode 100644 index 000000000000..afa558503b7c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-indent.el @@ -0,0 +1,1596 @@ +;;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode -*- lexical-binding: t -*- + +;; Copyright 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright 1997-1998 Guy Lapalme + +;; Author: 1997-1998 Guy Lapalme <lapalme@iro.umontreal.ca> + +;; Keywords: indentation Haskell layout-rule +;; 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; 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 <http://www.haskell.org/haskell-mode/> +;; 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 <chris.vanhumbeeck@cs.kuleuven.ac.be> +;; 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: + +(require 'cl-lib) +(require 'haskell-string) + +(defvar haskell-literate) + +;;;###autoload +(defgroup haskell-indent nil + "Haskell indentation." + :group 'haskell + :link '(custom-manual "(haskell-mode)Indentation") + :prefix "haskell-indent-") + +(defcustom haskell-indent-offset 4 + "Indentation of Haskell statements with respect to containing block." + :type 'integer + :safe #'natnump + :group 'haskell-indent) + +(defcustom haskell-indent-literate-Bird-default-offset 1 + "Default number of blanks after > in a Bird style literate script." + :type 'integer + :safe #'natnump + :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 + :safe #'natnump + :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" "signature" "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 + (cl-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 + :safe #'booleanp + :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) + (cl-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\\|mdo\\|rec\\)\\>[ \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 "\\<data\\>" valname-string) + (if rhs-sign (haskell-indent-push-pos rhs-sign) + (haskell-indent-push-pos-offset valname)) + (haskell-indent-push-pos-offset valname))) + (cl-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 + (or (null valname-string) + (not (string= (haskell-string-trim valname-string) + (haskell-string-trim 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 "\\<data\\>" 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)) + (cl-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) + (cl-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) + (cl-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 + (cl-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 + :safe #'booleanp + :type 'integer) + +(defun haskell-indent-closing-keyword (start) + (let ((open (save-excursion + (haskell-indent-find-matching-start + (cl-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) + ("mdo" 2) + ("rec" 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 (cl-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-local haskell-indent-mode nil + "Non-nil if the semi-intelligent Haskell indentation mode is in effect.") + +(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 (kbd "C-c C-=") 'haskell-indent-insert-equal) + (define-key map (kbd "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 (kbd "C-c C-g") 'haskell-indent-insert-guard) + (define-key map (kbd "C-c C-o") 'haskell-indent-insert-otherwise) + (define-key map (kbd "C-c C-w") 'haskell-indent-insert-where) + (define-key map (kbd "C-c C-.") 'haskell-indent-align-guards-and-rhs) + (define-key map (kbd "C-c C->") 'haskell-indent-put-region-in-literate) + map)) + +;;;###autoload +(defun turn-on-haskell-indent () + "Turn on ``intelligent'' Haskell indentation mode." + (when (and (bound-and-true-p haskell-indentation-mode) + (fboundp 'haskell-indentation-mode)) + (haskell-indentation-mode 0)) + + (setq-local indent-line-function 'haskell-indent-cycle) + (setq-local 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 haskell-indent-map is already active: there's nothing to do. + (unless map + ;; 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) + (kill-local-variable 'indent-region-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 + +If `ARG' is falsey, toggle `haskell-indent-mode'. Else sets +`haskell-indent-mode' to whether `ARG' is greater than 0. + +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) + +;;; haskell-indent.el ends here |