/ emacs.d / haskell / haskell-indent.el
haskell-indent.el
   1  ;;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode
   2  
   3  ;; Copyright 2004, 2005, 2007  Free Software Foundation, Inc.
   4  ;; Copyright 1997-1998  Guy Lapalme
   5  
   6  ;; Author: 1997-1998 Guy Lapalme <lapalme@iro.umontreal.ca>
   7  
   8  ;; Keywords: indentation Haskell layout-rule
   9  ;; Version: 1.2
  10  ;; URL: http://www.iro.umontreal.ca/~lapalme/layout/index.html
  11  
  12  ;;; This file is not part of GNU Emacs.
  13  
  14  ;; This file is free software; you can redistribute it and/or modify
  15  ;; it under the terms of the GNU General Public License as published by
  16  ;; the Free Software Foundation; either version 2, or (at your option)
  17  ;; any later version.
  18  
  19  ;; This file is distributed in the hope that it will be useful,
  20  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22  ;; GNU General Public License for more details.
  23  
  24  ;; You should have received a copy of the GNU General Public License
  25  ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26  ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27  ;; Boston, MA 02111-1307, USA.
  28  
  29  
  30  ;;; Commentary:
  31  
  32  ;; Purpose:
  33  ;;
  34  ;; To support automatic indentation of Haskell programs using
  35  ;; the layout rule descrived in section 1.5 and appendix B.3 of the
  36  ;; the Haskell report.  The rationale and the implementation principles
  37  ;; are described in an article to appear in Journal of Functional Programming.
  38  ;;   "Dynamic tabbing for automatic indentation with the layout rule"
  39  ;;
  40  ;; It supports literate scripts.
  41  ;; Haskell indentation is performed
  42  ;;     within \begin{code}...\end{code} sections of a literate script
  43  ;;     and in lines beginning with > with Bird style literate script
  44  ;; TAB aligns to the left column outside of these sections.
  45  ;;
  46  ;; Installation:
  47  ;;
  48  ;; To turn indentation on for all Haskell buffers under the Haskell
  49  ;; mode of Moss&Thorn <http://www.haskell.org/haskell-mode/>
  50  ;; add this to .emacs:
  51  ;;
  52  ;;    (add-hook haskell-mode-hook 'turn-on-haskell-indent)
  53  ;;
  54  ;; Otherwise, call `turn-on-haskell-indent'.
  55  ;;
  56  ;;
  57  ;; Customisation:
  58  ;;       The "standard" offset for statements is 4 spaces.
  59  ;;       It can be changed by setting the variable "haskell-indent-offset" to
  60  ;;       another value
  61  ;;
  62  ;;       The default number of blanks after > in a Bird style literate script
  63  ;;       is 1; it can be changed by setting the variable
  64  ;;       "haskell-indent-literate-Bird-default-offset"
  65  ;;
  66  ;;       `haskell-indent-hook' is invoked if not nil.
  67  ;;
  68  ;; All functions/variables start with
  69  ;; `(turn-(on/off)-)haskell-indent' or `haskell-indent-'.
  70  
  71  ;; This file can also be used as a hook for the Hugs Mode developed by
  72  ;;         Chris Van Humbeeck <chris.vanhumbeeck@cs.kuleuven.ac.be>
  73  ;; It can be obtained at:
  74  ;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el
  75  ;;
  76  ;; For the Hugs mode put the following in your .emacs
  77  ;;
  78  ;;(setq auto-mode-alist (append auto-mode-alist '(("\\.hs\\'" . hugs-mode))))
  79  ;;(autoload 'hugs-mode "hugs-mode" "Go into hugs mode" t)
  80  ;;
  81  ;; If only the indentation mode is used then replace the two
  82  ;; preceding lines with
  83  ;;(setq auto-mode-alist (append auto-mode-alist
  84  ;;                              '(("\\.hs\\'" . turn-on-haskell-indent))))
  85  ;;(autoload 'turn-on-haskell-indent "hindent" "Indentation mode for Haskell" t)
  86  ;;
  87  ;; For indentation in both cases then add the following to your .emacs
  88  ;;(add-hook 'hugs-mode-hook 'turn-on-haskell-indent)
  89  ;;(autoload 'haskell-indent-cycle "hindent" "Indentation cycle for Haskell" t)
  90  ;;
  91  
  92  ;;; Code:
  93  
  94  (eval-when-compile (require 'cl))	;need defs of push and pop
  95  (defvar haskell-literate)
  96  
  97  (defgroup haskell-indent nil
  98    "Haskell indentation."
  99    :group 'haskell
 100    :prefix "haskell-indent-")
 101  
 102  (defcustom haskell-indent-offset 4
 103    "Indentation of Haskell statements with respect to containing block."
 104    :type 'integer
 105    :group 'haskell-indent)
 106  
 107  (defcustom haskell-indent-literate-Bird-default-offset 1
 108    "Default number of blanks after > in a Bird style literate script."
 109    :type 'integer
 110    :group 'haskell-indent)
 111  
 112  (defcustom haskell-indent-rhs-align-column 0
 113    "Column on which to align right-hand sides (use 0 for ad-hoc alignment)."
 114    :type 'integer
 115    :group 'haskell-indent)
 116  
 117  (defun haskell-indent-point-to-col (apoint)
 118    "Return the column number of APOINT."
 119    (save-excursion
 120      (goto-char apoint)
 121      (current-column)))
 122  
 123  (defconst haskell-indent-start-keywords-re
 124    (concat "\\<"
 125            (regexp-opt '("class" "data" "import" "infix" "infixl" "infixr"
 126                          "instance" "module" "newtype" "primitive" "type") t)
 127            "\\>")
 128    "Regexp describing keywords to complete when standing at the first word
 129  of a line.")
 130  
 131  
 132  ;; Customizations for different kinds of environments
 133  ;; in which dealing with low-level events are different.
 134  (defun haskell-indent-mark-active ()
 135    (if (featurep 'xemacs)
 136        (if zmacs-regions
 137            zmacs-region-active-p
 138          t)
 139      mark-active))
 140  
 141  ;;  for pushing indentation information
 142  
 143  (defvar haskell-indent-info)            ;Used with dynamic scoping.
 144  
 145  (defun haskell-indent-push-col (col &optional name)
 146    "Push indentation information for the column COL.
 147  The info is followed by NAME (if present).
 148  Makes sure that the same indentation info is not pushed twice.
 149  Uses free var `haskell-indent-info'."
 150    (let ((tmp (cons col name)))
 151      (if (member tmp haskell-indent-info)
 152  	haskell-indent-info
 153        (push tmp haskell-indent-info))))
 154  
 155  (defun haskell-indent-push-pos (pos &optional name)
 156    "Pushes indentation information for the column corresponding to POS
 157  followed by NAME (if present)."
 158    (haskell-indent-push-col (haskell-indent-point-to-col pos) name))
 159  
 160  (defun haskell-indent-push-pos-offset (pos &optional offset)
 161    "Pushes indentation information for the column corresponding to POS
 162  followed by an OFFSET (if present use its value otherwise use
 163  `haskell-indent-offset')."
 164    (haskell-indent-push-col (+ (haskell-indent-point-to-col pos)
 165                                (or offset haskell-indent-offset))))
 166  
 167  ;; redefinition of some Emacs function for dealing with
 168  ;; Bird Style literate scripts
 169  
 170  (defun haskell-indent-bolp ()
 171    "`bolp' but dealing with Bird-style literate scripts."
 172    (or (bolp)
 173        (and (eq haskell-literate 'bird)
 174             (<= (current-column) (1+ haskell-indent-literate-Bird-default-offset))
 175             (eq (char-after (line-beginning-position)) ?\>))))
 176  
 177  (defun haskell-indent-empty-line-p ()
 178    "Checks if the current line is empty; deals with Bird style scripts."
 179    (save-excursion
 180      (beginning-of-line)
 181      (if (and (eq haskell-literate 'bird)
 182               (eq (following-char) ?\>))
 183          (forward-char 1))
 184      (looking-at "[ \t]*$")))
 185  
 186  (defun haskell-indent-back-to-indentation ()
 187    "`back-to-indentation' function but dealing with Bird-style literate scripts."
 188    (if (and (eq haskell-literate 'bird)
 189             (progn (beginning-of-line) (eq (following-char) ?\>)))
 190        (progn
 191          (forward-char 1)
 192          (skip-chars-forward " \t"))
 193      (back-to-indentation)))
 194  
 195  (defun haskell-indent-current-indentation ()
 196    "`current-indentation' function but dealing with Bird-style literate
 197  scripts."
 198    (if (eq haskell-literate 'bird)
 199        (save-excursion
 200          (haskell-indent-back-to-indentation)
 201          (current-column))
 202      (current-indentation)))
 203  
 204  (defun haskell-indent-backward-to-indentation (n)
 205    "`backward-to-indentation' function but dealing with Bird-style literate
 206  scripts."
 207    (if (eq haskell-literate 'bird)
 208        (progn
 209          (forward-line (- n))
 210          (haskell-indent-back-to-indentation))
 211      (backward-to-indentation n)))
 212  
 213  (defun haskell-indent-forward-line (&optional n)
 214    "`forward-line' function but dealing with Bird-style literate scripts."
 215    (prog1
 216        (forward-line n)
 217      (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>))
 218          (progn (forward-char 1)                ; skip > and initial blanks...
 219                 (skip-chars-forward " \t")))))
 220  
 221  (defun haskell-indent-line-to (n)
 222    "`indent-line-to' function but dealing with Bird-style literate scripts."
 223    (if (eq haskell-literate 'bird)
 224        (progn
 225          (beginning-of-line)
 226          (if (eq (following-char) ?\>)
 227              (delete-char 1))
 228          (delete-horizontal-space)       ; remove any starting TABs so
 229          (indent-line-to n)              ; that indent-line only adds spaces
 230          (save-excursion
 231            (beginning-of-line)
 232            (if (> n 0) (delete-char 1))  ; delete the first space before
 233            (insert ?\>)))                ; inserting a >
 234      (indent-line-to n)))
 235  
 236  (defun haskell-indent-skip-blanks-and-newlines-forward (end)
 237    "Skips forward blanks, tabs and newlines until END taking
 238  account of Bird style literate scripts."
 239    (skip-chars-forward " \t\n" end)
 240    (if (eq haskell-literate 'bird)
 241        (while (and (bolp) (eq (following-char) ?\>))
 242          (forward-char 1)                ; skip >
 243          (skip-chars-forward " \t\n" end))))
 244  
 245  (defun haskell-indent-skip-blanks-and-newlines-backward (start)
 246    "Skips backward blanks, tabs and newlines upto START
 247  taking account of Bird style literate scripts."
 248    (skip-chars-backward " \t\n" start)
 249    (if (eq haskell-literate 'bird)
 250        (while (and (eq (current-column) 1)
 251                    (eq (preceding-char) ?\>))
 252          (forward-char -1)               ; skip back >
 253          (skip-chars-backward " \t\n" start))))
 254  
 255  ;; specific functions for literate code
 256  
 257  (defun haskell-indent-within-literate-code ()
 258    "Checks if point is within a part of literate Haskell code and if so
 259  returns its start otherwise returns NIL:
 260  If it is Bird Style, then returns the position of the >
 261  otherwise returns the ending position \\begin{code}."
 262    (save-excursion
 263      (case haskell-literate
 264        (bird
 265         (beginning-of-line)
 266         (if (or (eq (following-char) ?\>)
 267                 (and (bolp) (forward-line -1) (eq (following-char) ?\>)))
 268             (progn
 269               (while (and (zerop (forward-line -1))
 270                           (eq (following-char) ?\>)))
 271               (if (not (eq (following-char) ?\>))
 272                   (forward-line))
 273               (point))))
 274        ;;  Look for a \begin{code} or \end{code} line.
 275        (latex
 276         (if (re-search-backward
 277              "^\\(\\\\begin{code}$\\)\\|\\(\\\\end{code}$\\)" nil t)
 278             ;; within a literate code part if it was a \\begin{code}.
 279             (match-end 1)))
 280        (t (error "haskell-indent-within-literate-code: should not happen!")))))
 281  
 282  (defun haskell-indent-put-region-in-literate (beg end &optional arg)
 283    "Put lines of the region as a piece of literate code.
 284  With C-u prefix arg, remove indication that the region is literate code.
 285  It deals with both Bird style and non Bird-style scripts."
 286    (interactive "r\nP")
 287    (unless haskell-literate
 288      (error "Cannot put a region in literate in a non literate script"))
 289    (if (eq haskell-literate 'bird)
 290        (let ((comment-start "> ")        ; Change dynamic bindings for
 291              (comment-start-skip "^> ?") ; comment-region.
 292              (comment-end "")
 293              (comment-end-skip "\n")
 294              (comment-style 'plain))
 295          (comment-region beg end arg))
 296      ;; Not Bird style.
 297      (if arg                             ; Remove the literate indication.
 298          (save-excursion
 299            (goto-char end)               ; Remove end.
 300            (if (re-search-backward "^\\\\end{code}[ \t\n]*\\="
 301                                    (line-beginning-position -2) t)
 302                (delete-region (point) (line-beginning-position 2)))
 303            (goto-char beg)               ; Remove end.
 304            (beginning-of-line)
 305            (if (looking-at "\\\\begin{code}")
 306                (kill-line 1)))
 307        (save-excursion                   ; Add the literate indication.
 308          (goto-char end)
 309          (unless (bolp) (newline))
 310          (insert "\\end{code}\n")
 311          (goto-char beg)
 312          (unless (bolp) (newline))
 313          (insert "\\begin{code}\n")))))
 314  
 315  ;;; Start of indentation code
 316  
 317  (defcustom haskell-indent-look-past-empty-line t
 318    "If nil, indentation engine will not look past an empty line for layout points."
 319    :type 'boolean)
 320  
 321  (defun haskell-indent-start-of-def ()
 322    "Return the position of the start of a definition.
 323  The start of a def is expected to be recognizable by starting in column 0,
 324  unless `haskell-indent-look-past-empty-line' is nil, in which case we
 325  take a coarser approximation and stop at the first empty line."
 326    (save-excursion
 327      (let ((start-code (and haskell-literate
 328                             (haskell-indent-within-literate-code)))
 329            (top-col (if (eq haskell-literate 'bird) 2 0))
 330            (save-point (point)))
 331        ;; determine the starting point of the current piece of code
 332        (setq start-code (if start-code (1+ start-code) (point-min)))
 333        ;; go backward until the first preceding empty line
 334        (haskell-indent-forward-line -1)
 335        (while (and (if haskell-indent-look-past-empty-line
 336                        (or (> (haskell-indent-current-indentation) top-col)
 337                            (haskell-indent-empty-line-p))
 338                      (and (> (haskell-indent-current-indentation) top-col)
 339                           (not (haskell-indent-empty-line-p))))
 340                    (> (point) start-code)
 341                    (= 0 (haskell-indent-forward-line -1))))
 342        ;; go forward after the empty line
 343        (if (haskell-indent-empty-line-p)
 344            (haskell-indent-forward-line 1))
 345        (setq start-code (point))
 346        ;; find the first line of code which is not a comment
 347        (forward-comment (point-max))
 348        (if (> (point) save-point)
 349  	  start-code
 350  	(point)))))
 351  
 352  (defun haskell-indent-open-structure (start end)
 353    "If any structure (list or tuple) is not closed, between START and END,
 354  returns the location of the opening symbol, nil otherwise."
 355    (save-excursion
 356      (nth 1 (parse-partial-sexp start end))))
 357  
 358  (defun haskell-indent-in-string (start end)
 359    "If a string is not closed , between START and END, returns the
 360  location of the opening symbol, nil otherwise."
 361    (save-excursion
 362      (let ((pps (parse-partial-sexp start end)))
 363        (if (nth 3 pps) (nth 8 pps)))))
 364  
 365  (defun haskell-indent-in-comment (start end)
 366    "Check, starting from START, if END is at or within a comment.
 367  Returns the location of the start of the comment, nil otherwise."
 368    (let (pps)
 369      (assert (<= start end))
 370      (cond ((= start end) nil)
 371  	  ((nth 4 (save-excursion (setq pps (parse-partial-sexp start end))))
 372  	   (nth 8 pps))
 373  	  ;; We also want to say that we are *at* the beginning of a comment.
 374  	  ((and (not (nth 8 pps))
 375                  (>= (point-max) (+ end 2))
 376  		(nth 4 (save-excursion
 377  			 (setq pps (parse-partial-sexp end (+ end 2))))))
 378  	   (nth 8 pps)))))
 379  
 380  (defvar haskell-indent-off-side-keywords-re
 381        "\\<\\(do\\|let\\|of\\|where\\)\\>[ \t]*")
 382  
 383  (defun haskell-indent-type-at-point ()
 384    "Return the type of the line (also puts information in `match-data')."
 385    (cond
 386     ((haskell-indent-empty-line-p) 'empty)
 387     ((haskell-indent-in-comment (point-min) (point)) 'comment)
 388     ((looking-at "\\(\\([a-zA-Z]\\(\\sw\\|'\\)*\\)\\|_\\)[ \t\n]*") 'ident)
 389     ((looking-at "\\(|[^|]\\)[ \t\n]*") 'guard)
 390     ((looking-at "\\(=[^>=]\\|::\\|->\\|<-\\)[ \t\n]*") 'rhs)
 391     (t 'other)))
 392  
 393  (defvar haskell-indent-current-line-first-ident ""
 394    "Global variable that keeps track of the first ident of the line to indent.")
 395  
 396  
 397  (defun haskell-indent-contour-line (start end)
 398    "Generate contour information between START and END points."
 399    (if (< start end)
 400        (save-excursion
 401  	(goto-char end)
 402  	(haskell-indent-skip-blanks-and-newlines-backward start)
 403          (let ((cur-col (current-column))            ; maximum column number
 404                (fl 0)     ; number of lines that forward-line could not advance
 405                contour)
 406            (while (and (> cur-col 0) (= fl 0) (>= (point) start))
 407              (haskell-indent-back-to-indentation)
 408  	    (if (< (point) start) (goto-char start))
 409              (and (not (member (haskell-indent-type-at-point)
 410                                '(empty comment))) ; skip empty and comment lines
 411                   (< (current-column) cur-col) ; less indented column found
 412                   (push (point) contour) ; new contour point found
 413                   (setq cur-col (current-column)))
 414              (setq fl (haskell-indent-forward-line -1)))
 415            contour))))
 416  
 417  (defun haskell-indent-next-symbol (end)
 418    "Puts point to the next following symbol."
 419    (skip-syntax-forward ")" end)
 420    (if (< (point) end)
 421       (progn
 422         (forward-sexp 1)
 423         (haskell-indent-skip-blanks-and-newlines-forward end))))
 424  
 425  (defun haskell-indent-separate-valdef (start end)
 426    "Returns a list of positions for important parts of a valdef."
 427    (save-excursion
 428      (let (valname valname-string aft-valname
 429                    guard aft-guard
 430                    rhs-sign aft-rhs-sign
 431                    type)
 432        ;; "parse" a valdef separating important parts
 433        (goto-char start)
 434        (setq type (haskell-indent-type-at-point))
 435        (if (or (memq type '(ident other))) ; possible start of a value def
 436            (progn
 437              (if (eq type 'ident)
 438                  (progn
 439                    (setq valname (match-beginning 0))
 440                    (setq valname-string (match-string 0))
 441                    (goto-char (match-end 0)))
 442                (skip-chars-forward " \t" end)
 443                (setq valname (point))    ; type = other
 444                (haskell-indent-next-symbol end))
 445              (while (and (< (point) end)
 446                          (setq type (haskell-indent-type-at-point))
 447                          (or (memq type '(ident other))))
 448                (if (null aft-valname)
 449                    (setq aft-valname (point)))
 450                (haskell-indent-next-symbol end))))
 451        (if (and (< (point) end) (eq type 'guard)) ; start of a guard
 452            (progn
 453              (setq guard (match-beginning 0))
 454              (goto-char (match-end 0))
 455              (while (and (< (point) end)
 456                          (setq type (haskell-indent-type-at-point))
 457                          (not (eq type 'rhs)))
 458                (if (null aft-guard)
 459                    (setq aft-guard (point)))
 460                (haskell-indent-next-symbol end))))
 461        (if (and (< (point) end) (eq type 'rhs)) ; start of a rhs
 462            (progn
 463              (setq rhs-sign (match-beginning 0))
 464              (goto-char (match-end 0))
 465              (if (< (point) end)
 466                  (setq aft-rhs-sign (point)))))
 467        (list valname valname-string aft-valname
 468              guard aft-guard rhs-sign aft-rhs-sign))))
 469  
 470  (defsubst haskell-indent-no-otherwise (guard)
 471    "Check if there is no otherwise at GUARD."
 472    (save-excursion
 473      (goto-char guard)
 474      (not (looking-at "|[ \t]*otherwise\\>"))))
 475  
 476  
 477  (defun haskell-indent-guard (start end end-visible indent-info)
 478    "Finds indentation information for a line starting with a guard."
 479    (save-excursion
 480      (let* ((haskell-indent-info indent-info)
 481             (sep (haskell-indent-separate-valdef start end))
 482             (valname (nth 0 sep))
 483             (guard (nth 3 sep))
 484             (rhs-sign (nth 5 sep)))
 485        ;; push information indentation for the visible part
 486        (if (and guard (< guard end-visible) (haskell-indent-no-otherwise guard))
 487            (haskell-indent-push-pos guard)
 488          (if rhs-sign
 489              (haskell-indent-push-pos rhs-sign) ; probably within a data definition...
 490            (if valname
 491                (haskell-indent-push-pos-offset valname))))
 492        haskell-indent-info)))
 493  
 494  (defun haskell-indent-rhs (start end end-visible indent-info)
 495    "Finds indentation information for a line starting with a rhs."
 496    (save-excursion
 497      (let* ((haskell-indent-info indent-info)
 498             (sep (haskell-indent-separate-valdef start end))
 499             (valname (nth 0 sep))
 500             (guard (nth 3 sep))
 501             (rhs-sign (nth 5 sep)))
 502        ;; push information indentation for the visible part
 503        (if (and rhs-sign (< rhs-sign end-visible))
 504            (haskell-indent-push-pos rhs-sign)
 505          (if (and guard (< guard end-visible))
 506              (haskell-indent-push-pos-offset guard)
 507            (if valname                   ; always visible !!
 508                (haskell-indent-push-pos-offset valname))))
 509        haskell-indent-info)))
 510  
 511  (defconst haskell-indent-decision-table
 512    (let ((or "\\)\\|\\("))
 513      (concat "\\("
 514              "1.1.11" or                 ; 1= vn gd rh arh
 515              "1.1.10" or                 ; 2= vn gd rh
 516              "1.1100" or                 ; 3= vn gd agd
 517              "1.1000" or                 ; 4= vn gd
 518              "1.0011" or                 ; 5= vn rh arh
 519              "1.0010" or                 ; 6= vn rh
 520              "110000" or                 ; 7= vn avn
 521              "100000" or                 ; 8= vn
 522              "001.11" or                 ; 9= gd rh arh
 523              "001.10" or                 ;10= gd rh
 524              "001100" or                 ;11= gd agd
 525              "001000" or                 ;12= gd
 526              "000011" or                 ;13= rh arh
 527              "000010" or                 ;14= rh
 528              "000000"                    ;15=
 529              "\\)")))
 530  
 531  (defun haskell-indent-find-case (test)
 532    "Find the index that matches in the decision table."
 533    (if (string-match haskell-indent-decision-table test)
 534        ;; use the fact that the resulting match-data is a list of the form
 535        ;; (0 6 [2*(n-1) nil] 0 6) where n is the number of the matching regexp
 536        ;; so n= ((length match-data)/2)-1
 537        (- (/ (length (match-data 'integers)) 2) 1)
 538      (error "haskell-indent-find-case: impossible case: %s" test)))
 539  
 540  (defun haskell-indent-empty (start end end-visible indent-info)
 541    "Finds indentation points for an empty line."
 542    (save-excursion
 543      (let* ((haskell-indent-info indent-info)
 544             (sep (haskell-indent-separate-valdef start end))
 545             (valname (pop sep))
 546             (valname-string (pop sep))
 547             (aft-valname (pop sep))
 548             (guard (pop sep))
 549             (aft-guard (pop sep))
 550             (rhs-sign (pop sep))
 551             (aft-rhs-sign (pop sep))
 552             (last-line (= end end-visible))
 553             (test (string
 554                    (if valname ?1 ?0)
 555                    (if (and aft-valname (< aft-valname end-visible)) ?1 ?0)
 556                    (if (and guard (< guard end-visible)) ?1 ?0)
 557                    (if (and aft-guard (< aft-guard end-visible)) ?1 ?0)
 558                    (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0)
 559                    (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0))))
 560        (if (and valname-string           ; special case for start keywords
 561                 (string-match haskell-indent-start-keywords-re valname-string))
 562            (progn
 563              (haskell-indent-push-pos valname)
 564              ;; very special for data keyword
 565              (if (string-match "\\<data\\>" valname-string)
 566                  (if rhs-sign (haskell-indent-push-pos rhs-sign)
 567                    (haskell-indent-push-pos-offset valname))
 568                (haskell-indent-push-pos-offset valname)))
 569          (case                           ; general case
 570              (haskell-indent-find-case test)
 571            ;; "1.1.11"   1= vn gd rh arh
 572            (1 (haskell-indent-push-pos valname)
 573               (haskell-indent-push-pos valname valname-string)
 574               (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| "))
 575               (haskell-indent-push-pos aft-rhs-sign))
 576            ;; "1.1.10"   2= vn gd rh
 577            (2 (haskell-indent-push-pos valname)
 578               (haskell-indent-push-pos valname valname-string)
 579               (if last-line
 580                   (haskell-indent-push-pos-offset guard)
 581                 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| "))))
 582            ;; "1.1100"   3= vn gd agd
 583            (3 (haskell-indent-push-pos valname)
 584               (haskell-indent-push-pos aft-guard)
 585               (if last-line (haskell-indent-push-pos-offset valname)))
 586            ;; "1.1000"   4= vn gd
 587            (4 (haskell-indent-push-pos valname)
 588               (if last-line (haskell-indent-push-pos-offset guard 2)))
 589            ;; "1.0011"   5= vn rh arh
 590            (5 (haskell-indent-push-pos valname)
 591               (if (or (and aft-valname (= (char-after rhs-sign) ?\=))
 592                       (= (char-after rhs-sign) ?\:))
 593                   (haskell-indent-push-pos valname valname-string))
 594               (haskell-indent-push-pos aft-rhs-sign))
 595            ;; "1.0010"   6= vn rh
 596            (6 (haskell-indent-push-pos valname)
 597               (haskell-indent-push-pos valname valname-string)
 598               (if last-line (haskell-indent-push-pos-offset valname)))
 599            ;; "110000"   7= vn avn
 600            (7 (haskell-indent-push-pos valname)
 601               (if last-line
 602                   (haskell-indent-push-pos aft-valname)
 603                 (haskell-indent-push-pos valname valname-string)))
 604            ;; "100000"   8= vn
 605            (8 (haskell-indent-push-pos valname))
 606            ;; "001.11"   9= gd rh arh
 607            (9 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| "))
 608               (haskell-indent-push-pos aft-rhs-sign))
 609            ;; "001.10"  10= gd rh
 610            (10 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| "))
 611  	      (if last-line (haskell-indent-push-pos-offset guard)))
 612            ;; "001100"  11= gd agd
 613            (11 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| "))
 614  	      (haskell-indent-push-pos aft-guard))
 615            ;; "001000"  12= gd
 616            (12 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| "))
 617  	      (if last-line (haskell-indent-push-pos-offset guard 2)))
 618            ;; "000011"  13= rh arh
 619            (13 (haskell-indent-push-pos aft-rhs-sign))
 620            ;; "000010"  14= rh
 621            (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2 )))
 622            ;; "000000"  15=
 623            (t (error "haskell-indent-empty: %s impossible case" test ))))
 624        haskell-indent-info)))
 625  
 626  (defun haskell-indent-ident (start end end-visible indent-info)
 627    "Finds indentation points for a line starting with an identifier."
 628    (save-excursion
 629      (let*
 630          ((haskell-indent-info indent-info)
 631           (sep (haskell-indent-separate-valdef start end))
 632           (valname (pop sep))
 633           (valname-string (pop sep))
 634           (aft-valname (pop sep))
 635           (guard (pop sep))
 636           (aft-guard (pop sep))
 637           (rhs-sign (pop sep))
 638           (aft-rhs-sign (pop sep))
 639           (last-line (= end end-visible))
 640           (is-where
 641            (string-match "where[ \t]*" haskell-indent-current-line-first-ident))
 642           (diff-first                 ; not a function def with the same name
 643            (not(string= valname-string haskell-indent-current-line-first-ident)))
 644           ;; (is-type-def
 645           ;;  (and rhs-sign (eq (char-after rhs-sign) ?\:)))
 646           (test (string
 647                  (if valname ?1 ?0)
 648                  (if (and aft-valname (< aft-valname end-visible)) ?1 ?0)
 649                  (if (and guard (< guard end-visible)) ?1 ?0)
 650                  (if (and aft-guard (< aft-guard end-visible)) ?1 ?0)
 651                  (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0)
 652                  (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0))))
 653        (if (and valname-string           ; special case for start keywords
 654                 (string-match haskell-indent-start-keywords-re valname-string))
 655            (progn
 656              (haskell-indent-push-pos valname)
 657              (if (string-match "\\<data\\>" valname-string)
 658                  ;; very special for data keyword
 659                  (if aft-rhs-sign (haskell-indent-push-pos aft-rhs-sign)
 660                    (haskell-indent-push-pos-offset valname))
 661                (if (not (string-match
 662                          haskell-indent-start-keywords-re
 663                          haskell-indent-current-line-first-ident))
 664                    (haskell-indent-push-pos-offset valname))))
 665          (if (string= haskell-indent-current-line-first-ident "::")
 666              (if valname (haskell-indent-push-pos valname))
 667            (case                         ; general case
 668                (haskell-indent-find-case test)
 669              ;; "1.1.11"   1= vn gd rh arh
 670              (1 (if is-where
 671                     (haskell-indent-push-pos guard)
 672                   (haskell-indent-push-pos valname)
 673                   (if diff-first (haskell-indent-push-pos aft-rhs-sign))))
 674              ;; "1.1.10"   2= vn gd rh
 675              (2 (if is-where
 676                     (haskell-indent-push-pos guard)
 677                   (haskell-indent-push-pos valname)
 678                   (if last-line
 679                       (haskell-indent-push-pos-offset guard))))
 680              ;; "1.1100"   3= vn gd agd
 681              (3 (if is-where
 682                     (haskell-indent-push-pos-offset guard)
 683                   (haskell-indent-push-pos valname)
 684                   (if diff-first
 685                       (haskell-indent-push-pos aft-guard))))
 686              ;; "1.1000"   4= vn gd
 687              (4 (if is-where
 688                     (haskell-indent-push-pos guard)
 689                   (haskell-indent-push-pos valname)
 690                   (if last-line
 691                       (haskell-indent-push-pos-offset guard 2))))
 692              ;; "1.0011"   5= vn rh arh
 693              (5 (if is-where
 694                     (haskell-indent-push-pos-offset valname)
 695                   (haskell-indent-push-pos valname)
 696                   (if diff-first
 697                       (haskell-indent-push-pos aft-rhs-sign))))
 698              ;; "1.0010"   6= vn rh
 699              (6 (if is-where
 700                     (haskell-indent-push-pos-offset valname)
 701                   (haskell-indent-push-pos valname)
 702                   (if last-line
 703                       (haskell-indent-push-pos-offset valname))))
 704              ;; "110000"   7= vn avn
 705              (7 (if is-where
 706                     (haskell-indent-push-pos-offset valname)
 707                   (haskell-indent-push-pos valname)
 708                   (if last-line
 709                       (haskell-indent-push-pos aft-valname))))
 710              ;; "100000"   8= vn
 711              (8 (if is-where
 712                     (haskell-indent-push-pos-offset valname)
 713                   (haskell-indent-push-pos valname)))
 714              ;; "001.11"   9= gd rh arh
 715              (9 (if is-where
 716                     (haskell-indent-push-pos guard)
 717                   (haskell-indent-push-pos aft-rhs-sign)))
 718              ;; "001.10"  10= gd rh
 719              (10 (if is-where
 720                      (haskell-indent-push-pos guard)
 721                    (if last-line
 722                        (haskell-indent-push-pos-offset guard))))
 723              ;; "001100"  11= gd agd
 724              (11 (if is-where
 725                      (haskell-indent-push-pos guard)
 726                    (if (haskell-indent-no-otherwise guard)
 727                        (haskell-indent-push-pos aft-guard))))
 728              ;; "001000"  12= gd
 729              (12 (if last-line (haskell-indent-push-pos-offset guard 2)))
 730              ;; "000011"  13= rh arh
 731              (13 (haskell-indent-push-pos aft-rhs-sign))
 732              ;; "000010"  14= rh
 733              (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2)))
 734              ;; "000000"  15=
 735              (t (error "haskell-indent-ident: %s impossible case" test )))))
 736        haskell-indent-info)))
 737  
 738  (defun haskell-indent-other (start end end-visible indent-info)
 739    "Finds indentation points for a non-empty line starting with something other
 740  than an identifier, a guard or rhs."
 741    (save-excursion
 742      (let* ((haskell-indent-info indent-info)
 743             (sep (haskell-indent-separate-valdef start end))
 744             (valname (pop sep))
 745             (valname-string (pop sep))
 746             (aft-valname (pop sep))
 747             (guard (pop sep))
 748             (aft-guard (pop sep))
 749             (rhs-sign (pop sep))
 750             (aft-rhs-sign (pop sep))
 751             (last-line (= end end-visible))
 752             (test (string
 753                    (if valname ?1 ?0)
 754                    (if (and aft-valname (< aft-valname end-visible)) ?1 ?0)
 755                    (if (and guard (< guard end-visible)) ?1 ?0)
 756                    (if (and aft-guard (< aft-guard end-visible)) ?1 ?0)
 757                    (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0)
 758                    (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0))))
 759        (if (and valname-string           ; special case for start keywords
 760                 (string-match haskell-indent-start-keywords-re valname-string))
 761            (haskell-indent-push-pos-offset valname)
 762          (case                           ; general case
 763           (haskell-indent-find-case test)
 764           ;; "1.1.11"   1= vn gd rh arh
 765           (1 (haskell-indent-push-pos aft-rhs-sign))
 766           ;; "1.1.10"   2= vn gd rh
 767           (2 (if last-line
 768                     (haskell-indent-push-pos-offset guard)
 769                 (haskell-indent-push-pos-offset rhs-sign 2)))
 770           ;; "1.1100"   3= vn gd agd
 771           (3 (haskell-indent-push-pos aft-guard))
 772           ;; "1.1000"   4= vn gd
 773           (4 (haskell-indent-push-pos-offset guard 2))
 774           ;; "1.0011"   5= vn rh arh
 775           (5 (haskell-indent-push-pos valname)
 776              (haskell-indent-push-pos aft-rhs-sign))
 777           ;; "1.0010"   6= vn rh
 778           (6 (if last-line
 779                  (haskell-indent-push-pos-offset valname)
 780                (haskell-indent-push-pos-offset rhs-sign 2)))
 781           ;; "110000"   7= vn avn
 782           (7 (haskell-indent-push-pos-offset aft-valname))
 783           ;; "100000"   8= vn
 784           (8 (haskell-indent-push-pos valname))
 785           ;; "001.11"   9= gd rh arh
 786           (9 (haskell-indent-push-pos aft-rhs-sign))
 787           ;; "001.10"  10= gd rh
 788           (10 (if last-line
 789                     (haskell-indent-push-pos-offset guard)
 790                 (haskell-indent-push-pos-offset rhs-sign 2)))
 791           ;; "001100"  11= gd agd
 792           (11 (if (haskell-indent-no-otherwise guard)
 793                     (haskell-indent-push-pos aft-guard)))
 794           ;; "001000"  12= gd
 795           (12 (if last-line (haskell-indent-push-pos-offset guard 2)))
 796           ;; "000011"  13= rh arh
 797           (13 (haskell-indent-push-pos aft-rhs-sign))
 798           ;; "000010"  14= rh
 799           (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2)))
 800           ;; "000000"  15=
 801           (t (error "haskell-indent-other: %s impossible case" test ))))
 802        haskell-indent-info)))
 803  
 804  (defun haskell-indent-valdef-indentation (start end end-visible curr-line-type
 805                                            indent-info)
 806    "Find indentation information for a value definition."
 807    (let ((haskell-indent-info indent-info))
 808      (if (< start end-visible)
 809          (case curr-line-type
 810            (empty (haskell-indent-empty start end end-visible indent-info))
 811            (ident (haskell-indent-ident start end end-visible indent-info))
 812            (guard (haskell-indent-guard start end end-visible indent-info))
 813            (rhs   (haskell-indent-rhs start end end-visible indent-info))
 814            (comment (error "Comment indent should never happen"))
 815            (other (haskell-indent-other start end end-visible indent-info)))
 816        haskell-indent-info)))
 817  
 818  (defun haskell-indent-line-indentation (line-start line-end end-visible
 819                                           curr-line-type indent-info)
 820    "Compute indentation info between LINE-START and END-VISIBLE.
 821  Separate a line of program into valdefs between offside keywords
 822  and find indentation info for each part."
 823    (save-excursion
 824      ;; point is (already) at line-start
 825      (assert (eq (point) line-start))
 826      (let ((haskell-indent-info indent-info)
 827            (start (or (haskell-indent-in-comment line-start line-end)
 828                       (haskell-indent-in-string line-start line-end))))
 829        (if start                         ; if comment at the end
 830            (setq line-end start))  ; end line before it
 831        ;; loop on all parts separated by off-side-keywords
 832        (while (and (re-search-forward haskell-indent-off-side-keywords-re
 833                                       line-end t)
 834                    (not (or (haskell-indent-in-comment line-start (point))
 835                             (haskell-indent-in-string line-start (point)))))
 836  	(let ((beg-match (match-beginning 0)) ; save beginning of match
 837  	      (end-match (match-end 0)))      ; save end of match
 838            ;; Do not try to find indentation points if off-side-keyword at
 839            ;; the start...
 840            (if (or (< line-start beg-match)
 841                    ;; Actually, if we're looking at a "let" inside a "do", we
 842                    ;; should add the corresponding indentation point.
 843                    (eq (char-after beg-match) ?l))
 844                (setq haskell-indent-info
 845                      (haskell-indent-valdef-indentation line-start beg-match
 846                                                         end-visible
 847                                                         curr-line-type
 848                                                         haskell-indent-info)))
 849            ;; ...but keep the start of the line if keyword alone on the line
 850            (if (= line-end end-match)
 851                (haskell-indent-push-pos beg-match))
 852            (setq line-start end-match)
 853            (goto-char line-start)))
 854        (haskell-indent-valdef-indentation line-start line-end end-visible
 855                                           curr-line-type haskell-indent-info))))
 856  
 857  
 858  (defun haskell-indent-layout-indent-info (start contour-line)
 859    (let ((haskell-indent-info nil)
 860          (curr-line-type (haskell-indent-type-at-point))
 861  	line-start line-end end-visible)
 862      (save-excursion
 863        (if (eq curr-line-type 'ident)
 864  	  (let				; guess the type of line
 865  	      ((sep
 866  		(haskell-indent-separate-valdef
 867  		 (point) (line-end-position))))
 868  	    ;; if the first ident is where or the start of a def
 869  	    ;; keep it in a global variable
 870  	    (setq haskell-indent-current-line-first-ident
 871  		  (if (string-match "where[ \t]*" (nth 1 sep))
 872  		      (nth 1 sep)
 873  		    (if (nth 5 sep)		; is there a rhs-sign
 874  			(if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef
 875  			    "::" (nth 1 sep))
 876  		      "")))))
 877        (while contour-line		; explore the contour points
 878  	(setq line-start (pop contour-line))
 879  	(goto-char line-start)
 880  	(setq line-end (line-end-position))
 881  	(setq end-visible		; visible until the column of the
 882  	      (if contour-line		; next contour point
 883  		  (save-excursion
 884  		    (move-to-column
 885  		     (haskell-indent-point-to-col (car contour-line)))
 886  		    (point))
 887  		line-end))
 888  	(unless (or (haskell-indent-open-structure start line-start)
 889  		    (haskell-indent-in-comment start line-start))
 890  	  (setq haskell-indent-info
 891  		(haskell-indent-line-indentation line-start line-end
 892  						 end-visible curr-line-type
 893  						 haskell-indent-info)))))
 894      haskell-indent-info))
 895  
 896  (defun haskell-indent-find-matching-start (regexp limit &optional pred start)
 897    (let ((open (haskell-indent-open-structure limit (point))))
 898      (if open (setq limit (1+ open))))
 899    (unless start (setq start (point)))
 900    (when (re-search-backward regexp limit t)
 901      (let ((nestedcase (match-end 1))
 902            (outer (or (haskell-indent-in-string limit (point))
 903                       (haskell-indent-in-comment limit (point))
 904                       (haskell-indent-open-structure limit (point))
 905                       (if (and pred (funcall pred start)) (point)))))
 906        (cond
 907         (outer
 908          (goto-char outer)
 909          (haskell-indent-find-matching-start regexp limit pred start))
 910         (nestedcase
 911          ;; Nested case.
 912          (and (haskell-indent-find-matching-start regexp limit pred)
 913               (haskell-indent-find-matching-start regexp limit pred start)))
 914         (t (point))))))
 915  
 916  (defun haskell-indent-filter-let-no-in (start)
 917    "Return non-nil if point is in front of a `let' that has no `in'.
 918  START is the position of the presumed `in'."
 919    ;; We're looking at either `in' or `let'.
 920    (when (looking-at "let")
 921      (ignore-errors
 922        (save-excursion
 923          (forward-word 1)
 924          (forward-comment (point-max))
 925          (if (looking-at "{")
 926              (progn
 927                (forward-sexp 1)
 928                (forward-comment (point-max))
 929                (< (point) start))
 930            ;; Use the layout rule to see whether this let is already closed
 931            ;; without an `in'.
 932            (let ((col (current-column)))
 933              (while (progn (forward-line 1) (haskell-indent-back-to-indentation)
 934                            (< (point) start))
 935                (when (< (current-column) col)
 936                  (setq col nil)
 937                  (goto-char start)))
 938              (null col)))))))
 939  
 940  (defun haskell-indent-comment (open start)
 941    "Compute indent info for comments and text inside comments.
 942  OPEN is the start position of the comment in which point is."
 943    ;; Ideally we'd want to guess whether it's commented out code or
 944    ;; whether it's text.  Instead, we'll assume it's text.
 945    (save-excursion
 946      (if (= open (point))
 947  	;; We're actually just in front of a comment: align with following
 948  	;; code or with comment on previous line.
 949          (let ((prev-line-info
 950                 (cond
 951                  ((eq (char-after) ?\{) nil) ;Align as if it were code.
 952                  ((and (forward-comment -1)
 953                        (> (line-beginning-position 3) open))
 954                   ;; We're after another comment and there's no empty line
 955                   ;; between us.
 956                   (list (list (haskell-indent-point-to-col (point)))))
 957                  (t nil))))              ;Else align as if it were code
 958            ;; Align with following code.
 959            (forward-comment (point-max))
 960            ;; There are several possible indentation points for this code-line,
 961            ;; but the only valid indentation point for the comment is the one
 962            ;; that the user will select for the code-line.  Obviously we can't
 963            ;; know that, so we just assume that the code-line is already at its
 964            ;; proper place.
 965            ;; Strictly speaking "assume it's at its proper place" would mean
 966            ;; we'd just use (current-column), but since this is using info from
 967            ;; lines further down and it's common to reindent line-by-line,
 968            ;; we'll align not with the current indentation, but with the
 969            ;; one that auto-indentation "will" select.
 970            (append
 971             prev-line-info
 972             (let ((indent-info (save-excursion
 973                                  (haskell-indent-indentation-info start)))
 974                   (col (current-column)))
 975               ;; Sort the indent-info so that the current indentation comes
 976               ;; out first.
 977               (setq indent-info
 978                     (sort indent-info
 979                           (lambda (x y)
 980                             (<= (abs (- col (car x))) (abs (- col (car y)))))))
 981               indent-info)))
 982  
 983        ;; We really are inside a comment.
 984        (if (looking-at "-}")
 985  	  (progn
 986  	    (forward-char 2)
 987  	    (forward-comment -1)
 988              (list (list (1+ (haskell-indent-point-to-col (point))))))
 989  	(let ((offset (if (looking-at "--?")
 990  			  (- (match-beginning 0) (match-end 0)))))
 991  	  (forward-line -1)		;Go to previous line.
 992  	  (haskell-indent-back-to-indentation)
 993  	  (if (< (point) start) (goto-char start))
 994  
 995            (list (list (if (looking-at comment-start-skip)
 996                            (if offset
 997                                (+ 2 offset (haskell-indent-point-to-col (point)))
 998                              (haskell-indent-point-to-col (match-end 0)))
 999                          (haskell-indent-point-to-col (point))))))))))
1000  
1001  (defun haskell-indent-closing-keyword (start)
1002    (let ((open (save-excursion
1003                  (haskell-indent-find-matching-start
1004                   (case (char-after)
1005                     (?i "\\<\\(?:\\(in\\)\\|let\\)\\>")
1006                     (?o "\\<\\(?:\\(of\\)\\|case\\)\\>")
1007                     (?t "\\<\\(?:\\(then\\)\\|if\\)\\>")
1008                     (?e "\\<\\(?:\\(else\\)\\|if\\)\\>"))
1009                   start
1010                   (if (eq (char-after) ?i)
1011                       ;; Filter out the `let's that have no `in'.
1012                       'haskell-indent-filter-let-no-in)))))
1013      ;; For a "hanging let/case/if at EOL" we should use a different
1014      ;; indentation scheme.
1015      (save-excursion
1016        (goto-char open)
1017        (if (haskell-indent-hanging-p)
1018            (setq open (haskell-indent-virtual-indentation start))))
1019      (list (list (haskell-indent-point-to-col open)))))
1020  
1021  (defcustom haskell-indent-after-keywords
1022    '(("where" 2 0)
1023      ("of" 2)
1024      ("do" 2)
1025      ("in" 2 0)
1026      ("{" 2)
1027      "if"
1028      "then"
1029      "else"
1030      "let")
1031    "Keywords after which indentation should be indented by some offset.
1032  Each keyword info can have the following forms:
1033  
1034     KEYWORD | (KEYWORD OFFSET [OFFSET-HANGING])
1035  
1036  If absent OFFSET-HANGING defaults to OFFSET.
1037  If absent OFFSET defaults to `haskell-indent-offset'.
1038  
1039  OFFSET-HANGING is the offset to use in the case where the keyword
1040  is at the end of an otherwise-non-empty line."
1041    :type '(repeat (choice string
1042                           (cons :tag "" (string :tag "keyword:")
1043                           (cons :tag "" (integer :tag "offset")
1044                           (choice (const nil)
1045                                   (list :tag ""
1046                                         (integer :tag "offset-pending"))))))))
1047  
1048  (defun haskell-indent-skip-lexeme-forward ()
1049    (and (zerop (skip-syntax-forward "w"))
1050         (skip-syntax-forward "_")
1051         (skip-syntax-forward "(")
1052         (skip-syntax-forward ")")))
1053  
1054  (defvar haskell-indent-inhibit-after-offset nil)
1055  
1056  (defun haskell-indent-offset-after-info ()
1057    "Return the info from `haskell-indent-after-keywords' for keyword at point."
1058    (let ((id (buffer-substring
1059               (point)
1060               (save-excursion
1061                 (haskell-indent-skip-lexeme-forward)
1062                 (point)))))
1063      (or (assoc id haskell-indent-after-keywords)
1064          (car (member id haskell-indent-after-keywords)))))
1065  
1066  (defcustom haskell-indent-dont-hang '("(")
1067    "Lexemes that should never be considered as hanging."
1068    :type '(repeat string))
1069  
1070  (defun haskell-indent-hanging-p ()
1071    ;; A Hanging keyword is one that's at the end of a line except it's not at
1072    ;; the beginning of a line.
1073    (not (or (= (current-column) (haskell-indent-current-indentation))
1074             (save-excursion
1075               (let ((lexeme
1076                      (buffer-substring
1077                       (point)
1078                       (progn (haskell-indent-skip-lexeme-forward) (point)))))
1079                 (or (member lexeme haskell-indent-dont-hang)
1080                     (> (line-end-position)
1081                        (progn (forward-comment (point-max)) (point)))))))))
1082  
1083  (defun haskell-indent-after-keyword-column (offset-info start &optional default)
1084    (unless offset-info
1085      (setq offset-info (haskell-indent-offset-after-info)))
1086    (unless default (setq default haskell-indent-offset))
1087    (setq offset-info
1088          (if haskell-indent-inhibit-after-offset '(0) (cdr-safe offset-info)))
1089    (if (not (haskell-indent-hanging-p))
1090        (+ (current-column) (or (car offset-info) default))
1091      ;; The keyword is hanging at the end of the line.
1092      (+ (haskell-indent-virtual-indentation start)
1093         (or (cadr offset-info) (car offset-info) default))))
1094  
1095  (defun haskell-indent-inside-paren (open)
1096    ;; there is an open structure to complete
1097    (if (looking-at "\\s)\\|[;,]")
1098        ;; A close-paren or a , or ; can only correspond syntactically to
1099        ;; the open-paren at `open'.  So there is no ambiguity.
1100        (progn
1101          (if (or (and (eq (char-after) ?\;) (eq (char-after open) ?\())
1102                  (and (eq (char-after) ?\,) (eq (char-after open) ?\{)))
1103              (message "Mismatched punctuation: `%c' in %c...%c"
1104                       (char-after) (char-after open)
1105                       (if (eq (char-after open) ?\() ?\) ?\})))
1106          (save-excursion
1107            (goto-char open)
1108            (list (list
1109                   (if (haskell-indent-hanging-p)
1110                       (haskell-indent-virtual-indentation nil)
1111                     (haskell-indent-point-to-col open))))))
1112      ;; There might still be layout within the open structure.
1113      (let* ((end (point))
1114             (basic-indent-info
1115               ;; Anything else than a ) is subject to layout.
1116               (if (looking-at "\\s.\\|\\$ ")
1117                   (haskell-indent-point-to-col open) ; align a punct with (
1118                 (let ((follow (save-excursion
1119                                 (goto-char (1+ open))
1120                                 (haskell-indent-skip-blanks-and-newlines-forward end)
1121                                 (point))))
1122                   (if (= follow end)
1123                       (save-excursion
1124                         (goto-char open)
1125                         (haskell-indent-after-keyword-column nil nil 1))
1126                     (haskell-indent-point-to-col follow)))))
1127             (open-column (haskell-indent-point-to-col open))
1128             (contour-line (haskell-indent-contour-line (1+ open) end)))
1129        (if (null contour-line)
1130            (list (list basic-indent-info))
1131          (let ((indent-info
1132                 (haskell-indent-layout-indent-info
1133                  (1+ open) contour-line)))
1134            ;; Fix up indent info.
1135            (let ((base-elem (assoc open-column indent-info)))
1136              (if base-elem
1137                  (progn (setcar base-elem basic-indent-info)
1138                         (setcdr base-elem nil))
1139                (setq indent-info
1140                      (append indent-info (list (list basic-indent-info)))))
1141              indent-info))))))
1142  
1143  (defun haskell-indent-virtual-indentation (start)
1144    "Compute the \"virtual indentation\" of text at point.
1145  The \"virtual indentation\" is the indentation that text at point would have
1146  had, if it had been placed on its own line."
1147    (let ((col (current-column))
1148          (haskell-indent-inhibit-after-offset (haskell-indent-hanging-p)))
1149      (if (save-excursion (skip-chars-backward " \t") (bolp))
1150          ;; If the text is indeed on its own line, than the virtual indent is
1151          ;; the current indentation.
1152          col
1153        ;; Else, compute the indentation that it would have had.
1154        (let ((info (haskell-indent-indentation-info start))
1155              (max -1))
1156          ;; `info' is a list of possible indent points.  Each indent point is
1157          ;; assumed to correspond to a different parse.  So we need to find
1158          ;; the parse that corresponds to the case at hand (where there's no
1159          ;; line break), which is assumed to always be the
1160          ;; deepest indentation.
1161          (dolist (x info)
1162            (setq x (car x))
1163            ;; Sometimes `info' includes the current indentation (or yet
1164            ;; deeper) by mistake, because haskell-indent-indentation-info
1165            ;; wasn't designed to be called on a piece of text that is not at
1166            ;; BOL.  So ignore points past `col'.
1167            (if (and (> x max) (not (>= x col)))
1168                (setq max x)))
1169          ;; In case all the indent points are past `col', just use `col'.
1170          (if (>= max 0) max col)))))
1171  
1172  (defun haskell-indent-indentation-info (&optional start)
1173    "Return a list of possible indentations for the current line.
1174  These are then used by `haskell-indent-cycle'.
1175  START if non-nil is a presumed start pos of the current definition."
1176    (unless start (setq start (haskell-indent-start-of-def)))
1177    (let (open contour-line)
1178      (cond
1179       ;; in string?
1180       ((setq open (haskell-indent-in-string start (point)))
1181        (list (list (+ (haskell-indent-point-to-col open)
1182                       (if (looking-at "\\\\") 0 1)))))
1183  
1184       ;; in comment ?
1185       ((setq open (haskell-indent-in-comment start (point)))
1186        (haskell-indent-comment open start))
1187  
1188       ;; Closing the declaration part of a `let' or the test exp part of a case.
1189       ((looking-at "\\(?:in\\|of\\|then\\|else\\)\\>")
1190        (haskell-indent-closing-keyword start))
1191  
1192       ;; Right after a special keyword.
1193       ((save-excursion
1194          (forward-comment (- (point-max)))
1195          (when (and (not (zerop (skip-syntax-backward "w")))
1196                     (setq open (haskell-indent-offset-after-info)))
1197            (list (list (haskell-indent-after-keyword-column open start))))))
1198  
1199       ;; open structure? ie  ( { [
1200       ((setq open (haskell-indent-open-structure start (point)))
1201        (haskell-indent-inside-paren open))
1202  
1203       ;; full indentation
1204       ((setq contour-line (haskell-indent-contour-line start (point)))
1205        (haskell-indent-layout-indent-info start contour-line))
1206  
1207       (t
1208        ;; simple contour just one indentation at start
1209        (list (list (if (and (eq haskell-literate 'bird)
1210                             (eq (haskell-indent-point-to-col start) 1))
1211                        ;; for a Bird style literate script put default offset
1212                        ;; in the case of no indentation
1213                        (1+ haskell-indent-literate-Bird-default-offset)
1214                      (haskell-indent-point-to-col start))))))))
1215  
1216  (defvar haskell-indent-last-info nil)
1217  
1218  
1219  (defun haskell-indent-cycle ()
1220    "Indentation cycle.
1221  We stay in the cycle as long as the TAB key is pressed."
1222    (interactive "*")
1223    (if (and haskell-literate
1224             (not (haskell-indent-within-literate-code)))
1225        ;; use the ordinary tab for text...
1226        (funcall (default-value 'indent-line-function))
1227      (let ((marker (if (> (current-column) (haskell-indent-current-indentation))
1228  		      (point-marker)))
1229  	  (bol (progn (beginning-of-line) (point))))
1230        (haskell-indent-back-to-indentation)
1231        (unless (and (eq last-command this-command)
1232  		   (eq bol (car haskell-indent-last-info)))
1233  	(save-excursion
1234  	  (setq haskell-indent-last-info
1235  		(list bol (haskell-indent-indentation-info) 0 0))))
1236  
1237        (let* ((il (nth 1 haskell-indent-last-info))
1238  	     (index (nth 2 haskell-indent-last-info))
1239  	     (last-insert-length (nth 3 haskell-indent-last-info))
1240  	     (indent-info (nth index il)))
1241  
1242  	(haskell-indent-line-to (car indent-info)) ; insert indentation
1243  	(delete-char last-insert-length)
1244  	(setq last-insert-length 0)
1245  	(let ((text (cdr indent-info)))
1246  	  (if text
1247  	      (progn
1248  		(insert text)
1249  		(setq last-insert-length (length text)))))
1250  
1251  	(setq haskell-indent-last-info
1252  	      (list bol il (% (1+ index) (length il)) last-insert-length))
1253  
1254  	(if (= (length il) 1)
1255  	    (message "Sole indentation")
1256  	  (message "Indent cycle (%d)..." (length il)))
1257  
1258  	(if marker
1259  	    (goto-char (marker-position marker)))))))
1260  
1261  ;;; alignment functions
1262  
1263  (defun haskell-indent-shift-columns (dest-column region-stack)
1264    "Shifts columns in region-stack to go to DEST-COLUMN.
1265  Elements of the stack are pairs of points giving the start and end
1266  of the regions to move."
1267    (let (reg col diffcol reg-end)
1268      (while (setq reg (pop region-stack))
1269        (setq reg-end (copy-marker (cdr reg)))
1270        (goto-char (car reg))
1271        (setq col (current-column))
1272        (setq diffcol (- dest-column col))
1273        (if (not (zerop diffcol))
1274            (catch 'end-of-buffer
1275              (while (<= (point) (marker-position reg-end))
1276                (if (< diffcol 0)
1277                    (backward-delete-char-untabify (- diffcol) nil)
1278                  (insert-char ?\  diffcol))
1279                (end-of-line 2)           ; should be (forward-line 1)
1280                (if (eobp)                ; but it adds line at the end...
1281                    (throw 'end-of-buffer nil))
1282                (move-to-column col)))))))
1283  
1284  (defun haskell-indent-align-def (p-arg type)
1285    "Align guards or rhs within the current definition before point.
1286  If P-ARG is t align all defs up to the mark.
1287  TYPE is either 'guard or 'rhs."
1288    (save-excursion
1289      (let (start-block end-block
1290            (maxcol (if (eq type 'rhs) haskell-indent-rhs-align-column 0))
1291            contour sep defname defnamepos
1292            defcol pos lastpos
1293            regstack eqns-start start-found)
1294        ;; find the starting and ending boundary points for alignment
1295        (if p-arg
1296            (if (mark)                    ; aligning everything in the region
1297              (progn
1298                (when (> (mark) (point)) (exchange-point-and-mark))
1299                (setq start-block
1300                      (save-excursion
1301                        (goto-char (mark))
1302                        (line-beginning-position)))
1303                (setq end-block
1304                    (progn (if (haskell-indent-bolp)
1305                               (haskell-indent-forward-line -1))
1306                           (line-end-position))))
1307              (error "The mark is not set for aligning definitions"))
1308          ;; aligning the current definition
1309          (setq start-block (haskell-indent-start-of-def))
1310          (setq end-block (line-end-position)))
1311        ;; find the start of the current valdef using the contour line
1312        ;; in reverse order because we need the nearest one from the end
1313        (setq contour
1314              (reverse (haskell-indent-contour-line start-block end-block)))
1315        (setq pos (car contour))          ; keep the start of the first contour
1316        ;; find the nearest start of a definition
1317        (while (and (not defname) contour)
1318          (goto-char (pop contour))
1319          (if (haskell-indent-open-structure start-block (point))
1320              nil
1321            (setq sep (haskell-indent-separate-valdef (point) end-block))
1322            (if (nth 5 sep)               ; is there a rhs?
1323                (progn (setq defnamepos (nth 0 sep))
1324                       (setq defname (nth 1 sep))))))
1325        ;; start building the region stack
1326        (if defnamepos
1327            (progn                        ; there is a valdef
1328              ;; find the start of each equation or guard
1329              (if p-arg      ; when indenting a region
1330                  ;; accept any start of id or pattern as def name
1331                  (setq defname "\\<\\|("))
1332              (setq defcol (haskell-indent-point-to-col defnamepos))
1333              (goto-char pos)
1334              (setq end-block (line-end-position))
1335              (catch 'top-of-buffer
1336                (while (and (not start-found)
1337                            (>= (point) start-block))
1338                  (if (<= (haskell-indent-current-indentation) defcol)
1339                      (progn
1340                        (move-to-column defcol)
1341                        (if (and (looking-at defname) ; start of equation
1342                                 (not (haskell-indent-open-structure start-block (point))))
1343                            (push (cons (point) 'eqn) eqns-start)
1344                          ;; found a less indented point not starting an equation
1345                          (setq start-found t)))
1346                    ;; more indented line
1347                    (haskell-indent-back-to-indentation)
1348                    (if (and (eq (haskell-indent-type-at-point) 'guard) ; start of a guard
1349                             (not (haskell-indent-open-structure start-block (point))))
1350                        (push (cons (point) 'gd) eqns-start)))
1351                  (if (bobp)
1352                      (throw 'top-of-buffer nil)
1353                    (haskell-indent-backward-to-indentation 1))))
1354              ;; remove the spurious guards before the first equation
1355              (while (and eqns-start (eq (cdar eqns-start) 'gd))
1356                (pop eqns-start))
1357              ;; go through each equation to find the region to indent
1358              (while eqns-start
1359                (let ((eqn (caar eqns-start)))
1360  		(setq lastpos (if (cdr eqns-start)
1361  				  (save-excursion
1362  				    (goto-char (caadr eqns-start))
1363  				    (haskell-indent-forward-line -1)
1364  				    (line-end-position))
1365  				end-block))
1366  		(setq sep (haskell-indent-separate-valdef eqn lastpos)))
1367                (if (eq type 'guard)
1368                    (setq pos (nth 3 sep))
1369                  ;; check if what follows a rhs sign is more indented or not
1370                  (let ((rhs (nth 5 sep))
1371                        (aft-rhs (nth 6 sep)))
1372                    (if (and rhs aft-rhs
1373                             (> (haskell-indent-point-to-col rhs)
1374                                (haskell-indent-point-to-col aft-rhs)))
1375                        (setq pos aft-rhs)
1376                      (setq pos rhs))))
1377                (if pos
1378                    (progn                ; update region stack
1379                      (push (cons pos (or lastpos pos)) regstack)
1380                      (setq maxcol        ; find the highest column number
1381                            (max maxcol
1382                                 (progn   ;find the previous non-empty column
1383                                   (goto-char pos)
1384                                   (skip-chars-backward
1385                                    " \t"
1386                                    (line-beginning-position))
1387                                   (if (haskell-indent-bolp)
1388                                       ;;if on an empty prefix
1389                                       (haskell-indent-point-to-col pos) ;keep original indent
1390                                     (1+ (haskell-indent-point-to-col (point)))))))))
1391                (pop eqns-start))
1392              ;; now shift according to the region stack
1393              (if regstack
1394                  (haskell-indent-shift-columns maxcol regstack)))))))
1395  
1396  (defun haskell-indent-align-guards-and-rhs (start end)
1397    "Align the guards and rhs of functions in the region which must be active."
1398    ;; The `start' and `end' args are dummys right now: they're just there so
1399    ;; we can use the "r" interactive spec which properly signals an error.
1400    (interactive "*r")
1401    (haskell-indent-align-def t 'guard)
1402    (haskell-indent-align-def t 'rhs))
1403  
1404  ;;;  insertion functions
1405  
1406  (defun haskell-indent-insert-equal ()
1407    "Insert an = sign and align the previous rhs of the current function."
1408    (interactive "*")
1409    (if (or (haskell-indent-bolp)
1410            (/= (preceding-char) ?\ ))
1411        (insert ?\ ))
1412    (insert "= ")
1413    (haskell-indent-align-def (haskell-indent-mark-active) 'rhs))
1414  
1415  (defun haskell-indent-insert-guard (&optional text)
1416    "Insert and align a guard sign (|) followed by optional TEXT.
1417  Alignment works only if all guards are to the south-east of their |."
1418    (interactive "*")
1419    (let ((pc (if (haskell-indent-bolp) ?\012
1420                  (preceding-char)))
1421          (pc1 (or (char-after (- (point) 2)) 0)))
1422      ;; check what guard to insert depending on the previous context
1423      (if (= pc ?\ )                      ; x = any char other than blank or |
1424          (if (/= pc1 ?\|)
1425              (insert "| ")               ; after " x"
1426            ())                           ; after " |"
1427        (if (= pc ?\|)
1428            (if (= pc1 ?\|)
1429                (insert " | ")            ; after "||"
1430              (insert " "))               ; after "x|"
1431          (insert " | ")))                ; general case
1432      (if text (insert text))
1433      (haskell-indent-align-def (haskell-indent-mark-active) 'guard)))
1434  
1435  (defun haskell-indent-insert-otherwise ()
1436    "Insert a guard sign (|) followed by 'otherwise' and align the
1437  previous guards of the current function."
1438    (interactive "*")
1439    (haskell-indent-insert-guard "otherwise")
1440    (haskell-indent-insert-equal))
1441  
1442  (defun haskell-indent-insert-where ()
1443    "Insert and a where keyword at point and indent the resulting
1444  line with an indentation cycle."
1445    (interactive "*")
1446    (insert "where ")
1447    (haskell-indent-cycle))
1448  
1449  
1450  ;;; haskell-indent-mode
1451  
1452  (defvar haskell-indent-mode nil
1453    "Indicates if the semi-intelligent Haskell indentation mode is in effect
1454  in the current buffer.")
1455  (make-variable-buffer-local 'haskell-indent-mode)
1456  
1457  (defun turn-on-haskell-indent ()
1458    "Turn on ``intelligent'' haskell indentation mode."
1459    (set (make-local-variable 'indent-line-function) 'haskell-indent-cycle)
1460    ;; Removed: remapping DEL seems a bit naughty --SDM
1461    ;; (local-set-key "\177"  'backward-delete-char-untabify)
1462    ;; The binding to TAB is already handled by indent-line-function.  --Stef
1463    ;; (local-set-key "\t"    'haskell-indent-cycle)
1464    (local-set-key [?\C-c ?\C-=] 'haskell-indent-insert-equal)
1465    (local-set-key [?\C-c ?\C-|] 'haskell-indent-insert-guard)
1466    (local-set-key [?\C-c ?\C-o] 'haskell-indent-insert-otherwise)
1467    (local-set-key [?\C-c ?\C-w] 'haskell-indent-insert-where)
1468    (local-set-key [?\C-c ?\C-.] 'haskell-indent-align-guards-and-rhs)
1469    (local-set-key [?\C-c ?\C->] 'haskell-indent-put-region-in-literate)
1470    (setq haskell-indent-mode t)
1471    (run-hooks 'haskell-indent-hook))
1472  
1473  (defun turn-off-haskell-indent ()
1474    "Turn off ``intelligent'' haskell indentation mode that deals with
1475  the layout rule of Haskell."
1476    (kill-local-variable 'indent-line-function)
1477    ;; (local-unset-key "\t")
1478    ;; (local-unset-key "\177")
1479    (local-unset-key [?\C-c ?\C-=])
1480    (local-unset-key [?\C-c ?\C-|])
1481    (local-unset-key [?\C-c ?\C-o])
1482    (local-unset-key [?\C-c ?\C-w])
1483    (local-unset-key [?\C-c ?\C-.])
1484    (local-unset-key [?\C-c ?\C->])
1485    (setq haskell-indent-mode nil))
1486  
1487  ;; Put this minor mode on the global minor-mode-alist.
1488  (or (assq 'haskell-indent-mode (default-value 'minor-mode-alist))
1489      (setq-default minor-mode-alist
1490                    (append (default-value 'minor-mode-alist)
1491                            '((haskell-indent-mode " Ind")))))
1492  
1493  ;;;###autoload
1494  (defun haskell-indent-mode (&optional arg)
1495    "``intelligent'' Haskell indentation mode that deals with
1496  the layout rule of Haskell.  \\[haskell-indent-cycle] starts the cycle
1497  which proposes new possibilities as long as the TAB key is pressed.
1498  Any other key or mouse click terminates the cycle and is interpreted
1499  except for RET which merely exits the cycle.
1500  Other special keys are:
1501      \\[haskell-indent-insert-equal]
1502        inserts an =
1503      \\[haskell-indent-insert-guard]
1504        inserts an |
1505      \\[haskell-indent-insert-otherwise]
1506        inserts an | otherwise =
1507  these functions also align the guards and rhs of the current definition
1508      \\[haskell-indent-insert-where]
1509        inserts a where keyword
1510      \\[haskell-indent-align-guards-and-rhs]
1511        aligns the guards and rhs of the region
1512      \\[haskell-indent-put-region-in-literate]
1513        makes the region a piece of literate code in a literate script
1514  
1515  Note: \\[indent-region] which applies \\[haskell-indent-cycle] for each line
1516  of the region also works but it stops and asks for any line having more
1517  than one possible indentation.
1518  Use TAB to cycle until the right indentation is found and then RET to go the
1519  next line to indent.
1520  
1521  Invokes `haskell-indent-hook' if not nil."
1522    (interactive "P")
1523    (setq haskell-indent-mode
1524          (if (null arg) (not haskell-indent-mode)
1525            (> (prefix-numeric-value arg) 0)))
1526    (if haskell-indent-mode
1527        (turn-on-haskell-indent)
1528      (turn-off-haskell-indent)))
1529  
1530  (provide 'haskell-indent)
1531  
1532  ;; arch-tag: e4e5e90a-12e2-4002-b5cb-7b2375710013
1533  ;;; haskell-indent.el ends here