cgit.sxemacs.org Git - packages/blob - xemacs-packages/haskell-mode/haskell-indent.el

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