Emacs config utilizing prelude as a base
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.

5585 lines
186 KiB

  1. ;; erlang.el --- Major modes for editing and running Erlang
  2. ;; %CopyrightBegin%
  3. ;;
  4. ;; Copyright Ericsson AB 1996-2011. All Rights Reserved.
  5. ;;
  6. ;; The contents of this file are subject to the Erlang Public License,
  7. ;; Version 1.1, (the "License"); you may not use this file except in
  8. ;; compliance with the License. You should have received a copy of the
  9. ;; Erlang Public License along with this software. If not, it can be
  10. ;; retrieved online at http://www.erlang.org/.
  11. ;;
  12. ;; Software distributed under the License is distributed on an "AS IS"
  13. ;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  14. ;; the License for the specific language governing rights and limitations
  15. ;; under the License.
  16. ;;
  17. ;; %CopyrightEnd%
  18. ;;
  19. ;; Copyright (C) 2004 Free Software Foundation, Inc.
  20. ;; Author: Anders Lindgren
  21. ;; Keywords: erlang, languages, processes
  22. ;; Lars Thors�n's modifications of 2000-06-07 included.
  23. ;; The original version of this package was written by Robert Virding.
  24. ;;
  25. ;;; Commentary:
  26. ;; Introduction:
  27. ;; ------------
  28. ;;
  29. ;; This package provides support for the programming language Erlang.
  30. ;; The package provides an editing mode with lots of bells and
  31. ;; whistles, compilation support, and it makes it possible for the
  32. ;; user to start Erlang shells that run inside Emacs.
  33. ;;
  34. ;; See the Erlang distribution for full documentation of this package.
  35. ;; Installation:
  36. ;; ------------
  37. ;;
  38. ;; Place this file in Emacs load path, byte-compile it, and add the
  39. ;; following line to the appropriate init file:
  40. ;;
  41. ;; (require 'erlang-start)
  42. ;;
  43. ;; The full documentation contains much more extensive description of
  44. ;; the installation procedure.
  45. ;; Reporting Bugs:
  46. ;; --------------
  47. ;;
  48. ;; Please send bug reports to the following email address:
  49. ;; erlang-bugs@erlang.org
  50. ;; or if you have a patch suggestion to:
  51. ;; erlang-patches@erlang.org
  52. ;; Please state as exactly as possible:
  53. ;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
  54. ;; and of any other relevant software.
  55. ;; - What the expected result was.
  56. ;; - What you did, preferably in a repeatable step-by-step form.
  57. ;; - A description of the unexpected result.
  58. ;; - Relevant pieces of Erlang code causing the problem.
  59. ;; - Personal Emacs customisations, if any.
  60. ;;
  61. ;; Should the Emacs generate an error, please set the Emacs variable
  62. ;; `debug-on-error' to `t'. Repeat the error and enclose the debug
  63. ;; information in your bug-report.
  64. ;;
  65. ;; To set the variable you can use the following command:
  66. ;; M-x set-variable RET debug-on-error RET t RET
  67. ;;; Code:
  68. ;; Variables:
  69. (defconst erlang-version "2.7"
  70. "The version number of Erlang mode.")
  71. (defvar erlang-root-dir nil
  72. "The directory where the Erlang system is installed.
  73. The name should not contain the trailing slash.
  74. Should this variable be nil, no manual pages will show up in the
  75. Erlang mode menu.")
  76. (eval-and-compile
  77. (defconst erlang-emacs-major-version
  78. (if (boundp 'emacs-major-version)
  79. emacs-major-version
  80. (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
  81. (erlang-string-to-int (substring emacs-version
  82. (match-beginning 1) (match-end 1))))
  83. "Major version number of Emacs."))
  84. (eval-and-compile
  85. (defconst erlang-emacs-minor-version
  86. (if (boundp 'emacs-minor-version)
  87. emacs-minor-version
  88. (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
  89. (erlang-string-to-int (substring emacs-version
  90. (match-beginning 2) (match-end 2))))
  91. "Minor version number of Emacs."))
  92. (defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version)
  93. "Non-nil when running under XEmacs or Lucid Emacs.")
  94. (defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil)
  95. "Common popup menu for all buffers in Erlang mode.
  96. This variable is destructively modified every time the Erlang menu
  97. is modified. The effect is that all changes take effect in all
  98. buffers in Erlang mode, just like under GNU Emacs.
  99. Never EVER set this variable!")
  100. (defvar erlang-menu-items '(erlang-menu-base-items
  101. erlang-menu-skel-items
  102. erlang-menu-shell-items
  103. erlang-menu-compile-items
  104. erlang-menu-man-items
  105. erlang-menu-personal-items
  106. erlang-menu-version-items)
  107. "*List of menu item list to combine to create Erlang mode menu.
  108. External programs which temporarily add menu items to the Erlang mode
  109. menu may use this variable. Please use the function `add-hook' to add
  110. items.
  111. Please call the function `erlang-menu-init' after every change to this
  112. variable.")
  113. (defvar erlang-menu-base-items
  114. '(("Indent"
  115. (("Indent Line" erlang-indent-command)
  116. ("Indent Region " erlang-indent-region
  117. (if erlang-xemacs-p (mark) mark-active))
  118. ("Indent Clause" erlang-indent-clause)
  119. ("Indent Function" erlang-indent-function)
  120. ("Indent Buffer" erlang-indent-current-buffer)))
  121. ("Edit"
  122. (("Fill Comment" erlang-fill-paragraph)
  123. ("Comment Region" comment-region
  124. (if erlang-xemacs-p (mark) mark-active))
  125. ("Uncomment Region" erlang-uncomment-region
  126. (if erlang-xemacs-p (mark) mark-active))
  127. nil
  128. ("Beginning of Function" erlang-beginning-of-function)
  129. ("End of Function" erlang-end-of-function)
  130. ("Mark Function" erlang-mark-function)
  131. nil
  132. ("Beginning of Clause" erlang-beginning-of-clause)
  133. ("End of Clause" erlang-end-of-clause)
  134. ("Mark Clause" erlang-mark-clause)
  135. nil
  136. ("New Clause" erlang-generate-new-clause)
  137. ("Clone Arguments" erlang-clone-arguments)
  138. nil
  139. ("Align Arrows" erlang-align-arrows)))
  140. ("Syntax Highlighting"
  141. (("Level 4" erlang-font-lock-level-4)
  142. ("Level 3" erlang-font-lock-level-3)
  143. ("Level 2" erlang-font-lock-level-2)
  144. ("Level 1" erlang-font-lock-level-1)
  145. ("Off" erlang-font-lock-level-0)))
  146. ("TAGS"
  147. (("Find Tag" find-tag)
  148. ("Find Next Tag" erlang-find-next-tag)
  149. ;("Find Regexp" find-tag-regexp)
  150. ("Complete Word" erlang-complete-tag)
  151. ("Tags Apropos" tags-apropos)
  152. ("Search Files" tags-search))))
  153. "Description of menu used in Erlang mode.
  154. This variable must be a list. The elements are either nil representing
  155. a horizontal line or a list with two or three elements. The first is
  156. the name of the menu item, the second is the function to call, or a
  157. submenu, on the same same form as ITEMS. The third optional argument
  158. is an expression which is evaluated every time the menu is displayed.
  159. Should the expression evaluate to nil the menu item is ghosted.
  160. Example:
  161. '((\"Func1\" function-one)
  162. (\"SubItem\"
  163. ((\"Yellow\" function-yellow)
  164. (\"Blue\" function-blue)))
  165. nil
  166. (\"Region Function\" spook-function midnight-variable))
  167. Call the function `erlang-menu-init' after modifying this variable.")
  168. (defvar erlang-menu-shell-items
  169. '(nil
  170. ("Shell"
  171. (("Start New Shell" erlang-shell)
  172. ("Display Shell" erlang-shell-display))))
  173. "Description of the Shell menu used by Erlang mode.
  174. Please see the documentation of `erlang-menu-base-items'.")
  175. (defvar erlang-menu-compile-items
  176. '(("Compile"
  177. (("Compile Buffer" erlang-compile)
  178. ("Display Result" erlang-compile-display)
  179. ("Next Error" erlang-next-error))))
  180. "Description of the Compile menu used by Erlang mode.
  181. Please see the documentation of `erlang-menu-base-items'.")
  182. (defvar erlang-menu-version-items
  183. '(nil
  184. ("Version" erlang-version))
  185. "Description of the version menu used in Erlang mode.")
  186. (defvar erlang-menu-personal-items nil
  187. "Description of personal menu items used in Erlang mode.
  188. Please see the variable `erlang-menu-base-items' for a description
  189. of the format.")
  190. (defvar erlang-menu-man-items nil
  191. "The menu containing man pages.
  192. The format of the menu should be compatible with `erlang-menu-base-items'.
  193. This variable is added to the list of Erlang menus stored in
  194. `erlang-menu-items'.")
  195. (defvar erlang-menu-skel-items '()
  196. "Description of the menu containing the skeleton entries.
  197. The menu is in the form described by the variable `erlang-menu-base-items'.")
  198. (defvar erlang-mode-hook nil
  199. "*Functions to run when Erlang mode is activated.
  200. This hook is used to change the behaviour of Erlang mode. It is
  201. normally used by the user to personalise the programming environment.
  202. When used in a site init file, it could be used to customise Erlang
  203. mode for all users on the system.
  204. The functions added to this hook are run every time Erlang mode is
  205. started. See also `erlang-load-hook', a hook which is run once,
  206. when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook'
  207. which is run every time a new inferior Erlang shell is started.
  208. To use a hook, create an Emacs lisp function to perform your actions
  209. and add the function to the hook by calling `add-hook'.
  210. The following example binds the key sequence C-c C-c to the command
  211. `erlang-compile' (normally bound to C-c C-k). The example also
  212. activates Font Lock mode to fontify the buffer and adds a menu
  213. containing all functions defined in the current buffer.
  214. To use the example, copy the following lines to your `~/.emacs' file:
  215. (add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
  216. (defun my-erlang-mode-hook ()
  217. (local-set-key \"\\C-c\\C-c\" 'erlang-compile)
  218. (if window-system
  219. (progn
  220. (setq font-lock-maximum-decoration t)
  221. (font-lock-mode 1)))
  222. (if (and window-system (fboundp 'imenu-add-to-menubar))
  223. (imenu-add-to-menubar \"Imenu\")))")
  224. (defvar erlang-load-hook nil
  225. "*Functions to run when Erlang mode is loaded.
  226. This hook is used to change the behaviour of Erlang mode. It is
  227. normally used by the user to personalise the programming environment.
  228. When used in a site init file, it could be used to customize Erlang
  229. mode for all users on the system.
  230. The difference between this hook and `erlang-mode-hook' and
  231. `erlang-shell-mode-hook' is that the functions in this hook
  232. is only called once, when the Erlang mode is loaded into Emacs
  233. the first time.
  234. Natural actions for the functions added to this hook are actions which
  235. only should be performed once, and actions which should be performed
  236. before starting Erlang mode. For example, a number of variables are
  237. used by Erlang mode before `erlang-mode-hook' is run.
  238. The following example sets the variable `erlang-root-dir' so that the
  239. manual pages can be retrieved (note that you must set the value of
  240. `erlang-root-dir' to match the location of Erlang on your system):
  241. (add-hook 'erlang-load-hook 'my-erlang-load-hook)
  242. (defun my-erlang-load-hook ()
  243. (setq erlang-root-dir \"/usr/local/erlang\"))")
  244. (defvar erlang-new-file-hook nil
  245. "Functions to run when a new Erlang source file is being edited.
  246. A useful function is `tempo-template-erlang-normal-header'.
  247. \(This function only exists when the `tempo' package is available.)")
  248. (defvar erlang-check-module-name 'ask
  249. "*Non-nil means check that module name and file name agrees when saving.
  250. If the value of this variable is the atom `ask', the user is
  251. prompted. If the value is t the source is silently changed.")
  252. (defvar erlang-electric-commands
  253. '(erlang-electric-comma
  254. erlang-electric-semicolon
  255. erlang-electric-gt)
  256. "*List of activated electric commands.
  257. The list should contain the electric commands which should be active.
  258. Currently, the available electric commands are:
  259. `erlang-electric-comma'
  260. `erlang-electric-semicolon'
  261. `erlang-electric-gt'
  262. `erlang-electric-newline'
  263. Should the variable be bound to t, all electric commands
  264. are activated.
  265. To deactivate all electric commands, set this variable to nil.")
  266. (defvar erlang-electric-newline-inhibit t
  267. "*Set to non-nil to inhibit newline after electric command.
  268. This is useful since a lot of people press return after executing an
  269. electric command.
  270. In order to work, the command must also be in the
  271. list `erlang-electric-newline-inhibit-list'.
  272. Note that commands in this list are required to set the variable
  273. `erlang-electric-newline-inhibit' to nil when the newline shouldn't be
  274. inhibited.")
  275. (defvar erlang-electric-newline-inhibit-list
  276. '(erlang-electric-semicolon
  277. erlang-electric-comma
  278. erlang-electric-gt)
  279. "*Commands which can inhibit the next newline.")
  280. (defvar erlang-electric-semicolon-insert-blank-lines nil
  281. "*Number of blank lines inserted before header, or nil.
  282. This variable controls the behaviour of `erlang-electric-semicolon'
  283. when a new function header is generated. When nil, no blank line is
  284. inserted between the current line and the new header. When bound to a
  285. number it represents the number of blank lines which should be
  286. inserted.")
  287. (defvar erlang-electric-semicolon-criteria
  288. '(erlang-next-lines-empty-p
  289. erlang-at-keyword-end-p
  290. erlang-at-end-of-function-p)
  291. "*List of functions controlling `erlang-electric-semicolon'.
  292. The functions in this list are called, in order, whenever a semicolon
  293. is typed. Each function in the list is called with no arguments,
  294. and should return one of the following values:
  295. nil -- no determination made, continue checking
  296. 'stop -- do not create prototype for next line
  297. (anything else) -- insert prototype, and stop checking
  298. If every function in the list is called with no determination made,
  299. then no prototype is inserted.
  300. The test is performed by the function `erlang-test-criteria-list'.")
  301. (defvar erlang-electric-comma-criteria
  302. '(erlang-stop-when-inside-argument-list
  303. erlang-stop-when-at-guard
  304. erlang-next-lines-empty-p
  305. erlang-at-keyword-end-p
  306. erlang-at-end-of-clause-p
  307. erlang-at-end-of-function-p)
  308. "*List of functions controlling `erlang-electric-comma'.
  309. The functions in this list are called, in order, whenever a comma
  310. is typed. Each function in the list is called with no arguments,
  311. and should return one of the following values:
  312. nil -- no determination made, continue checking
  313. 'stop -- do not create prototype for next line
  314. (anything else) -- insert prototype, and stop checking
  315. If every function in the list is called with no determination made,
  316. then no prototype is inserted.
  317. The test is performed by the function `erlang-test-criteria-list'.")
  318. (defvar erlang-electric-arrow-criteria
  319. '(erlang-stop-when-in-type-spec
  320. erlang-next-lines-empty-p
  321. erlang-at-end-of-function-p)
  322. "*List of functions controlling the arrow aspect of `erlang-electric-gt'.
  323. The functions in this list are called, in order, whenever a `>'
  324. is typed. Each function in the list is called with no arguments,
  325. and should return one of the following values:
  326. nil -- no determination made, continue checking
  327. 'stop -- do not create prototype for next line
  328. (anything else) -- insert prototype, and stop checking
  329. If every function in the list is called with no determination made,
  330. then no prototype is inserted.
  331. The test is performed by the function `erlang-test-criteria-list'.")
  332. (defvar erlang-electric-newline-criteria
  333. '(t)
  334. "*List of functions controlling `erlang-electric-newline'.
  335. The electric newline commands indents the next line. Should the
  336. current line begin with a comment the comment start is copied to
  337. the newly created line.
  338. The functions in this list are called, in order, whenever a comma
  339. is typed. Each function in the list is called with no arguments,
  340. and should return one of the following values:
  341. nil -- no determination made, continue checking
  342. 'stop -- do not create prototype for next line
  343. (anything else) -- trigger the electric command.
  344. If every function in the list is called with no determination made,
  345. then no prototype is inserted. Should the atom t be a member of the
  346. list, it is treated as a function triggering the electric command.
  347. The test is performed by the function `erlang-test-criteria-list'.")
  348. (defvar erlang-next-lines-empty-threshold 2
  349. "*Number of blank lines required to activate an electric command.
  350. Actually, this value controls the behaviour of the function
  351. `erlang-next-lines-empty-p' which normally is a member of the
  352. criteria lists controlling the electric commands. (Please see
  353. the variables `erlang-electric-semicolon-criteria' and
  354. `erlang-electric-comma-criteria'.)
  355. The variable is bound to a threshold value, a number, representing the
  356. number of lines which must be empty.
  357. Setting this variable to zero, electric commands will always be
  358. triggered by `erlang-next-lines-empty-p', unless inhibited by other
  359. rules.
  360. Should this variable be nil, `erlang-next-lines-empty-p' will never
  361. trigger an electric command. The same effect would be reached if the
  362. function `erlang-next-lines-empty-p' would be removed from the criteria
  363. lists.
  364. Note that even if `erlang-next-lines-empty-p' should not trigger an
  365. electric command, other functions in the criteria list could.")
  366. (defvar erlang-new-clause-with-arguments nil
  367. "*Non-nil means that the arguments are cloned when a clause is generated.
  368. A new function header can be generated by calls to the function
  369. `erlang-generate-new-clause' and by use of the electric semicolon.")
  370. (defvar erlang-compile-use-outdir t
  371. "*When nil, go to the directory containing source file when compiling.
  372. This is a workaround for a bug in the `outdir' option of compile. If the
  373. outdir is not in the current load path, Erlang doesn't load the object
  374. module after it has been compiled.
  375. To activate the workaround, place the following in your `~/.emacs' file:
  376. (setq erlang-compile-use-outdir nil)")
  377. (defvar erlang-indent-level 4
  378. "*Indentation of Erlang calls/clauses within blocks.")
  379. (put 'erlang-indent-level 'safe-local-variable 'integerp)
  380. (defvar erlang-indent-guard 2
  381. "*Indentation of Erlang guards.")
  382. (put 'erlang-indent-guard 'safe-local-variable 'integerp)
  383. (defvar erlang-argument-indent 2
  384. "*Indentation of the first argument in a function call.
  385. When nil, indent to the column after the `(' of the
  386. function.")
  387. (put 'erlang-argument-indent 'safe-local-variable '(lambda (val) (or (null val) (integerp val))))
  388. (defvar erlang-tab-always-indent t
  389. "*Non-nil means TAB in Erlang mode should always re-indent the current line,
  390. regardless of where in the line point is when the TAB command is used.")
  391. (defvar erlang-error-regexp-alist
  392. '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
  393. "*Patterns for matching Erlang errors.")
  394. (defvar erlang-man-inhibit (eq system-type 'windows-nt)
  395. "Inhibit the creation of the Erlang Manual Pages menu.
  396. The Windows distribution of Erlang does not include man pages, hence
  397. there is no attempt to create the menu.")
  398. (defvar erlang-man-dirs
  399. '(("Man - Commands" "/man/man1" t)
  400. ("Man - Modules" "/man/man3" t)
  401. ("Man - Files" "/man/man4" t)
  402. ("Man - Applications" "/man/man6" t))
  403. "*The man directories displayed in the Erlang menu.
  404. Each item in the list should be a list with three elements, the first
  405. the name of the menu, the second the directory, and the last a flag.
  406. Should the flag the nil, the directory is absolute, should it be non-nil
  407. the directory is relative to the variable `erlang-root-dir'.")
  408. (defvar erlang-man-max-menu-size 35
  409. "*The maximum number of menu items in one menu allowed.")
  410. (defvar erlang-man-display-function 'erlang-man-display
  411. "*Function used to display man page.
  412. The function is called with one argument, the name of the file
  413. containing the man page. Use this variable when the default
  414. function, `erlang-man-display', does not work on your system.")
  415. (defvar erlang-compile-extra-opts '()
  416. "*Additional options to the compilation command.
  417. This is an elisp list of options. Each option can be either:
  418. - an atom
  419. - a dotted pair
  420. - a string
  421. Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))")
  422. (defvar erlang-compile-command-function-alist
  423. '((".erl\\'" . inferior-erlang-compute-erl-compile-command)
  424. (".xrl\\'" . inferior-erlang-compute-leex-compile-command)
  425. (".yrl\\'" . inferior-erlang-compute-yecc-compile-command)
  426. ("." . inferior-erlang-compute-erl-compile-command))
  427. "*Alist of filename patterns vs corresponding compilation functions.
  428. Each element looks like (REGEXP . FUNCTION). Compiling a file whose name
  429. matches REGEXP specifies FUNCTION to use to compute the compilation
  430. command. The FUNCTION will be called with two arguments: module name and
  431. default compilation options, like output directory. The FUNCTION
  432. is expected to return a string.")
  433. (defvar erlang-leex-compile-opts '()
  434. "*Options to pass to leex when compiling xrl files.
  435. This is an elisp list of options. Each option can be either:
  436. - an atom
  437. - a dotted pair
  438. - a string")
  439. (defvar erlang-yecc-compile-opts '()
  440. "*Options to pass to yecc when compiling yrl files.
  441. This is an elisp list of options. Each option can be either:
  442. - an atom
  443. - a dotted pair
  444. - a string")
  445. (eval-and-compile
  446. (defvar erlang-regexp-modern-p
  447. (if (> erlang-emacs-major-version 21) t nil)
  448. "Non-nil when this version of Emacs uses a modern version of regexp.
  449. Supporting \_< and \_> This is determined by checking the version of Emacs used."))
  450. (eval-and-compile
  451. (defconst erlang-atom-quoted-regexp
  452. "'\\(?:[^\\']\\|\\(?:\\\\.\\)\\)*'"
  453. "Regexp describing a single-quoted atom"))
  454. (eval-and-compile
  455. (defconst erlang-atom-regular-regexp
  456. (if erlang-regexp-modern-p
  457. "\\_<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\_>"
  458. "\\<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\>")
  459. "Regexp describing a regular (non-quoted) atom"))
  460. (eval-and-compile
  461. (defconst erlang-atom-regexp
  462. (concat "\\(" erlang-atom-quoted-regexp "\\|"
  463. erlang-atom-regular-regexp "\\)")
  464. "Regexp describing an Erlang atom."))
  465. (eval-and-compile
  466. (defconst erlang-atom-regexp-matches 1
  467. "Number of regexp parenthesis pairs in `erlang-atom-regexp'.
  468. This is used to determine parenthesis matches in complex regexps which
  469. contains `erlang-atom-regexp'."))
  470. (eval-and-compile
  471. (defconst erlang-variable-regexp
  472. (if erlang-regexp-modern-p
  473. "\\_<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\_>"
  474. "\\<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\>")
  475. "Regexp which should match an Erlang variable.
  476. The regexp must be surrounded with a pair of regexp parentheses."))
  477. (eval-and-compile
  478. (defconst erlang-variable-regexp-matches 1
  479. "Number of regexp parenthesis pairs in `erlang-variable-regexp'.
  480. This is used to determine matches in complex regexps which contains
  481. `erlang-variable-regexp'."))
  482. (eval-and-compile
  483. (defun erlang-regexp-opt (strings &optional paren)
  484. "Like `regexp-opt', except if PAREN is `symbols', then the
  485. resulting regexp is surrounded by \\_< and \\_>."
  486. (if (eq paren 'symbols)
  487. (if erlang-regexp-modern-p
  488. (concat "\\_<" (regexp-opt strings t) "\\_>")
  489. (concat "\\<" (regexp-opt strings t) "\\>"))
  490. (regexp-opt strings paren))))
  491. (eval-and-compile
  492. (defvar erlang-keywords
  493. '("after"
  494. "begin"
  495. "catch"
  496. "case"
  497. "cond"
  498. "end"
  499. "fun"
  500. "if"
  501. "let"
  502. "of"
  503. "query"
  504. "receive"
  505. "try"
  506. "when")
  507. "Erlang reserved keywords"))
  508. (eval-and-compile
  509. (defconst erlang-keywords-regexp (erlang-regexp-opt erlang-keywords 'symbols)))
  510. (eval-and-compile
  511. (defvar erlang-operators
  512. '("and"
  513. "andalso"
  514. "band"
  515. "bnot"
  516. "bor"
  517. "bsl"
  518. "bsr"
  519. "bxor"
  520. "div"
  521. "not"
  522. "or"
  523. "orelse"
  524. "rem"
  525. "xor")
  526. "Erlang operators"))
  527. ;; What about these?
  528. ;; '+' '-' '*' '/' '>', '>=', '<', '=<', '=:=', '==', '=/=', '/='
  529. (eval-and-compile
  530. (defconst erlang-operators-regexp (erlang-regexp-opt erlang-operators 'symbols)))
  531. (eval-and-compile
  532. (defvar erlang-guards
  533. '("is_atom"
  534. "is_binary"
  535. "is_bitstring"
  536. "is_boolean"
  537. "is_float"
  538. "is_function"
  539. "is_integer"
  540. "is_list"
  541. "is_number"
  542. "is_pid"
  543. "is_port"
  544. "is_record"
  545. "is_reference"
  546. "is_tuple"
  547. "atom"
  548. "binary"
  549. "bitstring"
  550. "boolean"
  551. ;;"float" ; Not included to avoid clashes with the bif float/1
  552. "function"
  553. "integer"
  554. "list"
  555. "number"
  556. "pid"
  557. "port"
  558. "record"
  559. "reference"
  560. "tuple")
  561. "Erlang guards"))
  562. (eval-and-compile
  563. (defconst erlang-guards-regexp (erlang-regexp-opt erlang-guards 'symbols)))
  564. (eval-and-compile
  565. (defvar erlang-predefined-types
  566. '("any"
  567. "arity"
  568. "boolean"
  569. "byte"
  570. "char"
  571. "cons"
  572. "deep_string"
  573. "iolist"
  574. "maybe_improper_list"
  575. "module"
  576. "mfa"
  577. "nil"
  578. "neg_integer"
  579. "none"
  580. "non_neg_integer"
  581. "nonempty_list"
  582. "nonempty_improper_list"
  583. "nonempty_maybe_improper_list"
  584. "no_return"
  585. "pos_integer"
  586. "string"
  587. "term"
  588. "timeout")
  589. "Erlang type specs types"))
  590. (eval-and-compile
  591. (defconst erlang-predefined-types-regexp
  592. (erlang-regexp-opt erlang-predefined-types 'symbols)))
  593. (eval-and-compile
  594. (defvar erlang-int-bifs
  595. '("abs"
  596. "adler32"
  597. "adler32_combine"
  598. "alive"
  599. "apply"
  600. "atom_to_binary"
  601. "atom_to_list"
  602. "binary_to_atom"
  603. "binary_to_existing_atom"
  604. "binary_to_list"
  605. "binary_to_term"
  606. "bit_size"
  607. "bitstring_to_list"
  608. "byte_size"
  609. "check_process_code"
  610. "contact_binary"
  611. "crc32"
  612. "crc32_combine"
  613. "date"
  614. "decode_packet"
  615. "delete_module"
  616. "disconnect_node"
  617. "element"
  618. "erase"
  619. "exit"
  620. "float"
  621. "float_to_list"
  622. "garbage_collect"
  623. "get"
  624. "get_keys"
  625. "group_leader"
  626. "halt"
  627. "hd"
  628. "integer_to_list"
  629. "internal_bif"
  630. "iolist_size"
  631. "iolist_to_binary"
  632. "is_alive"
  633. "is_atom"
  634. "is_binary"
  635. "is_bitstring"
  636. "is_boolean"
  637. "is_float"
  638. "is_function"
  639. "is_integer"
  640. "is_list"
  641. "is_number"
  642. "is_pid"
  643. "is_port"
  644. "is_process_alive"
  645. "is_record"
  646. "is_reference"
  647. "is_tuple"
  648. "length"
  649. "link"
  650. "list_to_atom"
  651. "list_to_binary"
  652. "list_to_bitstring"
  653. "list_to_existing_atom"
  654. "list_to_float"
  655. "list_to_integer"
  656. "list_to_pid"
  657. "list_to_tuple"
  658. "load_module"
  659. "make_ref"
  660. "module_loaded"
  661. "monitor_node"
  662. "node"
  663. "node_link"
  664. "node_unlink"
  665. "nodes"
  666. "notalive"
  667. "now"
  668. "open_port"
  669. "pid_to_list"
  670. "port_close"
  671. "port_command"
  672. "port_connect"
  673. "port_control"
  674. "pre_loaded"
  675. "process_flag"
  676. "process_info"
  677. "processes"
  678. "purge_module"
  679. "put"
  680. "register"
  681. "registered"
  682. "round"
  683. "self"
  684. "setelement"
  685. "size"
  686. "spawn"
  687. "spawn_link"
  688. "spawn_monitor"
  689. "spawn_opt"
  690. "split_binary"
  691. "statistics"
  692. "term_to_binary"
  693. "time"
  694. "throw"
  695. "tl"
  696. "trunc"
  697. "tuple_size"
  698. "tuple_to_list"
  699. "unlink"
  700. "unregister"
  701. "whereis")
  702. "Erlang built-in functions (BIFs)"))
  703. (eval-and-compile
  704. (defconst erlang-int-bif-regexp (erlang-regexp-opt erlang-int-bifs 'symbols)))
  705. (eval-and-compile
  706. (defvar erlang-ext-bifs
  707. '("append_element"
  708. "bump_reductions"
  709. "cancel_timer"
  710. "demonitor"
  711. "display"
  712. "fun_info"
  713. "fun_to_list"
  714. "function_exported"
  715. "get_cookie"
  716. "get_stacktrace"
  717. "hash"
  718. "integer_to_list"
  719. "is_builtin"
  720. "list_to_integer"
  721. "loaded"
  722. "localtime"
  723. "localtime_to_universaltime"
  724. "make_tuple"
  725. "max"
  726. "md5"
  727. "md5_final"
  728. "md5_init"
  729. "md5_update"
  730. "memory"
  731. "min"
  732. "monitor"
  733. "monitor_node"
  734. "phash"
  735. "phash2"
  736. "port_call"
  737. "port_info"
  738. "port_to_list"
  739. "ports"
  740. "process_display"
  741. "read_timer"
  742. "ref_to_list"
  743. "resume_process"
  744. "send"
  745. "send_after"
  746. "send_nosuspend"
  747. "set_cookie"
  748. "start_timer"
  749. "suspend_process"
  750. "system_flag"
  751. "system_info"
  752. "system_monitor"
  753. "system_profile"
  754. "trace"
  755. "trace_delivered"
  756. "trace_info"
  757. "trace_pattern"
  758. "universaltime"
  759. "universaltime_to_localtime"
  760. "yield")
  761. "Erlang built-in functions (BIFs) that needs erlang: prefix"))
  762. (eval-and-compile
  763. (defconst erlang-ext-bif-regexp
  764. (erlang-regexp-opt (append erlang-int-bifs erlang-ext-bifs) 'symbols)))
  765. (defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
  766. "Regexp which should match beginning of a clause.")
  767. (defvar erlang-file-name-extension-regexp "\\.[eh]rl$"
  768. "*Regexp which should match an Erlang file name.
  769. This regexp is used when an Erlang module name is extracted from the
  770. name of an Erlang source file.
  771. The regexp should only match the section of the file name which should
  772. be excluded from the module name.
  773. To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\".
  774. The matches all except the extension. This is useful if the Erlang
  775. tags system should interpret tags on the form `module:tag' for
  776. files written in other languages than Erlang.")
  777. (defvar erlang-inferior-shell-split-window t
  778. "*If non-nil, when starting an inferior shell, split windows.
  779. If nil, the inferior shell replaces the window. This is the traditional
  780. behaviour.")
  781. (defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist)
  782. "Non-nil means use `compilation-minor-mode' in Erlang shell.")
  783. (defvar erlang-mode-map
  784. (let ((map (make-sparse-keymap)))
  785. (unless (boundp 'indent-line-function)
  786. (define-key map "\t" 'erlang-indent-command))
  787. (define-key map ";" 'erlang-electric-semicolon)
  788. (define-key map "," 'erlang-electric-comma)
  789. (define-key map "<" 'erlang-electric-lt)
  790. (define-key map ">" 'erlang-electric-gt)
  791. (define-key map "\C-m" 'erlang-electric-newline)
  792. (if (not (boundp 'delete-key-deletes-forward))
  793. (define-key map "\177" 'backward-delete-char-untabify)
  794. (define-key map [(backspace)] 'backward-delete-char-untabify))
  795. ;;(unless (boundp 'fill-paragraph-function)
  796. (define-key map "\M-q" 'erlang-fill-paragraph)
  797. (unless (boundp 'beginning-of-defun-function)
  798. (define-key map "\M-\C-a" 'erlang-beginning-of-function)
  799. (define-key map "\M-\C-e" 'erlang-end-of-function)
  800. (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs
  801. (define-key map "\M-\t" 'erlang-complete-tag)
  802. (define-key map "\C-c\M-\t" 'tempo-complete-tag)
  803. (define-key map "\M-+" 'erlang-find-next-tag)
  804. (define-key map "\C-c\M-a" 'erlang-beginning-of-clause)
  805. (define-key map "\C-c\M-b" 'tempo-backward-mark)
  806. (define-key map "\C-c\M-e" 'erlang-end-of-clause)
  807. (define-key map "\C-c\M-f" 'tempo-forward-mark)
  808. (define-key map "\C-c\M-h" 'erlang-mark-clause)
  809. (define-key map "\C-c\C-c" 'comment-region)
  810. (define-key map "\C-c\C-j" 'erlang-generate-new-clause)
  811. (define-key map "\C-c\C-k" 'erlang-compile)
  812. (define-key map "\C-c\C-l" 'erlang-compile-display)
  813. (define-key map "\C-c\C-s" 'erlang-show-syntactic-information)
  814. (define-key map "\C-c\C-q" 'erlang-indent-function)
  815. (define-key map "\C-c\C-u" 'erlang-uncomment-region)
  816. (define-key map "\C-c\C-y" 'erlang-clone-arguments)
  817. (define-key map "\C-c\C-a" 'erlang-align-arrows)
  818. (define-key map "\C-c\C-z" 'erlang-shell-display)
  819. (unless inferior-erlang-use-cmm
  820. (define-key map "\C-x`" 'erlang-next-error))
  821. map)
  822. "*Keymap used in Erlang mode.")
  823. (defvar erlang-mode-abbrev-table nil
  824. "Abbrev table in use in Erlang-mode buffers.")
  825. (defvar erlang-mode-syntax-table nil
  826. "Syntax table in use in Erlang-mode buffers.")
  827. (defvar erlang-skel-file "erlang-skels"
  828. "The type of erlang-skeletons that should be used, default
  829. uses edoc type, for the old type, standard comments,
  830. set \"erlang-skels-old\" in your .emacs and restart.
  831. Or define your own and set the variable to that file.")
  832. ;; Tempo skeleton templates:
  833. (load erlang-skel-file)
  834. ;; Font-lock variables
  835. ;; The next few variables define different Erlang font-lock patterns.
  836. ;; They could be appended to form a custom font-lock appearance.
  837. ;;
  838. ;; The function `erlang-font-lock-set-face' could be used to change
  839. ;; the face of a pattern.
  840. ;;
  841. ;; Note that Erlang strings and atoms are highlighted with using
  842. ;; syntactic analysis.
  843. (defvar erlang-font-lock-keywords-function-header
  844. (list
  845. (list (concat "^" erlang-atom-regexp "\\s-*(")
  846. 1 'font-lock-function-name-face t))
  847. "Font lock keyword highlighting a function header.")
  848. (defvar erlang-font-lock-keywords-int-bifs
  849. (list
  850. (list (concat erlang-int-bif-regexp "\\s-*(")
  851. 1 'font-lock-builtin-face))
  852. "Font lock keyword highlighting built in functions.")
  853. (defvar erlang-font-lock-keywords-ext-bifs
  854. (list
  855. (list (concat "\\<\\(erlang\\)\\s-*:\\s-*" erlang-ext-bif-regexp "\\s-*(")
  856. '(1 'font-lock-builtin-face)
  857. '(2 'font-lock-builtin-face)))
  858. "Font lock keyword highlighting built in functions.")
  859. (defvar erlang-font-lock-keywords-int-function-calls
  860. (list
  861. (list (concat erlang-atom-regexp "\\s-*(")
  862. 1 'font-lock-type-face))
  863. "Font lock keyword highlighting an internal function call.")
  864. (defvar erlang-font-lock-keywords-ext-function-calls
  865. (list
  866. (list (concat erlang-atom-regexp "\\s-*:\\s-*"
  867. erlang-atom-regexp "\\s-*(")
  868. '(1 'font-lock-type-face)
  869. '(2 'font-lock-type-face)))
  870. "Font lock keyword highlighting an external function call.")
  871. (defvar erlang-font-lock-keywords-fun-n
  872. (list
  873. (list (concat "\\(" erlang-atom-regexp "/[0-9]+\\)")
  874. 1 'font-lock-type-face))
  875. "Font lock keyword highlighting a fun descriptor in F/N format.")
  876. (defvar erlang-font-lock-keywords-operators
  877. (list
  878. (list erlang-operators-regexp
  879. 1 'font-lock-builtin-face))
  880. "Font lock keyword highlighting Erlang operators.")
  881. (defvar erlang-font-lock-keywords-dollar
  882. (list
  883. (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)"
  884. 1 'font-lock-constant-face))
  885. "Font lock keyword highlighting numbers in ASCII form (e.g. $A).")
  886. (defvar erlang-font-lock-keywords-arrow
  887. (list
  888. (list "->\\(\\s \\|$\\)" 1 'font-lock-function-name-face))
  889. "Font lock keyword highlighting clause arrow.")
  890. (defvar erlang-font-lock-keywords-lc
  891. (list
  892. (list "\\(<-\\|<=\\|||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face))
  893. "Font lock keyword highlighting list comprehension operators.")
  894. (defvar erlang-font-lock-keywords-keywords
  895. (list
  896. (list erlang-keywords-regexp 1 'font-lock-keyword-face))
  897. "Font lock keyword highlighting Erlang keywords.")
  898. (defvar erlang-font-lock-keywords-attr
  899. (list
  900. (list (concat "^\\(-" erlang-atom-regexp "\\)\\(\\s-\\|\\.\\|(\\)")
  901. 1 (if (boundp 'font-lock-preprocessor-face)
  902. 'font-lock-preprocessor-face
  903. 'font-lock-constant-face)))
  904. "Font lock keyword highlighting attributes.")
  905. (defvar erlang-font-lock-keywords-quotes
  906. (list
  907. (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'"
  908. 1
  909. 'font-lock-keyword-face
  910. t))
  911. "Font lock keyword highlighting words in single quotes in comments.
  912. This is not the highlighting of Erlang strings and atoms, which
  913. are highlighted by syntactic analysis.")
  914. (defvar erlang-font-lock-keywords-guards
  915. (list
  916. (list (concat "[^:]" erlang-guards-regexp "\\s-*(")
  917. 1 'font-lock-builtin-face))
  918. "Font lock keyword highlighting guards.")
  919. (defvar erlang-font-lock-keywords-predefined-types
  920. (list
  921. (list (concat "[^:]" erlang-predefined-types-regexp "\\s-*(")
  922. 1 'font-lock-builtin-face))
  923. "Font lock keyword highlighting predefined types.")
  924. (defvar erlang-font-lock-keywords-macros
  925. (list
  926. (list (concat "?\\s-*\\(" erlang-atom-regexp
  927. "\\|" erlang-variable-regexp "\\)")
  928. 1 'font-lock-constant-face)
  929. (list (concat "^\\(-\\(?:define\\|ifn?def\\)\\)\\s-*(\\s-*\\(" erlang-atom-regexp
  930. "\\|" erlang-variable-regexp "\\)")
  931. (if (boundp 'font-lock-preprocessor-face)
  932. (list 1 'font-lock-preprocessor-face t)
  933. (list 1 'font-lock-constant-face t))
  934. (list 3 'font-lock-type-face t t))
  935. (list "^-e\\(lse\\|ndif\\)\\>" 0 'font-lock-preprocessor-face t))
  936. "Font lock keyword highlighting macros.
  937. This must be placed in front of `erlang-font-lock-keywords-vars'.")
  938. (defvar erlang-font-lock-keywords-records
  939. (list
  940. (list (concat "#\\s *" erlang-atom-regexp)
  941. 1 'font-lock-type-face)
  942. ;; Don't highlight numerical constants.
  943. (list (if erlang-regexp-modern-p
  944. "\\_<[0-9]+#\\([0-9a-zA-Z]+\\)"
  945. "\\<[0-9]+#\\([0-9a-zA-Z]+\\)")
  946. 1 nil t)
  947. (list (concat "^-record\\s-*(\\s-*" erlang-atom-regexp)
  948. 1 'font-lock-type-face))
  949. "Font lock keyword highlighting Erlang records.
  950. This must be placed in front of `erlang-font-lock-keywords-vars'.")
  951. (defvar erlang-font-lock-keywords-vars
  952. (list
  953. (list (concat "[^#]" erlang-variable-regexp) ; no numerical constants
  954. 1 'font-lock-variable-name-face))
  955. "Font lock keyword highlighting Erlang variables.
  956. Must be preceded by `erlang-font-lock-keywords-macros' to work properly.")
  957. (defvar erlang-font-lock-descr-string
  958. "Font-lock keywords used by Erlang Mode.
  959. There exists three levels of Font Lock keywords for Erlang:
  960. `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
  961. `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'.
  962. `erlang-font-lock-keywords-3' - Variables, macros and records.
  963. `erlang-font-lock-keywords-4' - Function names, Funs, LCs (not Atoms)
  964. To use a specific level, please set the variable
  965. `font-lock-maximum-decoration' to the appropriate level. Note that the
  966. variable must be set before Erlang mode is activated.
  967. Example:
  968. (setq font-lock-maximum-decoration 2)")
  969. (defvar erlang-font-lock-keywords-1
  970. (append erlang-font-lock-keywords-function-header
  971. erlang-font-lock-keywords-dollar
  972. erlang-font-lock-keywords-arrow
  973. erlang-font-lock-keywords-keywords
  974. )
  975. ;; DocStringOrig: erlang-font-lock-keywords
  976. erlang-font-lock-descr-string)
  977. (defvar erlang-font-lock-keywords-2
  978. (append erlang-font-lock-keywords-1
  979. erlang-font-lock-keywords-int-bifs
  980. erlang-font-lock-keywords-ext-bifs
  981. erlang-font-lock-keywords-attr
  982. erlang-font-lock-keywords-quotes
  983. erlang-font-lock-keywords-guards
  984. )
  985. ;; DocStringCopy: erlang-font-lock-keywords
  986. erlang-font-lock-descr-string)
  987. (defvar erlang-font-lock-keywords-3
  988. (append erlang-font-lock-keywords-2
  989. erlang-font-lock-keywords-operators
  990. erlang-font-lock-keywords-macros
  991. erlang-font-lock-keywords-records
  992. erlang-font-lock-keywords-vars
  993. erlang-font-lock-keywords-predefined-types
  994. )
  995. ;; DocStringCopy: erlang-font-lock-keywords
  996. erlang-font-lock-descr-string)
  997. (defvar erlang-font-lock-keywords-4
  998. (append erlang-font-lock-keywords-3
  999. erlang-font-lock-keywords-int-function-calls
  1000. erlang-font-lock-keywords-ext-function-calls
  1001. erlang-font-lock-keywords-fun-n
  1002. erlang-font-lock-keywords-lc
  1003. )
  1004. ;; DocStringCopy: erlang-font-lock-keywords
  1005. erlang-font-lock-descr-string)
  1006. (defvar erlang-font-lock-keywords erlang-font-lock-keywords-4
  1007. ;; DocStringCopy: erlang-font-lock-keywords
  1008. erlang-font-lock-descr-string)
  1009. (defvar erlang-font-lock-syntax-table nil
  1010. "Syntax table used by Font Lock mode.
  1011. The difference between this and the standard Erlang Mode
  1012. syntax table is that `_' is treated as part of words by
  1013. this syntax table.
  1014. Unfortunately, XEmacs hasn't got support for a special Font
  1015. Lock syntax table. The effect is that `apply' in the atom
  1016. `foo_apply' will be highlighted as a bif.")
  1017. ;;; Avoid errors while compiling this file.
  1018. ;; `eval-when-compile' is not defined in Emacs 18. We define it as a
  1019. ;; no-op.
  1020. (or (fboundp 'eval-when-compile)
  1021. (defmacro eval-when-compile (&rest rest) nil))
  1022. ;; These umm...functions are new in Emacs 20. And, yes, until version
  1023. ;; 19.27 Emacs backquotes were this ugly.
  1024. (or (fboundp 'unless)
  1025. (defmacro unless (condition &rest body)
  1026. "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil."
  1027. `((if (, condition) nil ,@body))))
  1028. (or (fboundp 'when)
  1029. (defmacro when (condition &rest body)
  1030. "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil."
  1031. `((if (, condition) (progn ,@body) nil))))
  1032. (or (fboundp 'char-before)
  1033. (defmacro char-before (&optional pos)
  1034. "Return the character in the current buffer just before POS."
  1035. `( (char-after (1- (or ,pos (point)))))))
  1036. ;; defvar some obsolete variables, which we still support for
  1037. ;; backwards compatibility reasons.
  1038. (eval-when-compile
  1039. (defvar comment-indent-hook)
  1040. (defvar dabbrev-case-fold-search)
  1041. (defvar tempo-match-finder)
  1042. (defvar compilation-menu-map)
  1043. (defvar next-error-last-buffer))
  1044. (eval-when-compile
  1045. (if (or (featurep 'bytecomp)
  1046. (featurep 'byte-compile))
  1047. (progn
  1048. (cond ((string-match "Lucid\\|XEmacs" emacs-version)
  1049. (put 'comment-indent-hook 'byte-obsolete-variable nil)
  1050. ;; Do not warn for unused variables
  1051. ;; when compiling under XEmacs.
  1052. (setq byte-compile-warnings
  1053. '(free-vars unresolved callargs redefine))))
  1054. (require 'comint)
  1055. (require 'tempo)
  1056. (require 'compile))))
  1057. (defun erlang-version ()
  1058. "Return the current version of Erlang mode."
  1059. (interactive)
  1060. (if (interactive-p)
  1061. (message "Erlang mode version %s, written by Anders Lindgren"
  1062. erlang-version))
  1063. erlang-version)
  1064. ;;;###autoload
  1065. (defun erlang-mode ()
  1066. "Major mode for editing Erlang source files in Emacs.
  1067. It knows about syntax and comment, it can indent code, it is capable
  1068. of fontifying the source file, the TAGS commands are aware of Erlang
  1069. modules, and the Erlang man pages can be accessed.
  1070. Should this module, \"erlang.el\", be installed properly, Erlang mode
  1071. is activated whenever an Erlang source or header file is loaded into
  1072. Emacs. To indicate this, the mode line should contain the word
  1073. \"Erlang\".
  1074. The main feature of Erlang mode is indentation, press TAB and the
  1075. current line will be indented correctly.
  1076. Comments starting with only one `%' are indented to the column stored
  1077. in the variable `comment-column'. Comments starting with two `%':s
  1078. are indented with the same indentation as code. Comments starting
  1079. with at least three `%':s are indented to the first column.
  1080. However, Erlang mode contains much more, this is a list of the most
  1081. useful commands:
  1082. TAB - Indent the line.
  1083. C-c C-q - Indent current function.
  1084. M-; - Create a comment at the end of the line.
  1085. M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
  1086. will look better.
  1087. M-a - Goto the beginning of an Erlang clause.
  1088. M-C-a - Ditto for function.
  1089. M-e - Goto the end of an Erlang clause.
  1090. M-C-e - Ditto for function.
  1091. M-h - Mark current Erlang clause.
  1092. M-C-h - Ditto for function.
  1093. C-c C-z - Start, or switch to, an inferior Erlang shell.
  1094. C-c C-k - Compile current file.
  1095. C-x ` - Next error.
  1096. , - Electric comma.
  1097. ; - Electric semicolon.
  1098. Erlang mode check the name of the file against the module name when
  1099. saving, whenever a mismatch occurs Erlang mode offers to modify the
  1100. source.
  1101. The variable `erlang-electric-commands' controls the electric
  1102. commands. To deactivate all of them, set it to nil.
  1103. There exists a large number of commands and variables in the Erlang
  1104. module. Please press `M-x apropos RET erlang RET' to see a complete
  1105. list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
  1106. RET'to see the full description of functions and variables,
  1107. respectively.
  1108. On entry to this mode the contents of the hook `erlang-mode-hook' is
  1109. executed.
  1110. Please see the beginning of the file `erlang.el' for more information
  1111. and examples of hooks.
  1112. Other commands:
  1113. \\{erlang-mode-map}"
  1114. (interactive)
  1115. (kill-all-local-variables)
  1116. (setq major-mode 'erlang-mode)
  1117. (setq mode-name "Erlang")
  1118. (erlang-syntax-table-init)
  1119. (use-local-map erlang-mode-map)
  1120. (erlang-electric-init)
  1121. (erlang-menu-init)
  1122. (erlang-mode-variables)
  1123. (erlang-check-module-name-init)
  1124. (erlang-add-compilation-alist erlang-error-regexp-alist)
  1125. (erlang-man-init)
  1126. (erlang-tags-init)
  1127. (erlang-font-lock-init)
  1128. (erlang-skel-init)
  1129. (tempo-use-tag-list 'erlang-tempo-tags)
  1130. (run-hooks 'erlang-mode-hook)
  1131. (if (zerop (buffer-size))
  1132. (run-hooks 'erlang-new-file-hook))
  1133. ;; Doesn't exist in Emacs v21.4; required by Emacs v23.
  1134. (if (boundp 'after-change-major-mode-hook)
  1135. (run-hooks 'after-change-major-mode-hook)))
  1136. (defun erlang-syntax-table-init ()
  1137. (if (null erlang-mode-syntax-table)
  1138. (let ((table (make-syntax-table)))
  1139. (modify-syntax-entry ?\n ">" table)
  1140. (modify-syntax-entry ?\" "\"" table)
  1141. (modify-syntax-entry ?# "." table)
  1142. ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards
  1143. ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems
  1144. (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $"
  1145. ;; we have to live with that for now..it is the best alternative
  1146. ;; that can be worked around with "string hat ends with \$"
  1147. (modify-syntax-entry ?% "<" table)
  1148. (modify-syntax-entry ?& "." table)
  1149. (modify-syntax-entry ?\' "\"" table)
  1150. (modify-syntax-entry ?* "." table)
  1151. (modify-syntax-entry ?+ "." table)
  1152. (modify-syntax-entry ?- "." table)
  1153. (modify-syntax-entry ?/ "." table)
  1154. (modify-syntax-entry ?: "." table)
  1155. (modify-syntax-entry ?< "." table)
  1156. (modify-syntax-entry ?= "." table)
  1157. (modify-syntax-entry ?> "." table)
  1158. (modify-syntax-entry ?\\ "\\" table)
  1159. (modify-syntax-entry ?_ "_" table)
  1160. (modify-syntax-entry ?| "." table)
  1161. (modify-syntax-entry ?^ "'" table)
  1162. ;; Pseudo bit-syntax: Latin1 double angle quotes as parens.
  1163. ;;(modify-syntax-entry ?\253 "(?\273" table)
  1164. ;;(modify-syntax-entry ?\273 ")?\253" table)
  1165. (setq erlang-mode-syntax-table table)))
  1166. (set-syntax-table erlang-mode-syntax-table))
  1167. (defun erlang-electric-init ()
  1168. ;; Set up electric character functions to work with
  1169. ;; delsel/pending-del mode. Also, set up text properties for bit
  1170. ;; syntax handling.
  1171. (mapc #'(lambda (cmd)
  1172. (put cmd 'delete-selection t) ;for delsel (Emacs)
  1173. (put cmd 'pending-delete t)) ;for pending-del (XEmacs)
  1174. '(erlang-electric-semicolon
  1175. erlang-electric-comma
  1176. erlang-electric-gt))
  1177. (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>))
  1178. (put 'bitsyntax-open-outer 'rear-nonsticky '(category))
  1179. (put 'bitsyntax-open-inner 'rear-nonsticky '(category))
  1180. (put 'bitsyntax-close-inner 'rear-nonsticky '(category))
  1181. (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<))
  1182. (put 'bitsyntax-close-outer 'rear-nonsticky '(category))
  1183. (make-local-variable 'parse-sexp-lookup-properties)
  1184. (setq parse-sexp-lookup-properties 't))
  1185. (defun erlang-mode-variables ()
  1186. (or erlang-mode-abbrev-table
  1187. (define-abbrev-table 'erlang-mode-abbrev-table ()))
  1188. (setq local-abbrev-table erlang-mode-abbrev-table)
  1189. (make-local-variable 'paragraph-start)
  1190. (setq paragraph-start (concat "^$\\|" page-delimiter))
  1191. (make-local-variable 'paragraph-separate)
  1192. (setq paragraph-separate paragraph-start)
  1193. (make-local-variable 'paragraph-ignore-fill-prefix)
  1194. (setq paragraph-ignore-fill-prefix t)
  1195. (make-local-variable 'require-final-newline)
  1196. (setq require-final-newline t)
  1197. (make-local-variable 'defun-prompt-regexp)
  1198. (setq defun-prompt-regexp erlang-defun-prompt-regexp)
  1199. (make-local-variable 'comment-start)
  1200. (setq comment-start "%")
  1201. (make-local-variable 'comment-start-skip)
  1202. (setq comment-start-skip "%+\\s *")
  1203. (make-local-variable 'comment-column)
  1204. (setq comment-column 48)
  1205. (make-local-variable 'indent-line-function)
  1206. (setq indent-line-function 'erlang-indent-command)
  1207. (make-local-variable 'indent-region-function)
  1208. (setq indent-region-function 'erlang-indent-region)
  1209. (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent)
  1210. (if (<= erlang-emacs-major-version 18)
  1211. (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent))
  1212. (set (make-local-variable 'parse-sexp-ignore-comments) t)
  1213. (set (make-local-variable 'dabbrev-case-fold-search) nil)
  1214. (set (make-local-variable 'imenu-prev-index-position-function)
  1215. 'erlang-beginning-of-function)
  1216. (set (make-local-variable 'imenu-extract-index-name-function)
  1217. 'erlang-get-function-name-and-arity)
  1218. (set (make-local-variable 'tempo-match-finder)
  1219. "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")
  1220. (set (make-local-variable 'beginning-of-defun-function)
  1221. 'erlang-beginning-of-function)
  1222. (set (make-local-variable 'end-of-defun-function) 'erlang-end-of-function)
  1223. (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
  1224. (set (make-local-variable 'fill-paragraph-function) 'erlang-fill-paragraph)
  1225. (set (make-local-variable 'comment-add) 1)
  1226. (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$")
  1227. (set (make-local-variable 'outline-level) (lambda () 1))
  1228. (set (make-local-variable 'add-log-current-defun-function)
  1229. 'erlang-current-defun))
  1230. ;; Compilation.
  1231. ;;
  1232. ;; The following code is compatible with the standard package `compilation',
  1233. ;; making it possible to go to errors using `erlang-next-error' (or just
  1234. ;; `next-error' in Emacs 21).
  1235. ;;
  1236. ;; The normal `compile' command works of course. For best result, please
  1237. ;; execute `make' with the `-w' flag.
  1238. ;;
  1239. ;; Please see the variables named `compiling-..' above.
  1240. (defun erlang-add-compilation-alist (alist)
  1241. (require 'compile)
  1242. (cond ((boundp 'compilation-error-regexp-alist) ; Emacs 19
  1243. (while alist
  1244. (or (assoc (car (car alist)) compilation-error-regexp-alist)
  1245. (setq compilation-error-regexp-alist
  1246. (cons (car alist) compilation-error-regexp-alist)))
  1247. (setq alist (cdr alist))))
  1248. ((boundp 'compilation-error-regexp)
  1249. ;; Emacs 18, Only one regexp is allowed.
  1250. (funcall (symbol-function 'set)
  1251. 'compilation-error-regexp (car (car alist))))))
  1252. (defun erlang-font-lock-init ()
  1253. "Initialize Font Lock for Erlang mode."
  1254. (or erlang-font-lock-syntax-table
  1255. (setq erlang-font-lock-syntax-table
  1256. (let ((table (copy-syntax-table erlang-mode-syntax-table)))
  1257. (modify-syntax-entry ?_ "w" table)
  1258. table)))
  1259. (set (make-local-variable 'font-lock-syntax-table)
  1260. erlang-font-lock-syntax-table)
  1261. (set (make-local-variable 'font-lock-beginning-of-syntax-function)
  1262. 'erlang-beginning-of-clause)
  1263. (make-local-variable 'font-lock-keywords)
  1264. (let ((level (cond ((boundp 'font-lock-maximum-decoration)
  1265. (symbol-value 'font-lock-maximum-decoration))
  1266. ((boundp 'font-lock-use-maximal-decoration)
  1267. (symbol-value 'font-lock-use-maximal-decoration))
  1268. (t nil))))
  1269. (if (consp level)
  1270. (setq level (cdr-safe (or (assq 'erlang-mode level)
  1271. (assq t level)))))
  1272. ;; `level' can here be:
  1273. ;; A number - The fontification level
  1274. ;; nil - Use the default
  1275. ;; t - Use maximum
  1276. (cond ((eq level nil)
  1277. (set 'font-lock-keywords erlang-font-lock-keywords))
  1278. ((eq level 1)
  1279. (set 'font-lock-keywords erlang-font-lock-keywords-1))
  1280. ((eq level 2)
  1281. (set 'font-lock-keywords erlang-font-lock-keywords-2))
  1282. ((eq level 3)
  1283. (set 'font-lock-keywords erlang-font-lock-keywords-3))
  1284. (t
  1285. (set 'font-lock-keywords erlang-font-lock-keywords-4))))
  1286. ;; Modern font-locks can handle the above much more elegantly:
  1287. (set (make-local-variable 'font-lock-defaults)
  1288. '((erlang-font-lock-keywords erlang-font-lock-keywords-1
  1289. erlang-font-lock-keywords-2
  1290. erlang-font-lock-keywords-3
  1291. erlang-font-lock-keywords-4)
  1292. nil nil ((?_ . "w")) erlang-beginning-of-clause
  1293. (font-lock-mark-block-function . erlang-mark-clause)
  1294. (font-lock-syntactic-keywords
  1295. ;; A dollar sign right before the double quote that ends a
  1296. ;; string is not a character escape.
  1297. ;;
  1298. ;; And a "string" has with a double quote not escaped by a
  1299. ;; dollar sign, any number of non-backslash non-newline
  1300. ;; characters or escaped backslashes, a dollar sign
  1301. ;; (otherwise we wouldn't care) and a double quote. This
  1302. ;; doesn't match multi-line strings, but this is probably
  1303. ;; the best we can get, since while font-locking we don't
  1304. ;; know whether matching started inside a string: limiting
  1305. ;; search to a single line keeps things sane.
  1306. . (("\\(?:^\\|[^$]\\)\"\\(?:[^\"\n]\\|\\\\\"\\)*\\(\\$\\)\"" 1 "w")
  1307. ;; And the dollar sign in $\" escapes two characters, not
  1308. ;; just one.
  1309. ("\\(\\$\\)\\\\\\\"" 1 "'"))))))
  1310. ;; Useful when defining your own keywords.
  1311. (defun erlang-font-lock-set-face (ks &rest faces)
  1312. "Replace the face components in a list of keywords.
  1313. The first argument, KS, is a list of keywords. The rest of the
  1314. arguments are expressions to replace the face information with. The
  1315. first expression replaces the face of the first keyword, the second
  1316. expression the second keyword etc.
  1317. Should an expression be nil, the face of the corresponding keyword is
  1318. not changed.
  1319. Should fewer expressions than keywords be given, the last expression
  1320. is used for all remaining keywords.
  1321. Normally, the expressions are just atoms representing the new face.
  1322. They could however be more complex, returning different faces in
  1323. different situations.
  1324. This function only handles keywords with elements on the forms:
  1325. (REGEXP NUMBER FACE)
  1326. (REGEXP NUMBER FACE OVERWRITE)
  1327. This could be used when defining your own special font-lock setup, e.g:
  1328. \(setq my-font-lock-keywords
  1329. (append erlang-font-lock-keywords-function-header
  1330. erlang-font-lock-keywords-dollar
  1331. (erlang-font-lock-set-face
  1332. erlang-font-lock-keywords-macros 'my-neon-green-face)
  1333. (erlang-font-lock-set-face
  1334. erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red)
  1335. erlang-font-lock-keywords-attr))
  1336. For a more elaborate example, please see the beginning of the file
  1337. `erlang.el'."
  1338. (let ((res '()))
  1339. (while ks
  1340. (let* ((regexp (car (car ks)))
  1341. (number (car (cdr (car ks))))
  1342. (new-face (if (and faces (car faces))
  1343. (car faces)
  1344. (car (cdr (cdr (car ks))))))
  1345. (overwrite (car (cdr (cdr (cdr (car ks))))))
  1346. (new-keyword (list regexp number new-face)))
  1347. (if overwrite (nconc new-keyword (list overwrite)))
  1348. (setq res (cons new-keyword res))
  1349. (setq ks (cdr ks))
  1350. (if (and faces (cdr faces))
  1351. (setq faces (cdr faces)))))
  1352. (nreverse res)))
  1353. (defun erlang-font-lock-level-0 ()
  1354. ;; DocStringOrig: font-cmd
  1355. "Unfontify current buffer."
  1356. (interactive)
  1357. (font-lock-mode 0))
  1358. (defun erlang-font-lock-level-1 ()
  1359. ;; DocStringCopy: font-cmd
  1360. "Fontify current buffer at level 1.
  1361. This highlights function headers, reserved keywords, strings and comments."
  1362. (interactive)
  1363. (require 'font-lock)
  1364. (set 'font-lock-keywords erlang-font-lock-keywords-1)
  1365. (font-lock-mode 1)
  1366. (funcall (symbol-function 'font-lock-fontify-buffer)))
  1367. (defun erlang-font-lock-level-2 ()
  1368. ;; DocStringCopy: font-cmd
  1369. "Fontify current buffer at level 2.
  1370. This highlights level 1 features (see `erlang-font-lock-level-1')
  1371. plus bifs, guards and `single quotes'."
  1372. (interactive)
  1373. (require 'font-lock)
  1374. (set 'font-lock-keywords erlang-font-lock-keywords-2)
  1375. (font-lock-mode 1)
  1376. (funcall (symbol-function 'font-lock-fontify-buffer)))
  1377. (defun erlang-font-lock-level-3 ()
  1378. ;; DocStringCopy: font-cmd
  1379. "Fontify current buffer at level 3.
  1380. This highlights level 2 features (see `erlang-font-lock-level-2')
  1381. plus variables, macros and records."
  1382. (interactive)
  1383. (require 'font-lock)
  1384. (set 'font-lock-keywords erlang-font-lock-keywords-3)
  1385. (font-lock-mode 1)
  1386. (funcall (symbol-function 'font-lock-fontify-buffer)))
  1387. (defun erlang-font-lock-level-4 ()
  1388. ;; DocStringCopy: font-cmd
  1389. "Fontify current buffer at level 4.
  1390. This highlights level 3 features (see `erlang-font-lock-level-2')
  1391. plus variables, macros and records."
  1392. (interactive)
  1393. (require 'font-lock)
  1394. (set 'font-lock-keywords erlang-font-lock-keywords-4)
  1395. (font-lock-mode 1)
  1396. (funcall (symbol-function 'font-lock-fontify-buffer)))
  1397. (defun erlang-menu-init ()
  1398. "Init menus for Erlang mode.
  1399. The variable `erlang-menu-items' contain a description of the Erlang
  1400. mode menu. Normally, the list contains atoms, representing variables
  1401. bound to pieces of the menu.
  1402. Personal extensions could be added to `erlang-menu-personal-items'.
  1403. This function should be called if any variable describing the
  1404. menu configuration is changed."
  1405. (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t))
  1406. (defun erlang-menu-install (name items keymap &optional popup)
  1407. "Install a menu in Emacs or XEmacs based on an abstract description.
  1408. NAME is the name of the menu.
  1409. ITEMS is a list. The elements are either nil representing a horizontal
  1410. line or a list with two or three elements. The first is the name of
  1411. the menu item, the second the function to call, or a submenu, on the
  1412. same same form as ITEMS. The third optional element is an expression
  1413. which is evaluated every time the menu is displayed. Should the
  1414. expression evaluate to nil the menu item is ghosted.
  1415. KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu
  1416. will only be visible when this menu is the global, the local, or an
  1417. activate minor mode keymap.)
  1418. If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu'
  1419. variable, i.e. it will popup when pressing the right mouse button.
  1420. Please see the variable `erlang-menu-base-items'."
  1421. (cond (erlang-xemacs-p
  1422. (let ((menu (erlang-menu-xemacs name items keymap)))
  1423. ;; We add the menu to the global menubar.
  1424. ;;(funcall (symbol-function 'set-buffer-menubar)
  1425. ;; (symbol-value 'current-menubar))
  1426. (funcall (symbol-function 'add-submenu) nil menu)
  1427. (setcdr erlang-xemacs-popup-menu (cdr menu))
  1428. (if (and popup (boundp 'mode-popup-menu))
  1429. (funcall (symbol-function 'set)
  1430. 'mode-popup-menu erlang-xemacs-popup-menu))))
  1431. ((>= erlang-emacs-major-version 19)
  1432. (define-key keymap (vector 'menu-bar (intern name))
  1433. (erlang-menu-make-keymap name items)))
  1434. (t nil)))
  1435. (defun erlang-menu-make-keymap (name items)
  1436. "Build a menu for Emacs 19."
  1437. (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
  1438. name))
  1439. (count 0)
  1440. id def first second third)
  1441. (setq items (reverse items))
  1442. (while items
  1443. ;; Replace any occurrence of atoms by their value.
  1444. (while (and items (atom (car items)) (not (null (car items))))
  1445. (if (and (boundp (car items))
  1446. (listp (symbol-value (car items))))
  1447. (setq items (append (reverse (symbol-value (car items)))
  1448. (cdr items)))
  1449. (setq items (cdr items))))
  1450. (setq first (car-safe (car items)))
  1451. (setq second (car-safe (cdr-safe (car items))))
  1452. (setq third (car-safe (cdr-safe (cdr-safe (car items)))))
  1453. (cond ((null first)
  1454. (setq count (+ count 1))
  1455. (setq id (intern (format "separator-%d" count)))
  1456. (setq def '("--" . nil)))
  1457. ((and (consp second) (eq (car second) 'lambda))
  1458. (setq count (+ count 1))
  1459. (setq id (intern (format "lambda-%d" count)))
  1460. (setq def (cons first second)))
  1461. ((symbolp second)
  1462. (setq id second)
  1463. (setq def (cons first second)))
  1464. (t
  1465. (setq count (+ count 1))
  1466. (setq id (intern (format "submenu-%d" count)))
  1467. (setq def (erlang-menu-make-keymap first second))))
  1468. (define-key menumap (vector id) def)
  1469. (if third
  1470. (put id 'menu-enable third))
  1471. (setq items (cdr items)))
  1472. (cons name menumap)))
  1473. (defun erlang-menu-xemacs (name items &optional keymap)
  1474. "Build a menu for XEmacs."
  1475. (let ((res '())
  1476. first second third entry)
  1477. (while items
  1478. ;; Replace any occurrence of atoms by their value.
  1479. (while (and items (atom (car items)) (not (null (car items))))
  1480. (if (and (boundp (car items))
  1481. (listp (symbol-value (car items))))
  1482. (setq items (append (reverse (symbol-value (car items)))
  1483. (cdr items)))
  1484. (setq items (cdr items))))
  1485. (setq first (car-safe (car items)))
  1486. (setq second (car-safe (cdr-safe (car items))))
  1487. (setq third (car-safe (cdr-safe (cdr-safe (car items)))))
  1488. (cond ((null first)
  1489. (setq res (cons "------" res)))
  1490. ((symbolp second)
  1491. (setq res (cons (vector first second (or third t)) res)))
  1492. ((and (consp second) (eq (car second) 'lambda))
  1493. (setq res (cons (vector first (list 'call-interactively second)
  1494. (or third t)) res)))
  1495. (t
  1496. (setq res (cons (cons first
  1497. (cdr (erlang-menu-xemacs
  1498. first second)))
  1499. res))))
  1500. (setq items (cdr items)))
  1501. (setq res (reverse res))
  1502. ;; When adding a menu to a minor-mode keymap under Emacs,
  1503. ;; it disappears when the mode is disabled. The expression
  1504. ;; generated below imitates this behaviour.
  1505. ;; (This could be expressed much clearer using backquotes,
  1506. ;; but I don't want to pull in every package.)
  1507. (if keymap
  1508. (let ((expr (list 'or
  1509. (list 'eq keymap 'global-map)
  1510. (list 'eq keymap (list 'current-local-map))
  1511. (list 'symbol-value
  1512. (list 'car-safe
  1513. (list 'rassq
  1514. keymap
  1515. 'minor-mode-map-alist))))))
  1516. (setq res (cons ':included (cons expr res)))))
  1517. (cons name res)))
  1518. (defun erlang-menu-substitute (items alist)
  1519. "Substitute functions in menu described by ITEMS.
  1520. The menu ITEMS is updated destructively.
  1521. ALIST is list of pairs where the car is the old function and cdr the new."
  1522. (let (first second pair)
  1523. (while items
  1524. (setq first (car-safe (car items)))
  1525. (setq second (car-safe (cdr-safe (car items))))
  1526. (cond ((null first))
  1527. ((symbolp second)
  1528. (setq pair (and second (assq second alist)))
  1529. (if pair
  1530. (setcar (cdr (car items)) (cdr pair))))
  1531. ((and (consp second) (eq (car second) 'lambda)))
  1532. (t
  1533. (erlang-menu-substitute second alist)))
  1534. (setq items (cdr items)))))
  1535. (defun erlang-menu-add-above (entry above items)
  1536. "Add menu ENTRY above menu entry ABOVE in menu ITEMS.
  1537. Do nothing if the items already should be in the menu.
  1538. Should ABOVE not be in the list, the entry is added at
  1539. the bottom of the menu.
  1540. The new menu is returned. No guarantee is given that the original
  1541. menu is left unchanged.
  1542. The equality test is performed by `eq'.
  1543. Example: (erlang-menu-add-above 'my-erlang-menu-items
  1544. 'erlang-menu-man-items)"
  1545. (erlang-menu-add-below entry above items t))
  1546. (defun erlang-menu-add-below (entry below items &optional above-p)
  1547. "Add menu ENTRY below menu items BELOW in the Erlang menu.
  1548. Do nothing if the items already should be in the menu.
  1549. Should BELOW not be in the list, items is added at the bottom
  1550. of the menu.
  1551. The new menu is returned. No guarantee is given that the original
  1552. menu is left unchanged.
  1553. The equality test is performed by `eq'.
  1554. Example:
  1555. \(setq erlang-menu-items
  1556. (erlang-menu-add-below 'my-erlang-menu-items
  1557. 'erlang-menu-base-items
  1558. erlang-menu-items))"
  1559. (if (memq entry items)
  1560. items ; Return the original menu.
  1561. (let ((head '())
  1562. (done nil)
  1563. res)
  1564. (while (not done)
  1565. (cond ((null items)
  1566. (setq res (append head (list entry)))
  1567. (setq done t))
  1568. ((eq below (car items))
  1569. (setq res
  1570. (if above-p
  1571. (append head (cons entry items))
  1572. (append head (cons (car items)
  1573. (cons entry (cdr items))))))
  1574. (setq done t))
  1575. (t
  1576. (setq head (append head (list (car items))))
  1577. (setq items (cdr items)))))
  1578. res)))
  1579. (defun erlang-menu-delete (entry items)
  1580. "Delete ENTRY from menu ITEMS.
  1581. The new menu is returned. No guarantee is given that the original
  1582. menu is left unchanged."
  1583. (delq entry items))
  1584. ;; Man code:
  1585. (defun erlang-man-init ()
  1586. "Add menus containing the manual pages of the Erlang.
  1587. The variable `erlang-man-dirs' contains entries describing
  1588. the location of the manual pages."
  1589. (interactive)
  1590. (if erlang-man-inhibit
  1591. ()
  1592. (setq erlang-menu-man-items
  1593. '(nil
  1594. ("Man - Function" erlang-man-function)))
  1595. (if erlang-man-dirs
  1596. (setq erlang-menu-man-items
  1597. (append erlang-menu-man-items
  1598. (erlang-man-make-top-menu erlang-man-dirs))))
  1599. (setq erlang-menu-items
  1600. (erlang-menu-add-above 'erlang-menu-man-items
  1601. 'erlang-menu-version-items
  1602. erlang-menu-items))
  1603. (erlang-menu-init)))
  1604. (defun erlang-man-uninstall ()
  1605. "Remove the man pages from the Erlang mode."
  1606. (interactive)
  1607. (setq erlang-menu-items
  1608. (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items))
  1609. (erlang-menu-init))
  1610. ;; The man menu is a hierarchal structure, with the manual sections
  1611. ;; at the top, described by `erlang-man-dirs'. The next level could
  1612. ;; either be the manual pages if not to many, otherwise it is an index
  1613. ;; menu whose submenus will contain up to `erlang-man-max-menu-size'
  1614. ;; manual pages.
  1615. (defun erlang-man-make-top-menu (dir-list)
  1616. "Create one menu entry per element of DIR-LIST.
  1617. The format is described in the documentation of `erlang-man-dirs'."
  1618. (let ((menu '())
  1619. dir)
  1620. (while dir-list
  1621. (setq dir (cond ((nth 2 (car dir-list))
  1622. ;; Relative to `erlang-root-dir'.
  1623. (and (stringp erlang-root-dir)
  1624. (concat erlang-root-dir (nth 1 (car dir-list)))))
  1625. (t
  1626. ;; Absolute
  1627. (nth 1 (car dir-list)))))
  1628. (if (and dir
  1629. (file-readable-p dir))
  1630. (setq menu (cons (list (car (car dir-list))
  1631. (erlang-man-make-middle-menu
  1632. (erlang-man-get-files dir)))
  1633. menu)))
  1634. (setq dir-list (cdr dir-list)))
  1635. ;; Should no menus be found, generate a menu item which
  1636. ;; will display a help text, when selected.
  1637. (if menu
  1638. (nreverse menu)
  1639. '(("Man Pages"
  1640. (("Error! Why?" erlang-man-describe-error)))))))
  1641. ;; Should the menu be to long, let's split it into a number of
  1642. ;; smaller menus. Warning, this code contains beautiful
  1643. ;; destructive operations!
  1644. (defun erlang-man-make-middle-menu (filelist)
  1645. "Create the second level menu from FILELIST.
  1646. Should the list be longer than `erlang-man-max-menu-size', a tree of
  1647. menus is created."
  1648. (if (<= (length filelist) erlang-man-max-menu-size)
  1649. (erlang-man-make-menu filelist)
  1650. (let ((menu '())
  1651. (filelist (copy-sequence filelist))
  1652. segment submenu pair)
  1653. (while filelist
  1654. (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist))
  1655. (setq segment filelist)
  1656. (if (null pair)
  1657. (setq filelist nil)
  1658. (setq filelist (cdr pair))
  1659. (setcdr pair nil))
  1660. (setq submenu (erlang-man-make-menu segment))
  1661. (setq menu (cons (list (concat (car (car submenu))
  1662. " -- "
  1663. (car (car (reverse submenu))))
  1664. submenu)
  1665. menu)))
  1666. (nreverse menu))))
  1667. (defun erlang-man-make-menu (filelist)
  1668. "Make a leaf menu based on FILELIST."
  1669. (let ((menu '())
  1670. item)
  1671. (while filelist
  1672. (setq item (erlang-man-make-menu-item (car filelist)))
  1673. (if item
  1674. (setq menu (cons item menu)))
  1675. (setq filelist (cdr filelist)))
  1676. (nreverse menu)))
  1677. (defun erlang-man-make-menu-item (file)
  1678. "Create a menu item containing the name of the man page."
  1679. (and (string-match ".+/\\([^/]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file)
  1680. (let ((page (substring file (match-beginning 1) (match-end 1))))
  1681. (list (capitalize page)
  1682. (list 'lambda '()
  1683. '(interactive)
  1684. (list 'funcall 'erlang-man-display-function
  1685. file))))))
  1686. (defun erlang-man-get-files (dir)
  1687. "Return files in directory DIR."
  1688. (directory-files dir t ".+\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?\\'"))
  1689. (defun erlang-man-module (&optional module)
  1690. "Find manual page for MODULE, defaults to module of function under point.
  1691. This function is aware of imported functions."
  1692. (interactive
  1693. (list (let* ((mod (car-safe (erlang-get-function-under-point)))
  1694. (input (read-string
  1695. (format "Manual entry for module%s: "
  1696. (if (or (null mod) (string= mod ""))
  1697. ""
  1698. (format " (default %s)" mod))))))
  1699. (if (string= input "")
  1700. mod
  1701. input))))
  1702. (or module (setq module (car (erlang-get-function-under-point))))
  1703. (if (or (null module) (string= module ""))
  1704. (error "No Erlang module name given"))
  1705. (let ((dir-list erlang-man-dirs)
  1706. (pat (concat "/" (regexp-quote module) "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$"))
  1707. (file nil)
  1708. file-list)
  1709. (while (and dir-list (null file))
  1710. (setq file-list (erlang-man-get-files
  1711. (if (nth 2 (car dir-list))
  1712. (concat erlang-root-dir (nth 1 (car dir-list)))
  1713. (nth 1 (car dir-list)))))
  1714. (while (and file-list (null file))
  1715. (if (string-match pat (car file-list))
  1716. (setq file (car file-list)))
  1717. (setq file-list (cdr file-list)))
  1718. (setq dir-list (cdr dir-list)))
  1719. (if file
  1720. (funcall erlang-man-display-function file)
  1721. (error "No manual page for module %s found" module))))
  1722. ;; Warning, the function `erlang-man-function' is a hack!
  1723. ;; It links itself into the man code in a non-clean way. I have
  1724. ;; chosen to keep it since it provides a very useful functionality
  1725. ;; which is not possible to achieve using a clean approach.
  1726. ;; / AndersL
  1727. (defvar erlang-man-function-name nil
  1728. "Name of function for last `erlang-man-function' call.
  1729. Used for communication between `erlang-man-function' and the
  1730. patch to `Man-notify-when-ready'.")
  1731. (defun erlang-man-function (&optional name)
  1732. "Find manual page for NAME, where NAME is module:function.
  1733. The entry for `function' is displayed.
  1734. This function is aware of imported functions."
  1735. (interactive
  1736. (list (let* ((mod-func (erlang-get-function-under-point))
  1737. (mod (car-safe mod-func))
  1738. (func (nth 1 mod-func))
  1739. (input (read-string
  1740. (format
  1741. "Manual entry for `module:func' or `module'%s: "
  1742. (if (or (null mod) (string= mod ""))
  1743. ""
  1744. (format " (default %s:%s)" mod func))))))
  1745. (if (string= input "")
  1746. (if (and mod func)
  1747. (concat mod ":" func)
  1748. mod)
  1749. input))))
  1750. ;; Emacs 18 doesn't provide `man'...
  1751. (condition-case nil
  1752. (require 'man)
  1753. (error nil))
  1754. (let ((modname nil)
  1755. (funcname nil))
  1756. (cond ((null name)
  1757. (let ((mod-func (erlang-get-function-under-point)))
  1758. (setq modname (car-safe mod-func))
  1759. (setq funcname (nth 1 mod-func))))
  1760. ((string-match ":" name)
  1761. (setq modname (substring name 0 (match-beginning 0)))
  1762. (setq funcname (substring name (match-end 0) nil)))
  1763. ((stringp name)
  1764. (setq modname name)))
  1765. (if (or (null modname) (string= modname ""))
  1766. (error "No Erlang module name given"))
  1767. (cond ((fboundp 'Man-notify-when-ready)
  1768. ;; Emacs 19: The man command could possibly start an
  1769. ;; asynchronous process, i.e. we must hook ourselves into
  1770. ;; the system to be activated when the man-process
  1771. ;; terminates.
  1772. (if (null funcname)
  1773. ()
  1774. (erlang-man-patch-notify)
  1775. (setq erlang-man-function-name funcname))
  1776. (condition-case nil
  1777. (erlang-man-module modname)
  1778. (error (setq erlang-man-function-name nil))))
  1779. (t
  1780. (erlang-man-module modname)
  1781. (if funcname
  1782. (erlang-man-find-function
  1783. (or (get-buffer "*Manual Entry*") ; Emacs 18
  1784. (current-buffer)) ; XEmacs
  1785. funcname))))))
  1786. ;; Should the defadvice be at the top level, the package `advice' would
  1787. ;; be required. Now it is only required when this functionality
  1788. ;; is used. (Emacs 19 specific.)
  1789. (defun erlang-man-patch-notify ()
  1790. "Patch the function `Man-notify-when-ready' to search for function.
  1791. The variable `erlang-man-function-name' is assumed to be bound to
  1792. the function name, or to nil.
  1793. The reason for patching a function is that under Emacs 19, the man
  1794. command is executed asynchronously."
  1795. (condition-case nil
  1796. (require 'advice)
  1797. ;; This should never happened since this is only called when
  1798. ;; running under Emacs 19.
  1799. (error (error (concat "This command needs the package `advice', "
  1800. "please upgrade your Emacs."))))
  1801. (require 'man)
  1802. (defadvice Man-notify-when-ready
  1803. (after erlang-Man-notify-when-ready activate)
  1804. "Set point at the documentation of the function name in
  1805. `erlang-man-function-name' when the man page is displayed."
  1806. (if erlang-man-function-name
  1807. (erlang-man-find-function (ad-get-arg 0) erlang-man-function-name))
  1808. (setq erlang-man-function-name nil)))
  1809. (defun erlang-man-find-function (buf func)
  1810. "Find manual page for function in `erlang-man-function-name' in buffer BUF."
  1811. (if func
  1812. (let ((win (get-buffer-window buf)))
  1813. (if win
  1814. (progn
  1815. (set-buffer buf)
  1816. (goto-char (point-min))
  1817. (if (re-search-forward
  1818. (concat "^[ \t]+" func " ?(")
  1819. (point-max) t)
  1820. (progn
  1821. (forward-word -1)
  1822. (set-window-point win (point)))
  1823. (message "Could not find function `%s'" func)))))))
  1824. (defun erlang-man-display (file)
  1825. "Display FILE as a `man' file.
  1826. This is the default manual page display function.
  1827. The variables `erlang-man-display-function' contains the function
  1828. to be used."
  1829. ;; Emacs 18 doesn't `provide' man.
  1830. (condition-case nil
  1831. (require 'man)
  1832. (error nil))
  1833. (if file
  1834. (let ((process-environment (copy-sequence process-environment)))
  1835. (if (string-match "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file)
  1836. (let ((dir (substring file (match-beginning 1) (match-end 1)))
  1837. (page (substring file (match-beginning 2) (match-end 2))))
  1838. (if (fboundp 'setenv)
  1839. (setenv "MANPATH" dir)
  1840. ;; Emacs 18
  1841. (setq process-environment (cons (concat "MANPATH=" dir)
  1842. process-environment)))
  1843. (cond ((not (and (not erlang-xemacs-p)
  1844. (= erlang-emacs-major-version 19)
  1845. (< erlang-emacs-minor-version 29)))
  1846. (manual-entry page))
  1847. (t
  1848. ;; Emacs 19.28 and earlier versions of 19:
  1849. ;; The manual-entry command unconditionally prompts
  1850. ;; the user :-(
  1851. (funcall (symbol-function 'Man-getpage-in-background)
  1852. page))))
  1853. (error "Can't find man page for %s\n" file)))))
  1854. (defun erlang-man-describe-error ()
  1855. "Describe why the manual pages weren't found."
  1856. (interactive)
  1857. (with-output-to-temp-buffer "*Erlang Man Error*"
  1858. (princ "Normally, this menu should contain Erlang manual pages.
  1859. In order to find the manual pages, the variable `erlang-root-dir'
  1860. should be bound to the name of the directory containing the Erlang
  1861. installation. The name should not include the final slash.
  1862. Practically, you should add a line on the following form to
  1863. your ~/.emacs, or ask your system administrator to add it to
  1864. the site init file:
  1865. (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\")
  1866. For example:
  1867. (setq erlang-root-dir \"/usr/local/erlang\")
  1868. After installing the line, kill and restart Emacs, or restart Erlang
  1869. mode with the command `M-x erlang-mode RET'.")))
  1870. ;; Skeleton code:
  1871. ;; This code is based on the package `tempo' which is part of modern
  1872. ;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
  1873. (defun erlang-skel-init ()
  1874. "Generate the skeleton functions and menu items.
  1875. The variable `erlang-skel' contains the name and descriptions of
  1876. all skeletons.
  1877. The skeleton routines are based on the `tempo' package. Should this
  1878. package not be present, this function does nothing."
  1879. (interactive)
  1880. (condition-case nil
  1881. (require 'tempo)
  1882. (error t))
  1883. (if (featurep 'tempo)
  1884. (let ((skel erlang-skel)
  1885. (menu '()))
  1886. (while skel
  1887. (cond ((null (car skel))
  1888. (setq menu (cons nil menu)))
  1889. (t
  1890. (funcall (symbol-function 'tempo-define-template)
  1891. (concat "erlang-" (nth 1 (car skel)))
  1892. ;; The tempo template used contains an `include'
  1893. ;; function call only, hence changes to the
  1894. ;; variables describing the templates take effect
  1895. ;; immdiately.
  1896. (list (list 'erlang-skel-include (nth 2 (car skel))))
  1897. (nth 1 (car skel))
  1898. (car (car skel))
  1899. 'erlang-tempo-tags)
  1900. (setq menu (cons (erlang-skel-make-menu-item
  1901. (car skel)) menu))))
  1902. (setq skel (cdr skel)))
  1903. (setq erlang-menu-skel-items
  1904. (list nil (list "Skeletons" (nreverse menu))))
  1905. (setq erlang-menu-items
  1906. (erlang-menu-add-above 'erlang-menu-skel-items
  1907. 'erlang-menu-version-items
  1908. erlang-menu-items))
  1909. (erlang-menu-init))))
  1910. (defun erlang-skel-make-menu-item (skel)
  1911. (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel)))))
  1912. (cond ((null (nth 3 skel))
  1913. (list (car skel) func))
  1914. (t
  1915. (list (car skel)
  1916. (list 'lambda '()
  1917. '(interactive)
  1918. (list 'funcall
  1919. (list 'quote (nth 3 skel))
  1920. (list 'quote func))))))))
  1921. ;; Functions designed to be added to the skeleton menu.
  1922. ;; (Not normally used)
  1923. (defun erlang-skel-insert (func)
  1924. "Insert skeleton generated by FUNC and goto first tempo mark."
  1925. (save-excursion (funcall func))
  1926. (funcall (symbol-function 'tempo-forward-mark)))
  1927. (defun erlang-skel-header (func)
  1928. "Insert the header generated by FUNC at the beginning of the buffer."
  1929. (goto-char (point-min))
  1930. (save-excursion (funcall func))
  1931. (funcall (symbol-function 'tempo-forward-mark)))
  1932. ;; Functions used inside the skeleton descriptions.
  1933. (defun erlang-skel-skip-blank ()
  1934. (skip-chars-backward " \t")
  1935. nil)
  1936. (defun erlang-skel-include (&rest args)
  1937. "Include a template inside another template.
  1938. Example of use, assuming that `erlang-skel-func' is defined:
  1939. (defvar foo-skeleton '(\"%%% New function:\"
  1940. (erlang-skel-include erlang-skel-func)))
  1941. Technically, this function returns the `tempo' attribute`(l ...)' which
  1942. can contain other `tempo' attributes. Please see the function
  1943. `tempo-define-template' for a description of the `(l ...)' attribute."
  1944. (let ((res '())
  1945. entry)
  1946. (while args
  1947. (setq entry (car args))
  1948. (while entry
  1949. (setq res (cons (car entry) res))
  1950. (setq entry (cdr entry)))
  1951. (setq args (cdr args)))
  1952. (cons 'l (nreverse res))))
  1953. (defvar erlang-skel-separator-length 70)
  1954. (defun erlang-skel-separator (&optional percent)
  1955. "Return a comment separator."
  1956. (let ((percent (or percent 3)))
  1957. (concat (make-string percent ?%)
  1958. (make-string (- erlang-skel-separator-length percent) ?-)
  1959. "\n")))
  1960. (defun erlang-skel-double-separator (&optional percent)
  1961. "Return a comment separator."
  1962. (let ((percent (or percent 3)))
  1963. (concat (make-string percent ?%)
  1964. (make-string (- erlang-skel-separator-length percent) ?=)
  1965. "\n")))
  1966. (defun erlang-skel-dd-mmm-yyyy ()
  1967. "Return the current date as a string in \"DD Mon YYYY\" form.
  1968. The first character of DD is space if the value is less than 10."
  1969. (let ((date (current-time-string)))
  1970. (format "%2d %s %s"
  1971. (erlang-string-to-int (substring date 8 10))
  1972. (substring date 4 7)
  1973. (substring date -4))))
  1974. ;; Indentation code:
  1975. (defun erlang-indent-command (&optional whole-exp)
  1976. "Indent current line as Erlang code.
  1977. With argument, indent any additional lines of the same clause
  1978. rigidly along with this one."
  1979. (interactive "P")
  1980. (if whole-exp
  1981. ;; If arg, always indent this line as Erlang
  1982. ;; and shift remaining lines of clause the same amount.
  1983. (let ((shift-amt (erlang-indent-line))
  1984. beg end)
  1985. (save-excursion
  1986. (if erlang-tab-always-indent
  1987. (beginning-of-line))
  1988. (setq beg (point))
  1989. (erlang-end-of-clause 1)
  1990. (setq end (point))
  1991. (goto-char beg)
  1992. (forward-line 1)
  1993. (setq beg (point)))
  1994. (if (> end beg)
  1995. (indent-code-rigidly beg end shift-amt "\n")))
  1996. (if (and (not erlang-tab-always-indent)
  1997. (save-excursion
  1998. (skip-chars-backward " \t")
  1999. (not (bolp))))
  2000. (insert-tab)
  2001. (erlang-indent-line))))
  2002. (defun erlang-indent-line ()
  2003. "Indent current line as Erlang code.
  2004. Return the amount the indentation changed by."
  2005. (let ((pos (- (point-max) (point)))
  2006. indent beg
  2007. shift-amt)
  2008. (beginning-of-line 1)
  2009. (setq beg (point))
  2010. (skip-chars-forward " \t")
  2011. (cond ((looking-at "%")
  2012. (setq indent (funcall comment-indent-function))
  2013. (setq shift-amt (- indent (current-column))))
  2014. (t
  2015. (setq indent (erlang-calculate-indent))
  2016. (cond ((null indent)
  2017. (setq indent (current-indentation)))
  2018. ((eq indent t)
  2019. ;; This should never occur here.
  2020. (error "Erlang mode error"))
  2021. ;;((= (char-syntax (following-char)) ?\))
  2022. ;; (setq indent (1- indent)))
  2023. )
  2024. (setq shift-amt (- indent (current-column)))))
  2025. (if (zerop shift-amt)
  2026. nil
  2027. (delete-region beg (point))
  2028. (indent-to indent))
  2029. ;; If initial point was within line's indentation, position
  2030. ;; after the indentation. Else stay at same point in text.
  2031. (if (> (- (point-max) pos) (point))
  2032. (goto-char (- (point-max) pos)))
  2033. shift-amt))
  2034. (defun erlang-indent-region (beg end)
  2035. "Indent region of Erlang code.
  2036. This is automagically called by the user level function `indent-region'."
  2037. (interactive "r")
  2038. (save-excursion
  2039. (let ((case-fold-search nil)
  2040. (continue t)
  2041. (from-end (- (point-max) end))
  2042. indent-point;; The beginning of the current line
  2043. indent;; The indent amount
  2044. state)
  2045. (goto-char beg)
  2046. (beginning-of-line)
  2047. (setq indent-point (point))
  2048. (erlang-beginning-of-clause)
  2049. ;; Parse the Erlang code from the beginning of the clause to
  2050. ;; the beginning of the region.
  2051. (while (< (point) indent-point)
  2052. (setq state (erlang-partial-parse (point) indent-point state)))
  2053. ;; Indent every line in the region
  2054. (while continue
  2055. (goto-char indent-point)
  2056. (skip-chars-forward " \t")
  2057. (cond ((looking-at "%")
  2058. ;; Do not use our stack to help the user to customize
  2059. ;; comment indentation.
  2060. (setq indent (funcall comment-indent-function)))
  2061. ((looking-at "$")
  2062. ;; Don't indent empty lines.
  2063. (setq indent 0))
  2064. (t
  2065. (setq indent
  2066. (save-excursion
  2067. (erlang-calculate-stack-indent (point) state)))
  2068. (cond ((null indent)
  2069. (setq indent (current-indentation)))
  2070. ((eq indent t)
  2071. ;; This should never occur here.
  2072. (error "Erlang mode error"))
  2073. ;;((= (char-syntax (following-char)) ?\))
  2074. ;; (setq indent (1- indent)))
  2075. )))
  2076. (if (zerop (- indent (current-column)))
  2077. nil
  2078. (delete-region indent-point (point))
  2079. (indent-to indent))
  2080. ;; Find the next line in the region
  2081. (goto-char indent-point)
  2082. (save-excursion
  2083. (forward-line 1)
  2084. (setq indent-point (point)))
  2085. (if (>= from-end (- (point-max) indent-point))
  2086. (setq continue nil)
  2087. (while (< (point) indent-point)
  2088. (setq state (erlang-partial-parse
  2089. (point) indent-point state))))))))
  2090. (defun erlang-indent-current-buffer ()
  2091. "Indent current buffer as Erlang code."
  2092. (interactive)
  2093. (save-excursion
  2094. (save-restriction
  2095. (widen)
  2096. (erlang-indent-region (point-min) (point-max)))))
  2097. (defun erlang-indent-function ()
  2098. "Indent current Erlang function."
  2099. (interactive)
  2100. (save-excursion
  2101. (let ((end (progn (erlang-end-of-function 1) (point)))
  2102. (beg (progn (erlang-beginning-of-function 1) (point))))
  2103. (erlang-indent-region beg end))))
  2104. (defun erlang-indent-clause ()
  2105. "Indent current Erlang clause."
  2106. (interactive)
  2107. (save-excursion
  2108. (let ((end (progn (erlang-end-of-clause 1) (point)))
  2109. (beg (progn (erlang-beginning-of-clause 1) (point))))
  2110. (erlang-indent-region beg end))))
  2111. (defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack)))
  2112. (defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack)))
  2113. ;; Would much prefer to make caddr a macro but this clashes.
  2114. (defun erlang-caddr (x) (car (cdr (cdr x))))
  2115. (defun erlang-calculate-indent (&optional parse-start)
  2116. "Compute appropriate indentation for current line as Erlang code.
  2117. Return nil if line starts inside string, t if in a comment."
  2118. (save-excursion
  2119. (let ((indent-point (point))
  2120. (case-fold-search nil)
  2121. (state nil))
  2122. (if parse-start
  2123. (goto-char parse-start)
  2124. (erlang-beginning-of-clause))
  2125. (while (< (point) indent-point)
  2126. (setq state (erlang-partial-parse (point) indent-point state)))
  2127. (erlang-calculate-stack-indent indent-point state))))
  2128. (defun erlang-show-syntactic-information ()
  2129. "Show syntactic information for current line."
  2130. (interactive)
  2131. (save-excursion
  2132. (let ((starting-point (point))
  2133. (case-fold-search nil)
  2134. (state nil))
  2135. (erlang-beginning-of-clause)
  2136. (while (< (point) starting-point)
  2137. (setq state (erlang-partial-parse (point) starting-point state)))
  2138. (message "%S" state))))
  2139. (defun erlang-partial-parse (from to &optional state)
  2140. "Parse Erlang syntax starting at FROM until TO, with an optional STATE.
  2141. Value is list (stack token-start token-type in-what)."
  2142. (goto-char from) ; Start at the beginning
  2143. (erlang-skip-blank to)
  2144. (let ((cs (char-syntax (following-char)))
  2145. (stack (car state))
  2146. (token (point))
  2147. in-what)
  2148. (cond
  2149. ;; Done: Return previous state.
  2150. ((>= token to)
  2151. (setq token (nth 1 state))
  2152. (setq cs (nth 2 state))
  2153. (setq in-what (nth 3 state)))
  2154. ;; Word constituent: check and handle keywords.
  2155. ((= cs ?w)
  2156. (cond ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]")
  2157. ;; Must pop top icr layer, `after' will push a new
  2158. ;; layer next.
  2159. (progn
  2160. (while (and stack (eq (car (car stack)) '->))
  2161. (erlang-pop stack))
  2162. (if (and stack (memq (car (car stack)) '(icr begin fun try)))
  2163. (erlang-pop stack))))
  2164. ((looking-at "catch.*of")
  2165. t)
  2166. ((looking-at "catch\\s *\\($\\|%\\|.*->\\)")
  2167. ;; Must pop top icr layer, `catch' in try/catch
  2168. ;;will push a new layer next.
  2169. (progn
  2170. (while (and stack (eq (car (car stack)) '->))
  2171. (erlang-pop stack))
  2172. (if (and stack (memq (car (car stack)) '(icr begin try)))
  2173. (erlang-pop stack))))
  2174. )
  2175. (cond ((looking-at "\\(if\\|case\\|receive\\)[^_a-zA-Z0-9]")
  2176. ;; Must push a new icr (if/case/receive) layer.
  2177. (erlang-push (list 'icr token (current-column)) stack))
  2178. ((looking-at "\\(try\\|after\\)[^_a-zA-Z0-9]")
  2179. ;; Must handle separately, try catch or try X of -> catch
  2180. ;; same for `after', it could be
  2181. ;; receive after Time -> X end, or
  2182. ;; try after X end
  2183. (erlang-push (list 'try token (current-column)) stack))
  2184. ((looking-at "\\(of\\)[^_a-zA-Z0-9]")
  2185. ;; Must handle separately, try X of -> catch
  2186. (if (and stack (eq (car (car stack)) 'try))
  2187. (let ((try-column (nth 2 (car stack)))
  2188. (try-pos (nth 1 (car stack))))
  2189. (erlang-pop stack)
  2190. (erlang-push (list 'icr try-pos try-column) stack))))
  2191. ((looking-at "\\(fun\\)[^_a-zA-Z0-9]")
  2192. ;; Push a new layer if we are defining a `fun'
  2193. ;; expression, not when we are refering an existing
  2194. ;; function. 'fun's defines are only indented one level now.
  2195. (if (save-excursion
  2196. (goto-char (match-end 1))
  2197. (erlang-skip-blank to)
  2198. (eq (following-char) ?\())
  2199. (erlang-push (list 'fun token (current-column)) stack)))
  2200. ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]")
  2201. (erlang-push (list 'begin token (current-column)) stack))
  2202. ;; Normal when case
  2203. ;;((looking-at "when\\s ")
  2204. ;;((looking-at "when\\s *\\($\\|%\\)")
  2205. ((looking-at "when[^_a-zA-Z0-9]")
  2206. (erlang-push (list 'when token (current-column)) stack))
  2207. ((looking-at "catch.*of")
  2208. t)
  2209. ((looking-at "catch\\s *\\($\\|%\\|.*->\\)")
  2210. (erlang-push (list 'icr token (current-column)) stack))
  2211. ;;(erlang-push (list '-> token (current-column)) stack))
  2212. ;;((looking-at "^of$")
  2213. ;; (erlang-push (list 'icr token (current-column)) stack)
  2214. ;;(erlang-push (list '-> token (current-column)) stack))
  2215. )
  2216. (forward-sexp 1))
  2217. ;; String: Try to skip over it. (Catch error if not complete.)
  2218. ((= cs ?\")
  2219. (condition-case nil
  2220. (progn
  2221. (forward-sexp 1)
  2222. (if (> (point) to)
  2223. (progn
  2224. (setq in-what 'string)
  2225. (goto-char to))))
  2226. (error
  2227. (setq in-what 'string)
  2228. (goto-char to))))
  2229. ;; Expression prefix e.i. $ or ^ (Note ^ can be in the character
  2230. ;; literal $^ or part of string and $ outside of a string denotes
  2231. ;; a character literal)
  2232. ((= cs ?')
  2233. (cond
  2234. ((= (following-char) ?\") ;; $ or ^ was the last char in a string
  2235. (forward-char 1))
  2236. (t
  2237. ;; Maybe a character literal, quote the next char to avoid
  2238. ;; situations as $" being seen as the begining of a string.
  2239. ;; Note the quoting something in the middle of a string is harmless.
  2240. (quote (following-char))
  2241. (forward-char 1))))
  2242. ;; Symbol constituent or punctuation
  2243. ((memq cs '(?. ?_))
  2244. (cond
  2245. ;; Clause end
  2246. ((= (following-char) ?\;)
  2247. (if (eq (car (car (last stack))) 'spec)
  2248. (while (memq (car (car stack)) '(when ::))
  2249. (erlang-pop stack)))
  2250. (if (and stack (eq (car (car stack)) '->))
  2251. (erlang-pop stack))
  2252. (forward-char 1))
  2253. ;; Parameter separator
  2254. ((looking-at ",")
  2255. (forward-char 1)
  2256. (if (and stack (eq (car (car stack)) '::))
  2257. ;; Type or spec
  2258. (erlang-pop stack)))
  2259. ;; Function end
  2260. ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")
  2261. (setq stack nil)
  2262. (forward-char 1))
  2263. ;; Function head
  2264. ((looking-at "->")
  2265. (if (and stack (eq (car (car stack)) 'when))
  2266. (erlang-pop stack))
  2267. (erlang-push (list '-> token (current-column)) stack)
  2268. (forward-char 2))
  2269. ;; List-comprehension divider
  2270. ((looking-at "||")
  2271. (erlang-push (list '|| token (current-column)) stack)
  2272. (forward-char 2))
  2273. ;; Bit-syntax open paren
  2274. ((looking-at "<<")
  2275. (erlang-push (list '<< token (current-column)) stack)
  2276. (forward-char 2))
  2277. ;; Bbit-syntax close paren
  2278. ((looking-at ">>")
  2279. (while (memq (car (car stack)) '(|| ->))
  2280. (erlang-pop stack))
  2281. (cond ((eq (car (car stack)) '<<)
  2282. (erlang-pop stack))
  2283. ((memq (car (car stack)) '(icr begin fun))
  2284. (error "Missing `end'"))
  2285. (t
  2286. (error "Unbalanced parentheses")))
  2287. (forward-char 2))
  2288. ;; Macro
  2289. ((= (following-char) ??)
  2290. ;; Skip over the ?
  2291. (forward-char 1)
  2292. )
  2293. ;; Type spec's
  2294. ((looking-at "-type\\s \\|-opaque\\s ")
  2295. (if stack
  2296. (forward-char 1)
  2297. (erlang-push (list 'icr token (current-column)) stack)
  2298. (forward-char 6)))
  2299. ((looking-at "-spec\\s ")
  2300. (if stack
  2301. (forward-char 1)
  2302. (forward-char 6)
  2303. (skip-chars-forward "^(\n")
  2304. (erlang-push (list 'spec (point) (current-column)) stack)
  2305. ))
  2306. ;; Type spec delimiter
  2307. ((looking-at "::")
  2308. (erlang-push (list ':: token (current-column)) stack)
  2309. (forward-char 2))
  2310. ;; Don't follow through in the clause below
  2311. ;; '|' don't need spaces around it
  2312. ((looking-at "|")
  2313. (forward-char 1))
  2314. ;; Other punctuation: Skip over it and any following punctuation
  2315. ((= cs ?.)
  2316. ;; Skip over all characters in the operand.
  2317. (skip-syntax-forward "."))
  2318. ;; Other char: Skip over it.
  2319. (t
  2320. (forward-char 1))))
  2321. ;; Open parenthesis
  2322. ((= cs ?\()
  2323. (erlang-push (list '\( token (current-column)) stack)
  2324. (forward-char 1))
  2325. ;; Close parenthesis
  2326. ((= cs ?\))
  2327. (while (memq (car (car stack)) '(|| -> :: when))
  2328. (erlang-pop stack))
  2329. (cond ((eq (car (car stack)) '\()
  2330. (erlang-pop stack)
  2331. (if (and (eq (car (car stack)) 'fun)
  2332. (or (eq (car (car (last stack))) 'spec)
  2333. (eq (car (car (cdr stack))) '::))) ;; -type()
  2334. ;; Inside fun type def ') closes fun definition
  2335. (erlang-pop stack)))
  2336. ((eq (car (car stack)) 'icr)
  2337. (erlang-pop stack)
  2338. ;; Normal catch not try-catch might have caused icr
  2339. ;; and then incr should be removed and is not an error.
  2340. (if (eq (car (car stack)) '\()
  2341. (erlang-pop stack)
  2342. (error "Missing `end'")
  2343. ))
  2344. ((eq (car (car stack)) 'begin)
  2345. (error "Missing `end'"))
  2346. (t
  2347. (error "Unbalanced parenthesis"))
  2348. )
  2349. (forward-char 1))
  2350. ;; Character quote: Skip it and the quoted char.
  2351. ((= cs ?/)
  2352. (forward-char 2))
  2353. ;; Character escape: Skip it and the escape sequence.
  2354. ((= cs ?\\)
  2355. (forward-char 1)
  2356. (skip-syntax-forward "w"))
  2357. ;; Everything else
  2358. (t
  2359. (forward-char 1)))
  2360. (list stack token cs in-what)))
  2361. (defun erlang-calculate-stack-indent (indent-point state)
  2362. "From the given last position and state (stack) calculate indentation.
  2363. Return nil if inside string, t if in a comment."
  2364. (let* ((stack (and state (car state)))
  2365. (token (nth 1 state))
  2366. (stack-top (and stack (car stack))))
  2367. (cond ((null state) ;No state
  2368. 0)
  2369. ((nth 3 state)
  2370. ;; Return nil or t.
  2371. (eq (nth 3 state) 'comment))
  2372. ((null stack)
  2373. (if (looking-at "when[^_a-zA-Z0-9]")
  2374. erlang-indent-guard
  2375. 0))
  2376. ((eq (car stack-top) '\()
  2377. ;; Element of list, tuple or part of an expression,
  2378. (cond ((null erlang-argument-indent)
  2379. ;; indent to next column.
  2380. (1+ (nth 2 stack-top)))
  2381. ((= (char-syntax (following-char)) ?\))
  2382. (goto-char (nth 1 stack-top))
  2383. (cond ((looking-at "[({]\\s *\\($\\|%\\)")
  2384. ;; Line ends with parenthesis.
  2385. (let ((previous (erlang-indent-find-preceding-expr))
  2386. (stack-pos (nth 2 stack-top)))
  2387. (if (>= previous stack-pos) stack-pos
  2388. (- (+ previous erlang-argument-indent) 1))))
  2389. (t
  2390. (nth 2 stack-top))))
  2391. (t
  2392. (goto-char (nth 1 stack-top))
  2393. (let ((base (cond ((looking-at "[({]\\s *\\($\\|%\\)")
  2394. ;; Line ends with parenthesis.
  2395. (erlang-indent-parenthesis (nth 2 stack-top)))
  2396. (t
  2397. ;; Indent to the same column as the first
  2398. ;; argument.
  2399. (goto-char (1+ (nth 1 stack-top)))
  2400. (skip-chars-forward " \t")
  2401. (current-column)))))
  2402. (erlang-indent-standard indent-point token base 't)))))
  2403. ;;
  2404. ((eq (car stack-top) '<<)
  2405. ;; Element of binary (possible comprehension) expression,
  2406. (cond ((null erlang-argument-indent)
  2407. ;; indent to next column.
  2408. (+ 2 (nth 2 stack-top)))
  2409. ((looking-at "\\(>>\\)[^_a-zA-Z0-9]")
  2410. (nth 2 stack-top))
  2411. (t
  2412. (goto-char (nth 1 stack-top))
  2413. ;; Indent to the same column as the first
  2414. ;; argument.
  2415. (goto-char (+ 2 (nth 1 stack-top)))
  2416. (skip-chars-forward " \t")
  2417. (current-column))))
  2418. ((memq (car stack-top) '(icr fun spec))
  2419. ;; The default indentation is the column of the option
  2420. ;; directly following the keyword. (This does not apply to
  2421. ;; `case'.) Should no option be on the same line, the
  2422. ;; indentation is the indentation of the keyword +
  2423. ;; `erlang-indent-level'.
  2424. ;;
  2425. ;; `after' should be indented to the same level as the
  2426. ;; corresponding receive.
  2427. (cond ((looking-at "\\(after\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)")
  2428. (nth 2 stack-top))
  2429. ((looking-at "when[^_a-zA-Z0-9]")
  2430. ;; Handling one when part
  2431. (+ (nth 2 stack-top) erlang-indent-level erlang-indent-guard))
  2432. (t
  2433. (save-excursion
  2434. (goto-char (nth 1 stack-top))
  2435. (if (looking-at "case[^_a-zA-Z0-9]")
  2436. (+ (nth 2 stack-top) erlang-indent-level)
  2437. (skip-chars-forward "a-z")
  2438. (skip-chars-forward " \t")
  2439. (if (memq (following-char) '(?% ?\n))
  2440. (+ (nth 2 stack-top) erlang-indent-level)
  2441. (current-column))))))
  2442. )
  2443. ((and (eq (car stack-top) '||) (looking-at "\\(]\\|>>\\)[^_a-zA-Z0-9]"))
  2444. (nth 2 (car (cdr stack))))
  2445. ;; Real indentation, where operators create extra indentation etc.
  2446. ((memq (car stack-top) '(-> || try begin))
  2447. (if (looking-at "\\(of\\)[^_a-zA-Z0-9]")
  2448. (nth 2 stack-top)
  2449. (goto-char (nth 1 stack-top))
  2450. ;; Check if there is more code after the '->' on the
  2451. ;; same line. If so use this indentation as base, else
  2452. ;; use parent indentation + 2 * level as base.
  2453. (let ((off erlang-indent-level)
  2454. (skip 2))
  2455. (cond ((null (cdr stack))) ; Top level in function.
  2456. ((eq (car stack-top) 'begin)
  2457. (setq skip 5))
  2458. ((eq (car stack-top) 'try)
  2459. (setq skip 5))
  2460. ((eq (car stack-top) '->)
  2461. ;; If in fun definition use standard indent level not double
  2462. ;;(if (not (eq (car (car (cdr stack))) 'fun))
  2463. ;; Removed it made multi clause fun's look to bad
  2464. (setq off (* 2 erlang-indent-level)))) ;; )
  2465. (let ((base (erlang-indent-find-base stack indent-point off skip)))
  2466. ;; Special cases
  2467. (goto-char indent-point)
  2468. (cond ((looking-at "\\(end\\|after\\)\\($\\|[^_a-zA-Z0-9]\\)")
  2469. (if (eq (car stack-top) '->)
  2470. (erlang-pop stack))
  2471. (if stack
  2472. (erlang-caddr (car stack))
  2473. 0))
  2474. ((looking-at "catch\\($\\|[^_a-zA-Z0-9]\\)")
  2475. ;; Are we in a try
  2476. (let ((start (if (eq (car stack-top) '->)
  2477. (car (cdr stack))
  2478. stack-top)))
  2479. (if (null start) nil
  2480. (goto-char (nth 1 start)))
  2481. (cond ((looking-at "try\\($\\|[^_a-zA-Z0-9]\\)")
  2482. (progn
  2483. (if (eq (car stack-top) '->)
  2484. (erlang-pop stack))
  2485. (if stack
  2486. (erlang-caddr (car stack))
  2487. 0)))
  2488. (t (erlang-indent-standard indent-point token base 'nil))))) ;; old catch
  2489. (t
  2490. (erlang-indent-standard indent-point token base 'nil)
  2491. ))))
  2492. ))
  2493. ((eq (car stack-top) 'when)
  2494. (goto-char (nth 1 stack-top))
  2495. (if (looking-at "when\\s *\\($\\|%\\)")
  2496. (progn
  2497. (erlang-pop stack)
  2498. (if (and stack (memq (nth 0 (car stack)) '(icr fun)))
  2499. (progn
  2500. (goto-char (nth 1 (car stack)))
  2501. (+ (nth 2 (car stack)) erlang-indent-guard
  2502. ;; receive XYZ or receive
  2503. ;; XYZ
  2504. ;; This if thing does not seem to be needed
  2505. ;;(if (looking-at "[a-z]+\\s *\\($\\|%\\)")
  2506. ;; erlang-indent-level
  2507. ;; (* 2 erlang-indent-level))))
  2508. (* 2 erlang-indent-level)))
  2509. ;;erlang-indent-level))
  2510. (+ erlang-indent-level erlang-indent-guard)))
  2511. ;; "when" is followed by code, let's indent to the same
  2512. ;; column.
  2513. (forward-char 4) ; Skip "when"
  2514. (skip-chars-forward " \t")
  2515. (current-column)))
  2516. ;; Type and Spec indentation
  2517. ((eq (car stack-top) '::)
  2518. (if (looking-at "}")
  2519. ;; Closing record definition with types
  2520. ;; pop stack and recurse
  2521. (erlang-calculate-stack-indent indent-point
  2522. (cons (erlang-pop stack) (cdr state)))
  2523. (cond ((null erlang-argument-indent)
  2524. ;; indent to next column.
  2525. (+ 2 (nth 2 stack-top)))
  2526. ((looking-at "::[^_a-zA-Z0-9]")
  2527. (nth 2 stack-top))
  2528. (t
  2529. (let ((start-alternativ (if (looking-at "|") 2 0)))
  2530. (goto-char (nth 1 stack-top))
  2531. (- (cond ((looking-at "::\\s *\\($\\|%\\)")
  2532. ;; Line ends with ::
  2533. (if (eq (car (car (last stack))) 'spec)
  2534. (+ (erlang-indent-find-preceding-expr 1)
  2535. erlang-argument-indent)
  2536. (+ (erlang-indent-find-preceding-expr 2)
  2537. erlang-argument-indent)))
  2538. (t
  2539. ;; Indent to the same column as the first
  2540. ;; argument.
  2541. (goto-char (+ 2 (nth 1 stack-top)))
  2542. (skip-chars-forward " \t")
  2543. (current-column))) start-alternativ))))))
  2544. )))
  2545. (defun erlang-indent-standard (indent-point token base inside-parenthesis)
  2546. "Standard indent when in blocks or tuple or arguments.
  2547. Look at last thing to see in what state we are, move relative to the base."
  2548. (goto-char token)
  2549. (cond ((looking-at "||\\|,\\|->\\||")
  2550. base)
  2551. ((erlang-at-keyword)
  2552. (+ (current-column) erlang-indent-level))
  2553. ((or (= (char-syntax (following-char)) ?.)
  2554. (erlang-at-operator))
  2555. (+ base erlang-indent-level))
  2556. (t
  2557. (goto-char indent-point)
  2558. (cond ((memq (following-char) '(?\( ))
  2559. ;; Function application.
  2560. (+ (erlang-indent-find-preceding-expr)
  2561. erlang-argument-indent))
  2562. ;; Empty line, or end; treat it as the end of
  2563. ;; the block. (Here we have a choice: should
  2564. ;; the user be forced to reindent continued
  2565. ;; lines, or should the "end" be reindented?)
  2566. ;; Avoid treating comments a continued line.
  2567. ((= (following-char) ?%)
  2568. base)
  2569. ;; Continued line (e.g. line beginning
  2570. ;; with an operator.)
  2571. (t
  2572. (if (or (erlang-at-operator) (not inside-parenthesis))
  2573. (+ base erlang-indent-level)
  2574. base))))))
  2575. (defun erlang-indent-find-base (stack indent-point &optional offset skip)
  2576. "Find the base column for current stack."
  2577. (or skip (setq skip 2))
  2578. (or offset (setq offset erlang-indent-level))
  2579. (save-excursion
  2580. (let* ((stack-top (car stack)))
  2581. (goto-char (nth 1 stack-top))
  2582. (if (< skip (- (point-max) (point)))
  2583. (progn
  2584. (forward-char skip)
  2585. (if (looking-at "\\s *\\($\\|%\\)")
  2586. (progn
  2587. (if (memq (car stack-top) '(-> ||))
  2588. (erlang-pop stack))
  2589. ;; Take parent identation + offset,
  2590. ;; else just erlang-indent-level if no parent
  2591. (if stack
  2592. (+ (erlang-caddr (car stack))
  2593. offset)
  2594. erlang-indent-level))
  2595. (erlang-skip-blank indent-point)
  2596. (current-column)))
  2597. (+ (current-column) skip)))))
  2598. ;; Does not handle `begin' .. `end'.
  2599. (defun erlang-indent-find-preceding-expr (&optional arg)
  2600. "Return the first column of the preceding expression.
  2601. This assumes that the preceding expression is either simple
  2602. \(i.e. an atom) or parenthesized."
  2603. (save-excursion
  2604. (or arg (setq arg 1))
  2605. (forward-sexp (- arg))
  2606. (let ((col (current-column)))
  2607. (skip-chars-backward " \t")
  2608. ;; Needed to match the colon in "'foo':'bar'".
  2609. (if (not (memq (preceding-char) '(?# ?:)))
  2610. col
  2611. ;; Special hack to handle: (note line break)
  2612. ;; [#myrecord{
  2613. ;; foo = foo}]
  2614. (or
  2615. (ignore-errors
  2616. (backward-char 1)
  2617. (forward-sexp -1)
  2618. (current-column))
  2619. col)))))
  2620. (defun erlang-indent-parenthesis (stack-position)
  2621. (let ((previous (erlang-indent-find-preceding-expr)))
  2622. (if (> previous stack-position)
  2623. (+ stack-position erlang-argument-indent)
  2624. (+ previous erlang-argument-indent))))
  2625. (defun erlang-skip-blank (&optional lim)
  2626. "Skip over whitespace and comments until limit reached."
  2627. (or lim (setq lim (point-max)))
  2628. (let (stop)
  2629. (while (and (not stop) (< (point) lim))
  2630. (cond ((= (following-char) ?%)
  2631. (skip-chars-forward "^\n" lim))
  2632. ((= (following-char) ?\n)
  2633. (skip-chars-forward "\n" lim))
  2634. ((looking-at "\\s ")
  2635. (if (re-search-forward "\\S " lim 'move)
  2636. (forward-char -1)))
  2637. (t
  2638. (setq stop t))))
  2639. stop))
  2640. (defun erlang-at-keyword ()
  2641. "Are we looking at an Erlang keyword which will increase indentation?"
  2642. (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|query\\|"
  2643. "of\\|receive\\|after\\|catch\\|try\\)[^_a-zA-Z0-9]")))
  2644. (defun erlang-at-operator ()
  2645. "Are we looking at an Erlang operator?"
  2646. (looking-at
  2647. "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]"))
  2648. (defun erlang-comment-indent ()
  2649. "Compute Erlang comment indentation.
  2650. Used both by `indent-for-comment' and the Erlang specific indentation
  2651. commands."
  2652. (cond ((looking-at "%%%") 0)
  2653. ((looking-at "%%")
  2654. (or (erlang-calculate-indent)
  2655. (current-indentation)))
  2656. (t
  2657. (save-excursion
  2658. (skip-chars-backward " \t")
  2659. (max (if (bolp) 0 (1+ (current-column)))
  2660. comment-column)))))
  2661. ;;; Erlang movement commands
  2662. ;; All commands below work as movement commands. I.e. if the point is
  2663. ;; at the end of the clause, and the command `erlang-end-of-clause' is
  2664. ;; executed, the point is moved to the end of the NEXT clause. (This
  2665. ;; mimics the behaviour of `end-of-defun'.)
  2666. ;;
  2667. ;; Personally I would like to rewrite them to be "pure", and add a set
  2668. ;; of movement functions, like `erlang-next-clause',
  2669. ;; `erlang-previous-clause', and the same for functions.
  2670. ;;
  2671. ;; The current implementation makes it hopeless to use the functions as
  2672. ;; subroutines in more complex commands. /andersl
  2673. (defun erlang-beginning-of-clause (&optional arg)
  2674. "Move backward to previous start of clause.
  2675. With argument, do this that many times.
  2676. Return t unless search stops due to end of buffer."
  2677. (interactive "p")
  2678. (or arg (setq arg 1))
  2679. (if (< arg 0)
  2680. ;; Step back to the end of the previous line, unless we are at
  2681. ;; the beginning of the buffer. The reason for this move is
  2682. ;; that the regexp below includes the last character of the
  2683. ;; previous line.
  2684. (if (bobp)
  2685. (or (looking-at "\n")
  2686. (forward-char 1))
  2687. (forward-char -1)
  2688. (if (looking-at "\\`\n")
  2689. (forward-char 1))))
  2690. ;; The regexp matches a function header that isn't
  2691. ;; included in a string.
  2692. (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\(-?[a-z]\\|'\\|-\\)"
  2693. nil 'move (- arg))
  2694. (let ((beg (match-beginning 2)))
  2695. (and beg (goto-char beg))
  2696. t)))
  2697. (defun erlang-end-of-clause (&optional arg)
  2698. "Move to the end of the current clause.
  2699. With argument, do this that many times."
  2700. (interactive "p")
  2701. (or arg (setq arg 1))
  2702. (while (and (looking-at "[ \t]*[%\n]")
  2703. (zerop (forward-line 1))))
  2704. ;; Move to the next clause.
  2705. (erlang-beginning-of-clause (- arg))
  2706. (beginning-of-line);; Just to be sure...
  2707. (let ((continue t))
  2708. (while (and (not (bobp)) continue)
  2709. (forward-line -1)
  2710. (skip-chars-forward " \t")
  2711. (if (looking-at "[%\n]")
  2712. nil
  2713. (end-of-line)
  2714. (setq continue nil)))))
  2715. (defun erlang-mark-clause ()
  2716. "Put mark at end of clause, point at beginning."
  2717. (interactive)
  2718. (push-mark (point))
  2719. (erlang-end-of-clause 1)
  2720. ;; Sets the region. In Emacs 19 and XEmacs, we want to activate
  2721. ;; the region.
  2722. (condition-case nil
  2723. (push-mark (point) nil t)
  2724. (error (push-mark (point))))
  2725. (erlang-beginning-of-clause 1)
  2726. ;; The above function deactivates the mark.
  2727. (if (boundp 'deactivate-mark)
  2728. (funcall (symbol-function 'set) 'deactivate-mark nil)))
  2729. (defun erlang-beginning-of-function (&optional arg)
  2730. "Move backward to previous start of function.
  2731. With positive argument, do this that many times.
  2732. With negative argument, search forward.
  2733. Return t unless search stops due to end of buffer."
  2734. (interactive "p")
  2735. (or arg (setq arg 1))
  2736. (cond
  2737. ;; Search backward
  2738. ((> arg 0)
  2739. (while (and (> arg 0)
  2740. (and (erlang-beginning-of-clause 1)
  2741. (let ((start (point))
  2742. (name (erlang-name-of-function))
  2743. (arity (erlang-get-function-arity)))
  2744. ;; Note: "arity" is nil for e.g. "-import", hence
  2745. ;; two "-import" clauses are not considered to
  2746. ;; be part of the same function.
  2747. (while (and (erlang-beginning-of-clause 1)
  2748. (string-equal name
  2749. (erlang-name-of-function))
  2750. arity
  2751. (equal arity
  2752. (erlang-get-function-arity)))
  2753. (setq start (point)))
  2754. (goto-char start)
  2755. t)))
  2756. (setq arg (1- arg))))
  2757. ;; Search forward
  2758. ((< arg 0)
  2759. (end-of-line)
  2760. (erlang-beginning-of-clause 1)
  2761. ;; Step -arg functions forward.
  2762. (while (and (< arg 0)
  2763. ;; Step one function forward, or stop if the end of
  2764. ;; the buffer was reached. Return t if we found the
  2765. ;; function.
  2766. (let ((name (erlang-name-of-function))
  2767. (arity (erlang-get-function-arity))
  2768. (found (erlang-beginning-of-clause -1)))
  2769. (while (and found
  2770. (string-equal name (erlang-name-of-function))
  2771. arity
  2772. (equal arity
  2773. (erlang-get-function-arity)))
  2774. (setq found (erlang-beginning-of-clause -1)))
  2775. found))
  2776. (setq arg (1+ arg)))))
  2777. (zerop arg))
  2778. (defun erlang-end-of-function (&optional arg)
  2779. "Move forward to next end of function.
  2780. With argument, do this that many times.
  2781. With negative argument go towards the beginning of the buffer."
  2782. (interactive "p")
  2783. (or arg (setq arg 1))
  2784. (let ((first t))
  2785. ;; Forward
  2786. (while (and (> arg 0) (< (point) (point-max)))
  2787. (let ((pos (point)))
  2788. (while (progn
  2789. (if (and first
  2790. (progn
  2791. (forward-char 1)
  2792. (erlang-beginning-of-clause 1)))
  2793. nil
  2794. (or (bobp) (forward-char -1))
  2795. (erlang-beginning-of-clause -1))
  2796. (setq first nil)
  2797. (erlang-pass-over-function)
  2798. (skip-chars-forward " \t")
  2799. (if (looking-at "[%\n]")
  2800. (forward-line 1))
  2801. (<= (point) pos))))
  2802. (setq arg (1- arg)))
  2803. ;; Backward
  2804. (while (< arg 0)
  2805. (let ((pos (point)))
  2806. (erlang-beginning-of-clause 1)
  2807. (erlang-pass-over-function)
  2808. (forward-line 1)
  2809. (if (>= (point) pos)
  2810. (if (erlang-beginning-of-function 2)
  2811. (progn
  2812. (erlang-pass-over-function)
  2813. (skip-chars-forward " \t")
  2814. (if (looking-at "[%\n]")
  2815. (forward-line 1)))
  2816. (goto-char (point-min)))))
  2817. (setq arg (1+ arg)))))
  2818. (eval-and-compile
  2819. (if (default-boundp 'beginning-of-defun-function)
  2820. (defalias 'erlang-mark-function 'mark-defun)
  2821. (defun erlang-mark-function ()
  2822. "Put mark at end of function, point at beginning."
  2823. (interactive)
  2824. (push-mark (point))
  2825. (erlang-end-of-function 1)
  2826. ;; Sets the region. In Emacs 19 and XEmacs, we want to activate
  2827. ;; the region.
  2828. (condition-case nil
  2829. (push-mark (point) nil t)
  2830. (error (push-mark (point))))
  2831. (erlang-beginning-of-function 1)
  2832. ;; The above function deactivates the mark.
  2833. (if (boundp 'deactivate-mark)
  2834. (funcall (symbol-function 'set) 'deactivate-mark nil)))))
  2835. (defun erlang-pass-over-function ()
  2836. (while (progn
  2837. (erlang-skip-blank)
  2838. (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)"))
  2839. (not (eobp))))
  2840. (forward-sexp 1))
  2841. (if (not (eobp))
  2842. (forward-char 1)))
  2843. (defun erlang-name-of-function ()
  2844. (save-excursion
  2845. ;; Skip over attribute leader.
  2846. (if (looking-at "-[ \t]*")
  2847. (re-search-forward "-[ \t]*" nil 'move))
  2848. (let ((start (point)))
  2849. (forward-sexp 1)
  2850. (buffer-substring start (point)))))
  2851. ;;; Miscellaneous
  2852. (defun erlang-fill-paragraph (&optional justify)
  2853. "Like \\[fill-paragraph], but handle Erlang comments.
  2854. If any of the current line is a comment, fill the comment or the
  2855. paragraph of it that point is in, preserving the comment's indentation
  2856. and initial `%':s."
  2857. (interactive "P")
  2858. (let ((has-comment nil)
  2859. ;; If has-comment, the appropriate fill-prefix for the comment.
  2860. comment-fill-prefix)
  2861. ;; Figure out what kind of comment we are looking at.
  2862. (save-excursion
  2863. (beginning-of-line)
  2864. (cond
  2865. ;; Find the command prefix.
  2866. ((looking-at (concat "\\s *" comment-start-skip))
  2867. (setq has-comment t)
  2868. (setq comment-fill-prefix (buffer-substring (match-beginning 0)
  2869. (match-end 0))))
  2870. ;; A line with some code, followed by a comment? Remember that the
  2871. ;; % which starts the comment shouldn't be part of a string or
  2872. ;; character.
  2873. ((progn
  2874. (while (not (looking-at "%\\|$"))
  2875. (skip-chars-forward "^%\n\"\\\\")
  2876. (cond
  2877. ((eq (char-after (point)) ?\\) (forward-char 2))
  2878. ((eq (char-after (point)) ?\") (forward-sexp 1))))
  2879. (looking-at comment-start-skip))
  2880. (setq has-comment t)
  2881. (setq comment-fill-prefix
  2882. (concat (make-string (current-column) ? )
  2883. (buffer-substring (match-beginning 0) (match-end 0)))))))
  2884. (if (not has-comment)
  2885. (fill-paragraph justify)
  2886. ;; Narrow to include only the comment, and then fill the region.
  2887. (save-restriction
  2888. (narrow-to-region
  2889. ;; Find the first line we should include in the region to fill.
  2890. (save-excursion
  2891. (while (and (zerop (forward-line -1))
  2892. (looking-at "^\\s *%")))
  2893. ;; We may have gone to far. Go forward again.
  2894. (or (looking-at "^\\s *%")
  2895. (forward-line 1))
  2896. (point))
  2897. ;; Find the beginning of the first line past the region to fill.
  2898. (save-excursion
  2899. (while (progn (forward-line 1)
  2900. (looking-at "^\\s *%")))
  2901. (point)))
  2902. ;; Lines with only % on them can be paragraph boundaries.
  2903. (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$"))
  2904. (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$"))
  2905. (fill-prefix comment-fill-prefix))
  2906. (fill-paragraph justify))))))
  2907. (defun erlang-uncomment-region (beg end)
  2908. "Uncomment all commented lines in the region."
  2909. (interactive "r")
  2910. (uncomment-region beg end))
  2911. (defun erlang-generate-new-clause ()
  2912. "Create additional Erlang clause header.
  2913. Parses the source file for the name of the current Erlang function.
  2914. Create the header containing the name, A pair of parentheses,
  2915. and an arrow. The space between the function name and the
  2916. first parenthesis is preserved. The point is placed between
  2917. the parentheses."
  2918. (interactive)
  2919. (let ((name (save-excursion
  2920. (and (erlang-beginning-of-clause)
  2921. (erlang-get-function-name t))))
  2922. (arrow (save-excursion
  2923. (and (erlang-beginning-of-clause)
  2924. (erlang-get-function-arrow)))))
  2925. (if (or (null arrow) (null name))
  2926. (error "Can't find name of current Erlang function"))
  2927. (if (and (bolp) (eolp))
  2928. nil
  2929. (end-of-line)
  2930. (newline))
  2931. (insert name)
  2932. (save-excursion
  2933. (insert ") " arrow))
  2934. (if erlang-new-clause-with-arguments
  2935. (erlang-clone-arguments))))
  2936. (defun erlang-clone-arguments ()
  2937. "Insert, at the point, the argument list of the previous clause.
  2938. The mark is set at the beginning of the inserted text, the point
  2939. at the end."
  2940. (interactive)
  2941. (let ((args (save-excursion
  2942. (beginning-of-line)
  2943. (and (erlang-beginning-of-clause)
  2944. (erlang-get-function-arguments))))
  2945. (p (point)))
  2946. (if (null args)
  2947. (error "Can't clone argument list"))
  2948. (insert args)
  2949. (set-mark p)))
  2950. ;;; Information retrieval functions.
  2951. (defun erlang-buffer-substring (beg end)
  2952. "Like `buffer-substring-no-properties'.
  2953. Although, this function works on all versions of Emacs."
  2954. (if (fboundp 'buffer-substring-no-properties)
  2955. (funcall (symbol-function 'buffer-substring-no-properties) beg end)
  2956. (buffer-substring beg end)))
  2957. (defun erlang-get-module ()
  2958. "Return the name of the module as specified by `-module'.
  2959. Return nil if file contains no `-module' attribute."
  2960. (save-excursion
  2961. (save-restriction
  2962. (widen)
  2963. (goto-char (point-min))
  2964. (let ((md (match-data)))
  2965. (unwind-protect
  2966. (if (re-search-forward
  2967. (eval-when-compile
  2968. (concat "^-module\\s *(\\s *\\(\\("
  2969. erlang-atom-regexp
  2970. "\\)?\\)\\s *)\\s *\\."))
  2971. (point-max) t)
  2972. (erlang-remove-quotes
  2973. (erlang-buffer-substring (match-beginning 1)
  2974. (match-end 1)))
  2975. nil)
  2976. (store-match-data md))))))
  2977. (defun erlang-get-module-from-file-name (&optional file)
  2978. "Extract the module name from a file name.
  2979. First, the directory part is removed. Second, the part of the file name
  2980. matching `erlang-file-name-extension-regexp' is removed.
  2981. Should the match fail, nil is returned.
  2982. By modifying `erlang-file-name-extension-regexp' to match files other
  2983. than Erlang source files, Erlang specific functions could be applied on
  2984. non-Erlang files. Most notably; the support for Erlang modules in the
  2985. tags system could be used by files written in other languages."
  2986. (or file (setq file buffer-file-name))
  2987. (if (null file)
  2988. nil
  2989. (setq file (file-name-nondirectory file))
  2990. (if (string-match erlang-file-name-extension-regexp file)
  2991. (substring file 0 (match-beginning 0))
  2992. nil)))
  2993. ;; Used by `erlang-get-export' and `erlang-get-import'.
  2994. (defun erlang-get-function-arity-list ()
  2995. "Parse list of `function/arity' as used by `-import' and `-export'.
  2996. Point must be before the opening bracket. When the
  2997. function returns the point will be placed after the closing bracket.
  2998. The function does not return an error if the list is incorrectly
  2999. formatted.
  3000. Return list of (function . arity). The order of the returned list
  3001. corresponds to the order of the parsed Erlang list."
  3002. (let ((res '()))
  3003. (erlang-skip-blank)
  3004. (forward-char 1)
  3005. (if (not (eq (preceding-char) ?\[))
  3006. '() ; Not looking at an Erlang list.
  3007. (while ; Note: `while' has no body.
  3008. (progn
  3009. (erlang-skip-blank)
  3010. (and (looking-at (eval-when-compile
  3011. (concat erlang-atom-regexp "/\\([0-9]+\\)\\>")))
  3012. (progn
  3013. (setq res (cons
  3014. (cons
  3015. (erlang-remove-quotes
  3016. (erlang-buffer-substring
  3017. (match-beginning 1) (match-end 1)))
  3018. (erlang-string-to-int
  3019. (erlang-buffer-substring
  3020. (match-beginning
  3021. (+ 1 erlang-atom-regexp-matches))
  3022. (match-end
  3023. (+ 1 erlang-atom-regexp-matches)))))
  3024. res))
  3025. (goto-char (match-end 0))
  3026. (erlang-skip-blank)
  3027. (forward-char 1)
  3028. ;; Test if there are more exported functions.
  3029. (eq (preceding-char) ?,))))))
  3030. (nreverse res)))
  3031. ;;; Note that `-export' and the open parenthesis must be written on
  3032. ;;; the same line.
  3033. (defun erlang-get-export ()
  3034. "Return a list of `(function . arity)' as specified by `-export'."
  3035. (save-excursion
  3036. (goto-char (point-min))
  3037. (let ((md (match-data))
  3038. (res '()))
  3039. (unwind-protect
  3040. (progn
  3041. (while (re-search-forward "^-export\\s *(" (point-max) t)
  3042. (erlang-skip-blank)
  3043. (setq res (nconc res (erlang-get-function-arity-list))))
  3044. res)
  3045. (store-match-data md)))))
  3046. (defun erlang-get-import ()
  3047. "Parse an Erlang source file for imported functions.
  3048. Return an alist with module name as car part and list of conses containing
  3049. function and arity as cdr part."
  3050. (save-excursion
  3051. (goto-char (point-min))
  3052. (let ((md (match-data))
  3053. (res '()))
  3054. (unwind-protect
  3055. (progn
  3056. (while (re-search-forward "^-import\\s *(" (point-max) t)
  3057. (erlang-skip-blank)
  3058. (if (looking-at erlang-atom-regexp)
  3059. (let ((module (erlang-remove-quotes
  3060. (erlang-buffer-substring
  3061. (match-beginning 0)
  3062. (match-end 0)))))
  3063. (goto-char (match-end 0))
  3064. (erlang-skip-blank)
  3065. (if (eq (following-char) ?,)
  3066. (progn
  3067. (forward-char 1)
  3068. (erlang-skip-blank)
  3069. (let ((funcs (erlang-get-function-arity-list))
  3070. (pair (assoc module res)))
  3071. (if pair
  3072. (setcdr pair (nconc (cdr pair) funcs))
  3073. (setq res (cons (cons module funcs)
  3074. res)))))))))
  3075. (nreverse res))
  3076. (store-match-data md)))))
  3077. (defun erlang-get-function-name (&optional arg)
  3078. "Return name of current function, or nil.
  3079. If optional argument is non-nil, everything up to and including
  3080. the first `(' is returned.
  3081. Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
  3082. (save-excursion
  3083. (if (not (eobp)) (forward-char 1))
  3084. (and (erlang-beginning-of-clause)
  3085. (erlang-get-function-name t)))"
  3086. (let ((n (if arg 0 1)))
  3087. (and (looking-at (eval-when-compile
  3088. (concat "^" erlang-atom-regexp "\\s *(")))
  3089. (erlang-buffer-substring (match-beginning n) (match-end n)))))
  3090. (defun erlang-get-function-arrow ()
  3091. "Return arrow of current function, could be \"->\" or nil.
  3092. Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
  3093. (save-excursion
  3094. (if (not (eobp)) (forward-char 1))
  3095. (and (erlang-beginning-of-clause)
  3096. (erlang-get-function-arrow)))"
  3097. (and
  3098. (save-excursion
  3099. (re-search-forward "->" (point-max) t)
  3100. (erlang-buffer-substring (- (point) 2) (+ (point) 1)))))
  3101. (defun erlang-get-function-arity ()
  3102. "Return the number of arguments of function at point, or nil."
  3103. (and (looking-at (eval-when-compile
  3104. (concat "^" erlang-atom-regexp "\\s *(")))
  3105. (save-excursion
  3106. (goto-char (match-end 0))
  3107. (condition-case nil
  3108. (let ((res 0)
  3109. (cont t))
  3110. (while cont
  3111. (cond ((eobp)
  3112. (setq res nil)
  3113. (setq cont nil))
  3114. ((looking-at "\\s *)")
  3115. (setq cont nil))
  3116. ((looking-at "\\s *\\($\\|%\\)")
  3117. (forward-line 1))
  3118. ((looking-at "\\s *,")
  3119. (setq res (+ 1 res))
  3120. (goto-char (match-end 0)))
  3121. (t
  3122. (when (zerop res)
  3123. (setq res (+ 1 res)))
  3124. (forward-sexp 1))))
  3125. res)
  3126. (error nil)))))
  3127. (defun erlang-get-function-name-and-arity ()
  3128. "Return the name and arity of the function at point, or nil.
  3129. The return value is a string of the form \"foo/1\"."
  3130. (let ((name (erlang-get-function-name))
  3131. (arity (erlang-get-function-arity)))
  3132. (and name arity (format "%s/%d" name arity))))
  3133. (defun erlang-get-function-arguments ()
  3134. "Return arguments of current function, or nil."
  3135. (if (not (looking-at (eval-when-compile
  3136. (concat "^" erlang-atom-regexp "\\s *("))))
  3137. nil
  3138. (save-excursion
  3139. (condition-case nil
  3140. (let ((start (match-end 0)))
  3141. (goto-char (- start 1))
  3142. (forward-sexp)
  3143. (erlang-buffer-substring start (- (point) 1)))
  3144. (error nil)))))
  3145. (defun erlang-get-function-under-point ()
  3146. "Return the module and function under the point, or nil.
  3147. Should no explicit module name be present at the point, the
  3148. list of imported functions is searched.
  3149. The following could be returned:
  3150. (\"module\" \"function\") -- Both module and function name found.
  3151. (nil \"function\") -- No module name was found.
  3152. nil -- No function name found
  3153. In the future the list may contain more elements."
  3154. (save-excursion
  3155. (let ((md (match-data))
  3156. (res nil))
  3157. (if (eq (char-syntax (following-char)) ? )
  3158. (skip-chars-backward " \t"))
  3159. (skip-chars-backward "a-zA-Z0-9_:'")
  3160. (cond ((looking-at (eval-when-compile
  3161. (concat erlang-atom-regexp ":" erlang-atom-regexp)))
  3162. (setq res (list
  3163. (erlang-remove-quotes
  3164. (erlang-buffer-substring
  3165. (match-beginning 1) (match-end 1)))
  3166. (erlang-remove-quotes
  3167. (erlang-buffer-substring
  3168. (match-beginning (1+ erlang-atom-regexp-matches))
  3169. (match-end (1+ erlang-atom-regexp-matches)))))))
  3170. ((looking-at erlang-atom-regexp)
  3171. (let ((fk (erlang-remove-quotes
  3172. (erlang-buffer-substring
  3173. (match-beginning 0) (match-end 0))))
  3174. (mod nil)
  3175. (imports (erlang-get-import)))
  3176. (while (and imports (null mod))
  3177. (if (assoc fk (cdr (car imports)))
  3178. (setq mod (car (car imports)))
  3179. (setq imports (cdr imports))))
  3180. (setq res (list mod fk)))))
  3181. (store-match-data md)
  3182. res)))
  3183. ;; TODO: Escape single quotes inside the string without
  3184. ;; replace-regexp-in-string.
  3185. (defun erlang-add-quotes-if-needed (str)
  3186. "Return STR, possibly with quotes."
  3187. (let ((case-fold-search nil)) ; force string matching to be case sensitive
  3188. (if (and (stringp str)
  3189. (not (string-match (eval-when-compile
  3190. (concat "\\`" erlang-atom-regexp "\\'")) str)))
  3191. (progn (if (fboundp 'replace-regexp-in-string)
  3192. (setq str (replace-regexp-in-string "'" "\\'" str t t )))
  3193. (concat "'" str "'"))
  3194. str)))
  3195. (defun erlang-remove-quotes (str)
  3196. "Return STR without quotes, if present."
  3197. (let ((md (match-data)))
  3198. (prog1
  3199. (if (string-match "\\`'\\(.*\\)'\\'" str)
  3200. (substring str 1 -1)
  3201. str)
  3202. (store-match-data md))))
  3203. ;;; Check module name
  3204. ;; The function `write-file', bound to C-x C-w, calls
  3205. ;; `set-visited-file-name' which clears the hook. :-(
  3206. ;; To make sure that the hook always is present, we advise
  3207. ;; `set-visited-file-name'.
  3208. (defun erlang-check-module-name-init ()
  3209. "Initialize the functionality to compare file and module names.
  3210. Unless we have `before-save-hook', we redefine the function
  3211. `set-visited-file-name' since it clears the variable
  3212. `local-write-file-hooks'. The original function definition is
  3213. stored in `erlang-orig-set-visited-file-name'."
  3214. (if (boundp 'before-save-hook)
  3215. ;; If we have that, `make-local-hook' is obsolete.
  3216. (add-hook 'before-save-hook 'erlang-check-module-name nil t)
  3217. (require 'advice)
  3218. (unless (ad-advised-definition-p 'set-visited-file-name)
  3219. (defadvice set-visited-file-name (after erlang-set-visited-file-name
  3220. activate)
  3221. (if (eq major-mode 'erlang-mode)
  3222. (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
  3223. (add-hook 'local-write-file-hooks 'erlang-check-module-name)))
  3224. (defun erlang-check-module-name ()
  3225. "If the module name doesn't match file name, ask for permission to change.
  3226. The variable `erlang-check-module-name' controls the behaviour of this
  3227. function. It it is nil, this function does nothing. If it is t, the
  3228. source is silently changed. If it is set to the atom `ask', the user
  3229. is prompted.
  3230. This function is normally placed in the hook `local-write-file-hooks'."
  3231. (if erlang-check-module-name
  3232. (let ((mn (erlang-add-quotes-if-needed
  3233. (erlang-get-module)))
  3234. (fn (erlang-add-quotes-if-needed
  3235. (erlang-get-module-from-file-name (buffer-file-name)))))
  3236. (if (and (stringp mn) (stringp fn))
  3237. (or (string-equal mn fn)
  3238. (if (or (eq erlang-check-module-name t)
  3239. (y-or-n-p
  3240. "Module does not match file name. Modify source? "))
  3241. (save-excursion
  3242. (save-restriction
  3243. (widen)
  3244. (goto-char (point-min))
  3245. (if (re-search-forward
  3246. (eval-when-compile
  3247. (concat "^-module\\s *(\\s *\\(\\("
  3248. erlang-atom-regexp
  3249. "\\)?\\)\\s *)\\s *\\."))
  3250. (point-max) t)
  3251. (progn
  3252. (goto-char (match-beginning 1))
  3253. (delete-region (match-beginning 1)
  3254. (match-end 1))
  3255. (insert fn))))))))))
  3256. ;; Must return nil since it is added to `local-write-file-hook'.
  3257. nil)
  3258. ;;; Electric functions.
  3259. (defun erlang-electric-semicolon (&optional arg)
  3260. "Insert a semicolon character and possibly a prototype for the next line.
  3261. The variable `erlang-electric-semicolon-criteria' states a criterion,
  3262. when fulfilled a newline is inserted, the next line is indented and a
  3263. prototype for the next line is inserted. Normally the prototype
  3264. consists of \" ->\". Should the semicolon end the clause a new clause
  3265. header is generated.
  3266. The variable `erlang-electric-semicolon-insert-blank-lines' controls
  3267. the number of blank lines inserted between the current line and new
  3268. function header.
  3269. Behaves just like the normal semicolon when supplied with a
  3270. numerical arg, point is inside string or comment, or when there are
  3271. non-whitespace characters following the point on the current line."
  3272. (interactive "P")
  3273. (self-insert-command (prefix-numeric-value arg))
  3274. (if (or arg
  3275. (and (listp erlang-electric-commands)
  3276. (not (memq 'erlang-electric-semicolon
  3277. erlang-electric-commands)))
  3278. (erlang-in-literal)
  3279. (not (looking-at "\\s *\\(%.*\\)?$"))
  3280. (null (erlang-test-criteria-list
  3281. erlang-electric-semicolon-criteria)))
  3282. (setq erlang-electric-newline-inhibit nil)
  3283. (setq erlang-electric-newline-inhibit t)
  3284. (undo-boundary)
  3285. (erlang-indent-line)
  3286. (end-of-line)
  3287. (newline)
  3288. (if (condition-case nil
  3289. (progn (erlang-indent-line) t)
  3290. (error (if (bolp) (delete-backward-char 1))))
  3291. (if (not (bolp))
  3292. (save-excursion
  3293. (insert " ->"))
  3294. (condition-case nil
  3295. (progn
  3296. (erlang-generate-new-clause)
  3297. (if erlang-electric-semicolon-insert-blank-lines
  3298. (save-excursion
  3299. (beginning-of-line)
  3300. (newline
  3301. erlang-electric-semicolon-insert-blank-lines))))
  3302. (error (if (bolp) (delete-backward-char 1))))))))
  3303. (defun erlang-electric-comma (&optional arg)
  3304. "Insert a comma character and possibly a new indented line.
  3305. The variable `erlang-electric-comma-criteria' states a criterion,
  3306. when fulfilled a newline is inserted and the next line is indented.
  3307. Behaves just like the normal comma when supplied with a
  3308. numerical arg, point is inside string or comment, or when there are
  3309. non-whitespace characters following the point on the current line."
  3310. (interactive "P")
  3311. (self-insert-command (prefix-numeric-value arg))
  3312. (if (or arg
  3313. (and (listp erlang-electric-commands)
  3314. (not (memq 'erlang-electric-comma erlang-electric-commands)))
  3315. (erlang-in-literal)
  3316. (not (looking-at "\\s *\\(%.*\\)?$"))
  3317. (null (erlang-test-criteria-list
  3318. erlang-electric-comma-criteria)))
  3319. (setq erlang-electric-newline-inhibit nil)
  3320. (setq erlang-electric-newline-inhibit t)
  3321. (undo-boundary)
  3322. (erlang-indent-line)
  3323. (end-of-line)
  3324. (newline)
  3325. (condition-case nil
  3326. (erlang-indent-line)
  3327. (error (if (bolp) (delete-backward-char 1))))))
  3328. (defun erlang-electric-lt (&optional arg)
  3329. "Insert a less-than sign, and optionally mark it as an open paren."
  3330. (interactive "p")
  3331. (self-insert-command arg)
  3332. ;; Was this the second char in bit-syntax open (`<<')?
  3333. (unless (< (point) 2)
  3334. (save-excursion
  3335. (backward-char 2)
  3336. (when (and (eq (char-after (point)) ?<)
  3337. (not (eq (get-text-property (point) 'category)
  3338. 'bitsyntax-open-inner)))
  3339. ;; Then mark the two chars...
  3340. (put-text-property (point) (1+ (point))
  3341. 'category 'bitsyntax-open-outer)
  3342. (forward-char 1)
  3343. (put-text-property (point) (1+ (point))
  3344. 'category 'bitsyntax-open-inner)
  3345. ;;...and unmark any subsequent less-than chars.
  3346. (forward-char 1)
  3347. (while (eq (char-after (point)) ?<)
  3348. (remove-text-properties (point) (1+ (point))
  3349. '(category nil))
  3350. (forward-char 1))))))
  3351. (defun erlang-after-bitsyntax-close ()
  3352. "Return t if point is immediately after a bit-syntax close parenthesis (`>>')."
  3353. (and (>= (point) 2)
  3354. (save-excursion
  3355. (backward-char 2)
  3356. (and (eq (char-after (point)) ?>)
  3357. (not (eq (get-text-property (point) 'category)
  3358. 'bitsyntax-close-outer))))))
  3359. (defun erlang-after-arrow ()
  3360. "Return true if point is immediately after a function arrow (`->')."
  3361. (and (>= (point) 2)
  3362. (and
  3363. (save-excursion
  3364. (backward-char)
  3365. (eq (char-before (point)) ?-))
  3366. (or (not (listp erlang-electric-commands))
  3367. (memq 'erlang-electric-gt
  3368. erlang-electric-commands))
  3369. (not (erlang-in-literal))
  3370. (looking-at "\\s *\\(%.*\\)?$")
  3371. (erlang-test-criteria-list erlang-electric-arrow-criteria))))
  3372. (defun erlang-electric-gt (&optional arg)
  3373. "Insert a greater-than sign, and optionally mark it as a close paren."
  3374. (interactive "p")
  3375. (self-insert-command arg)
  3376. (cond
  3377. ;; Did we just write a bit-syntax close (`>>')?
  3378. ((erlang-after-bitsyntax-close)
  3379. (save-excursion
  3380. ;; Then mark the two chars...
  3381. (backward-char 2)
  3382. (put-text-property (point) (1+ (point))
  3383. 'category 'bitsyntax-close-inner)
  3384. (forward-char)
  3385. (put-text-property (point) (1+ (point))
  3386. 'category 'bitsyntax-close-outer)
  3387. ;;...and unmark any subsequent greater-than chars.
  3388. (forward-char)
  3389. (while (eq (char-after (point)) ?>)
  3390. (remove-text-properties (point) (1+ (point))
  3391. '(category nil))
  3392. (forward-char))))
  3393. ;; Did we just write a function arrow (`->')?
  3394. ((erlang-after-arrow)
  3395. (let ((erlang-electric-newline-inhibit t))
  3396. (undo-boundary)
  3397. (end-of-line)
  3398. (newline)
  3399. (condition-case nil
  3400. (erlang-indent-line)
  3401. (error (if (bolp) (delete-backward-char 1))))))
  3402. ;; Then it's just a plain greater-than.
  3403. (t
  3404. nil)))
  3405. (defun erlang-electric-arrow\ off (&optional arg)
  3406. "Insert a '>'-sign and possibly a new indented line.
  3407. This command is only `electric' when the `>' is part of an `->' arrow.
  3408. The variable `erlang-electric-arrow-criteria' states a sequence of
  3409. criteria, which decides when a newline should be inserted and the next
  3410. line indented.
  3411. It behaves just like the normal greater than sign when supplied with a
  3412. numerical arg, point is inside string or comment, or when there are
  3413. non-whitespace characters following the point on the current line.
  3414. After being split/merged into `erlang-after-arrow' and
  3415. `erlang-electric-gt', it is now unused and disabled."
  3416. (interactive "P")
  3417. (let ((prec (preceding-char)))
  3418. (self-insert-command (prefix-numeric-value arg))
  3419. (if (or arg
  3420. (and (listp erlang-electric-commands)
  3421. (not (memq 'erlang-electric-arrow
  3422. erlang-electric-commands)))
  3423. (not (eq prec ?-))
  3424. (erlang-in-literal)
  3425. (not (looking-at "\\s *\\(%.*\\)?$"))
  3426. (null (erlang-test-criteria-list
  3427. erlang-electric-arrow-criteria)))
  3428. (setq erlang-electric-newline-inhibit nil)
  3429. (setq erlang-electric-newline-inhibit t)
  3430. (undo-boundary)
  3431. (end-of-line)
  3432. (newline)
  3433. (condition-case nil
  3434. (erlang-indent-line)
  3435. (error (if (bolp) (delete-backward-char 1)))))))
  3436. (defun erlang-electric-newline (&optional arg)
  3437. "Break line at point and indent, continuing comment if within one.
  3438. The variable `erlang-electric-newline-criteria' states a criterion,
  3439. when fulfilled a newline is inserted and the next line is indented.
  3440. Should the current line begin with a comment, and the variable
  3441. `comment-multi-line' be non-nil, a new comment start is inserted.
  3442. Should the previous command be another electric command we assume that
  3443. the user pressed newline out of old habit, hence we will do nothing."
  3444. (interactive "P")
  3445. (cond ((and (not arg)
  3446. erlang-electric-newline-inhibit
  3447. (memq last-command erlang-electric-newline-inhibit-list))
  3448. ()) ; Do nothing!
  3449. ((or arg
  3450. (and (listp erlang-electric-commands)
  3451. (not (memq 'erlang-electric-newline
  3452. erlang-electric-commands)))
  3453. (null (erlang-test-criteria-list
  3454. erlang-electric-newline-criteria)))
  3455. (newline (prefix-numeric-value arg)))
  3456. (t
  3457. (if (and comment-multi-line
  3458. (save-excursion
  3459. (beginning-of-line)
  3460. (looking-at (concat "\\s *" comment-start-skip))))
  3461. (let ((str (buffer-substring
  3462. (or (match-end 1) (match-beginning 0))
  3463. (min (match-end 0) (point)))))
  3464. (newline)
  3465. (undo-boundary)
  3466. (insert str))
  3467. (newline)
  3468. (undo-boundary)
  3469. (indent-according-to-mode)))))
  3470. (defun erlang-test-criteria-list (criteria)
  3471. "Given a list of criterion functions, test if criteria are fulfilled.
  3472. Each element in the criteria list can a function returning nil, t or
  3473. the atom `stop'. t means that the criterion is fulfilled, `stop' means
  3474. that it isn't fulfilled and that the search should stop,
  3475. and nil means continue searching.
  3476. Should the list contain the atom t the criterion is assumed to be
  3477. fulfilled, unless preceded by a function returning `stop', of course.
  3478. Should the argument be the atom t instead of a list, the criterion is
  3479. assumed to be trivially true.
  3480. Should all functions return nil, the criteria are assumed not to be
  3481. fulfilled.
  3482. Return t if criteria fulfilled, nil otherwise."
  3483. (if (eq criteria t)
  3484. t
  3485. (save-excursion
  3486. (let ((answer nil))
  3487. (while (and criteria (null answer))
  3488. (if (eq (car criteria) t)
  3489. (setq answer t)
  3490. (setq answer (funcall (car criteria))))
  3491. (setq criteria (cdr criteria)))
  3492. (if (and answer (not (eq answer 'stop)))
  3493. t
  3494. nil)))))
  3495. (defun erlang-in-literal (&optional lim)
  3496. "Test if point is in string, quoted atom or comment.
  3497. Return one of the three atoms `atom', `string', and `comment'.
  3498. Should the point be inside none of the above mentioned types of
  3499. context, nil is returned."
  3500. (save-excursion
  3501. (let* ((lim (or lim (save-excursion
  3502. (erlang-beginning-of-clause)
  3503. (point))))
  3504. (state (if (fboundp 'syntax-ppss) ; post Emacs 21.3
  3505. (funcall (symbol-function 'syntax-ppss))
  3506. (parse-partial-sexp lim (point)))))
  3507. (cond
  3508. ((eq (nth 3 state) ?') 'atom)
  3509. ((nth 3 state) 'string)
  3510. ((nth 4 state) 'comment)
  3511. (t nil)))))
  3512. (defun erlang-at-end-of-function-p ()
  3513. "Test if point is at end of an Erlang function.
  3514. This function is designed to be a member of a criteria list."
  3515. (eq (save-excursion (erlang-skip-blank) (point))
  3516. (save-excursion
  3517. (erlang-beginning-of-function -1) (point))))
  3518. (defun erlang-at-end-of-clause-p ()
  3519. "Test if point is at end of an Erlang clause.
  3520. This function is designed to be a member of a criteria list."
  3521. (eq (save-excursion (erlang-skip-blank) (point))
  3522. (save-excursion
  3523. (erlang-beginning-of-clause -1) (point))))
  3524. (defun erlang-stop-when-inside-argument-list ()
  3525. "Return `stop' if inside parenthesis list, nil otherwise.
  3526. Knows about the list comprehension syntax. When the point is
  3527. after `||', `stop' is not returned.
  3528. This function is designed to be a member of a criteria list."
  3529. (save-excursion
  3530. (condition-case nil
  3531. (let ((orig-point (point))
  3532. (state nil))
  3533. (up-list -1)
  3534. (if (not (eq (following-char) ?\[))
  3535. 'stop
  3536. ;; Do not return `stop' when inside a list comprehension
  3537. ;; construction. (The point must be after `||').
  3538. (while (< (point) orig-point)
  3539. (setq state (erlang-partial-parse (point) orig-point state)))
  3540. (if (and (car state) (eq (car (car (car state))) '||))
  3541. nil
  3542. 'stop)))
  3543. (error
  3544. nil))))
  3545. (defun erlang-stop-when-at-guard ()
  3546. "Return `stop' when at function guards.
  3547. This function is designed to be a member of a criteria list."
  3548. (save-excursion
  3549. (beginning-of-line)
  3550. (if (and (looking-at (eval-when-compile
  3551. (concat "^" erlang-atom-regexp "\\s *(")))
  3552. (not (looking-at
  3553. (eval-when-compile
  3554. (concat "^" erlang-atom-regexp ".*->")))))
  3555. 'stop
  3556. nil)))
  3557. (defun erlang-stop-when-in-type-spec ()
  3558. "Return `stop' when in a type spec line.
  3559. This function is designed to be a member of a criteria list."
  3560. (save-excursion
  3561. (beginning-of-line)
  3562. (when (save-match-data (looking-at "-\\(spec\\|type\\)"))
  3563. 'stop)))
  3564. (defun erlang-next-lines-empty-p ()
  3565. "Return non-nil if next lines are empty.
  3566. The variable `erlang-next-lines-empty-threshold' contains the number
  3567. of lines required to be empty.
  3568. A line containing only spaces and tabs is considered empty.
  3569. This function is designed to be a member of a criteria list."
  3570. (and erlang-next-lines-empty-threshold
  3571. (save-excursion
  3572. (let ((left erlang-next-lines-empty-threshold)
  3573. (cont t))
  3574. (while (and cont (> left 0))
  3575. (forward-line 1)
  3576. (setq cont (looking-at "\\s *$"))
  3577. (setq left (- left 1)))
  3578. cont))))
  3579. (defun erlang-at-keyword-end-p ()
  3580. "Test if next readable token is the keyword end.
  3581. This function is designed to be a member of a criteria list."
  3582. (save-excursion
  3583. (erlang-skip-blank)
  3584. (looking-at "end[^_a-zA-Z0-9]")))
  3585. ;; Erlang tags support which is aware of erlang modules.
  3586. ;;
  3587. ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags
  3588. ;; package works under XEmacs.)
  3589. (eval-when-compile
  3590. (if (or (featurep 'bytecomp)
  3591. (featurep 'byte-compile))
  3592. (progn
  3593. (require 'etags))))
  3594. ;; Variables:
  3595. (defvar erlang-tags-function-alist
  3596. '((find-tag . erlang-find-tag)
  3597. (find-tag-other-window . erlang-find-tag-other-window)
  3598. (find-tag-regexp . erlang-find-tag-regexp)
  3599. (find-tag-other-frame . erlang-find-tag-other-frame))
  3600. "Alist of old tags commands and the replacement functions.")
  3601. (defvar erlang-tags-installed nil
  3602. "Non-nil when the Erlang tags system is installed.")
  3603. (defvar erlang-tags-file-list '()
  3604. "List of files in tag list. Used when finding tag on form `module:'.")
  3605. (defvar erlang-tags-completion-table nil
  3606. "Like `tags-completion-table', this table contains `tag' and `module:tag'.")
  3607. (defvar erlang-tags-buffer-installed-p nil
  3608. "Non-nil when Erlang module recognising functions installed.")
  3609. (defvar erlang-tags-buffer-list '()
  3610. "Temporary list of buffers.")
  3611. (defvar erlang-tags-orig-completion-table nil
  3612. "Temporary storage for `tags-completion-table'.")
  3613. (defvar erlang-tags-orig-tag-order nil
  3614. "Temporary storage for `find-tag-tag-order'.")
  3615. (defvar erlang-tags-orig-regexp-tag-order nil
  3616. "Temporary storage for `find-tag-regexp-tag-order'.")
  3617. (defvar erlang-tags-orig-search-function nil
  3618. "Temporary storage for `find-tag-search-function'.")
  3619. (defvar erlang-tags-orig-regexp-search-function nil
  3620. "Temporary storage for `find-tag-regexp-search-function'.")
  3621. (defvar erlang-tags-orig-format-hooks nil
  3622. "Temporary storage for `tags-table-format-hooks'.") ;v19
  3623. (defvar erlang-tags-orig-format-functions nil
  3624. "Temporary storage for `tags-table-format-functions'.") ;v > 19
  3625. (defun erlang-tags-init ()
  3626. "Install an alternate version of tags, aware of Erlang modules.
  3627. After calling this function, the tags functions are aware of
  3628. Erlang modules. Tags can be entered on the for `module:tag' as well
  3629. as on the old form `tag'.
  3630. In the completion list, `module:tag' and `module:' shows up.
  3631. Call this function from an appropriate init file, or add it to
  3632. Erlang mode hook with the commands:
  3633. (add-hook 'erlang-mode-hook 'erlang-tags-init)
  3634. (add-hook 'erlang-shell-mode-hook 'erlang-tags-init)
  3635. This function only works under Emacs 18 and Emacs 19. Currently, It
  3636. is not implemented under XEmacs. (Hint: The Emacs 19 etags module
  3637. works under XEmacs.)"
  3638. (interactive)
  3639. (cond ((= erlang-emacs-major-version 18)
  3640. (require 'tags)
  3641. (erlang-tags-define-keys (current-local-map))
  3642. (setq erlang-tags-installed t))
  3643. (t
  3644. (require 'etags)
  3645. ;; Test on a function available in the Emacs 19 version
  3646. ;; of tags but not in the XEmacs version.
  3647. (if (not (fboundp 'find-tag-noselect))
  3648. ()
  3649. (erlang-tags-define-keys (current-local-map))
  3650. (setq erlang-tags-installed t)))))
  3651. ;; Set all keys bound to `find-tag' et.al. in the global map and the
  3652. ;; menu to `erlang-find-tag' et.al. in `map'.
  3653. ;;
  3654. ;; The function `substitute-key-definition' does not work properly
  3655. ;; in all version of Emacs.
  3656. (defun erlang-tags-define-keys (map)
  3657. "Bind tags commands to keymap MAP aware of Erlang modules."
  3658. (let ((alist erlang-tags-function-alist))
  3659. (while alist
  3660. (let* ((old (car (car alist)))
  3661. (new (cdr (car alist)))
  3662. (keys (append (where-is-internal old global-map))))
  3663. (while keys
  3664. (define-key map (car keys) new)
  3665. (setq keys (cdr keys))))
  3666. (setq alist (cdr alist))))
  3667. ;; Update the menu.
  3668. (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist)
  3669. (erlang-menu-init))
  3670. ;; There exists a variable `find-tag-default-function'. It is not used
  3671. ;; since `complete-tag' uses it to get current word under point. In that
  3672. ;; situation we don't want the module to be prepended.
  3673. (defun erlang-find-tag-default ()
  3674. "Return the default tag.
  3675. Search `-import' list of imported functions.
  3676. Single quotes are been stripped away."
  3677. (let ((mod-func (erlang-get-function-under-point)))
  3678. (cond ((null mod-func)
  3679. nil)
  3680. ((null (car mod-func))
  3681. (nth 1 mod-func))
  3682. (t
  3683. (concat (car mod-func) ":" (nth 1 mod-func))))))
  3684. ;; Return `t' since it is used inside `tags-loop-form'.
  3685. ;;;###autoload
  3686. (defun erlang-find-tag (modtagname &optional next-p regexp-p)
  3687. "Like `find-tag'. Capable of retrieving Erlang modules.
  3688. Tags can be given on the forms `tag', `module:', `module:tag'."
  3689. (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
  3690. (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p))
  3691. t)
  3692. ;; Code mainly from `find-tag-other-window' in `etags.el'.
  3693. ;;;###autoload
  3694. (defun erlang-find-tag-other-window (tagname &optional next-p regexp-p)
  3695. "Like `find-tag-other-window' but aware of Erlang modules."
  3696. (interactive (erlang-tag-interactive
  3697. "Find `module:tag' or `tag' other window: "))
  3698. ;; This is to deal with the case where the tag is found in the
  3699. ;; selected window's buffer; without this, point is moved in both
  3700. ;; windows. To prevent this, we save the selected window's point
  3701. ;; before doing find-tag-noselect, and restore it afterwards.
  3702. (let* ((window-point (window-point (selected-window)))
  3703. (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p))
  3704. (tagpoint (progn (set-buffer tagbuf) (point))))
  3705. (set-window-point (prog1
  3706. (selected-window)
  3707. (switch-to-buffer-other-window tagbuf)
  3708. ;; We have to set this new window's point; it
  3709. ;; might already have been displaying a
  3710. ;; different portion of tagbuf, in which case
  3711. ;; switch-to-buffer-other-window doesn't set
  3712. ;; the window's point from the buffer.
  3713. (set-window-point (selected-window) tagpoint))
  3714. window-point)))
  3715. (defun erlang-find-tag-other-frame (tagname &optional next-p)
  3716. "Like `find-tag-other-frame' but aware of Erlang modules."
  3717. (interactive (erlang-tag-interactive
  3718. "Find `module:tag' or `tag' other frame: "))
  3719. (let ((pop-up-frames t))
  3720. (erlang-find-tag-other-window tagname next-p)))
  3721. (defun erlang-find-tag-regexp (regexp &optional next-p other-window)
  3722. "Like `find-tag-regexp' but aware of Erlang modules."
  3723. (interactive (if (fboundp 'find-tag-regexp)
  3724. (erlang-tag-interactive
  3725. "Find `module:regexp' or `regexp': ")
  3726. (error "This version of Emacs can't find tags by regexps")))
  3727. (funcall (if other-window
  3728. 'erlang-find-tag-other-window
  3729. 'erlang-find-tag)
  3730. regexp next-p t))
  3731. ;; Just like C-u M-. This could be added to the menu.
  3732. (defun erlang-find-next-tag ()
  3733. "Find next tag, like \\[find-tag] with prefix arg."
  3734. (interactive)
  3735. (let ((current-prefix-arg '(4)))
  3736. (if erlang-tags-installed
  3737. (call-interactively 'erlang-find-tag)
  3738. (call-interactively 'find-tag))))
  3739. ;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to
  3740. ;; be compatible with `tags.el'.
  3741. ;;
  3742. ;; Handles three cases:
  3743. ;; * `module:' Loop over all possible file names. Stop if a file-name
  3744. ;; without extension and directory matches the module.
  3745. ;;
  3746. ;; * `module:tag'
  3747. ;; Emacs 19: Replace test functions with functions aware of
  3748. ;; Erlang modules. Tricky because the etags system wasn't
  3749. ;; built for these kind of operations...
  3750. ;;
  3751. ;; Emacs 18: We loop over `find-tag' until we find a file
  3752. ;; whose module matches the requested module. The
  3753. ;; drawback is that a lot of files could be loaded into
  3754. ;; Emacs.
  3755. ;;
  3756. ;; * `tag' Just give it to `find-tag'.
  3757. (defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p)
  3758. "Like `find-tag-noselect' but aware of Erlang modules."
  3759. (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
  3760. (or modtagname
  3761. (setq modtagname (symbol-value 'last-tag)))
  3762. (funcall (symbol-function 'set) 'last-tag modtagname)
  3763. ;; `tags.el' uses this variable to record how M-, would
  3764. ;; know where to restart a tags command.
  3765. (if (boundp 'tags-loop-form)
  3766. (funcall (symbol-function 'set)
  3767. 'tags-loop-form '(erlang-find-tag nil t)))
  3768. (save-window-excursion
  3769. (cond
  3770. ((string-match ":$" modtagname)
  3771. ;; Only the module name was given. Read all files whose file name
  3772. ;; match.
  3773. (let ((modname (substring modtagname 0 (match-beginning 0)))
  3774. (file nil))
  3775. (if (not next-p)
  3776. (save-excursion
  3777. (visit-tags-table-buffer)
  3778. (setq erlang-tags-file-list
  3779. (funcall (symbol-function 'tags-table-files)))))
  3780. (while (null file)
  3781. (or erlang-tags-file-list
  3782. (save-excursion
  3783. (if (and (featurep 'etags)
  3784. (funcall
  3785. (symbol-function 'visit-tags-table-buffer) 'same)
  3786. (funcall
  3787. (symbol-function 'visit-tags-table-buffer) t))
  3788. (setq erlang-tags-file-list
  3789. (funcall (symbol-function 'tags-table-files)))
  3790. (error "No %stags containing %s" (if next-p "more " "")
  3791. modtagname))))
  3792. (if erlang-tags-file-list
  3793. (let ((this-module (erlang-get-module-from-file-name
  3794. (car erlang-tags-file-list))))
  3795. (if (and (stringp this-module)
  3796. (string= modname this-module))
  3797. (setq file (car erlang-tags-file-list)))
  3798. (setq erlang-tags-file-list (cdr erlang-tags-file-list)))))
  3799. (set-buffer (or (get-file-buffer file)
  3800. (find-file-noselect file)))))
  3801. ((string-match ":" modtagname)
  3802. (if (boundp 'find-tag-tag-order)
  3803. ;; Method one: Add module-recognising functions to the
  3804. ;; list of order functions. However, the tags system
  3805. ;; from Emacs 18, and derives thereof (read: XEmacs)
  3806. ;; hasn't got this feature.
  3807. (progn
  3808. (erlang-tags-install-module-check)
  3809. (unwind-protect
  3810. (funcall (symbol-function 'find-tag)
  3811. modtagname next-p regexp-p)
  3812. (erlang-tags-remove-module-check)))
  3813. ;; Method two: Call the tags system until a file matching
  3814. ;; the module is found. This could result in that many
  3815. ;; files are read. (e.g. The tag "foo:file" will take a
  3816. ;; while to process.)
  3817. (let* ((modname (substring modtagname 0 (match-beginning 0)))
  3818. (tagname (substring modtagname (match-end 0) nil))
  3819. (last-tag tagname)
  3820. file)
  3821. (while
  3822. (progn
  3823. (funcall (symbol-function 'find-tag) tagname next-p regexp-p)
  3824. (setq next-p t)
  3825. ;; Determine the module form the file name. (The
  3826. ;; alternative, to check `-module', would make this
  3827. ;; code useless for non-Erlang programs.)
  3828. (setq file (erlang-get-module-from-file-name buffer-file-name))
  3829. (not (and (stringp file)
  3830. (string= modname file))))))))
  3831. (t
  3832. (funcall (symbol-function 'find-tag) modtagname next-p regexp-p)))
  3833. (current-buffer))) ; Return the new buffer.
  3834. ;; Process interactive arguments for erlang-find-tag-*.
  3835. ;;
  3836. ;; Negative arguments work only for `etags', not `tags'. This is not
  3837. ;; a problem since negative arguments means step back into the
  3838. ;; history list, a feature not implemented in `tags'.
  3839. (defun erlang-tag-interactive (prompt)
  3840. (condition-case nil
  3841. (require 'etags)
  3842. (error
  3843. (require 'tags)))
  3844. (if current-prefix-arg
  3845. (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
  3846. '-
  3847. t))
  3848. (let* ((default (erlang-find-tag-default))
  3849. (prompt (if default
  3850. (format "%s(default %s) " prompt default)
  3851. prompt))
  3852. (spec (if (featurep 'etags)
  3853. (completing-read prompt 'erlang-tags-complete-tag)
  3854. (read-string prompt))))
  3855. (list (if (equal spec "")
  3856. (or default (error "There is no default tag"))
  3857. spec)))))
  3858. ;; Search tag functions which are aware of Erlang modules. The tactic
  3859. ;; is to store new search functions into the local variables of the
  3860. ;; TAGS buffers. The variables are restored directly after the
  3861. ;; search. The situation is complicated by the fact that new TAGS
  3862. ;; files can be loaded during the search.
  3863. ;;
  3864. (defun erlang-tags-install-module-check ()
  3865. "Install our own tag search functions."
  3866. ;; Make sure our functions are installed in TAGS files loaded
  3867. ;; into Emacs while searching.
  3868. (cond
  3869. ((>= erlang-emacs-major-version 20)
  3870. (setq erlang-tags-orig-format-functions
  3871. (symbol-value 'tags-table-format-functions))
  3872. (funcall (symbol-function 'set) 'tags-table-format-functions
  3873. (cons 'erlang-tags-recognize-tags-table
  3874. erlang-tags-orig-format-functions))
  3875. (setq erlang-tags-buffer-list '())
  3876. )
  3877. (t
  3878. (setq erlang-tags-orig-format-hooks
  3879. (symbol-value 'tags-table-format-hooks))
  3880. (funcall (symbol-function 'set) 'tags-table-format-hooks
  3881. (cons 'erlang-tags-recognize-tags-table
  3882. erlang-tags-orig-format-hooks))
  3883. (setq erlang-tags-buffer-list '())
  3884. ))
  3885. ;; Install our functions in the TAGS files already resident.
  3886. (save-excursion
  3887. (let ((files (symbol-value 'tags-table-computed-list)))
  3888. (while files
  3889. (if (stringp (car files))
  3890. (if (get-file-buffer (car files))
  3891. (progn
  3892. (set-buffer (get-file-buffer (car files)))
  3893. (erlang-tags-install-local))))
  3894. (setq files (cdr files))))))
  3895. (defun erlang-tags-install-local ()
  3896. "Install our tag search functions in current buffer."
  3897. (if erlang-tags-buffer-installed-p
  3898. ()
  3899. ;; Mark this buffer as "installed" and record.
  3900. (set (make-local-variable 'erlang-tags-buffer-installed-p) t)
  3901. (setq erlang-tags-buffer-list
  3902. (cons (current-buffer) erlang-tags-buffer-list))
  3903. ;; Save the original values.
  3904. (set (make-local-variable 'erlang-tags-orig-tag-order)
  3905. (symbol-value 'find-tag-tag-order))
  3906. (set (make-local-variable 'erlang-tags-orig-regexp-tag-order)
  3907. (symbol-value 'find-tag-regexp-tag-order))
  3908. (set (make-local-variable 'erlang-tags-orig-search-function)
  3909. (symbol-value 'find-tag-search-function))
  3910. (set (make-local-variable 'erlang-tags-orig-regexp-search-function)
  3911. (symbol-value 'find-tag-regexp-search-function))
  3912. ;; Install our own functions.
  3913. (set (make-local-variable 'find-tag-search-function)
  3914. 'erlang-tags-search-forward)
  3915. (set (make-local-variable 'find-tag-regexp-search-function)
  3916. 'erlang-tags-regexp-search-forward)
  3917. (set (make-local-variable 'find-tag-tag-order)
  3918. '(erlang-tag-match-module-p))
  3919. (set (make-local-variable 'find-tag-regexp-tag-order)
  3920. '(erlang-tag-match-module-regexp-p))))
  3921. (defun erlang-tags-remove-module-check ()
  3922. "Remove our own tags search functions."
  3923. (cond
  3924. ((>= erlang-emacs-major-version 20)
  3925. (funcall (symbol-function 'set)
  3926. 'tags-table-format-functions
  3927. erlang-tags-orig-format-functions)
  3928. )
  3929. (t
  3930. (funcall (symbol-function 'set)
  3931. 'tags-table-format-hooks
  3932. erlang-tags-orig-format-hooks)
  3933. ))
  3934. ;; Remove our functions from the TAGS files. (Note that
  3935. ;; `tags-table-computed-list' need not be the same list as when
  3936. ;; the search was started.)
  3937. (save-excursion
  3938. (let ((buffers erlang-tags-buffer-list))
  3939. (while buffers
  3940. (if (buffer-name (car buffers))
  3941. (progn
  3942. (set-buffer (car buffers))
  3943. (erlang-tags-remove-local)))
  3944. (setq buffers (cdr buffers))))))
  3945. (defun erlang-tags-remove-local ()
  3946. "Remove our tag search functions from current buffer."
  3947. (if (null erlang-tags-buffer-installed-p)
  3948. ()
  3949. (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil)
  3950. (funcall (symbol-function 'set)
  3951. 'find-tag-tag-order erlang-tags-orig-tag-order)
  3952. (funcall (symbol-function 'set)
  3953. 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order)
  3954. (funcall (symbol-function 'set)
  3955. 'find-tag-search-function erlang-tags-orig-search-function)
  3956. (funcall (symbol-function 'set)
  3957. 'find-tag-regexp-search-function
  3958. erlang-tags-orig-regexp-search-function)))
  3959. (defun erlang-tags-recognize-tags-table ()
  3960. "Install our functions in all loaded TAGS files.
  3961. This function is added to `tags-table-format-hooks/functions' when searching
  3962. for a tag on the form `module:tag'."
  3963. (if (null (funcall (symbol-function 'etags-recognize-tags-table)))
  3964. nil
  3965. (erlang-tags-install-local)
  3966. t))
  3967. (defun erlang-tags-search-forward (tag &optional bound noerror count)
  3968. "Forward search function, aware of Erlang module prefix."
  3969. (if (string-match ":" tag)
  3970. (setq tag (substring tag (match-end 0) nil)))
  3971. ;; Avoid unintended recursion.
  3972. (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward)
  3973. (search-forward tag bound noerror count)
  3974. (funcall erlang-tags-orig-search-function tag bound noerror count)))
  3975. (defun erlang-tags-regexp-search-forward (tag &optional bound noerror count)
  3976. "Forward regexp search function, aware of Erlang module prefix."
  3977. (if (string-match ":" tag)
  3978. (setq tag (substring tag (match-end 0) nil)))
  3979. (if (eq erlang-tags-orig-regexp-search-function
  3980. 'erlang-tags-regexp-search-forward)
  3981. (re-search-forward tag bound noerror count)
  3982. (funcall erlang-tags-orig-regexp-search-function
  3983. tag bound noerror count)))
  3984. ;; t if point is at a tag line that matches TAG, containing
  3985. ;; module information. Assumes that all other order functions
  3986. ;; are stored in `erlang-tags-orig-[regex]-tag-order'.
  3987. (defun erlang-tag-match-module-p (tag)
  3988. (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order))
  3989. (defun erlang-tag-match-module-regexp-p (tag)
  3990. (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order))
  3991. (defun erlang-tag-match-module-common-p (tag order)
  3992. (let ((mod nil)
  3993. (found nil))
  3994. (if (string-match ":" tag)
  3995. (progn
  3996. (setq mod (substring tag 0 (match-beginning 0)))
  3997. (setq tag (substring tag (match-end 0) nil))))
  3998. (while (and order (not found))
  3999. (setq found
  4000. (and (not (memq (car order)
  4001. '(erlang-tag-match-module-p
  4002. erlang-tag-match-module-regexp-p)))
  4003. (funcall (car order) tag)))
  4004. (setq order (cdr order)))
  4005. (and found
  4006. (or (null mod)
  4007. (string= mod (erlang-get-module-from-file-name
  4008. (file-of-tag)))))))
  4009. ;;; Tags completion, Emacs 19 `etags' specific.
  4010. ;;;
  4011. ;;; The basic idea is to create a second completion table `erlang-tags-
  4012. ;;; completion-table' containing all normal tags plus tags on the form
  4013. ;;; `module:tag'.
  4014. (defun erlang-complete-tag ()
  4015. "Perform tags completion on the text around point.
  4016. Completes to the set of names listed in the current tags table.
  4017. Should the Erlang tags system be installed this command knows
  4018. about Erlang modules."
  4019. (interactive)
  4020. (condition-case nil
  4021. (require 'etags)
  4022. (error nil))
  4023. (cond ((and erlang-tags-installed
  4024. (fboundp 'complete-tag)) ; Emacs 19
  4025. (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag)))
  4026. (fset 'tags-complete-tag
  4027. (symbol-function 'erlang-tags-complete-tag))
  4028. (unwind-protect
  4029. (funcall (symbol-function 'complete-tag))
  4030. (fset 'tags-complete-tag orig-tags-complete-tag))))
  4031. ((fboundp 'complete-tag) ; Emacs 19
  4032. (funcall (symbol-function 'complete-tag)))
  4033. ((fboundp 'tag-complete-symbol) ; XEmacs
  4034. (funcall (symbol-function 'tag-complete-symbol)))
  4035. (t
  4036. (error "This version of Emacs can't complete tags"))))
  4037. ;; Based on `tags-complete-tag', but this one uses
  4038. ;; `erlang-tags-completion-table' instead of `tags-completion-table'.
  4039. ;;
  4040. ;; This is the entry-point called by system function `completing-read'.
  4041. (defun erlang-tags-complete-tag (string predicate what)
  4042. (save-excursion
  4043. ;; If we need to ask for the tag table, allow that.
  4044. (let ((enable-recursive-minibuffers t))
  4045. (visit-tags-table-buffer))
  4046. (if (eq what t)
  4047. (all-completions string (erlang-tags-completion-table) predicate)
  4048. (try-completion string (erlang-tags-completion-table) predicate))))
  4049. ;; `tags-completion-table' calls itself recursively, make it
  4050. ;; call our own wedge instead. Note that the recursive call
  4051. ;; is very rare; it only occurs when a tags-file contains
  4052. ;; `include'-statements.
  4053. (defun erlang-tags-completion-table ()
  4054. "Build completion table. Tags on the form `tag' or `module:tag'."
  4055. (setq erlang-tags-orig-completion-table
  4056. (symbol-function 'tags-completion-table))
  4057. (fset 'tags-completion-table
  4058. (symbol-function 'erlang-tags-completion-table-1))
  4059. (unwind-protect
  4060. (erlang-tags-completion-table-1)
  4061. (fset 'tags-completion-table
  4062. erlang-tags-orig-completion-table)))
  4063. (defun erlang-tags-completion-table-1 ()
  4064. (make-local-variable 'erlang-tags-completion-table)
  4065. (or erlang-tags-completion-table
  4066. (let ((tags-completion-table nil)
  4067. (tags-completion-table-function
  4068. 'erlang-etags-tags-completion-table))
  4069. (funcall erlang-tags-orig-completion-table)
  4070. (setq erlang-tags-completion-table tags-completion-table))))
  4071. ;; Based on `etags-tags-completion-table'. The difference is that we
  4072. ;; add three symbols to the vector, the tag, module: and module:tag.
  4073. ;; The module is extracted from the file name of a tag. (This one
  4074. ;; only works if we are looking at an `etags' file. However, this is
  4075. ;; the only format supported by Emacs, so far.)
  4076. (defun erlang-etags-tags-completion-table ()
  4077. (let ((table (make-vector 511 0))
  4078. (file nil))
  4079. (save-excursion
  4080. (goto-char (point-min))
  4081. ;; This monster regexp matches an etags tag line.
  4082. ;; \1 is the string to match;
  4083. ;; \2 is not interesting;
  4084. ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
  4085. ;; \4 is not interesting;
  4086. ;; \5 is the explicitly-specified tag name.
  4087. ;; \6 is the line to start searching at;
  4088. ;; \7 is the char to start searching at.
  4089. (while (progn
  4090. (while (and
  4091. (eq (following-char) ?\f)
  4092. (looking-at "\f\n\\([^,\n]*\\),.*\n"))
  4093. (setq file (buffer-substring
  4094. (match-beginning 1) (match-end 1)))
  4095. (goto-char (match-end 0)))
  4096. (re-search-forward
  4097. "\
  4098. ^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
  4099. \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
  4100. \\([0-9]+\\)?,\\([0-9]+\\)?\n"
  4101. nil t))
  4102. (let ((tag (if (match-beginning 5)
  4103. ;; There is an explicit tag name.
  4104. (buffer-substring (match-beginning 5) (match-end 5))
  4105. ;; No explicit tag name. Best guess.
  4106. (buffer-substring (match-beginning 3) (match-end 3))))
  4107. (module (and file
  4108. (erlang-get-module-from-file-name file))))
  4109. (intern tag table)
  4110. (if (stringp module)
  4111. (progn
  4112. (intern (concat module ":" tag) table)
  4113. ;; Only the first one will be stored in the table.
  4114. (intern (concat module ":") table))))))
  4115. table))
  4116. ;;;
  4117. ;;; Prepare for other methods to run an Erlang slave process.
  4118. ;;;
  4119. (defvar erlang-shell-function 'inferior-erlang
  4120. "Command to execute start a new Erlang shell.
  4121. Change this variable to use your favorite
  4122. Erlang compilation package.")
  4123. (defvar erlang-shell-display-function 'inferior-erlang-run-or-select
  4124. "Command to execute to display Erlang shell.
  4125. Change this variable to use your favorite
  4126. Erlang compilation package.")
  4127. (defvar erlang-compile-function 'inferior-erlang-compile
  4128. "Command to execute to compile current buffer.
  4129. Change this variable to use your favorite
  4130. Erlang compilation package.")
  4131. (defvar erlang-compile-erlang-function "c"
  4132. "Erlang function to call to compile an erlang file.")
  4133. (defvar erlang-compile-display-function 'inferior-erlang-run-or-select
  4134. "Command to execute to view last compilation.
  4135. Change this variable to use your favorite
  4136. Erlang compilation package.")
  4137. (defvar erlang-next-error-function 'inferior-erlang-next-error
  4138. "Command to execute to go to the next error.
  4139. Change this variable to use your favorite Erlang compilation
  4140. package. Not used in Emacs 21.")
  4141. ;;;###autoload
  4142. (defun erlang-shell ()
  4143. "Start a new Erlang shell.
  4144. The variable `erlang-shell-function' decides which method to use,
  4145. default is to start a new Erlang host. It is possible that, in the
  4146. future, a new shell on an already running host will be started."
  4147. (interactive)
  4148. (call-interactively erlang-shell-function))
  4149. ;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
  4150. ;; It is customary for Emacs packages to supply a function on this
  4151. ;; form, even though it violates the `erlang-*' name convention.
  4152. (defalias 'run-erlang 'erlang-shell)
  4153. (defun erlang-shell-display ()
  4154. "Display an Erlang shell, or start a new."
  4155. (interactive)
  4156. (call-interactively erlang-shell-display-function))
  4157. ;;;###autoload
  4158. (defun erlang-compile ()
  4159. "Compile Erlang module in current buffer."
  4160. (interactive)
  4161. (call-interactively erlang-compile-function))
  4162. (defun erlang-compile-display ()
  4163. "Display compilation output."
  4164. (interactive)
  4165. (call-interactively erlang-compile-display-function))
  4166. (defun erlang-next-error ()
  4167. "Display next error message from the latest compilation."
  4168. (interactive)
  4169. (call-interactively erlang-next-error-function))
  4170. ;;;
  4171. ;;; Erlang Shell Mode -- Major mode used for Erlang shells.
  4172. ;;;
  4173. ;; This mode is designed to be implementation independent,
  4174. ;; e.g. it does not assume that we are running an inferior
  4175. ;; Erlang, there exists a lot of other possibilities.
  4176. (defvar erlang-shell-buffer-name "*erlang*"
  4177. "The name of the Erlang link shell buffer.")
  4178. (defvar erlang-shell-mode-map nil
  4179. "Keymap used by Erlang shells.")
  4180. (defvar erlang-shell-mode-hook nil
  4181. "*User functions to run when an Erlang shell is started.
  4182. This hook is used to change the behaviour of Erlang mode. It is
  4183. normally used by the user to personalise the programming environment.
  4184. When used in a site init file, it could be used to customise Erlang
  4185. mode for all users on the system.
  4186. The function added to this hook is run every time a new Erlang
  4187. shell is started.
  4188. See also `erlang-load-hook', a hook which is run once, when Erlang
  4189. mode is loaded, and `erlang-mode-hook' which is run every time a new
  4190. Erlang source file is loaded into Emacs.")
  4191. (defvar erlang-input-ring-file-name "~/.erlang_history"
  4192. "*When non-nil, file name used to store Erlang shell history information.")
  4193. (defun erlang-shell-mode ()
  4194. "Major mode for interacting with an Erlang shell.
  4195. We assume that we already are in Comint mode.
  4196. The following special commands are available:
  4197. \\{erlang-shell-mode-map}"
  4198. (interactive)
  4199. (setq major-mode 'erlang-shell-mode)
  4200. (setq mode-name "Erlang Shell")
  4201. (erlang-mode-variables)
  4202. (if erlang-shell-mode-map
  4203. nil
  4204. (setq erlang-shell-mode-map (copy-keymap comint-mode-map))
  4205. (erlang-shell-mode-commands erlang-shell-mode-map))
  4206. (use-local-map erlang-shell-mode-map)
  4207. (unless inferior-erlang-use-cmm
  4208. ;; This was originally not a marker, but it needs to be, at least
  4209. ;; in Emacs 21, and should be backwards-compatible. Otherwise,
  4210. ;; would need to test whether compilation-parsing-end is a marker
  4211. ;; after requiring `compile'.
  4212. (set (make-local-variable 'compilation-parsing-end) (copy-marker 1))
  4213. (set (make-local-variable 'compilation-error-list) nil)
  4214. (set (make-local-variable 'compilation-old-error-list) nil))
  4215. ;; Needed when compiling directly from the Erlang shell.
  4216. (setq compilation-last-buffer (current-buffer))
  4217. (erlang-add-compilation-alist erlang-error-regexp-alist)
  4218. (setq comint-prompt-regexp "^[^>=]*> *")
  4219. (setq comint-eol-on-send t)
  4220. (setq comint-input-ignoredups t)
  4221. (setq comint-scroll-show-maximum-output t)
  4222. (setq comint-scroll-to-bottom-on-output t)
  4223. ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If
  4224. ;; the call fails, just call the normal `add-hook'.
  4225. (condition-case nil
  4226. (progn
  4227. (add-hook 'comint-output-filter-functions
  4228. 'inferior-erlang-strip-delete nil t)
  4229. (add-hook 'comint-output-filter-functions
  4230. 'inferior-erlang-strip-ctrl-m nil t))
  4231. (error
  4232. (funcall (symbol-function 'make-local-hook)
  4233. 'comint-output-filter-functions) ; obsolete as of Emacs 21.1
  4234. (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete)
  4235. (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m)))
  4236. ;; Some older versions of comint don't have an input ring.
  4237. (if (fboundp 'comint-read-input-ring)
  4238. (progn
  4239. (setq comint-input-ring-file-name erlang-input-ring-file-name)
  4240. (comint-read-input-ring t)
  4241. (make-local-variable 'kill-buffer-hook)
  4242. (add-hook 'kill-buffer-hook 'comint-write-input-ring)))
  4243. ;; At least in Emacs 21, we need to be in `compilation-minor-mode'
  4244. ;; for `next-error' to work. We can avoid it clobbering the shell
  4245. ;; keys thus.
  4246. (when inferior-erlang-use-cmm
  4247. (compilation-minor-mode 1)
  4248. (set (make-local-variable 'minor-mode-overriding-map-alist)
  4249. `((compilation-minor-mode
  4250. . ,(let ((map (make-sparse-keymap)))
  4251. ;; It would be useful to put keymap properties on the
  4252. ;; error lines so that we could use RET and mouse-2
  4253. ;; on them directly.
  4254. (when (boundp 'compilation-skip-threshold) ; new compile.el
  4255. (define-key map [mouse-2] #'erlang-mouse-2-command)
  4256. (define-key map "\C-m" #'erlang-RET-command))
  4257. (if (boundp 'compilation-menu-map)
  4258. (define-key map [menu-bar compilation]
  4259. (cons "Errors" compilation-menu-map)))
  4260. map)))))
  4261. (run-hooks 'erlang-shell-mode-hook))
  4262. (defun erlang-mouse-2-command (event)
  4263. "Command bound to `mouse-2' in inferior Erlang buffer.
  4264. Selects Comint or Compilation mode command as appropriate."
  4265. (interactive "e")
  4266. (if (save-window-excursion
  4267. (save-excursion
  4268. (mouse-set-point event)
  4269. (consp (get-text-property (line-beginning-position) 'message))))
  4270. (call-interactively (lookup-key compilation-mode-map [mouse-2]))
  4271. (call-interactively (lookup-key comint-mode-map [mouse-2]))))
  4272. (defun erlang-RET-command ()
  4273. "Command bound to `RET' in inferior Erlang buffer.
  4274. Selects Comint or Compilation mode command as appropriate."
  4275. (interactive)
  4276. (if (consp (get-text-property (line-beginning-position) 'message))
  4277. (call-interactively (lookup-key compilation-mode-map "\C-m"))
  4278. (call-interactively (lookup-key comint-mode-map "\C-m"))))
  4279. (defun erlang-shell-mode-commands (map)
  4280. (define-key map "\M-\t" 'erlang-complete-tag)
  4281. (define-key map "\C-a" 'comint-bol) ; Normally the other way around.
  4282. (define-key map "\C-c\C-a" 'beginning-of-line)
  4283. (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof'
  4284. (define-key map "\M-\C-m" 'compile-goto-error)
  4285. (unless inferior-erlang-use-cmm
  4286. (define-key map "\C-x`" 'erlang-next-error)))
  4287. ;;;
  4288. ;;; Inferior Erlang -- Run an Erlang shell as a subprocess.
  4289. ;;;
  4290. (defvar inferior-erlang-display-buffer-any-frame nil
  4291. "*When nil, `inferior-erlang-display-buffer' use only selected frame.
  4292. When t, all frames are searched. When 'raise, the frame is raised.")
  4293. (defvar inferior-erlang-shell-type 'newshell
  4294. "The type of Erlang shell to use.
  4295. When this variable is set to the atom `oldshell', the old shell is used.
  4296. When set to `newshell' the new shell is used. Should the variable be
  4297. nil, the default shell is used.
  4298. This variable influence the setting of other variables.")
  4299. (defvar inferior-erlang-machine "erl"
  4300. "*The name of the Erlang shell.")
  4301. (defvar inferior-erlang-machine-options '()
  4302. "*The options used when activating the Erlang shell.
  4303. This must be a list of strings.")
  4304. (defvar inferior-erlang-process-name "inferior-erlang"
  4305. "The name of the inferior Erlang process.")
  4306. (defvar inferior-erlang-buffer-name erlang-shell-buffer-name
  4307. "The name of the inferior Erlang buffer.")
  4308. (defvar inferior-erlang-prompt-timeout 60
  4309. "*Number of seconds before `inferior-erlang-wait-prompt' timeouts.
  4310. The time specified is waited after every output made by the inferior
  4311. Erlang shell. When this variable is t, we assume that we always have
  4312. a prompt. When nil, we will wait forever, or until \\[keyboard-quit].")
  4313. (defvar inferior-erlang-process nil
  4314. "Process of last invoked inferior Erlang, or nil.")
  4315. (defvar inferior-erlang-buffer nil
  4316. "Buffer of last invoked inferior Erlang, or nil.")
  4317. ;; Enable uniquifying Erlang shell buffers based on directory name.
  4318. (eval-after-load "uniquify"
  4319. '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode))
  4320. ;;;###autoload
  4321. (defun inferior-erlang (&optional command)
  4322. "Run an inferior Erlang.
  4323. With prefix command, prompt for command to start Erlang with.
  4324. This is just like running Erlang in a normal shell, except that
  4325. an Emacs buffer is used for input and output.
  4326. \\<comint-mode-map>
  4327. The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
  4328. The history is saved between sessions.
  4329. Entry to this mode calls the functions in the variables
  4330. `comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
  4331. The following commands imitate the usual Unix interrupt and
  4332. editing control characters:
  4333. \\{erlang-shell-mode-map}"
  4334. (interactive
  4335. (when current-prefix-arg
  4336. (list (if (fboundp 'read-shell-command)
  4337. ;; `read-shell-command' is a new function in Emacs 23.
  4338. (read-shell-command "Erlang command: ")
  4339. (read-string "Erlang command: ")))))
  4340. (require 'comint)
  4341. (let (cmd opts)
  4342. (if command
  4343. (setq cmd "sh"
  4344. opts (list "-c" command))
  4345. (setq cmd inferior-erlang-machine
  4346. opts inferior-erlang-machine-options)
  4347. (cond ((eq inferior-erlang-shell-type 'oldshell)
  4348. (setq opts (cons "-oldshell" opts)))
  4349. ((eq inferior-erlang-shell-type 'newshell)
  4350. (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))))
  4351. ;; Using create-file-buffer and list-buffers-directory in this way
  4352. ;; makes uniquify give each buffer a unique name based on the
  4353. ;; directory.
  4354. (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory)))
  4355. (setq inferior-erlang-buffer (create-file-buffer fake-file-name))
  4356. (apply 'make-comint-in-buffer
  4357. inferior-erlang-process-name
  4358. inferior-erlang-buffer
  4359. cmd
  4360. nil opts)
  4361. (with-current-buffer inferior-erlang-buffer
  4362. (setq list-buffers-directory fake-file-name))))
  4363. (setq inferior-erlang-process
  4364. (get-buffer-process inferior-erlang-buffer))
  4365. (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings
  4366. (funcall (symbol-function 'set-process-query-on-exit-flag)
  4367. inferior-erlang-process nil)
  4368. (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process))
  4369. (if erlang-inferior-shell-split-window
  4370. (switch-to-buffer-other-window inferior-erlang-buffer)
  4371. (switch-to-buffer inferior-erlang-buffer))
  4372. (if (and (not (eq system-type 'windows-nt))
  4373. (eq inferior-erlang-shell-type 'newshell))
  4374. (setq comint-process-echoes t))
  4375. (erlang-shell-mode))
  4376. (defun inferior-erlang-run-or-select ()
  4377. "Switch to an inferior Erlang buffer, possibly starting new process."
  4378. (interactive)
  4379. (if (null (inferior-erlang-running-p))
  4380. (inferior-erlang)
  4381. (inferior-erlang-display-buffer t)))
  4382. (defun inferior-erlang-display-buffer (&optional select)
  4383. "Make the inferior Erlang process visible.
  4384. The window is returned.
  4385. Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is
  4386. displayed in the current frame. Should it be non-nil, and the buffer
  4387. already is visible in any other frame, no new window will be created.
  4388. Should it be the atom 'raise, the frame containing the window will
  4389. be raised.
  4390. Should the optional argument SELECT be non-nil, the window is
  4391. selected. Should the window be in another frame, that frame is raised.
  4392. Note, should the mouse pointer be places outside the raised frame, that
  4393. frame will become deselected before the next command."
  4394. (interactive)
  4395. (or (inferior-erlang-running-p)
  4396. (error "No inferior Erlang process is running"))
  4397. (let ((win (inferior-erlang-window
  4398. inferior-erlang-display-buffer-any-frame))
  4399. (frames-p (fboundp 'selected-frame)))
  4400. (if (null win)
  4401. (let ((old-win (selected-window)))
  4402. (save-excursion
  4403. (switch-to-buffer-other-window inferior-erlang-buffer)
  4404. (setq win (selected-window)))
  4405. (select-window old-win))
  4406. (if (and window-system
  4407. frames-p
  4408. (or select
  4409. (eq inferior-erlang-display-buffer-any-frame 'raise))
  4410. (not (eq (selected-frame) (window-frame win))))
  4411. (raise-frame (window-frame win))))
  4412. (if select
  4413. (select-window win))
  4414. (sit-for 0)
  4415. win))
  4416. (defun inferior-erlang-running-p ()
  4417. "Non-nil when an inferior Erlang is running."
  4418. (and inferior-erlang-process
  4419. (memq (process-status inferior-erlang-process) '(run open))
  4420. inferior-erlang-buffer
  4421. (buffer-name inferior-erlang-buffer)))
  4422. (defun inferior-erlang-window (&optional all-frames)
  4423. "Return the window containing the inferior Erlang, or nil."
  4424. (and (inferior-erlang-running-p)
  4425. (if (and all-frames (>= erlang-emacs-major-version 19))
  4426. (get-buffer-window inferior-erlang-buffer t)
  4427. (get-buffer-window inferior-erlang-buffer))))
  4428. (defun inferior-erlang-wait-prompt ()
  4429. "Wait until the inferior Erlang shell prompt appears."
  4430. (if (eq inferior-erlang-prompt-timeout t)
  4431. ()
  4432. (or (inferior-erlang-running-p)
  4433. (error "No inferior Erlang shell is running"))
  4434. (save-excursion
  4435. (set-buffer inferior-erlang-buffer)
  4436. (let ((msg nil))
  4437. (while (save-excursion
  4438. (goto-char (process-mark inferior-erlang-process))
  4439. (forward-line 0)
  4440. (not (looking-at comint-prompt-regexp)))
  4441. (if msg
  4442. ()
  4443. (setq msg t)
  4444. (message "Waiting for Erlang shell prompt (press C-g to abort)."))
  4445. (or (accept-process-output inferior-erlang-process
  4446. inferior-erlang-prompt-timeout)
  4447. (error "No Erlang shell prompt before timeout")))
  4448. (if msg (message ""))))))
  4449. (defun inferior-erlang-send-empty-cmd-unless-already-at-prompt ()
  4450. "If not already at a prompt, try to send an empty cmd to get a prompt.
  4451. The empty command resembles hitting RET. This is useful in some
  4452. situations, for instance if a crash or error report from sasl
  4453. has been printed after the last prompt."
  4454. (save-excursion
  4455. (set-buffer inferior-erlang-buffer)
  4456. (if (> (point-max) 1)
  4457. ;; make sure we get a prompt if buffer contains data
  4458. (if (save-excursion
  4459. (goto-char (process-mark inferior-erlang-process))
  4460. (forward-line 0)
  4461. (not (looking-at comint-prompt-regexp)))
  4462. (inferior-erlang-send-command "")))))
  4463. (autoload 'comint-send-input "comint")
  4464. (defun inferior-erlang-send-command (cmd &optional hist)
  4465. "Send command CMD to the inferior Erlang.
  4466. The contents of the current command line (if any) will
  4467. be placed at the next prompt.
  4468. If optional second argument is non-nil the command is inserted into
  4469. the history list.
  4470. Return the position after the newly inserted command."
  4471. (or (inferior-erlang-running-p)
  4472. (error "No inferior Erlang process is running"))
  4473. (let ((old-buffer (current-buffer))
  4474. (insert-point (marker-position (process-mark inferior-erlang-process)))
  4475. (insert-length (if comint-process-echoes
  4476. 0
  4477. (1+ (length cmd)))))
  4478. (set-buffer inferior-erlang-buffer)
  4479. (goto-char insert-point)
  4480. (insert cmd)
  4481. ;; Strange things happened if `comint-eol-on-send' is declared
  4482. ;; in the `let' expression above, but setq:d here. The
  4483. ;; `set-buffer' statement obviously makes the buffer local
  4484. ;; instance of `comint-eol-on-send' shadow this one.
  4485. ;; I'm considering this a bug in Elisp.
  4486. ;;
  4487. ;; This was previously cautioned against in the Lisp manual. It
  4488. ;; has been sorted out in Emacs 21. -- fx
  4489. (let ((comint-eol-on-send nil)
  4490. (comint-input-filter (if hist comint-input-filter 'ignore)))
  4491. (if (and (not erlang-xemacs-p)
  4492. (>= emacs-major-version 22))
  4493. (comint-send-input nil t)
  4494. (comint-send-input)))
  4495. ;; Adjust all windows whose points are incorrect.
  4496. (if (null comint-process-echoes)
  4497. (walk-windows
  4498. (function
  4499. (lambda (window)
  4500. (if (and (eq (window-buffer window) inferior-erlang-buffer)
  4501. (= (window-point window) insert-point))
  4502. (set-window-point window
  4503. (+ insert-point insert-length)))))
  4504. nil t))
  4505. (set-buffer old-buffer)
  4506. (+ insert-point insert-length)))
  4507. (defun inferior-erlang-strip-delete (&optional s)
  4508. "Remove `^H' (delete) and the characters it was supposed to remove."
  4509. (interactive)
  4510. (if (and (boundp 'comint-last-input-end)
  4511. (boundp 'comint-last-output-start))
  4512. (save-excursion
  4513. (goto-char
  4514. (if (interactive-p)
  4515. (symbol-value 'comint-last-input-end)
  4516. (symbol-value 'comint-last-output-start)))
  4517. (while (progn (skip-chars-forward "^\C-h")
  4518. (not (eq (point) (point-max))))
  4519. (delete-char 1)
  4520. (or (bolp)
  4521. (backward-delete-char 1))))))
  4522. ;; Basically `comint-strip-ctrl-m', with a few extra checks.
  4523. (defun inferior-erlang-strip-ctrl-m (&optional string)
  4524. "Strip trailing `^M' characters from the current output group."
  4525. (interactive)
  4526. (if (and (boundp 'comint-last-input-end)
  4527. (boundp 'comint-last-output-start))
  4528. (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
  4529. (save-excursion
  4530. (goto-char
  4531. (if (interactive-p)
  4532. (symbol-value 'comint-last-input-end)
  4533. (symbol-value 'comint-last-output-start)))
  4534. (while (re-search-forward "\r+$" pmark t)
  4535. (replace-match "" t t))))))
  4536. (defun inferior-erlang-compile (arg)
  4537. "Compile the file in the current buffer.
  4538. With prefix arg, compiles for debug.
  4539. Should Erlang return `{error, nofile}' it could not load the object
  4540. module after completing the compilation. This is due to a bug in the
  4541. compile command `c' when using the option `outdir'.
  4542. There exists two workarounds for this bug:
  4543. 1) Place the directory in the Erlang load path.
  4544. 2) Set the Emacs variable `erlang-compile-use-outdir' to nil.
  4545. To do so, place the following line in your `~/.emacs'-file:
  4546. (setq erlang-compile-use-outdir nil)"
  4547. (interactive "P")
  4548. (save-some-buffers)
  4549. (inferior-erlang-prepare-for-input)
  4550. (let* ((dir (inferior-erlang-compile-outdir))
  4551. ;;; (file (file-name-nondirectory (buffer-file-name)))
  4552. (noext (substring (buffer-file-name) 0 -4))
  4553. (opts (append (list (cons 'outdir dir))
  4554. (if current-prefix-arg
  4555. (list 'debug_info 'export_all))
  4556. erlang-compile-extra-opts))
  4557. end)
  4558. (save-excursion
  4559. (set-buffer inferior-erlang-buffer)
  4560. (compilation-forget-errors))
  4561. (setq end (inferior-erlang-send-command
  4562. (inferior-erlang-compute-compile-command noext opts)
  4563. nil))
  4564. (sit-for 0)
  4565. (inferior-erlang-wait-prompt)
  4566. (save-excursion
  4567. (set-buffer inferior-erlang-buffer)
  4568. (setq compilation-error-list nil)
  4569. (set-marker compilation-parsing-end end))
  4570. (setq compilation-last-buffer inferior-erlang-buffer)))
  4571. (defun inferior-erlang-prepare-for-input (&optional no-display)
  4572. "Create an inferior erlang buffer if needed and ready it for input.
  4573. The buffer is displayed, according to `inferior-erlang-display-buffer'
  4574. unless the optional NO-DISPLAY is non-nil."
  4575. (or (inferior-erlang-running-p)
  4576. (save-excursion
  4577. (inferior-erlang)))
  4578. (or (inferior-erlang-running-p)
  4579. (error "Error starting inferior Erlang shell"))
  4580. (if (not no-display)
  4581. (inferior-erlang-display-buffer))
  4582. (inferior-erlang-send-empty-cmd-unless-already-at-prompt)
  4583. (sit-for 0)
  4584. (inferior-erlang-wait-prompt))
  4585. (defun inferior-erlang-compile-outdir ()
  4586. "Return the directory to compile the current buffer into."
  4587. (let* ((buffer-dir (directory-file-name
  4588. (file-name-directory (buffer-file-name))))
  4589. (parent-dir (directory-file-name
  4590. (file-name-directory buffer-dir)))
  4591. (ebin-dir (concat (file-name-as-directory parent-dir) "ebin"))
  4592. (buffer-dir-base-name (file-name-nondirectory
  4593. (expand-file-name
  4594. (concat (file-name-as-directory buffer-dir)
  4595. ".")))))
  4596. (if (and (string= buffer-dir-base-name "src")
  4597. (file-directory-p ebin-dir))
  4598. (file-name-as-directory ebin-dir)
  4599. (file-name-as-directory buffer-dir))))
  4600. (defun inferior-erlang-compute-compile-command (module-name opts)
  4601. (let ((ccfn erlang-compile-command-function-alist)
  4602. (res (inferior-erlang-compute-erl-compile-command module-name opts))
  4603. ccfn-entry
  4604. done)
  4605. (if (not (null (buffer-file-name)))
  4606. (while (and (not done) (not (null ccfn)))
  4607. (setq ccfn-entry (car ccfn))
  4608. (setq ccfn (cdr ccfn))
  4609. (if (string-match (car ccfn-entry) (buffer-file-name))
  4610. (let ((c-fn (cdr ccfn-entry)))
  4611. (setq done t)
  4612. (if (not (null c-fn))
  4613. (setq result (funcall c-fn module-name opts)))))))
  4614. result))
  4615. (defun inferior-erlang-compute-erl-compile-command (module-name opts)
  4616. (let* ((out-dir-opt (assoc 'outdir opts))
  4617. (out-dir (cdr out-dir-opt)))
  4618. (if erlang-compile-use-outdir
  4619. (format "%s(\"%s\"%s)."
  4620. erlang-compile-erlang-function
  4621. module-name
  4622. (inferior-erlang-format-comma-opts opts))
  4623. (let (;; Hopefully, noone else will ever use these...
  4624. (tmpvar "Tmp7236")
  4625. (tmpvar2 "Tmp8742"))
  4626. (format
  4627. (concat
  4628. "f(%s), {ok, %s} = file:get_cwd(), "
  4629. "file:set_cwd(\"%s\"), "
  4630. "%s = %s(\"%s\"%s), file:set_cwd(%s), f(%s), %s.")
  4631. tmpvar2 tmpvar
  4632. out-dir
  4633. tmpvar2
  4634. erlang-compile-erlang-function
  4635. module-name (inferior-erlang-format-comma-opts
  4636. (remq out-dir-opt opts))
  4637. tmpvar tmpvar tmpvar2)))))
  4638. (defun inferior-erlang-compute-leex-compile-command (module-name opts)
  4639. (let ((file-name (buffer-file-name))
  4640. (erl-compile-expr (inferior-erlang-remove-any-trailing-dot
  4641. (inferior-erlang-compute-erl-compile-command
  4642. module-name opts))))
  4643. (format (concat "f(LErr1__), f(LErr2__), "
  4644. "case case leex:file(\"%s\", [%s]) of"
  4645. " ok -> ok;"
  4646. " {ok,_} -> ok;"
  4647. " {ok,_,_} -> ok;"
  4648. " LErr1__ -> LErr1__ "
  4649. "end of"
  4650. " ok -> %s;"
  4651. " LErr2__ -> LErr2__ "
  4652. "end.")
  4653. file-name
  4654. (inferior-erlang-format-comma-opts erlang-leex-compile-opts)
  4655. erl-compile-expr)))
  4656. (defun inferior-erlang-compute-yecc-compile-command (module-name opts)
  4657. (let ((file-name (buffer-file-name))
  4658. (erl-compile-expr (inferior-erlang-remove-any-trailing-dot
  4659. (inferior-erlang-compute-erl-compile-command
  4660. module-name opts))))
  4661. (format (concat "f(YErr1__), f(YErr2__), "
  4662. "case case yecc:file(\"%s\", [%s]) of"
  4663. " {ok,_} -> ok;"
  4664. " {ok,_,_} -> ok;"
  4665. " YErr1__ -> YErr1__ "
  4666. "end of"
  4667. " ok -> %s;"
  4668. " YErr2__ -> YErr2__ "
  4669. "end.")
  4670. file-name
  4671. (inferior-erlang-format-comma-opts erlang-yecc-compile-opts)
  4672. erl-compile-expr)))
  4673. (defun inferior-erlang-remove-any-trailing-dot (str)
  4674. (if (string= (substring str -1) ".")
  4675. (substring str 0 (1- (length str)))
  4676. str))
  4677. (defun inferior-erlang-format-comma-opts (opts)
  4678. (if (null opts)
  4679. ""
  4680. (concat ", " (inferior-erlang-format-opts opts))))
  4681. (defun inferior-erlang-format-opts (opts)
  4682. (concat "[" (inferior-erlang-string-join (mapcar 'inferior-erlang-format-opt
  4683. opts)
  4684. ", ")
  4685. "]"))
  4686. (defun inferior-erlang-format-opt (opt)
  4687. (cond ((stringp opt) (concat "\"" opt "\""))
  4688. ((atom opt) (format "%s" opt))
  4689. ((consp opt) (concat "{" (inferior-erlang-string-join
  4690. (mapcar 'inferior-erlang-format-opt
  4691. (list (car opt) (cdr opt)))
  4692. ", ")
  4693. "}"))
  4694. (t (error (format "Unexpected opt %s" opt)))))
  4695. (defun inferior-erlang-string-join (strs sep)
  4696. (let ((result (or (car strs) "")))
  4697. (setq strs (cdr strs))
  4698. (while strs
  4699. (setq result (concat result sep (car strs)))
  4700. (setq strs (cdr strs)))
  4701. result))
  4702. ;; `next-error' only accepts buffers with major mode `compilation-mode'
  4703. ;; or with the minor mode `compilation-minor-mode' activated.
  4704. ;; (To activate the minor mode is out of the question, since it will
  4705. ;; ruin the inferior Erlang keymap.)
  4706. ;; This is done differently in Emacs 21.
  4707. (defun inferior-erlang-next-error (&optional argp)
  4708. "Just like `next-error'.
  4709. Capable of finding error messages in an inferior Erlang buffer."
  4710. (interactive "P")
  4711. (let ((done nil)
  4712. (buf (or (and (boundp 'next-error-last-buffer)
  4713. next-error-last-buffer)
  4714. (and (boundp 'compilation-last-buffer)
  4715. compilation-last-buffer))))
  4716. (if (and (bufferp buf)
  4717. (save-excursion
  4718. (set-buffer buf)
  4719. (and (eq major-mode 'erlang-shell-mode)
  4720. (setq major-mode 'compilation-mode))))
  4721. (unwind-protect
  4722. (progn
  4723. (setq done t)
  4724. (next-error argp))
  4725. (save-excursion
  4726. (set-buffer buf)
  4727. (setq major-mode 'erlang-shell-mode))))
  4728. (or done
  4729. (next-error argp))))
  4730. (defun inferior-erlang-change-directory (&optional dir)
  4731. "Make the inferior Erlang change directory.
  4732. The default is to go to the directory of the current buffer."
  4733. (interactive)
  4734. (or dir (setq dir (file-name-directory (buffer-file-name))))
  4735. (or (inferior-erlang-running-p)
  4736. (error "No inferior Erlang is running"))
  4737. (inferior-erlang-display-buffer)
  4738. (inferior-erlang-send-empty-cmd-unless-already-at-prompt)
  4739. (inferior-erlang-wait-prompt)
  4740. (inferior-erlang-send-command (format "cd('%s')." dir) nil))
  4741. (defun erlang-align-arrows (start end)
  4742. "Align arrows (\"->\") in function clauses from START to END.
  4743. When called interactively, aligns arrows after function clauses inside
  4744. the region.
  4745. With a prefix argument, aligns all arrows, not just those in function
  4746. clauses.
  4747. Example:
  4748. sum(L) -> sum(L, 0).
  4749. sum([H|T], Sum) -> sum(T, Sum + H);
  4750. sum([], Sum) -> Sum.
  4751. becomes:
  4752. sum(L) -> sum(L, 0).
  4753. sum([H|T], Sum) -> sum(T, Sum + H);
  4754. sum([], Sum) -> Sum."
  4755. (interactive "r")
  4756. (save-excursion
  4757. (let (;; regexp for matching arrows. without a prefix argument,
  4758. ;; the regexp matches function heads. With a prefix, it
  4759. ;; matches any arrow.
  4760. (re (if current-prefix-arg
  4761. "^.*\\(\\)->"
  4762. (eval-when-compile
  4763. (concat "^" erlang-atom-regexp ".*\\(\\)->"))))
  4764. ;; part of regexp matching directly before the arrow
  4765. (arrow-match-pos (if current-prefix-arg
  4766. 1
  4767. (1+ erlang-atom-regexp-matches)))
  4768. ;; accumulator for positions where arrows are found, ordered
  4769. ;; by buffer position (from greatest to smallest)
  4770. (arrow-positions '())
  4771. ;; accumulator for longest distance from start of line to arrow
  4772. (most-indent 0)
  4773. ;; marker to track the end of the region we're aligning
  4774. (end-marker (progn (goto-char end)
  4775. (point-marker))))
  4776. ;; Pass 1: Find the arrow positions, adjust the whitespace
  4777. ;; before each arrow to one space, and find the greatest
  4778. ;; indentation level.
  4779. (goto-char start)
  4780. (while (re-search-forward re end-marker t)
  4781. (goto-char (match-beginning arrow-match-pos))
  4782. (just-one-space) ; adjust whitespace
  4783. (setq arrow-positions (cons (point) arrow-positions))
  4784. (setq most-indent (max most-indent (erlang-column-number))))
  4785. (set-marker end-marker nil) ; free the marker
  4786. ;; Pass 2: Insert extra padding so that all arrow indentation is
  4787. ;; equal. This is done last-to-first by buffer position, so that
  4788. ;; inserting spaces before one arrow doesn't change the
  4789. ;; positions of the next ones.
  4790. (mapc (lambda (arrow-pos)
  4791. (goto-char arrow-pos)
  4792. (let* ((pad (- most-indent (erlang-column-number))))
  4793. (when (> pad 0)
  4794. (insert-char ?\ pad))))
  4795. arrow-positions))))
  4796. (defun erlang-column-number ()
  4797. "Return the column number of the current position in the buffer.
  4798. Tab characters are counted by their visual width."
  4799. (string-width (buffer-substring (line-beginning-position) (point))))
  4800. (defun erlang-current-defun ()
  4801. "`add-log-current-defun-function' for Erlang."
  4802. (save-excursion
  4803. (erlang-beginning-of-function)
  4804. (if (looking-at "[a-z0-9_]+")
  4805. (match-string 0))))
  4806. ;; Aliases for backward compatibility with older versions of Erlang Mode.
  4807. ;;
  4808. ;; Unfortuantely, older versions of Emacs doesn't have `defalias' and
  4809. ;; `make-obsolete' so we have to define our own `obsolete' function.
  4810. (defun erlang-obsolete (sym newdef)
  4811. "Make the obsolete function SYM refer to the defined function NEWDEF.
  4812. Simplified version of a combination `defalias' and `make-obsolete',
  4813. it assumes that NEWDEF is loaded."
  4814. (defalias sym (symbol-function newdef))
  4815. (if (fboundp 'make-obsolete)
  4816. (make-obsolete sym newdef)))
  4817. (erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent)
  4818. (erlang-obsolete 'calculate-erlang-stack-indent
  4819. 'erlang-calculate-stack-indent)
  4820. (erlang-obsolete 'at-erlang-keyword 'erlang-at-keyword)
  4821. (erlang-obsolete 'at-erlang-operator 'erlang-at-operator)
  4822. (erlang-obsolete 'beginning-of-erlang-clause 'erlang-beginning-of-clause)
  4823. (erlang-obsolete 'end-of-erlang-clause 'erlang-end-of-clause)
  4824. (erlang-obsolete 'mark-erlang-clause 'erlang-mark-clause)
  4825. (erlang-obsolete 'beginning-of-erlang-function 'erlang-beginning-of-function)
  4826. (erlang-obsolete 'end-of-erlang-function 'erlang-end-of-function)
  4827. (erlang-obsolete 'mark-erlang-function 'erlang-mark-function)
  4828. (erlang-obsolete 'pass-over-erlang-clause 'erlang-pass-over-function)
  4829. (erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function)
  4830. ;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above.
  4831. (defconst erlang-unload-hook
  4832. (list (lambda ()
  4833. (defalias 'set-visited-file-name
  4834. 'erlang-orig-set-visited-file-name)
  4835. (when (featurep 'advice)
  4836. (ad-unadvise 'Man-notify-when-ready)
  4837. (ad-unadvise 'set-visited-file-name)))))
  4838. (defun erlang-string-to-int (string)
  4839. (if (fboundp 'string-to-number)
  4840. (string-to-number string)
  4841. (funcall (symbol-function 'string-to-int) string)))
  4842. ;; The end...
  4843. (provide 'erlang)
  4844. (run-hooks 'erlang-load-hook)
  4845. ;; Local variables:
  4846. ;; coding: iso-8859-1
  4847. ;; End:
  4848. ;;; erlang.el ends here