Klimi's new dotfiles with stow.
Вы не можете выбрать более 25 тем Темы должны начинаться с буквы или цифры, могут содержать дефисы(-) и должны содержать не более 35 символов.

1596 строки
68 KiB

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