|
|
- ;;; 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
|