Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

687 lines
28 KiB

5 years ago
  1. ;;; haskell-decl-scan.el --- Declaration scanning module for Haskell Mode -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc.
  3. ;; Copyright (C) 1997-1998 Graeme E Moss
  4. ;; Copyright (C) 2016 Chris Gregory
  5. ;; Author: 1997-1998 Graeme E Moss <gem@cs.york.ac.uk>
  6. ;; Maintainer: Stefan Monnier <monnier@gnu.org>
  7. ;; Keywords: declarations menu files Haskell
  8. ;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-decl-scan.el?rev=HEAD
  9. ;; This file is not part of GNU Emacs.
  10. ;; This file is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 3, or (at your option)
  13. ;; any later version.
  14. ;; This file is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  20. ;;; Commentary:
  21. ;; Purpose:
  22. ;;
  23. ;; Top-level declarations are scanned and placed in a menu. Supports
  24. ;; full Latin1 Haskell 1.4 as well as literate scripts.
  25. ;;
  26. ;;
  27. ;; Installation:
  28. ;;
  29. ;; To turn declaration scanning on for all Haskell buffers under the
  30. ;; Haskell mode of Moss&Thorn, add this to .emacs:
  31. ;;
  32. ;; (add-hook 'haskell-mode-hook 'haskell-decl-scan-mode)
  33. ;;
  34. ;; Otherwise, call `haskell-decl-scan-mode'.
  35. ;;
  36. ;;
  37. ;; Customisation:
  38. ;;
  39. ;; M-x customize-group haskell-decl-scan
  40. ;;
  41. ;;
  42. ;; History:
  43. ;;
  44. ;; If you have any problems or suggestions, after consulting the list
  45. ;; below, email gem@cs.york.ac.uk quoting the version of the library
  46. ;; you are using, the version of Emacs you are using, and a small
  47. ;; example of the problem or suggestion. Note that this library
  48. ;; requires a reasonably recent version of Emacs.
  49. ;;
  50. ;; Uses `imenu' under Emacs.
  51. ;;
  52. ;; Version 1.2:
  53. ;; Added support for LaTeX-style literate scripts.
  54. ;;
  55. ;; Version 1.1:
  56. ;; Use own syntax table. Fixed bug for very small buffers. Use
  57. ;; markers instead of pointers (markers move with the text).
  58. ;;
  59. ;; Version 1.0:
  60. ;; Brought over from Haskell mode v1.1.
  61. ;;
  62. ;;
  63. ;; Present Limitations/Future Work (contributions are most welcome!):
  64. ;;
  65. ;; . Declarations requiring information extending beyond starting line
  66. ;; don't get scanned properly, eg.
  67. ;; > class Eq a =>
  68. ;; > Test a
  69. ;;
  70. ;; . Comments placed in the midst of the first few lexemes of a
  71. ;; declaration will cause havoc, eg.
  72. ;; > infixWithComments :: Int -> Int -> Int
  73. ;; > x {-nastyComment-} `infixWithComments` y = x + y
  74. ;; but are not worth worrying about.
  75. ;;
  76. ;; . Would be nice to scan other top-level declarations such as
  77. ;; methods of a class, datatype field labels... any more?
  78. ;;
  79. ;; . Support for GreenCard?
  80. ;;
  81. ;; . Re-running (literate-)haskell-imenu should not cause the problems
  82. ;; that it does. The ability to turn off scanning would also be
  83. ;; useful. (Note that re-running (literate-)haskell-mode seems to
  84. ;; cause no problems.)
  85. ;; All functions/variables start with
  86. ;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'.
  87. ;; The imenu support is based on code taken from `hugs-mode',
  88. ;; thanks go to Chris Van Humbeeck.
  89. ;; Version.
  90. ;;; Code:
  91. (require 'cl-lib)
  92. (require 'haskell-mode)
  93. (require 'syntax)
  94. (require 'imenu)
  95. ;;;###autoload
  96. (defgroup haskell-decl-scan nil
  97. "Haskell declaration scanning (`imenu' support)."
  98. :link '(custom-manual "(haskell-mode)haskell-decl-scan-mode")
  99. :group 'haskell
  100. :prefix "haskell-decl-scan-")
  101. (defcustom haskell-decl-scan-bindings-as-variables nil
  102. "Whether to put top-level value bindings into a \"Variables\" category."
  103. :group 'haskell-decl-scan
  104. :type 'boolean)
  105. (defcustom haskell-decl-scan-add-to-menubar t
  106. "Whether to add a \"Declarations\" menu entry to menu bar."
  107. :group 'haskell-decl-scan
  108. :type 'boolean)
  109. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  110. ;; General declaration scanning functions.
  111. (defvar haskell-ds-start-keywords-re
  112. (concat "\\(\\<"
  113. "class\\|data\\|i\\(mport\\|n\\(fix\\(\\|[lr]\\)\\|stance\\)\\)\\|"
  114. "module\\|primitive\\|type\\|newtype"
  115. "\\)\\>")
  116. "Keywords that may start a declaration.")
  117. (defvar haskell-ds-syntax-table
  118. (let ((table (copy-syntax-table haskell-mode-syntax-table)))
  119. (modify-syntax-entry ?\' "w" table)
  120. (modify-syntax-entry ?_ "w" table)
  121. (modify-syntax-entry ?\\ "_" table)
  122. table)
  123. "Syntax table used for Haskell declaration scanning.")
  124. (defun haskell-ds-get-variable (prefix)
  125. "Return variable involved in value binding or type signature.
  126. Assumes point is looking at the regexp PREFIX followed by the
  127. start of a declaration (perhaps in the middle of a series of
  128. declarations concerning a single variable). Otherwise return nil.
  129. Point is not changed."
  130. ;; I think I can now handle all declarations bar those with comments
  131. ;; nested before the second lexeme.
  132. (save-excursion
  133. (with-syntax-table haskell-ds-syntax-table
  134. (if (looking-at prefix) (goto-char (match-end 0)))
  135. ;; Keyword.
  136. (if (looking-at haskell-ds-start-keywords-re)
  137. nil
  138. (or ;; Parenthesized symbolic variable.
  139. (and (looking-at "(\\(\\s_+\\))") (match-string-no-properties 1))
  140. ;; General case.
  141. (if (looking-at
  142. (if (eq ?\( (char-after))
  143. ;; Skip paranthesised expression.
  144. (progn
  145. (forward-sexp)
  146. ;; Repeating this code and avoiding moving point if
  147. ;; possible speeds things up.
  148. "\\(\\'\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)")
  149. "\\(\\sw+\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)"))
  150. (let ((match2 (match-string-no-properties 2)))
  151. ;; Weed out `::', `∷',`=' and `|' from potential infix
  152. ;; symbolic variable.
  153. (if (member match2 '("::" "" "=" "|"))
  154. ;; Variable identifier.
  155. (match-string-no-properties 1)
  156. (if (eq (aref match2 0) ?\`)
  157. ;; Infix variable identifier.
  158. (match-string-no-properties 3)
  159. ;; Infix symbolic variable.
  160. match2))))
  161. ;; Variable identifier.
  162. (and (looking-at "\\sw+") (match-string-no-properties 0)))))))
  163. (defun haskell-ds-move-to-start-regexp (inc regexp)
  164. "Move to beginning of line that succeeds/precedes (INC = 1/-1)
  165. current line that starts with REGEXP and is not in `font-lock-comment-face'."
  166. ;; Making this defsubst instead of defun appears to have little or
  167. ;; no effect on efficiency. It is probably not called enough to do
  168. ;; so.
  169. (while (and (= (forward-line inc) 0)
  170. (or (not (looking-at regexp))
  171. (eq (get-text-property (point) 'face)
  172. 'font-lock-comment-face)))))
  173. (defun haskell-ds-move-to-start-regexp-skipping-comments (inc regexp)
  174. "Like haskell-ds-move-to-start-regexp, but uses syntax-ppss to
  175. skip comments"
  176. (let (p)
  177. (cl-loop
  178. do (setq p (point))
  179. (haskell-ds-move-to-start-regexp inc regexp)
  180. while (and (nth 4 (syntax-ppss))
  181. (/= p (point))))))
  182. (defvar literate-haskell-ds-line-prefix "> ?"
  183. "Regexp matching start of a line of Bird-style literate code.
  184. Current value is \"> \" as we assume top-level declarations start
  185. at column 3. Must not contain the special \"^\" regexp as we may
  186. not use the regexp at the start of a regexp string. Note this is
  187. only for `imenu' support.")
  188. (defvar haskell-ds-start-decl-re "\\(\\sw\\|(\\)"
  189. "The regexp that starts a Haskell declaration.")
  190. (defvar literate-haskell-ds-start-decl-re
  191. (concat literate-haskell-ds-line-prefix haskell-ds-start-decl-re)
  192. "The regexp that starts a Bird-style literate Haskell declaration.")
  193. (defun haskell-ds-whitespace-p (char)
  194. "Test if CHAR is a whitespace character."
  195. ;; the nil is a bob/eob test
  196. (member char '(nil ?\t ?\n ?\ )))
  197. (defun haskell-ds-move-to-decl (direction bird-literate fix)
  198. "General function for moving to the start of a declaration,
  199. either forwards or backwards from point, with normal or with Bird-style
  200. literate scripts. If DIRECTION is t, then forward, else backward. If
  201. BIRD-LITERATE is t, then treat as Bird-style literate scripts, else
  202. normal scripts. Returns point if point is left at the start of a
  203. declaration, and nil otherwise, ie. because point is at the beginning
  204. or end of the buffer and no declaration starts there. If FIX is t,
  205. then point does not move if already at the start of a declaration."
  206. ;; As `haskell-ds-get-variable' cannot separate an infix variable
  207. ;; identifier out of a value binding with non-alphanumeric first
  208. ;; argument, this function will treat such value bindings as
  209. ;; separate from the declarations surrounding it.
  210. (let ( ;; The variable typed or bound in the current series of
  211. ;; declarations.
  212. name
  213. ;; The variable typed or bound in the new declaration.
  214. newname
  215. ;; Hack to solve hard problem for Bird-style literate scripts
  216. ;; that start with a declaration. We are in the abyss if
  217. ;; point is before start of this declaration.
  218. abyss
  219. (line-prefix (if bird-literate literate-haskell-ds-line-prefix ""))
  220. ;; The regexp to match for the start of a declaration.
  221. (start-decl-re (if bird-literate
  222. literate-haskell-ds-start-decl-re
  223. haskell-ds-start-decl-re))
  224. (increment (if direction 1 -1))
  225. (bound (if direction (point-max) (point-min))))
  226. ;; Change syntax table.
  227. (with-syntax-table haskell-ds-syntax-table
  228. ;; move to beginning of line that starts the "current
  229. ;; declaration" (dependent on DIRECTION and FIX), and then get
  230. ;; the variable typed or bound by this declaration, if any.
  231. (let ( ;; Where point was at call of function.
  232. (here (point))
  233. ;; Where the declaration on this line (if any) starts.
  234. (start (progn
  235. (beginning-of-line)
  236. ;; Checking the face to ensure a declaration starts
  237. ;; here seems to be the only addition to make this
  238. ;; module support LaTeX-style literate scripts.
  239. (if (and (looking-at start-decl-re)
  240. (not (elt (syntax-ppss) 4)))
  241. (match-beginning 1)))))
  242. (if (and start
  243. ;; This complicated boolean determines whether we
  244. ;; should include the declaration that starts on the
  245. ;; current line as the "current declaration" or not.
  246. (or (and (or (and direction (not fix))
  247. (and (not direction) fix))
  248. (>= here start))
  249. (and (or (and direction fix)
  250. (and (not direction) (not fix)))
  251. (> here start))))
  252. ;; If so, we are already at start of the current line, so
  253. ;; do nothing.
  254. ()
  255. ;; If point was before start of a declaration on the first
  256. ;; line of the buffer (possible for Bird-style literate
  257. ;; scripts) then we are in the abyss.
  258. (if (and start (bobp))
  259. (setq abyss t)
  260. ;; Otherwise we move to the start of the first declaration
  261. ;; on a line preceding the current one, skipping comments
  262. (haskell-ds-move-to-start-regexp-skipping-comments -1 start-decl-re))))
  263. ;; If we are in the abyss, position and return as appropriate.
  264. (if abyss
  265. (if (not direction)
  266. nil
  267. (re-search-forward (concat "\\=" line-prefix) nil t)
  268. (point))
  269. ;; Get the variable typed or bound by this declaration, if any.
  270. (setq name (haskell-ds-get-variable line-prefix))
  271. (if (not name)
  272. ;; If no such variable, stop at the start of this
  273. ;; declaration if moving backward, or move to the next
  274. ;; declaration if moving forward.
  275. (if direction
  276. (haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re))
  277. ;; If there is a variable, find the first
  278. ;; succeeding/preceding declaration that does not type or
  279. ;; bind it. Check for reaching start/end of buffer and
  280. ;; comments.
  281. (haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re)
  282. (while (and (/= (point) bound)
  283. (and (setq newname (haskell-ds-get-variable line-prefix))
  284. (string= name newname)))
  285. (setq name newname)
  286. (haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re))
  287. ;; If we are going backward, and have either reached a new
  288. ;; declaration or the beginning of a buffer that does not
  289. ;; start with a declaration, move forward to start of next
  290. ;; declaration (which must exist). Otherwise, we are done.
  291. (if (and (not direction)
  292. (or (and (looking-at start-decl-re)
  293. (not (string= name
  294. ;; Note we must not use
  295. ;; newname here as this may
  296. ;; not have been set if we
  297. ;; have reached the beginning
  298. ;; of the buffer.
  299. (haskell-ds-get-variable
  300. line-prefix))))
  301. (and (not (looking-at start-decl-re))
  302. (bobp))))
  303. (haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re)))
  304. ;; Store whether we are at the start of a declaration or not.
  305. ;; Used to calculate final result.
  306. (let ((at-start-decl (looking-at start-decl-re)))
  307. ;; If we are at the beginning of a line, move over
  308. ;; line-prefix, if present at point.
  309. (if (bolp)
  310. (re-search-forward (concat "\\=" line-prefix) (point-max) t))
  311. ;; Return point if at the start of a declaration and nil
  312. ;; otherwise.
  313. (if at-start-decl (point) nil))))))
  314. (defun haskell-ds-bird-p ()
  315. (and (boundp 'haskell-literate) (eq haskell-literate 'bird)))
  316. (defun haskell-ds-backward-decl ()
  317. "Move backward to the first character that starts a top-level declaration.
  318. A series of declarations concerning one variable is treated as one
  319. declaration by this function. So, if point is within a top-level
  320. declaration then move it to the start of that declaration. If point
  321. is already at the start of a top-level declaration, then move it to
  322. the start of the preceding declaration. Returns point if point is
  323. left at the start of a declaration, and nil otherwise, because
  324. point is at the beginning of the buffer and no declaration starts
  325. there."
  326. (interactive)
  327. (haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil))
  328. (defun haskell-ds-comment-p
  329. (&optional
  330. pt)
  331. "Test if the cursor is on whitespace or a comment.
  332. `PT' defaults to `(point)'"
  333. ;; ensure result is `t' or `nil' instead of just truthy
  334. (if (or
  335. ;; is cursor on whitespace
  336. (haskell-ds-whitespace-p (following-char))
  337. ;; http://emacs.stackexchange.com/questions/14269/how-to-detect-if-the-point-is-within-a-comment-area
  338. ;; is cursor at begging, inside, or end of comment
  339. (let ((fontfaces (get-text-property (or pt
  340. (point)) 'face)))
  341. (when (not (listp fontfaces))
  342. (setf fontfaces (list fontfaces)))
  343. (delq nil (mapcar
  344. #'(lambda (f)
  345. (member f '(font-lock-comment-face
  346. font-lock-doc-face
  347. font-lock-comment-delimiter-face)))
  348. fontfaces))))
  349. t
  350. nil))
  351. (defun haskell-ds-line-commented-p ()
  352. "Tests if all characters from `point' to `end-of-line' pass
  353. `haskell-ds-comment-p'"
  354. (let ((r t))
  355. (while (and r (not (eolp)))
  356. (if (not (haskell-ds-comment-p))
  357. (setq r nil))
  358. (forward-char))
  359. r))
  360. (defun haskell-ds-forward-decl ()
  361. "Move forward to the first character that starts a top-level
  362. declaration. As `haskell-ds-backward-decl' but forward."
  363. (interactive)
  364. (let ((p (point)) b e empty was-at-bob)
  365. ;; Go back to beginning of defun, then go to beginning of next
  366. (haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil)
  367. (setq b (point))
  368. (haskell-ds-move-to-decl t (haskell-ds-bird-p) nil)
  369. (setq e (point))
  370. ;; tests if line is empty
  371. (setq empty (and (<= (point) p)
  372. (not (eolp))))
  373. (setq was-at-bob (and (= (point-min) b)
  374. (= b p)
  375. (< p e)))
  376. ;; this conditional allows for when empty lines at end, first
  377. ;; `C-M-e' will go to end of defun, next will go to end of file.
  378. (when (or was-at-bob
  379. empty)
  380. (if (or (and was-at-bob
  381. (= ?\n
  382. (save-excursion
  383. (goto-char (point-min))
  384. (following-char))))
  385. empty)
  386. (haskell-ds-move-to-decl t (haskell-ds-bird-p) nil))
  387. ;; Then go back to end of current
  388. (forward-line -1)
  389. (while (and (haskell-ds-line-commented-p)
  390. ;; prevent infinite loop
  391. (not (bobp)))
  392. (forward-line -1))
  393. (forward-line 1)))
  394. (point))
  395. (defun haskell-ds-generic-find-next-decl (bird-literate)
  396. "Find the name, position and type of the declaration at or after point.
  397. Return ((NAME . (START-POSITION . NAME-POSITION)) . TYPE)
  398. if one exists and nil otherwise. The start-position is at the start
  399. of the declaration, and the name-position is at the start of the name
  400. of the declaration. The name is a string, the positions are buffer
  401. positions and the type is one of the symbols \"variable\", \"datatype\",
  402. \"class\", \"import\" and \"instance\"."
  403. (let ( ;; The name, type and name-position of the declaration to
  404. ;; return.
  405. name
  406. type
  407. name-pos
  408. ;; Buffer positions marking the start and end of the space
  409. ;; containing a declaration.
  410. start
  411. end)
  412. ;; Change to declaration scanning syntax.
  413. (with-syntax-table haskell-ds-syntax-table
  414. ;; Stop when we are at the end of the buffer or when a valid
  415. ;; declaration is grabbed.
  416. (while (not (or (eobp) name))
  417. ;; Move forward to next declaration at or after point.
  418. (haskell-ds-move-to-decl t bird-literate t)
  419. ;; Start and end of search space is currently just the starting
  420. ;; line of the declaration.
  421. (setq start (point)
  422. end (line-end-position))
  423. (cond
  424. ;; If the start of the top-level declaration does not begin
  425. ;; with a starting keyword, then (if legal) must be a type
  426. ;; signature or value binding, and the variable concerned is
  427. ;; grabbed.
  428. ((not (looking-at haskell-ds-start-keywords-re))
  429. (setq name (haskell-ds-get-variable ""))
  430. (if name
  431. (progn
  432. (setq type 'variable)
  433. (re-search-forward (regexp-quote name) end t)
  434. (setq name-pos (match-beginning 0)))))
  435. ;; User-defined datatype declaration.
  436. ((re-search-forward "\\=\\(data\\|newtype\\|type\\)\\>" end t)
  437. (re-search-forward "=>" end t)
  438. (if (looking-at "[ \t]*\\(\\sw+\\)")
  439. (progn
  440. (setq name (match-string-no-properties 1))
  441. (setq name-pos (match-beginning 1))
  442. (setq type 'datatype))))
  443. ;; Class declaration.
  444. ((re-search-forward "\\=class\\>" end t)
  445. (re-search-forward "=>" end t)
  446. (if (looking-at "[ \t]*\\(\\sw+\\)")
  447. (progn
  448. (setq name (match-string-no-properties 1))
  449. (setq name-pos (match-beginning 1))
  450. (setq type 'class))))
  451. ;; Import declaration.
  452. ((looking-at "import[ \t]+\\(?:safe[\t ]+\\)?\\(?:qualified[ \t]+\\)?\\(?:\"[^\"]*\"[\t ]+\\)?\\(\\(?:\\sw\\|.\\)+\\)")
  453. (setq name (match-string-no-properties 1))
  454. (setq name-pos (match-beginning 1))
  455. (setq type 'import))
  456. ;; Instance declaration.
  457. ((re-search-forward "\\=instance[ \t]+" end t)
  458. (re-search-forward "=>[ \t]+" end t)
  459. ;; The instance "title" starts just after the `instance' (and
  460. ;; any context) and finishes just before the _first_ `where'
  461. ;; if one exists. This solution is ugly, but I can't find a
  462. ;; nicer one---a simple regexp will pick up the last `where',
  463. ;; which may be rare but nevertheless...
  464. (setq name-pos (point))
  465. (setq name (buffer-substring-no-properties
  466. (point)
  467. (progn
  468. ;; Look for a `where'.
  469. (if (re-search-forward "\\<where\\>" end t)
  470. ;; Move back to just before the `where'.
  471. (progn
  472. (re-search-backward "\\s-where")
  473. (point))
  474. ;; No `where' so move to last non-whitespace
  475. ;; before `end'.
  476. (progn
  477. (goto-char end)
  478. (skip-chars-backward " \t")
  479. (point))))))
  480. ;; If we did not manage to extract a name, cancel this
  481. ;; declaration (eg. when line ends in "=> ").
  482. (if (string-match "^[ \t]*$" name) (setq name nil))
  483. (setq type 'instance)))
  484. ;; Move past start of current declaration.
  485. (goto-char end))
  486. ;; If we have a valid declaration then return it, otherwise return
  487. ;; nil.
  488. (if name
  489. (cons (cons name (cons (copy-marker start t) (copy-marker name-pos t)))
  490. type)
  491. nil))))
  492. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  493. ;; Declaration scanning via `imenu'.
  494. ;;;###autoload
  495. (defun haskell-ds-create-imenu-index ()
  496. "Function for finding `imenu' declarations in Haskell mode.
  497. Finds all declarations (classes, variables, imports, instances and
  498. datatypes) in a Haskell file for the `imenu' package."
  499. ;; Each list has elements of the form `(INDEX-NAME . INDEX-POSITION)'.
  500. ;; These lists are nested using `(INDEX-TITLE . INDEX-ALIST)'.
  501. (let* ((bird-literate (haskell-ds-bird-p))
  502. (index-alist '())
  503. (index-class-alist '()) ;; Classes
  504. (index-var-alist '()) ;; Variables
  505. (index-imp-alist '()) ;; Imports
  506. (index-inst-alist '()) ;; Instances
  507. (index-type-alist '()) ;; Datatypes
  508. ;; Variables for showing progress.
  509. (bufname (buffer-name))
  510. (divisor-of-progress (max 1 (/ (buffer-size) 100)))
  511. ;; The result we wish to return.
  512. result)
  513. (goto-char (point-min))
  514. ;; Loop forwards from the beginning of the buffer through the
  515. ;; starts of the top-level declarations.
  516. (while (< (point) (point-max))
  517. (message "Scanning declarations in %s... (%3d%%)" bufname
  518. (/ (- (point) (point-min)) divisor-of-progress))
  519. ;; Grab the next declaration.
  520. (setq result (haskell-ds-generic-find-next-decl bird-literate))
  521. (if result
  522. ;; If valid, extract the components of the result.
  523. (let* ((name-posns (car result))
  524. (name (car name-posns))
  525. (posns (cdr name-posns))
  526. (start-pos (car posns))
  527. (type (cdr result)))
  528. ;; Place `(name . start-pos)' in the correct alist.
  529. (cl-case type
  530. (variable
  531. (setq index-var-alist
  532. (cl-acons name start-pos index-var-alist)))
  533. (datatype
  534. (setq index-type-alist
  535. (cl-acons name start-pos index-type-alist)))
  536. (class
  537. (setq index-class-alist
  538. (cl-acons name start-pos index-class-alist)))
  539. (import
  540. (setq index-imp-alist
  541. (cl-acons name start-pos index-imp-alist)))
  542. (instance
  543. (setq index-inst-alist
  544. (cl-acons name start-pos index-inst-alist)))))))
  545. ;; Now sort all the lists, label them, and place them in one list.
  546. (message "Sorting declarations in %s..." bufname)
  547. (when index-type-alist
  548. (push (cons "Datatypes"
  549. (sort index-type-alist 'haskell-ds-imenu-label-cmp))
  550. index-alist))
  551. (when index-inst-alist
  552. (push (cons "Instances"
  553. (sort index-inst-alist 'haskell-ds-imenu-label-cmp))
  554. index-alist))
  555. (when index-imp-alist
  556. (push (cons "Imports"
  557. (sort index-imp-alist 'haskell-ds-imenu-label-cmp))
  558. index-alist))
  559. (when index-class-alist
  560. (push (cons "Classes"
  561. (sort index-class-alist 'haskell-ds-imenu-label-cmp))
  562. index-alist))
  563. (when index-var-alist
  564. (if haskell-decl-scan-bindings-as-variables
  565. (push (cons "Variables"
  566. (sort index-var-alist 'haskell-ds-imenu-label-cmp))
  567. index-alist)
  568. (setq index-alist (append index-alist
  569. (sort index-var-alist 'haskell-ds-imenu-label-cmp)))))
  570. (message "Sorting declarations in %s...done" bufname)
  571. ;; Return the alist.
  572. index-alist))
  573. (defun haskell-ds-imenu-label-cmp (el1 el2)
  574. "Predicate to compare labels in lists from `haskell-ds-create-imenu-index'."
  575. (string< (car el1) (car el2)))
  576. (defun haskell-ds-imenu ()
  577. "Install `imenu' for Haskell scripts."
  578. (setq imenu-create-index-function 'haskell-ds-create-imenu-index)
  579. (when haskell-decl-scan-add-to-menubar
  580. (imenu-add-to-menubar "Declarations")))
  581. ;; The main functions to turn on declaration scanning.
  582. ;;;###autoload
  583. (defun turn-on-haskell-decl-scan ()
  584. "Unconditionally activate `haskell-decl-scan-mode'."
  585. (interactive)
  586. (haskell-decl-scan-mode))
  587. (make-obsolete 'turn-on-haskell-decl-scan
  588. 'haskell-decl-scan-mode
  589. "2015-07-23")
  590. ;;;###autoload
  591. (define-minor-mode haskell-decl-scan-mode
  592. "Toggle Haskell declaration scanning minor mode on or off.
  593. With a prefix argument ARG, enable minor mode if ARG is
  594. positive, and disable it otherwise. If called from Lisp, enable
  595. the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
  596. See also info node `(haskell-mode)haskell-decl-scan-mode' for
  597. more details about this minor mode.
  598. Top-level declarations are scanned and listed in the menu item
  599. \"Declarations\" (if enabled via option
  600. `haskell-decl-scan-add-to-menubar'). Selecting an item from this
  601. menu will take point to the start of the declaration.
  602. \\[beginning-of-defun] and \\[end-of-defun] move forward and backward to the start of a declaration.
  603. This may link with `haskell-doc-mode'.
  604. For non-literate and LaTeX-style literate scripts, we assume the
  605. common convention that top-level declarations start at the first
  606. column. For Bird-style literate scripts, we assume the common
  607. convention that top-level declarations start at the third column,
  608. ie. after \"> \".
  609. Anything in `font-lock-comment-face' is not considered for a
  610. declaration. Therefore, using Haskell font locking with comments
  611. coloured in `font-lock-comment-face' improves declaration scanning.
  612. Literate Haskell scripts are supported: If the value of
  613. `haskell-literate' (set automatically by `literate-haskell-mode')
  614. is `bird', a Bird-style literate script is assumed. If it is nil
  615. or `tex', a non-literate or LaTeX-style literate script is
  616. assumed, respectively.
  617. Invokes `haskell-decl-scan-mode-hook' on activation."
  618. :group 'haskell-decl-scan
  619. (kill-local-variable 'beginning-of-defun-function)
  620. (kill-local-variable 'end-of-defun-function)
  621. (kill-local-variable 'imenu-create-index-function)
  622. (unless haskell-decl-scan-mode
  623. ;; How can we cleanly remove the "Declarations" menu?
  624. (when haskell-decl-scan-add-to-menubar
  625. (local-set-key [menu-bar index] nil)))
  626. (when haskell-decl-scan-mode
  627. (setq-local beginning-of-defun-function 'haskell-ds-backward-decl)
  628. (setq-local end-of-defun-function 'haskell-ds-forward-decl)
  629. (haskell-ds-imenu)))
  630. ;; Provide ourselves:
  631. (provide 'haskell-decl-scan)
  632. ;;; haskell-decl-scan.el ends here