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.

5588 lines
186 KiB

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