blob: 5916f73fc6991689d4c72de2b2497fdc033b4a41 [file] [log] [blame]
Christopher Piro094823a2007-07-18 00:26:12 +00001;; $Id: erlang.el,v 1.21 2004/08/03 20:38:43 mlogan Exp $
2;; erlang.el --- Major modes for editing and running Erlang
3
4;; Copyright (C) 1995-1998,2000 Ericsson Telecom AB
5
6;; Author: Anders Lindgren
7;; Version: 2.4
8;; Keywords: erlang, languages, processes
9;; Date: 2000-09-11
10
11;; Lars Thorsén's modifications of 2000-06-07 included.
12
13;; The original version of this package was written by Robert Virding.
14;;
15;; Most skeletons has been written at Ericsson Telecom by
16;; magnus@erix.ericsson.se and janne@erix.ericsson.se
17
18;;; Commentary:
19
20;; Introduction:
21;; ------------
22;;
23;; This package provides support for the programming language Erlang.
24;; The package provides an editing mode with lots of bells and
25;; whistles, compilation support, and it makes it possible for the
26;; user to start Erlang shells that run inside Emacs.
27;;
28;; See the Erlang distribution for full documentation of this package.
29
30;; Installation:
31;; ------------
32;;
33;; Place this file in Emacs load path, byte-compile it, and add the
34;; following line to the appropriate init file:
35;;
36;; (require 'erlang-start)
37;;
38;; The full documentation contains much more extensive description of
39;; the installation procedure.
40
41;; Reporting Bugs:
42;; --------------
43;;
44;; Please send bug reports to the following email address:
45;; support@erlang.ericsson.se
46;;
47;; Please state as exactly as possible:
48;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
49;; and of any other relevant software.
50;; - What the expected result was.
51;; - What you did, preferably in a repeatable step-by-step form.
52;; - A description of the unexpected result.
53;; - Relevant pieces of Erlang code causing the problem.
54;; - Personal Emacs customisations, if any.
55;;
56;; Should the Emacs generate an error, please set the emacs variable
57;; `debug-on-error' to `t'. Repeat the error and enclose the debug
58;; information in your bug-report.
59;;
60;; To set the variable you can use the following command:
61;; M-x set-variable RET debug-on-error RET t RET
62
63;;; Code:
64
65;; Variables:
66
67(defconst erlang-version "2.4"
68 "The version number of Erlang mode.")
69
70(defvar erlang-root-dir nil
71 "The directory where the Erlang system is installed.
72The name should not contain the ending slash.
73
74Should this variable be nil, no manual pages will show up in the
75Erlang mode menu.")
76
77(defvar erlang-menu-items '(erlang-menu-base-items
78 erlang-menu-skel-items
79 erlang-menu-shell-items
80 erlang-menu-compile-items
81 erlang-menu-man-items
82 erlang-menu-personal-items
83 erlang-menu-version-items)
84 "*List of menu item list to combine to create Erland mode menu.
85
86External programs which temporary adds menu items to the Erland mode
87menu use this variable. Please use the function `add-hook' to add
88items.
89
90Please call the function `erlang-menu-init' after every change to this
91variable.")
92
93(defvar erlang-menu-base-items
94 '(("Indent"
95 (("Indent Line" erlang-indent-command)
96 ("Indent Region " erlang-indent-region
97 (if erlang-xemacs-p (mark) mark-active))
98 ("Indent Clause" erlang-indent-clause)
99 ("Indent Function" erlang-indent-function)
100 ("Indent Buffer" erlang-indent-current-buffer)))
101 ("Edit"
102 (("Fill Comment" erlang-fill-paragraph)
103 ("Comment Region" comment-region
104 (if erlang-xemacs-p (mark) mark-active))
105 ("Uncomment Region" erlang-uncomment-region
106 (if erlang-xemacs-p (mark) mark-active))
107 nil
108 ("Beginning of Function" erlang-beginning-of-function)
109 ("End of Function" erlang-end-of-function)
110 ("Mark Function" erlang-mark-function)
111 nil
112 ("Beginning of Clause" erlang-beginning-of-clause)
113 ("End of Clause" erlang-end-of-clause)
114 ("Mark Clause" erlang-mark-clause)
115 nil
116 ("New Clause" erlang-generate-new-clause)
117 ("Clone Arguments" erlang-clone-arguments)))
118 ("Syntax Highlighting"
119 (("Level 3" erlang-font-lock-level-3)
120 ("Level 2" erlang-font-lock-level-2)
121 ("Level 1" erlang-font-lock-level-1)
122 ("Off" erlang-font-lock-level-0)))
123 ("TAGS"
124 (("Find Tag" find-tag)
125 ("Find Next Tag" erlang-find-next-tag)
126 ;("Find Regexp" find-tag-regexp)
127 ("Complete Word" erlang-complete-tag)
128 ("Tags Apropos" tags-apropos)
129 ("Search Files" tags-search))))
130 "*Description of menu used in Erlang mode.
131
132This variable must be a list. The elements are either nil representing
133a horisontal line or a list with two or three elements. The first is
134the name of the menu item, the second is the function to call, or a
135submenu, on the same same form as ITEMS. The third optional argument
136is an expression which is evaluated every time the menu is displayed.
137Should the expression evaluate to nil the menu item is ghosted.
138
139Example:
140 '((\"Func1\" function-one)
141 (\"SubItem\"
142 ((\"Yellow\" function-yellow)
143 (\"Blue\" function-blue)))
144 nil
145 (\"Region Funtion\" spook-function midnight-variable))
146
147Call the function `erlang-menu-init' after modifying this variable.")
148
149(defvar erlang-menu-shell-items
150 '(nil
151 ("Shell"
152 (("Start New Shell" erlang-shell)
153 ("Display Shell" erlang-shell-display))))
154 "*Description of the Shell menu used by Erlang mode.
155
156Please see the documentation of `erlang-menu-base-items'.")
157
158(defvar erlang-menu-compile-items
159 '(("Compile"
160 (("Compile Buffer" erlang-compile)
161 ("Display Result" erlang-compile-display)
162 ("Next Error" erlang-next-error))))
163 "*Description of the Compile menu used by Erlang mode.
164
165Please see the documentation of `erlang-menu-base-items'.")
166
167(defvar erlang-menu-version-items
168 '(nil
169 ("Version" erlang-version))
170 "*Description of the version menu used in Erlang mode.")
171
172(defvar erlang-menu-personal-items nil
173 "*Description of personal menu items used in Erlang mode.
174
175Please see the variable `erlang-menu-base-items' for a description
176of the format.")
177
178(defvar erlang-menu-man-items nil
179 "The menu containing man pages.
180
181The format of the menu should be compatible with `erlang-menu-base-items'.
182This variable is added to the list of Erlang menus stored in
183`erlang-menu-items'.")
184
185(defvar erlang-menu-skel-items '()
186 "Description of the menu containing the skeleton entries.
187The menu is in the form described by the variable `erlang-menu-base-items'.")
188
189(defvar erlang-mode-hook nil
190 "*Functions to run when Erlang mode is activated.
191
192This hook is used to change the behaviour of Erlang mode. It is
193normally used by the user to personalise the programming environment.
194When used in a site init file, it could be used to customise Erlang
195mode for all users on the system.
196
197The functions added to this hook is runed every time Erlang mode is
198started. See also `erlang-load-hook', a hook which is runed once,
199when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook'
200which is run every time a new inferior Erlang shell is started.
201
202To use a hook, create an Emacs lisp function to perform your actions
203and add the function to the hook by calling `add-hook'.
204
205The following example binds the key sequence C-c C-c to the command
206`erlang-compile' (normally bound to C-c C-k). The example also
207activates Font Lock mode to fontify the buffer and adds a menu
208containing all functions defined in the current buffer.
209
210To use the example, copy the following lines to your `~/.emacs' file:
211
212 (add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
213
214 (defun my-erlang-mode-hook ()
215 (local-set-key \"\\C-c\\C-c\" 'erlang-compile)
216 (if window-system
217 (progn
218 (setq font-lock-maximum-decoration t)
219 (font-lock-mode 1)))
220 (if (and window-system (fboundp 'imenu-add-to-menubar))
221 (imenu-add-to-menubar \"Imenu\")))")
222
223(defvar erlang-load-hook nil
224 "*Functions to run when Erlang mode is loaded.
225
226This hook is used to change the behaviour of Erlang mode. It is
227normally used by the user to personalise the programming environment.
228When used in a site init file, it could be used to customize Erlang
229mode for all users on the system.
230
231The difference between this hook and `erlang-mode-hook' and
232`erlang-shell-mode-hook' is that the functions in this hook
233is only called once, when the Erlang mode is loaded into Emacs
234the first time.
235
236Natural actions for the functions added to this hook are actions which
237only should be performed once, and actions which should be performed
238before starting Erlang mode. For example, a number of variables are
239used by Erlang mode before `erlang-mode-hook' is runed.
240
241The following example sets the variable `erlang-root-dir' so that the
242manual pages can be retrieved (note that you must set the value of
243`erlang-root-dir' to match the loation of Erlang on your system):
244
245 (add-hook 'erlang-load-hook 'my-erlang-load-hook)
246
247 (defun my-erlang-load-hook ()
248 (setq erlang-root-dir \"/usr/local/erlang\"))")
249
250(defvar erlang-new-file-hook nil
251 "Functions to run when a new Erlang source file is being edited.
252
253A useful function is `tempo-template-erlang-normal-header'.
254\(This function only exists when the `tempo' packags is available.)")
255
256(defvar erlang-check-module-name 'ask
257 "*Non-nil means check that module name and file name agrees when saving.
258
259If the value of this variable is the atom `ask', the user is
260prompted. If the value is t the source is silently changed.")
261
262(defvar erlang-electric-commands
263 '(erlang-electric-comma
264 erlang-electric-semicolon
265 erlang-electric-gt)
266 "*List of activated electric commands.
267
268The list should contain the electric commands which should be active.
269Currently, the available electric commands are:
270 erlang-electric-comma
271 erlang-electric-semicolon
272 erlang-electric-gt
273 erlang-electric-newline
274
275Should the variable be bound to t, all electric commands
276are activated.
277
278To deactivate all electric commands, set this variable to nil.")
279
280(defvar erlang-electric-newline-inhibit t
281 "*Set to non-nil to inhibit newline after electric command.
282
283This is useful since a lot of people press return after executing an
284electric command.
285
286In order to work, the command must also be in the
287list `erlang-electric-newline-inhibit-list'.
288
289Note that commands in this list are required to set the variable
290`erlang-electric-newline-inhibit' to nil when the newline shouldn't be
291inhibited.")
292
293(defvar erlang-electric-newline-inhibit-list
294 '(erlang-electric-semicolon
295 erlang-electric-comma
296 erlang-electric-gt)
297 "*Command which can inhibit the next newline.")
298
299(defvar erlang-electric-semicolon-insert-blank-lines nil
300 "*Number of blank lines inserted before header, or nil.
301
302This variable controls the behaviour of `erlang-electric-semicolon'
303when a new function header is generated. When nil, no blank line is
304inserted between the current line and the new header. When bound to a
305number it represents the number of blank lines which should be
306inserted.")
307
308(defvar erlang-electric-semicolon-criteria
309 '(erlang-next-lines-empty-p
310 erlang-at-keyword-end-p
311 erlang-at-end-of-function-p)
312 "*List of functions controlling `erlang-electric-semicolon'.
313The functions in this list are called, in order, whenever a semicolon
314is typed. Each function in the list is called with no arguments,
315and should return one of the following values:
316
317 nil -- no determination made, continue checking
318 'stop -- do not create prototype for next line
319 (anything else) -- insert prototype, and stop checking
320
321If every function in the list is called with no determination made,
322then no prototype is inserted.
323
324The test is performed by the function `erlang-test-criteria-list'.")
325
326(defvar erlang-electric-comma-criteria
327 '(erlang-stop-when-inside-argument-list
328 erlang-stop-when-at-guard
329 erlang-next-lines-empty-p
330 erlang-at-keyword-end-p
331 erlang-at-end-of-function-p)
332 "*List of functions controlling `erlang-electric-comma'.
333The functions in this list are called, in order, whenever a comma
334is typed. Each function in the list is called with no arguments,
335and should return one of the following values:
336
337 nil -- no determination made, continue checking
338 'stop -- do not create prototype for next line
339 (anything else) -- insert prototype, and stop checking
340
341If every function in the list is called with no determination made,
342then no prototype is inserted.
343
344The test is performed by the function `erlang-test-criteria-list'.")
345
346(defvar erlang-electric-arrow-criteria
347 '(erlang-next-lines-empty-p
348 erlang-at-end-of-function-p)
349 "*List of functions controlling the arrow aspect of `erlang-electric-gt'.
350The functions in this list are called, in order, whenever a `>'
351is typed. Each function in the list is called with no arguments,
352and should return one of the following values:
353
354 nil -- no determination made, continue checking
355 'stop -- do not create prototype for next line
356 (anything else) -- insert prototype, and stop checking
357
358If every function in the list is called with no determination made,
359then no prototype is inserted.
360
361The test is performed by the function `erlang-test-criteria-list'.")
362
363(defvar erlang-electric-newline-criteria
364 '(t)
365 "*List of functions controlling `erlang-electric-newline'.
366
367The electric newline commands indents the next line. Should the
368current line begin with a comment the comment start is copied to
369the newly created line.
370
371The functions in this list are called, in order, whenever a comma
372is typed. Each function in the list is called with no arguments,
373and should return one of the following values:
374
375 nil -- no determination made, continue checking
376 'stop -- do not create prototype for next line
377 (anything else) -- trigger the electric command.
378
379If every function in the list is called with no determination made,
380then no prototype is inserted. Should the atom t be a member of the
381list, it is treated as a function triggering the electric command.
382
383The test is performed by the function `erlang-test-criteria-list'.")
384
385(defvar erlang-next-lines-empty-threshold 2
386 "*Number of blank lines required to activate an electric command.
387
388Actually, this value controls the behaviour of the function
389`erlang-next-lines-empty-p' which normally is a member of the
390criteria lists controlling the electric commands. (Please see
391the variables `erlang-electric-semicolon-criteria' and
392`erlang-electric-comma-criteria'.)
393
394The variable is bound to a threshold value, a number, representing the
395number of lines which must be empty.
396
397Setting this variable to zero, electric commands will always be
398triggered by `erlang-next-lines-empty-p', unless inhibited by other
399rules.
400
401Should this variable be `nil', `erlang-next-lines-empty-p' will never
402trigger an electric command. The same effect would be reached if the
403function `erlang-next-lines-empty-p' would be removed from the criteria
404lists.
405
406Note that even if `erlang-next-lines-empty-p' should not trigger an
407electric command, other functions in the criteria list could.")
408
409(defvar erlang-new-clause-with-arguments nil
410 "*Non-nil means that the arguments are cloned when a clause is generated.
411
412A new function header can be generated by calls to the function
413`erlang-generate-new-clause' and by use of the electric semicolon.")
414
415(defvar erlang-compile-use-outdir t
416 "*When nil, go to the directory containing source file when compiling.
417
418This is a workaround for a bug in the `outdir' option of compile. If the
419outdir is not in the current load path, Erlang doesn't load the object
420module after it has been compiled.
421
422To activate the workaround, place the following in your `~/.emacs' file:
423 (setq erlang-compile-use-outdir nil)")
424
425(defvar erlang-indent-level 4
426 "*Indentation of Erlang calls/clauses within blocks.")
427
428(defvar erlang-indent-guard 2
429 "*Indentation of Erlang guards.")
430
431(defvar erlang-argument-indent 2
432 "*Indentation of the first argument in a function call.
433When nil, indent to the column after the `(' of the
434function.")
435
436(defvar erlang-tab-always-indent t
437 "*Non-nil means TAB in Erlang mode should always reindent the current line,
438regardless of where in the line point is when the TAB command is used.")
439
440(defvar erlang-error-regexp-alist
441 '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
442 "*Patterns for matching Erlang errors.")
443
444(defvar erlang-man-inhibit (eq system-type 'windows-nt)
445 "Inhibit the creation of the Erlang Manual Pages menu.
446
447The Windows distribution of Erlang does not include man pages, hence
448there is no idea to create the menu.")
449
450(defvar erlang-man-dirs
451 '(("Man - Commands" "/man/man1" t)
452 ("Man - Modules" "/man/man3" t)
453 ("Man - Unsupported" "/uc/man/man3" t))
454 "*The man directories displayed in the Erlang menu.
455
456Each item in the list should be a list with three elements, the first
457the name of the menu, the second the directory, and the last a flag.
458Should the flag the nil, the directory is absolute, should it be non-nil
459the directory is relative to the variable `erlang-root-dir'.")
460
461(defvar erlang-man-max-menu-size 20
462 "*The maximum number of menu items in one menu allowed.")
463
464(defvar erlang-man-display-function 'erlang-man-display
465 "*Function used to display man page.
466
467The function is called with one argument, the name of the file
468containing the man page. Use this variable when the default
469function, erlang-man-display, does not work on your system.")
470
471(defconst erlang-atom-regexp "\\([a-z][a-zA-Z0-9_]*\\|'[^\n']*[^\\]'\\)"
472 "Regexp which should match an Erlang atom.
473
474The regexp must be surrounded with a pair of regexp parentheses.")
475(defconst erlang-atom-regexp-matches 1
476 "Number of regexp parenthesis pairs in `erlang-atom-regexp'.
477
478This is used to determine parenthesis matches in complex regexps which
479contains `erlang-atom-regexp'.")
480
481(defconst erlang-variable-regexp "\\([A-Z_][a-zA-Z0-9_]*\\)"
482 "Regexp which should match an Erlang variable.
483
484The regexp must be surrounded with a pair of regexp parenthesis.")
485(defconst erlang-variable-regexp-matches 1
486 "Number of regexp parenthesis pairs in `erlang-variable-regexp'.
487
488This is used to determine matches in complex rexeps which contains
489`erlang-variable-regexp'.")
490
491(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
492 "*Regexp which should match beginning of a clause.")
493
494(defvar erlang-file-name-extension-regexp "\\.[eh]rl$"
495 "*Regexp which should match an erlang file name.
496
497This regexp is used when an Erlang module name is extracted from the
498name of an Erlang source file.
499
500The regexp should only match the section of the file name which should
501be excluded from the module name.
502
503To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\".
504The matches all except the extension. This is useful if the Erlang
505tags system should interpretate tags on the form `module:tag' for
506files written in other languages than Erlang.")
507
508(defvar erlang-mode-map nil
509 "*Keymap used in Erlang mode.")
510(defvar erlang-mode-abbrev-table nil
511 "Abbrev table in use in Erlang-mode buffers.")
512(defvar erlang-mode-syntax-table nil
513 "Syntax table in use in Erlang-mode buffers.")
514
515(defconst erlang-emacs-major-version
516 (if (boundp 'emacs-major-version)
517 emacs-major-version
518 (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
519 (string-to-int (substring emacs-version
520 (match-beginning 1) (match-end 1))))
521 "Major version number of Emacs.")
522
523(defconst erlang-emacs-minor-version
524 (if (boundp 'emacs-minor-version)
525 emacs-minor-version
526 (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
527 (string-to-int (substring emacs-version
528 (match-beginning 2) (match-end 2))))
529 "Minor version number of Emacs.")
530
531(defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version)
532 "Non-nil when running under XEmacs or Lucid Emacs.")
533
534(defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil)
535 "Common popup menu for all buffers in Erlang mode.
536
537This variable is destructively modified every time the Erlang menu
538is modified. The effect is that all changes take effekt in all
539buffers in Erlang mode, just like under GNU Emacs.
540
541Never EVER set this variable!")
542
543
544;; Tempo skeleton templates:
545
546(defvar erlang-skel
547 '(("If" "if" erlang-skel-if)
548 ("Case" "case" erlang-skel-case)
549 ("Receive" "receive" erlang-skel-receive)
550 ("Receive After" "after" erlang-skel-receive-after)
551 ("Receive Loop" "loop" erlang-skel-receive-loop)
552 ("Module" "module" erlang-skel-module)
553 ("Author" "author" erlang-skel-author)
554 ()
555 ("Small Header" "small-header"
556 erlang-skel-small-header erlang-skel-header)
557 ("Normal Header" "normal-header"
558 erlang-skel-normal-header erlang-skel-header)
559 ("Large Header" "large-header"
560 erlang-skel-large-header erlang-skel-header)
561 ()
562 ("Small Server" "small-server"
563 erlang-skel-small-server erlang-skel-header)
564 ()
565 ("Application" "application"
566 erlang-skel-application erlang-skel-header)
567 ("General Tcp Receive" "fs_gen_tcp_recv"
568 erlang-skel-fs-gen-tcp-recv erlang-skel-header)
569 ("Test Suite" "test-suite"
570 erlang-skel-test-suite erlang-skel-header)
571 ("Tcp Gateway" "fs_tcp_gateway"
572 erlang-skel-fs-tcp-gateway erlang-skel-header)
573 ("Edoc function" "fs_edoc_header"
574 erlang-skel-fs-edoc-header erlang-skel-header)
575 ("DB Initialize" "fs_db_init"
576 erlang-skel-fs-db-init erlang-skel-header)
577 ("gen_leader" "generic-leader"
578 erlang-skel-generic-leader erlang-skel-header)
579 ("Supervisor" "supervisor"
580 erlang-skel-supervisor erlang-skel-header)
581 ("supervisor_bridge" "supervisor-bridge"
582 erlang-skel-supervisor-bridge erlang-skel-header)
583 ("gen_server" "generic-server"
584 erlang-skel-generic-server erlang-skel-header)
585 ("gen_event" "gen-event"
586 erlang-skel-gen-event erlang-skel-header)
587 ("gen_fsm" "gen-fsm"
588 erlang-skel-gen-fsm erlang-skel-header)
589 ("Library module" "gen-lib"
590 erlang-skel-lib erlang-skel-header)
591 ("Corba callback" "gen-corba-cb"
592 erlang-skel-corba-callback erlang-skel-header))
593 "*Description of all skeletons templates.
594Both functions and menu entries will be created.
595
596Each entry in `erlang-skel' should be a list with three or four
597elements, or the empty list.
598
599The first element is the name which shows up in the menu. The second
600is the `tempo' identfier (The string \"erlang-\" will be added in
601front of it). The third is the skeleton descriptor, a variable
602containing `tempo' attributes as described in the function
603`tempo-define-template'. The optional fourth elements denotes a
604function which should be called when the menu is selected.
605
606Functions corresponding to every template will be created. The name
607of the function will be `tempo-template-erlang-X' where `X' is the
608tempo identifier as specified in the second argument of the elements
609in this list.
610
611A list with zero elements means that the a horisontal line should
612be placed in the menu.")
613
614;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH!
615;; What's wrong with that? RFC 822 says it's legal. [sverkerw]
616(defvar erlang-skel-mail-address
617 (concat (user-login-name) "@"
618 (or (and (boundp 'mail-host-address)
619 (symbol-value 'mail-host-address))
620 (system-name)))
621 "Mail address of the user.")
622
623;; Expression templates:
624(defvar erlang-skel-case
625 '((erlang-skel-skip-blank) o >
626 "case " p " of" n> p "_ ->" n> p "ok" n> "end" p)
627 "*The skeleton of a `case' expression.
628Please see the function `tempo-define-template'.")
629
630(defvar erlang-skel-if
631 '((erlang-skel-skip-blank) o >
632 "if" n> p " ->" n> p "ok" n> "end" p)
633 "The skeleton of an `if' expression.
634Please see the function `tempo-define-template'.")
635
636(defvar erlang-skel-receive
637 '((erlang-skel-skip-blank) o >
638 "receive" n> p "_ ->" n> p "ok" n> "end" p)
639 "*The skeleton of a `receive' expression.
640Please see the function `tempo-define-template'.")
641
642(defvar erlang-skel-receive-after
643 '((erlang-skel-skip-blank) o >
644 "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n>
645 p "ok" n> "end" p)
646 "*The skeleton of a `receive' expression with an `after' clause.
647Please see the function `tempo-define-template'.")
648
649(defvar erlang-skel-receive-loop
650 '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n>
651 "loop(" p ")" n> "end.")
652 "*The skeleton of a simple `recieve' loop.
653Please see the function `tempo-define-template'.")
654
655
656;; Attribute templates
657
658(defvar erlang-skel-module
659 '(& "-module("
660 (erlang-add-quotes-if-needed (erlang-get-module-from-file-name))
661 ")." n)
662 "*The skeleton of a `module' attribute.
663Please see the function `tempo-define-template'.")
664
665(defvar erlang-skel-author
666 '(& "-author('" erlang-skel-mail-address "')." n)
667 "*The skeleton of a `author' attribute.
668Please see the function `tempo-define-template'.")
669
670(defvar erlang-skel-vc nil
671 "*The skeleton template to generate a version control attribute.
672The default is to insert nothing. Example of usage:
673
674 (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n)
675
676Please see the function `tempo-define-template'.")
677
678(defvar erlang-skel-export
679 '(& "-export([" n> "])." n)
680 "*The skeleton of an `export' attribute.
681Please see the function `tempo-define-template'.")
682
683(defvar erlang-skel-import
684 '(& "%%-import(Module, [Function/Arity, ...])." n)
685 "*The skeleton of an `import' attribute.
686Please see the function `tempo-define-template'.")
687
688(defvar erlang-skel-compile nil
689;; '(& "%%-compile(export_all)." n)
690 "*The skeleton of a `compile' attribute.
691Please see the function `tempo-define-template'.")
692
693
694;; Comment templates.
695
696(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy
697 "*Function which returns date string.
698Look in the module `time-stamp' for a battery of functions.")
699
700(defvar erlang-skel-copyright-comment '()
701 "*The template for a copyright line in the header, normally empty.
702This variable should be bound to a `tempo' template, for example:
703 '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n)
704
705Please see the function `tempo-define-template'.")
706
707(defvar erlang-skel-created-comment
708 '(& "%%% Created : " (funcall erlang-skel-date-function) " by "
709 (user-full-name) " <" erlang-skel-mail-address ">" n)
710 "*The template for the \"Created:\" comment line.")
711
712(defvar erlang-skel-author-comment
713 '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n)
714 "*The template for creating the \"Author:\" line in the header.
715Please see the function `tempo-define-template'.")
716
717(defvar erlang-skel-file-comment
718 '(& "%%% File : " (file-name-nondirectory buffer-file-name) n)
719 "*The template for creating the \"Module:\" line in the header.
720Please see the function `tempo-define-template'.")
721
722(defvar erlang-skel-small-header
723 '(o (erlang-skel-include erlang-skel-module)
724;; erlang-skel-author)
725 n
726 (erlang-skel-include erlang-skel-compile
727;; erlang-skel-export
728 erlang-skel-vc))
729 "*The template of a small header without any comments.
730Please see the function `tempo-define-template'.")
731
732(defvar erlang-skel-normal-header
733 '(o (erlang-skel-include erlang-skel-copyright-comment
734 erlang-skel-file-comment
735 erlang-skel-author-comment)
736 "%%% Description : " p n
737 (erlang-skel-include erlang-skel-created-comment) n
738 (erlang-skel-include erlang-skel-small-header) n)
739 "*The template of a normal header.
740Please see the function `tempo-define-template'.")
741
742(defvar erlang-skel-large-header
743 '(o "%%% $Id: erlang.el,v 1.21 2004/08/03 20:38:43 mlogan Exp $" n (erlang-skel-separator)
744 (erlang-skel-include erlang-skel-copyright-comment
745 erlang-skel-file-comment
746 erlang-skel-author-comment)
747 "%%%" n
748 "%%% @doc " p n
749 "%%% @end" n
750 "%%%" n
751 (erlang-skel-include erlang-skel-created-comment)
752 (erlang-skel-separator)
753 (erlang-skel-include erlang-skel-small-header) )
754 "*The template of a large header.
755Please see the function `tempo-define-template'.")
756
757
758;; Server templates.
759
760(defvar erlang-skel-small-server
761 '((erlang-skel-include erlang-skel-large-header)
762 (erlang-skel-separator 2)
763 "%% Include files" n
764 (erlang-skel-separator 2) n
765 (erlang-skel-separator 2)
766 "%% External exports" n
767 (erlang-skel-separator 2)
768 "-export([start_link/0])." n n
769 (erlang-skel-separator 2)
770 "%% Internal exports" n
771 (erlang-skel-separator 2)
772 "-export([init/1])." n n
773 n
774 (erlang-skel-separator 2)
775 "%% Macros" n
776 (erlang-skel-separator 2)
777 "-define(SERVER, ?MODULE)." n
778 n
779 (erlang-skel-separator 2)
780 "%% Records" n
781 (erlang-skel-separator 2)
782 n
783 (erlang-skel-double-separator 2)
784 "%% External functions" n
785 (erlang-skel-double-separator 2)
786 n
787 (erlang-skel-separator 2)
788 "%% @doc The starting point." n
789 "%% @spec start_link() -> {ok, Pid}" n
790 "%% @end" n
791 (erlang-skel-separator 2)
792 "start_link() ->" n>
793 "proc_lib:start_link(?MODULE, init, [self()])." n n
794 (erlang-skel-double-separator 2)
795 "%% Server functions" n
796 (erlang-skel-double-separator 2)
797 (erlang-skel-separator 2)
798 "%% Description: Initializes this server." n
799 "%% Variables:" n
800 "%% From - The pid of the parent process." n
801 (erlang-skel-separator 2)
802 "init(From) ->" n>
803 "register(?SERVER, self())," n>
804 "proc_lib:init_ack(From, {ok, self()})," n>
805 "loop(From)." n n
806 (erlang-skel-double-separator 2)
807 "%% Internal functions" n
808 (erlang-skel-double-separator 2)
809 "loop(From) ->" n>
810 "receive" n>
811 p "_ ->" n>
812 "loop(From)" n>
813 "end."
814 )
815 "*Template of a small server.
816Please see the function `tempo-define-template'.")
817
818;; Behaviour templates.
819
820(defvar erlang-skel-application
821 '((erlang-skel-include erlang-skel-large-header)
822 "-behaviour(application)." n
823 (erlang-skel-separator 2)
824 "%% Include files" n
825 (erlang-skel-separator 2)
826 n
827 (erlang-skel-separator 2)
828 "%% External exports" n
829 (erlang-skel-separator 2)
830 "-export([" n>
831 "start/2," n>
832 "shutdown/0," n>
833 "stop/1" n>
834 "])." n
835 n
836 (erlang-skel-separator 2)
837 "%% Macros" n
838 (erlang-skel-separator 2)
839 n
840 (erlang-skel-separator 2)
841 "%% Records" n
842 (erlang-skel-separator 2)
843 n
844 (erlang-skel-double-separator 2)
845 "%% External functions" n
846 (erlang-skel-double-separator 2)
847 (erlang-skel-separator 2)
848 "%% @doc The starting point for an erlang application." n
849 "%% @spec start(Type, StartArgs) -> {ok, Pid} | {ok, Pid, State} | {error, Reason}" n
850 "%% @end" n
851 (erlang-skel-separator 2)
852 "start(Type, StartArgs) ->" n>
853 "case "(erlang-get-module-from-file-name)"_sup:start_link(StartArgs) of" n>
854 "{ok, Pid} -> " n>
855 "{ok, Pid};" n>
856 "Error ->" n>
857 "Error" n>
858 "end." n
859 n
860 (erlang-skel-separator 2)
861 "%% @doc Called to shudown the "(erlang-get-module-from-file-name)" application." n
862 "%% @spec shutdown() -> ok "n
863 "%% @end"n
864 (erlang-skel-separator 2)
865 "shutdown() ->" n>
866 "application:stop("(erlang-get-module-from-file-name)")." n
867 n
868 (erlang-skel-double-separator 2)
869 "%% Internal functions" n
870 (erlang-skel-double-separator 2)
871 n
872 (erlang-skel-separator 2)
873 "%% Called upon the termintion of an application." n
874 (erlang-skel-separator 2)
875 "stop(State) ->" n>
876 "ok." n
877 n
878 )
879 "*The template of an application behaviour.
880Please see the function `tempo-define-template'.")
881
882;; Martins work
883
884;; test server test suite template
885(defvar erlang-skel-test-suite
886 '((erlang-skel-include erlang-skel-copyright-comment
887 erlang-skel-file-comment
888 erlang-skel-author-comment)
889 "%%%" n
890 "%%% @doc " p n
891 "%%% <p>A test spec consists of the test server required functions as detailed" n
892 "%%% by the comments for the functions themselves further down in this" n
893 "%%% file. The rest of a test suite consists of user defined Case functions" n
894 "%%% as referenced by the suite clause of the all/1 function and "n
895 "%%% described below.</p>"n
896 "%%%"n
897 "%%% <strong>"
898 "%%% Case(doc) -> [Decription]" n
899 "%%% Case(suite) -> [] | TestSpec | {skip, Comment}" n
900 "%%% Case(Config) -> {skip, Comment} | {comment, Comment} | Ok" n
901 "%%% </strong><pre>"n
902 "%%%"n
903 "%%% Variables:" n
904 "%%% Description - Short description of the test case TestSpec" n
905 "%%% Comment - This comment will be printed on the HTML result page " n
906 "%%%"n
907 "%%% Types:" n
908 "%%% Description = string()" n
909 "%%% TestSpec = list()" n
910 "%%% Ok = term()" n
911 "%%% Comment = string()" n
912 "%%% Config = term()" n
913 "%%% </pre>" n
914 "%%% <p>The documentation clause (argument doc) can be used for" n
915 "%%% automatic generation of test documentation or test descriptions.</p>" n
916 "%%%"n
917 "%%% <p>The specification clause (argument spec) shall return an empty" n
918 "%%% list, the test specification for the test case or {skip,Comment}." n
919 "%%% The syntax of a test specification is described in the reference " n
920 "%%% manual for the Test Server application.</p>" n
921 "%%%"n
922 "%%% <p>Note that the specification clause always is executed on "n
923 "%%% the controller host.</p>"n
924 "%%%"n
925 "%%% <p>The execution clause (argument Config) is only called if "n
926 "%%% the specification clause returns an empty list. The execution "n
927 "%%% clause is the real test case. Here you must call the functions "n
928 "%%% you want to test, and do whatever you need to check the result. "n
929 "%%% If someting fails, make sure the process crashes or call "n
930 "%%% test_server:fail/0/1 (which also will cause the process to crash).</p>"n
931 "%%%"n
932 "%%% <p>You can return {skip,Comment} if you decide not to run the "n
933 "%%% test case after all, e.g. if it is not applicable on this platform.</p>"n
934 "%%%"n
935 "%%% <p>You can return {comment,Comment} if you wish to print some "n
936 "%%% information in the 'Comment' field on the HTML result page.</p>"n
937 "%%%"n
938 "%%% <p>If the execution clause returns anything else, it is considered "n
939 "%%% a success. </p>"n
940 "%%% @end" n
941 "%%%" n
942 (erlang-skel-include erlang-skel-created-comment)
943 (erlang-skel-separator)
944 (erlang-skel-include erlang-skel-small-header)
945 (erlang-skel-separator 2)
946 "%% Include files" n
947 (erlang-skel-separator 2)
948 n
949 (erlang-skel-separator 2)
950 "%% Macro Definitions" n
951 (erlang-skel-separator 2)
952 n
953 (erlang-skel-separator 2)
954 "%% Test Suite Exports" n
955 (erlang-skel-separator 2)
956 "-export(["n>"all/1,"n>"init_per_testcase/2,"n>"fin_per_testcase/2"n>"])." n
957 n
958 (erlang-skel-separator 2)
959 "%% External Exports - test cases must be exported." n
960 (erlang-skel-separator 2)
961 "-export(["n>"])."n
962 n
963 (erlang-skel-double-separator 2)
964 "%% Test Server Functions" n
965 (erlang-skel-double-separator 2)
966 n
967 (erlang-skel-separator 2)
968 "%% @doc This function returns the test specification for the test suite module."n
969 "%% <pre>"n
970 "%% Types:"n
971 "%% TestSpec = list()"n
972 "%% Comment = string()"n
973 "%%"n
974 "%% </pre>"n
975 "%% @spec all(suite) -> TestSpec | {skip, Comment}"n
976 "%% @end"n
977 (erlang-skel-separator 2)
978 "all(doc) -> [];"n
979 "all(suite) -> []."n n
980 n
981 (erlang-skel-separator 2)
982 "%% @doc This function is called before each test case."n
983 "%% <pre>"n
984 "%% Types:"n
985 "%% Case = atom()"n
986 "%% Config = NewConfig = term()"n
987 "%%"n
988 "%% </pre>"n
989 "%% @spec init_per_testcase(Case, Config) -> NewConfig"n
990 "%% @end"n
991 (erlang-skel-separator 2)
992 "init_per_testcase(Case, Config) -> []."n n
993 n
994 (erlang-skel-separator 2)
995 "%% @doc This function is called after each test case."n
996 "%% <pre>"n
997 "%% Types:"n
998 "%% Case = atom()"n
999 "%% Config = term()"n
1000 "%%"n
1001 "%% </pre>"n
1002 "%% @spec fin_per_testcase(Case, Config) -> void()"n
1003 "%% @end"n
1004 (erlang-skel-separator 2)
1005 "fin_per_testcase(Case, Config) -> ok."n n
1006 n
1007 (erlang-skel-double-separator 2)
1008 "%% Individual Test Case Functions" n
1009 (erlang-skel-double-separator 2)
1010 n
1011 (erlang-skel-separator 2)
1012 "%% @doc ." n
1013 "%% @end" n
1014 (erlang-skel-separator 2)
1015 "Case(doc) -> [];"n
1016 "Case(suite) -> [];"n
1017 "Case(Config) when list(Config) -> ok."n n
1018 n
1019 (erlang-skel-double-separator 2)
1020 "%% Internal Functions" n
1021 (erlang-skel-double-separator 2)
1022 )
1023 "*The template of an application behaviour.
1024Please see the function `tempo-define-template'.")
1025
1026
1027;; fs_tcp_gateway template
1028(defvar erlang-skel-fs-tcp-gateway
1029 '((erlang-skel-include erlang-skel-large-header)
1030 "%% TODO Implement this behaviour" n
1031 "%% -behaviour(tcp_gateway)." n
1032 (erlang-skel-separator 2)
1033 "%% Include files" n
1034 (erlang-skel-separator 2)
1035 n
1036 (erlang-skel-separator 2)
1037 "%% External exports" n
1038 (erlang-skel-separator 2)
1039 "-export([" n> "start_link/1, init/0, sync_request/5, async_request/5, terminate/2" n
1040 " ])." n
1041 n
1042 (erlang-skel-separator 2)
1043 "%% Macros" n
1044 (erlang-skel-separator 2)
1045 "-define(SERVER, ?MODULE)." n
1046 n
1047 (erlang-skel-separator 2)
1048 "%% Records" n
1049 (erlang-skel-separator 2)
1050 "-record(state, {})."n
1051 n
1052 (erlang-skel-double-separator 2)
1053 "%% External functions" n
1054 (erlang-skel-double-separator 2)
1055 (erlang-skel-separator 2)
1056 "%% @doc Starts the gateway server."n
1057 "%% <pre>"n
1058 "%%"n
1059 "%% Expects:"n
1060 "%% Port - The port number to bind to."n
1061 "%%"n
1062 "%% Types:"n
1063 "%% Port = integer()"n
1064 "%%"n
1065 "%% </pre>"n
1066 "%%"n
1067 "%% @spec start_link(Port) -> {ok, pid()}"n
1068 "%% @end"n
1069 (erlang-skel-separator 2)
1070 "start_link(Port) ->" n>
1071 "CallBackModule = ?MODULE,"n>
1072 " fs_tcp_gateway:start_link(CallBackModule, Port)."n
1073 n
1074 (erlang-skel-double-separator 2)
1075 "%% Callbacks" n
1076 (erlang-skel-double-separator 2)
1077 (erlang-skel-separator 2)
1078 "%% @doc Initialization stage for each new connection to the gateway server."n
1079 "%% <pre>"n
1080 "%%"n
1081 "%% Types:"n
1082 "%% State = term()"n
1083 "%%"n
1084 "%% </pre>"n
1085 "%%"n
1086 "%% @spec init() -> {ok, State}"n
1087 "%% @end"n
1088 (erlang-skel-separator 2)
1089 "init() ->"n>
1090 "{ok, #state{}}."n
1091 n
1092 (erlang-skel-separator 2)
1093 "%% @doc Called when the server receives a syncronous request from a client."n
1094 "%% <pre>"n
1095 "%%"n
1096 "%% Expects:"n
1097 "%% ID - The request ID number"n
1098 "%% M - module name"n
1099 "%% F - function name"n
1100 "%% A - List of arguments"n
1101 "%% Reply - A message sent back over the tcp stream to the client"n
1102 "%%"n
1103 "%% Types:"n
1104 "%% ID = M = F = Reply = string()"n
1105 "%% A = [string()]"n
1106 "%% State = term()"n
1107 "%% Reply = string()"n
1108 "%%"n
1109 "%% </pre>"n
1110 "%%"n
1111 "%% @spec sync_request(ID, M, F, A, State) ->"n
1112 "%% {reply, Reply, State} | {stop, Reply, Reason, State} | {noreply, State}"n
1113 "%% @end"n
1114 (erlang-skel-separator 2)
1115 "sync_request(ID, M, F, A, State) ->"n>
1116 "{reply, \"sync ok\", State}."n
1117 n
1118 (erlang-skel-separator 2)
1119 "%% @doc Called when the server receives a asyncronous request from a client."n
1120 "%% <pre>"n
1121 "%%"n
1122 "%% Expects:"n
1123 "%% ID - The request ID number"n
1124 "%% M - module name"n
1125 "%% F - function name"n
1126 "%% A - List of arguments"n
1127 "%% Reply - A message sent back over the tcp stream to the client"n
1128 "%%"n
1129 "%% Types:"n
1130 "%% ID = M = F = string()"n
1131 "%% A = [string()]"n
1132 "%% State = term()"n
1133 "%% Reply = string()"n
1134 "%%"n
1135 "%% </pre>"n
1136 "%%"n
1137 "%% @spec async_request(ID, M, F, A, State) ->"n
1138 "%% {stop, Reason, State} | {noreply, State}"n
1139 "%% @end"n
1140 (erlang-skel-separator 2)
1141 "async_request(ID, M, F, A, State) ->"n>
1142 "{noreply, State}."n
1143 n
1144 (erlang-skel-separator 2)
1145 "%% @doc Called upon the shutdown of a connection."n
1146 "%% @spec terminate(Reason, State) -> void()"n
1147 "%% @end"n
1148 (erlang-skel-separator 2)
1149 "terminate(Reason, State) ->"n>
1150 "ok."n
1151 n
1152 (erlang-skel-double-separator 2)
1153 "%% Internal functions" n
1154 (erlang-skel-double-separator 2)
1155 )
1156 "*The template of a fs_tcp_gateway behaviour.
1157Please see the function `tempo-define-template'.")
1158
1159
1160;; gen_tcp_recv template
1161(defvar erlang-skel-fs-gen-tcp-recv
1162 '((erlang-skel-include erlang-skel-large-header)
1163 "%% TODO Implement this behaviour" n
1164 "%% -behaviour(gen_tcp_recv)." n
1165 (erlang-skel-separator 2)
1166 "%% External exports" n
1167 (erlang-skel-separator 2)
1168 "-export([" n> "start_link/0" n> "])." n n
1169 (erlang-skel-separator 2)
1170 "%% Server Callbacks" n
1171 (erlang-skel-separator 2)
1172 "-export([" n> "init/1," n> "handle_packet/3," n> "handle_call/4" n>
1173 "handle_info/3" n> "terminate/2" n> "])." n n
1174 (erlang-skel-separator 2)
1175 "%% Include files" n
1176 (erlang-skel-separator 2)
1177 n
1178 (erlang-skel-separator 2)
1179 "%% API - External Exports" n
1180 (erlang-skel-separator 2)
1181 "-export([" n>
1182 "start_link/1" n>
1183 "])." n
1184 n
1185 (erlang-skel-separator 2)
1186 "%% Macros" n
1187 (erlang-skel-separator 2)
1188 "-define(SERVER, ?MODULE)." n
1189 n
1190 (erlang-skel-separator 2)
1191 "%% Records" n
1192 (erlang-skel-separator 2)
1193 n
1194 (erlang-skel-double-separator 2)
1195 "%% External functions" n
1196 (erlang-skel-double-separator 2) n
1197 (erlang-skel-separator 2)
1198 "%% @doc Starts the fs_gen_tcp_recv server." n
1199 "%% @spec start_link() -> {ok, Pid}" n
1200 "%% @end" n
1201 (erlang-skel-separator 2)
1202 "start_link() ->" n>
1203 "fs_gen_tcp_recv:start_link(CallbackModule, ?TCP_PORT, [], [], [])." n n n
1204 (erlang-skel-double-separator 2)
1205 "%% Server Functions" n
1206 (erlang-skel-double-separator 2) n
1207 (erlang-skel-separator 2)
1208 "%% Initializes the state for a gen_tcp_recv server." n
1209 "%% Returns: {ok, State}" n
1210 "%% State = term()" n
1211 (erlang-skel-separator 2)
1212 "init([]) ->" n>
1213 "{ok, []}." n n n
1214 (erlang-skel-separator 2)
1215 "%% Receives packets from the socket. Also receives timout messages." n
1216 "%% Types:" n
1217 "%% Socket = socket()" n
1218 "%% Packet = binary() | string(). Can be altered in TCPOptions" n
1219 "%% Reply = binary() | string(). Can be altered in TCPOptions" n
1220 "%% State = NewState = term()" n
1221 "%% Timeout = integer() in miliseconds." n
1222 "%% Returns: " n
1223 "%% {noreply, NewState} {noreply, NewState, Timeout}" n
1224 "%% {reply, Reply, NewState} {reply, Reply, NewState, Timeout}" n
1225 "%% {stop, Reason, NewState}" n
1226 (erlang-skel-separator 2)
1227 "handle_packet(Socket, Packet, State) ->" n>
1228 "{noreply, State}." n n n
1229 (erlang-skel-separator 2)
1230 "%% Receives sync calls from a client." n
1231 "%% Variables:" n
1232 "%% Reply - A message sent back to the caller." n
1233 "%% " n
1234 "%% Types:" n
1235 "%% Socket = socket()" n
1236 "%% Msg = Reply = term()" n
1237 "%% State = NewState = term()" n
1238 "%% Timeout = integer() in miliseconds." n
1239 "%% Returns: " n
1240 "%% {noreply, NewState} {noreply, NewState, Timeout}" n
1241 "%% {reply, Reply, NewState} {reply, Reply, NewState, Timeout}" n
1242 "%% {stop, Reason, NewState} | {stop, Reason, Reply, NewState}" n
1243 (erlang-skel-separator 2)
1244 "handle_call(Socket, From, Msg, State) ->" n>
1245 "{reply, Reply, State}." n n n
1246 (erlang-skel-separator 2)
1247 "%% Receives messages from other processes and timeouts." n
1248 "%% Types:" n
1249 "%% Socket = socket()" n
1250 "%% Msg = term() | timeout" n
1251 "%% State = NewState = term()" n
1252 "%% Timeout = integer() in miliseconds." n
1253 "%% Returns: " n
1254 "%% {noreply, NewState} {noreply, NewState, Timeout}" n
1255 "%% {stop, Reason, NewState}" n
1256 (erlang-skel-separator 2)
1257 "handle_info(Socket, Msg, State) ->" n>
1258 "{noreply, State}." n n n
1259 (erlang-skel-separator 2)
1260 "%% Called after a socket closes or {stop, Reason, NewState}" n
1261 "%% Types:" n
1262 "%% Socket = socket()" n
1263 "%% State = NewState = term()" n
1264 "%% Returns: term()" n
1265 (erlang-skel-separator 2)
1266 "terminate(Socket, State) ->" n>
1267 "ok." n n n
1268 (erlang-skel-double-separator 2)
1269 "%%% Internal Functions" n
1270 (erlang-skel-double-separator 2)
1271 )
1272 "*The template of a fs_gen_tcp_recv behaviour.
1273Please see the function `tempo-define-template'.")
1274
1275;; fs_edoc_header template
1276(defvar erlang-skel-fs-edoc-header
1277 '((erlang-skel-separator 2)
1278 "%% @doc" n
1279 "%% <pre>" n
1280 "%% Variables:" n
1281 "%% Types:" n
1282 "%% </pre> term()" n
1283 "%% @spec" n
1284 "%% @end" n
1285 (erlang-skel-separator 2)
1286 )
1287 "*The template of an edoc function header.
1288Please see the function `tempo-define-template'.")
1289
1290;; fs_db_init template
1291(defvar erlang-skel-fs-db-init
1292 '((erlang-skel-include erlang-skel-large-header)
1293 "%% TODO Implement this behaviour" n
1294 "%% -behaviour(db_init)." n
1295 (erlang-skel-separator 2)
1296 "%% Include files" n
1297 (erlang-skel-separator 2)
1298 n
1299 (erlang-skel-separator 2)
1300 "%% External exports" n
1301 (erlang-skel-separator 2)
1302 "-export([" n> "start_link/1, start_link/3, init/1, local_init/0, remote_init/0" n
1303 " ])." n
1304 n
1305 (erlang-skel-separator 2)
1306 "%% Macros" n
1307 (erlang-skel-separator 2)
1308 "-define(SERVER, ?MODULE)." n
1309 n
1310 (erlang-skel-separator 2)
1311 "%% Records" n
1312 (erlang-skel-separator 2)
1313 n
1314 (erlang-skel-double-separator 2)
1315 "%% External functions" n
1316 (erlang-skel-separator 2)
1317 "%% @doc Starts the server. " n>
1318 "%% <pre>" n>
1319 "%% Variables:" n>
1320 "%% CallBackModule - The module that exhibits the db init behaviour." n>
1321 "%% Args - A list of arguments delivered to the CallBackModule:init/1 function." n>
1322 "%% Options - A list of options for fs_db_init." n>
1323 "%%" n>
1324 "%% The options are as follows:" n>
1325 "%% {schema_type, Type}" n>
1326 "%%" n>
1327 "%% Types:" n>
1328 "%% Args = list()" n>
1329 "%% Options = list()" n>
1330 "%% Type = ram_copies | disc_copies | disc_only_copies" n>
1331 "%%" n>
1332 "%% </pre>" n>
1333 "%% @spec start_link(CallBackModule, Args, Options) -> {ok, pid()} | {error, Reason}" n>
1334 "%% @end" n>
1335 "(erlang-skel-separator 2)"
1336 "start_link(CallBackModule, Args, Options) ->" n>
1337 "proc_lib:start_link(?MODULE, db_init, [self(), CallBackModule, Args, Options])." n>
1338 n
1339 "%% @spec start_link(CallBackModule) -> {ok, pid()} | {error, Reason}" n>
1340 "%% @equiv start_link(CallBackModule, [], [])" n>
1341 "start_link(CallBackModule) ->" n>
1342 "start_link(CallBackModule, [], [])." n>
1343 n
1344 (erlang-skel-double-separator 2)
1345 "%% Callbacks" n
1346 (erlang-skel-double-separator 2)
1347 (erlang-skel-separator 2)
1348 "%% @doc" n
1349 "%% Returns a list of nodes that db_init should try to replicate with." n
1350 "%%" n
1351 "%% <pre>" n
1352 "%% Types:" n
1353 "%% DBNodes = [node()]" n
1354 "%% </pre>" n
1355 "%%" n
1356 "%% @spec init(Args) -> {ok, DBNodes} | no_init" n
1357 "%% @end" n
1358 (erlang-skel-separator 2)
1359 "init(Args) ->" n
1360 " {ok, DBNodesToReplicateFrom = []}." n
1361 (erlang-skel-separator 2)
1362 "%% @doc" n
1363 "%% Created a schema and seeds the local database." n
1364 "%% Returns a list of records with their initial data." n
1365 "%% These are to be the tables and initial values for the database." n
1366 "%%" n
1367 "%% <pre>" n
1368 "%% Reclist = [record()]" n
1369 "%% Reason = atom()" n
1370 "%% </pre>" n
1371 "%%" n
1372 "%% @spec local_init() -> {ok, RecList} | {error, Reason}" n
1373 "%% @end" n
1374 (erlang-skel-separator 2)
1375 "local_init() ->" n
1376 " {ok, []}." n
1377 (erlang-skel-separator 2)
1378 "%% @doc Pushes the schema and the table definitions to the node" n
1379 "%% specified by the variable node." n
1380 "%% NOTE: Do not include the schema in this list." n
1381 "%%" n
1382 "%% <pre>" n
1383 "%% Types " n
1384 "%% Node = node()" n
1385 "%% TableList = [{Table, Type}]" n
1386 "%% Table = atom()" n
1387 "%% Type = ram_copies, disc_copies" n
1388 "%% Reason = atom()" n
1389 "%% </pre>" n
1390 "%%" n
1391 "%% @spec remote_init() -> {ok, TableList} | {error, Reason}" n
1392 "%% @end" n
1393 (erlang-skel-separator 2)
1394 "remote_init() ->" n
1395 " {ok, [{ini, ram_copies}]}." n
1396 n
1397 )
1398 "*The template of a fs_db_init behaviour.
1399Please see the function `tempo-define-template'.")
1400
1401(defvar erlang-skel-supervisor
1402 '((erlang-skel-include erlang-skel-large-header)
1403 "-behaviour(supervisor)." n
1404 (erlang-skel-separator 2)
1405 "%% Include files" n
1406 (erlang-skel-separator 2)
1407 n
1408 (erlang-skel-separator 2)
1409 "%% External exports" n
1410 (erlang-skel-separator 2)
1411 "-export([" n> "start_link/1" n
1412 " ])." n
1413 n
1414 (erlang-skel-separator 2)
1415 "%% Internal exports" n
1416 (erlang-skel-separator 2)
1417 "-export([" n> "init/1" n
1418 " ])." n
1419 n
1420 (erlang-skel-separator 2)
1421 "%% Macros" n
1422 (erlang-skel-separator 2)
1423 "-define(SERVER, ?MODULE)." n
1424 n
1425 (erlang-skel-separator 2)
1426 "%% Records" n
1427 (erlang-skel-separator 2)
1428 n
1429 (erlang-skel-double-separator 2)
1430 "%% External functions" n
1431 (erlang-skel-double-separator 2)
1432 (erlang-skel-separator 2)
1433 "%% @doc Starts the supervisor." n
1434 "%% @spec start_link(StartArgs) -> {ok, pid()} | Error" n
1435 "%% @end" n
1436 (erlang-skel-separator 2)
1437 "start_link(StartArgs) ->" n>
1438 "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n
1439 n
1440 (erlang-skel-double-separator 2)
1441 "%% Server functions" n
1442 (erlang-skel-double-separator 2)
1443 (erlang-skel-separator 2)
1444 "%% Func: init/1" n
1445 "%% Returns: {ok, {SupFlags, [ChildSpec]}} |" n
1446 "%% ignore |" n
1447 "%% {error, Reason} " n
1448 (erlang-skel-separator 2)
1449 "init([]) ->" n>
1450 "RestartStrategy = one_for_one," n>
1451 "MaxRestarts = 1000," n>
1452 "MaxTimeBetRestarts = 3600," n>
1453 n>
1454 "SupFlags = {RestartStrategy, MaxRestarts, MaxTimeBetRestarts}," n>
1455 n>
1456 "ChildSpecs =" n>
1457 "[" n>
1458 "{AppName," n>
1459 "{AppName, start_link, []}," n>
1460 "permanent," n>
1461 "1000," n>
1462 "worker," n>
1463 "[AppName]}" n>
1464 "]," n>
1465 "{ok,{SupFlags, ChildSpecs}}." n
1466
1467 (erlang-skel-double-separator 2)
1468 "%% Internal functions" n
1469 (erlang-skel-double-separator 2)
1470 )
1471 "*The template of an supervisor behaviour.
1472Please see the function `tempo-define-template'.")
1473
1474(defvar erlang-skel-supervisor-bridge
1475 '((erlang-skel-include erlang-skel-large-header)
1476 "-behaviour(supervisor_bridge)." n
1477 (erlang-skel-separator 2)
1478 "%% Include files" n
1479 (erlang-skel-separator 2)
1480 n
1481 (erlang-skel-separator 2)
1482 "%% External exports" n
1483 (erlang-skel-separator 2)
1484 "-export([" n> "start_link/0" n
1485 " ])." n
1486 n
1487 (erlang-skel-separator 2)
1488 "%% Internal exports" n
1489 (erlang-skel-separator 2)
1490 "-export([" n> "init/1, " n> "terminate/2" n
1491 " ])." n
1492 n
1493 (erlang-skel-separator 2)
1494 "%% Macros" n
1495 (erlang-skel-separator 2)
1496 "-define(SERVER, ?MODULE)." n
1497 n
1498 (erlang-skel-separator 2)
1499 "%% Records" n
1500 (erlang-skel-separator 2)
1501 "-record(state, {})." n
1502 n
1503 (erlang-skel-double-separator 2)
1504 "%% External functions" n
1505 (erlang-skel-double-separator 2)
1506 (erlang-skel-separator 2)
1507 "%% Function: start_link/0" n
1508 "%% Description: Starts the supervisor bridge" n
1509 (erlang-skel-separator 2)
1510 "start_link() ->" n>
1511 "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n
1512 n
1513 (erlang-skel-double-separator 2)
1514 "%% Server functions" n
1515 (erlang-skel-double-separator 2)
1516 (erlang-skel-separator 2)
1517 "%% Func: init/1" n
1518 "%% Returns: {ok, Pid, State} |" n
1519 "%% ignore |" n
1520 "%% {error, Reason} " n
1521 (erlang-skel-separator 2)
1522 "init([]) ->" n>
1523 "case 'AModule':start_link() of" n>
1524 "{ok, Pid} ->" n>
1525 "{ok, Pid, #state{}};" n>
1526 "Error ->" n>
1527 "Error" n>
1528 "end." n
1529 n
1530 (erlang-skel-separator 2)
1531 "%% Func: terminate/2" n
1532 "%% Purpose: Synchronized shutdown of the underlying sub system." n
1533 "%% Returns: any" n
1534 (erlang-skel-separator 2)
1535 "terminate(Reason, State) ->" n>
1536 "'AModule':stop()," n>
1537 "ok." n
1538 n
1539 (erlang-skel-double-separator 2)
1540 "%% Internal functions" n
1541 (erlang-skel-double-separator 2)
1542 )
1543 "*The template of an supervisor_bridge behaviour.
1544Please see the function `tempo-define-template'.")
1545
1546(defvar erlang-skel-generic-server
1547 '((erlang-skel-include erlang-skel-large-header)
1548 "-behaviour(gen_server)." n
1549 (erlang-skel-separator 2)
1550 "%% Include files" n
1551 (erlang-skel-separator 2)
1552 n
1553 (erlang-skel-separator 2)
1554 "%% External exports" n
1555 (erlang-skel-separator 2)
1556 "-export([" n>"start_link/0,"n>"stop/0"n>"])." n
1557 n
1558 (erlang-skel-separator 2)
1559 "%% gen_server callbacks" n
1560 (erlang-skel-separator 2)
1561 "-export([init/1, handle_call/3, handle_cast/2, "
1562 "handle_info/2, terminate/2, code_change/3])." n n
1563 (erlang-skel-separator 2)
1564 "%% record definitions" n
1565 (erlang-skel-separator 2)
1566 "-record(state, {})." n n
1567 (erlang-skel-separator 2)
1568 "%% macro definitions" n
1569 (erlang-skel-separator 2)
1570 "-define(SERVER, ?MODULE)." n
1571 n
1572 (erlang-skel-double-separator 2)
1573 "%% External functions" n
1574 (erlang-skel-double-separator 2)
1575 (erlang-skel-separator 2)
1576 "%% @doc Starts the server." n
1577 "%% @spec start_link() -> {ok, pid()} | {error, Reason}" n
1578 "%% @end"n
1579 (erlang-skel-separator 2)
1580 "start_link() ->" n>
1581 "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n
1582 n
1583 (erlang-skel-separator 2)
1584 "%% @doc Stops the server." n
1585 "%% @spec stop() -> ok" n
1586 "%% @end"n
1587 (erlang-skel-separator 2)
1588 "stop() ->" n>
1589 "gen_server:cast(?SERVER, stop)." n
1590 n
1591 (erlang-skel-double-separator 2)
1592 "%% Server functions" n
1593 (erlang-skel-double-separator 2)
1594 n
1595 (erlang-skel-separator 2)
1596 "%% Function: init/1" n
1597 "%% Description: Initiates the server" n
1598 "%% Returns: {ok, State} |" n
1599 "%% {ok, State, Timeout} |" n
1600 "%% ignore |" n
1601 "%% {stop, Reason}" n
1602 (erlang-skel-separator 2)
1603 "init([]) ->" n>
1604 "{ok, #state{}}." n
1605 n
1606 (erlang-skel-separator 2)
1607 "%% Function: handle_call/3" n
1608 "%% Description: Handling call messages" n
1609 "%% Returns: {reply, Reply, State} |" n
1610 "%% {reply, Reply, State, Timeout} |" n
1611 "%% {noreply, State} |" n
1612 "%% {noreply, State, Timeout} |" n
1613 "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n
1614 "%% {stop, Reason, State} (terminate/2 is called)" n
1615 (erlang-skel-separator 2)
1616 "handle_call(Request, From, State) ->" n>
1617 "Reply = ok," n>
1618 "{reply, Reply, State}." n
1619 n
1620 (erlang-skel-separator 2)
1621 "%% Function: handle_cast/2" n
1622 "%% Description: Handling cast messages" n
1623 "%% Returns: {noreply, State} |" n
1624 "%% {noreply, State, Timeout} |" n
1625 "%% {stop, Reason, State} (terminate/2 is called)" n
1626 (erlang-skel-separator 2)
1627 "handle_cast(stop, State) ->" n>
1628 "{stop, normal, State};" n
1629 "handle_cast(Msg, State) ->" n>
1630 "{noreply, State}." n
1631 n
1632 (erlang-skel-separator 2)
1633 "%% Function: handle_info/2" n
1634 "%% Description: Handling all non call/cast messages" n
1635 "%% Returns: {noreply, State} |" n
1636 "%% {noreply, State, Timeout} |" n
1637 "%% {stop, Reason, State} (terminate/2 is called)" n
1638 (erlang-skel-separator 2)
1639 "handle_info(Info, State) ->" n>
1640 "{noreply, State}." n
1641 n
1642 (erlang-skel-separator 2)
1643 "%% Function: terminate/2" n
1644 "%% Description: Shutdown the server" n
1645 "%% Returns: any (ignored by gen_server)" n
1646 (erlang-skel-separator 2)
1647 "terminate(Reason, State) ->" n>
1648 "ok." n
1649 n
1650 (erlang-skel-separator 2)
1651 "%% Func: code_change/3" n
1652 "%% Purpose: Convert process state when code is changed" n
1653 "%% Returns: {ok, NewState}" n
1654 (erlang-skel-separator 2)
1655 "code_change(OldVsn, State, Extra) ->" n>
1656 "{ok, State}." n
1657 n
1658 (erlang-skel-double-separator 2)
1659 "%%% Internal functions" n
1660 (erlang-skel-double-separator 2)
1661 )
1662 "*The template of a generic server.
1663Please see the function `tempo-define-template'.")
1664
1665(defvar erlang-skel-gen-event
1666 '((erlang-skel-include erlang-skel-large-header)
1667 "-behaviour(gen_event)." n
1668 (erlang-skel-separator 2)
1669 "%% Include files" n
1670 (erlang-skel-separator 2)
1671 n
1672 (erlang-skel-separator 2)
1673 "%% External exports" n
1674 (erlang-skel-separator 2)
1675 "-export([start_link/0, add_handler/0])." n
1676 n
1677 (erlang-skel-separator 2)
1678 "%% gen_event callbacks" n
1679 (erlang-skel-separator 2)
1680 "-export([init/1, handle_event/2, handle_call/2, "
1681 "handle_info/2, terminate/2, code_change/3])." n n
1682 (erlang-skel-separator 2)
1683 "%% Record Definitions" n
1684 (erlang-skel-separator 2)
1685 "-record(state, {})." n n
1686 (erlang-skel-separator 2)
1687 "%% Macro Definitions" n
1688 (erlang-skel-separator 2)
1689 "-define(SERVER, ?MODULE)." n
1690 n
1691 (erlang-skel-double-separator 2)
1692 "%% External functions" n
1693 (erlang-skel-double-separator 2)
1694 (erlang-skel-separator 2)
1695 "%% @doc Starts the server" n
1696 "%% @spec start_link() -> {ok, Pid} | {error, {already_started, Pid}}" n
1697 "%% @end" n
1698 (erlang-skel-separator 2)
1699 "start_link() ->" n>
1700 "gen_event:start_link({local, ?SERVER}). " n
1701 n
1702 (erlang-skel-separator 2)
1703 "%% @doc Adds an event handler" n
1704 "%% @spec add_handler() -> ok | {'EXIT', Reason}" n
1705 "%% @end" n
1706 (erlang-skel-separator 2)
1707 "add_handler() ->" n>
1708 "gen_event:add_handler(?SERVER, ?MODULE, [])." n
1709 n
1710 (erlang-skel-double-separator 2)
1711 "%% Server functions" n
1712 (erlang-skel-double-separator 2)
1713 (erlang-skel-separator 2)
1714 "%% Func: init/1" n
1715 "%% Returns: {ok, State} |" n
1716 "%% Other" n
1717 (erlang-skel-separator 2)
1718 "init([]) ->" n>
1719 "{ok, #state{}}." n
1720 n
1721 (erlang-skel-separator 2)
1722 "%% Func: handle_event/2" n
1723 "%% Returns: {ok, State} |" n
1724 "%% {swap_handler, Args1, State1, Mod2, Args2} |" n
1725 "%% remove_handler " n
1726 (erlang-skel-separator 2)
1727 "handle_event(Event, State) ->" n>
1728 "{ok, State}." n
1729 n
1730 (erlang-skel-separator 2)
1731 "%% Func: handle_call/2" n
1732 "%% Returns: {ok, Reply, State} |" n
1733 "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n
1734 "%% {remove_handler, Reply} " n
1735 (erlang-skel-separator 2)
1736 "handle_call(Request, State) ->" n>
1737 "Reply = ok," n>
1738 "{ok, Reply, State}." n
1739 n
1740 (erlang-skel-separator 2)
1741 "%% Func: handle_info/2" n
1742 "%% Returns: {ok, State} |" n
1743 "%% {swap_handler, Args1, State1, Mod2, Args2} |" n
1744 "%% remove_handler " n
1745 (erlang-skel-separator 2)
1746 "handle_info(Info, State) ->" n>
1747 "{ok, State}." n
1748 n
1749 (erlang-skel-separator 2)
1750 "%% Func: terminate/2" n
1751 "%% Purpose: Shutdown the server" n
1752 "%% Returns: any" n
1753 (erlang-skel-separator 2)
1754 "terminate(Reason, State) ->" n>
1755 "ok." n
1756 n
1757 (erlang-skel-separator 2)
1758 "%% Func: code_change/3" n
1759 "%% Purpose: Convert process state when code is changed" n
1760 "%% Returns: {ok, NewState}" n
1761 (erlang-skel-separator 2)
1762 "code_change(OldVsn, State, Extra) ->" n>
1763 "{ok, State}." n
1764 n
1765 (erlang-skel-separator 2)
1766 "%%% Internal functions" n
1767 (erlang-skel-separator 2)
1768 )
1769 "*The template of a gen_event.
1770Please see the function `tempo-define-template'.")
1771
1772(defvar erlang-skel-gen-fsm
1773 '((erlang-skel-include erlang-skel-large-header)
1774 "-behaviour(gen_fsm)." n
1775 (erlang-skel-separator 2)
1776 "%% Include files" n
1777 (erlang-skel-separator 2)
1778 n
1779 (erlang-skel-separator 2)
1780 "%% External exports" n
1781 "-export([start_link/0])." n
1782 n
1783 "%% gen_fsm callbacks" n
1784 "-export([init/1, state_name/2, state_name/3, handle_event/3," n>
1785 "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n
1786 "-record(state, {})." n
1787 n
1788 (erlang-skel-double-separator 2)
1789 "%% External functions" n
1790 (erlang-skel-double-separator 2)
1791 (erlang-skel-separator 2)
1792 "%% Function: start_link/0" n
1793 "%% Description: Starts the server" n
1794 (erlang-skel-separator 2)
1795 "start_link() ->" n>
1796 "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n
1797 n
1798 (erlang-skel-double-separator 2)
1799 "%% Server functions" n
1800 (erlang-skel-double-separator 2)
1801 (erlang-skel-separator 2)
1802 "%% Func: init/1" n
1803 "%% Returns: {ok, StateName, StateData} |" n
1804 "%% {ok, StateName, StateData, Timeout} |" n
1805 "%% ignore |" n
1806 "%% {stop, StopReason} " n
1807 (erlang-skel-separator 2)
1808 "init([]) ->" n>
1809 "{ok, state_name, #state{}}." n
1810 n
1811 (erlang-skel-separator 2)
1812 "%% Func: StateName/2" n
1813 "%% Returns: {next_state, NextStateName, NextStateData} |" n
1814 "%% {next_state, NextStateName, NextStateData, Timeout} |" n
1815 "%% {stop, Reason, NewStateData} " n
1816 (erlang-skel-separator 2)
1817 "state_name(Event, StateData) ->" n>
1818 "{next_state, state_name, StateData}." n
1819 n
1820 (erlang-skel-separator 2)
1821 "%% Func: StateName/3" n
1822 "%% Returns: {next_state, NextStateName, NextStateData} |" n
1823 "%% {next_state, NextStateName, NextStateData, Timeout} |" n
1824 "%% {reply, Reply, NextStateName, NextStateData} |" n
1825 "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n
1826 "%% {stop, Reason, NewStateData} |" n
1827 "%% {stop, Reason, Reply, NewStateData} " n
1828 (erlang-skel-separator 2)
1829 "state_name(Event, From, StateData) ->" n>
1830 "Reply = ok," n>
1831 "{reply, Reply, state_name, StateData}." n
1832 n
1833 (erlang-skel-separator 2)
1834 "%% Func: handle_event/3" n
1835 "%% Returns: {next_state, NextStateName, NextStateData} |" n
1836 "%% {next_state, NextStateName, NextStateData, Timeout} |" n
1837 "%% {stop, Reason, NewStateData} " n
1838 (erlang-skel-separator 2)
1839 "handle_event(Event, StateName, StateData) ->" n>
1840 "{next_state, StateName, StateData}." n
1841 n
1842 (erlang-skel-separator 2)
1843 "%% Func: handle_sync_event/4" n
1844 "%% Returns: {next_state, NextStateName, NextStateData} |" n
1845 "%% {next_state, NextStateName, NextStateData, Timeout} |" n
1846 "%% {reply, Reply, NextStateName, NextStateData} |" n
1847 "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n
1848 "%% {stop, Reason, NewStateData} |" n
1849 "%% {stop, Reason, Reply, NewStateData} " n
1850 (erlang-skel-separator 2)
1851 "handle_sync_event(Event, From, StateName, StateData) ->" n>
1852 "Reply = ok," n>
1853 "{reply, Reply, StateName, StateData}." n
1854 n
1855 (erlang-skel-separator 2)
1856 "%% Func: handle_info/3" n
1857 "%% Returns: {next_state, NextStateName, NextStateData} |" n
1858 "%% {next_state, NextStateName, NextStateData, Timeout} |" n
1859 "%% {stop, Reason, NewStateData} " n
1860 (erlang-skel-separator 2)
1861 "handle_info(Info, StateName, StateData) ->" n>
1862 "{next_state, StateName, StateData}." n
1863 n
1864 (erlang-skel-separator 2)
1865 "%% Func: terminate/3" n
1866 "%% Purpose: Shutdown the fsm" n
1867 "%% Returns: any" n
1868 (erlang-skel-separator 2)
1869 "terminate(Reason, StateName, StatData) ->" n>
1870 "ok." n
1871 n
1872 (erlang-skel-separator 2)
1873 "%% Func: code_change/4" n
1874 "%% Purpose: Convert process state when code is changed" n
1875 "%% Returns: {ok, NewState, NewStateData}" n
1876 (erlang-skel-separator 2)
1877 "code_change(OldVsn, StateName, StateData, Extra) ->" n>
1878 "{ok, StateName, StateData}." n
1879 n
1880 (erlang-skel-separator 2)
1881 "%%% Internal functions" n
1882 (erlang-skel-separator 2)
1883 )
1884 "*The template of a gen_fsm.
1885Please see the function `tempo-define-template'.")
1886
1887(defvar erlang-skel-lib
1888 '((erlang-skel-include erlang-skel-large-header)
1889 (erlang-skel-separator 2)
1890 "%% Include files" n
1891 (erlang-skel-separator 2)
1892 n
1893 (erlang-skel-separator 2)
1894 "%% External exports" n
1895 (erlang-skel-separator 2)
1896 "-export([" n
1897 " ])." n
1898 n
1899 (erlang-skel-separator 2)
1900 "%% Internal exports" n
1901 (erlang-skel-separator 2)
1902 "-export([" n
1903 " ])." n
1904 n
1905 (erlang-skel-separator 2)
1906 "%% Macros" n
1907 (erlang-skel-separator 2)
1908 n
1909 (erlang-skel-separator 2)
1910 "%% Records" n
1911 (erlang-skel-separator 2)
1912 n
1913 (erlang-skel-double-separator 2)
1914 "%% External functions" n
1915 (erlang-skel-double-separator 2)
1916 (erlang-skel-separator 2)
1917 "%% @doc" n
1918 "%% @spec " n
1919 "%% @end " n
1920 (erlang-skel-separator 2)
1921 n
1922 (erlang-skel-double-separator 2)
1923 "%% Internal functions" n
1924 (erlang-skel-double-separator 2)
1925 )
1926 "*The template of a library module.
1927Please see the function `tempo-define-template'.")
1928
1929
1930(defvar erlang-skel-generic-leader
1931 '((erlang-skel-include erlang-skel-large-header)
1932 "-behaviour(fs_gen_leader)." n
1933 (erlang-skel-separator 2)
1934 "%% Include files" n
1935 (erlang-skel-separator 2)
1936 n
1937 (erlang-skel-separator 2)
1938 "%% External exports" n
1939 (erlang-skel-separator 2)
1940 "-export([" n>"start_link/0,"n>"stop/0"n>"])." n
1941 n
1942 (erlang-skel-separator 2)
1943 "%% gen_leader callbacks" n
1944 (erlang-skel-separator 2)
1945 "-export([init/1," n>
1946 "elected/2," n>
1947 "surrendered/3," n>
1948 "handle_DOWN/3," n>
1949 "handle_leader_call/4," n>
1950 "handle_leader_cast/3," n>
1951 "from_leader/3," n>
1952 "handle_call/3," n>
1953 "handle_cast/2," n>
1954 "handle_info/2," n>
1955 "terminate/2," n>
1956 "code_change/4" n>
1957 "])." n>
1958 (erlang-skel-separator 2)
1959 "%% record definitions" n
1960 (erlang-skel-separator 2)
1961 "-record(state, {})." n n
1962 (erlang-skel-separator 2)
1963 "%% macro definitions" n
1964 (erlang-skel-separator 2)
1965 "-define(SERVER, ?MODULE)." n
1966 n
1967 (erlang-skel-double-separator 2)
1968 "%% External functions" n
1969 (erlang-skel-double-separator 2)
1970 (erlang-skel-separator 2)
1971 "%% @doc Starts the gen_leader." n
1972 "%% @spec start_link() -> {ok, pid()} | {error, Reason}" n
1973 "%% @end"n
1974 (erlang-skel-separator 2)
1975 "start_link() ->" n>
1976 "Candidates = [node()|nodes()]," n>
1977 "Workers = []," n>
1978 "gen_leader:start_link({local, ?SERVER}, Candidates, Workers, ?MODULE, [], [])." n
1979 n
1980 (erlang-skel-separator 2)
1981 "%% @doc Stops the gen_leader." n
1982 "%% @spec stop() -> ok" n
1983 "%% @end"n
1984 (erlang-skel-separator 2)
1985 "stop() ->" n>
1986 "gen_leader:cast(?SERVER, stop)." n
1987 n
1988 (erlang-skel-double-separator 2)
1989 "%% Server functions" n
1990 (erlang-skel-double-separator 2)
1991 n
1992
1993
1994
1995 (erlang-skel-separator 2)
1996 "%% Function: init/1" n>
1997 "%% Description: Initiates the server" n>
1998 "%% Returns: {ok, State} |" n>
1999 "%% {ok, State, Timeout} |" n>
2000 "%% ignore |" n>
2001 "%% {stop, Reason}" n>
2002 (erlang-skel-separator 2)
2003 "init([]) ->" n>
2004 "{ok, #state{}}." n
2005 n
2006
2007 (erlang-skel-separator 2)
2008 "%% Called when we become the leader." n>
2009 "%%" n>
2010 "%% elected(State::state(), E::election()) -> {ok, Broadcast, NState}" n>
2011 (erlang-skel-separator 2)
2012 "elected(State, E) ->" n>
2013 "BroadcastToAllCandidates = [],"n>
2014 "{ok, BroadcastToAllCandidates , State}." n
2015 n
2016
2017 (erlang-skel-separator 2)
2018 "%% Called by each candidate when it recognizes another instance as leader." n>
2019 "%% Strictly speaking, this function is called when the candidate " n>
2020 "%% acknowledges a leader and receives a Synch message in return." n>
2021 "%%" n>
2022 "%% surrendered(State::state(), Synch::broadcast(), E::election()) -> {ok, NState}" n>
2023 (erlang-skel-separator 2)
2024 "surrendered(State, BCastFromLeaderElectedCall, E) ->" n>
2025 "{ok, State#state{leader_node = LeaderNode}}."n
2026 n
2027
2028 (erlang-skel-separator 2)
2029 "%% Called by the leader when it detects loss of a candidate node." n>
2030 "%% If the function returns a broadcast() object, this will" n>
2031 "%% be sent to all candidates, and they will receive it in the function" n>
2032 "%% link from_leader/3. from_leader/3" n>
2033 "%%" n>
2034 "%% handle_DOWN(Node::node(), State::state(), E::election()) -> {ok, NState} | {ok, Broadcast, NState}" n>
2035 (erlang-skel-separator 2)
2036 "handle_DOWN(Node, State, _E) ->" n>
2037 "{ok, State}." n>
2038
2039 (erlang-skel-separator 2)
2040 "%% handle_leader_call(Msg::term(), From::callerRef(), State::state(), E::election()) -> " n>
2041 "%% {reply, Reply, NState} |" n>
2042 "%% {reply, Reply, Broadcast, NState} |" n>
2043 "%% {noreply, state()} |" n>
2044 "%% {stop, Reason, Reply, NState} |" n>
2045 "%% commonReply()" n>
2046 "%%" n>
2047 "%% Called by the leader in response to a gen_leader:leader_call/2. leader_call()." n>
2048 (erlang-skel-separator 2)
2049 "handle_leader_call(Msg, _From, State, _E) ->" n>
2050 "{reply, Reply = [], State}." n
2051 n
2052
2053 (erlang-skel-separator 2)
2054 "%% Called by the leader in response to a gen_leader:leader_cast/2 leader_cast()" n>
2055 "%% handle_leader_cast(Msg::term(), State::term(), E::election()) -> commonReply()" n>
2056 "%%" n>
2057 "%% BUG: This has not yet been implemented." n>
2058 (erlang-skel-separator 2)
2059 "handle_leader_cast(_Msg, State, _E) ->" n>
2060 "{ok, State}." n
2061 n
2062
2063 (erlang-skel-separator 2)
2064 "%% Called by each candidate in response to a message from the leader. " n>
2065 "%% In this particular module, the leader passes an update function to be " n>
2066 "%% applied to the candidate's state. " n>
2067 "%% " n>
2068 "%% from_leader(Msg::term(), State::state(), E::election()) -> {ok, NState} " n>
2069 (erlang-skel-separator 2)
2070 "from_leader(MSG, State, _E) -> " n>
2071 "{ok, State}. " n
2072 n
2073
2074 n
2075 (erlang-skel-separator 2)
2076 "%% Function: handle_call/3" n
2077 "%% Description: Handling call messages" n
2078 "%% Returns: {reply, Reply, State} |" n
2079 "%% {reply, Reply, State, Timeout} |" n
2080 "%% {noreply, State} |" n
2081 "%% {noreply, State, Timeout} |" n
2082 "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n
2083 "%% {stop, Reason, State} (terminate/2 is called)" n
2084 (erlang-skel-separator 2)
2085 "handle_call(Request, From, State) ->" n>
2086 "Reply = ok," n>
2087 "{reply, Reply, State}." n
2088 n
2089 (erlang-skel-separator 2)
2090 "%% Function: handle_cast/2" n
2091 "%% Description: Handling cast messages" n
2092 "%% Returns: {noreply, State} |" n
2093 "%% {noreply, State, Timeout} |" n
2094 "%% {stop, Reason, State} (terminate/2 is called)" n
2095 (erlang-skel-separator 2)
2096 "handle_cast(stop, State) ->" n>
2097 "{stop, normal, State};" n
2098 "handle_cast(Msg, State) ->" n>
2099 "{noreply, State}." n
2100 n
2101 (erlang-skel-separator 2)
2102 "%% Function: handle_info/2" n
2103 "%% Description: Handling all non call/cast messages" n
2104 "%% Returns: {noreply, State} |" n
2105 "%% {noreply, State, Timeout} |" n
2106 "%% {stop, Reason, State} (terminate/2 is called)" n
2107 (erlang-skel-separator 2)
2108 "handle_info(Info, State) ->" n>
2109 "{noreply, State}." n
2110 n
2111 (erlang-skel-separator 2)
2112 "%% Function: terminate/2" n
2113 "%% Description: Shutdown the server" n
2114 "%% Returns: any (ignored by gen_server)" n
2115 (erlang-skel-separator 2)
2116 "terminate(Reason, State) ->" n>
2117 "ok." n
2118 n
2119 (erlang-skel-separator 2)
2120 "%% Func: code_change/3" n
2121 "%% Purpose: Convert process state when code is changed" n
2122 "%% Returns: {ok, NewState}" n
2123 (erlang-skel-separator 2)
2124 "code_change(OldVsn, State, _E, _Extra) ->" n>
2125 "{ok, State}." n
2126 n
2127
2128 n
2129 (erlang-skel-separator 2)
2130 "%%% Internal functions" n
2131 (erlang-skel-separator 2)
2132 )
2133 "*The template of a generic leader.
2134Please see the function `tempo-define-template'.")
2135
2136
2137(defvar erlang-skel-corba-callback
2138 '((erlang-skel-include erlang-skel-large-header)
2139 (erlang-skel-separator 2)
2140 "%% Include files" n
2141 (erlang-skel-separator 2)
2142 n
2143 (erlang-skel-separator 2)
2144 "%% External exports" n
2145 (erlang-skel-separator 2)
2146 "-export([" n> "init/1, " n> "terminate/2," n> "code_change/3" n
2147 " ])." n
2148 n
2149 (erlang-skel-separator 2)
2150 "%% Internal exports" n
2151 (erlang-skel-separator 2)
2152 "-export([" n
2153 " ])." n
2154 n
2155 (erlang-skel-separator 2)
2156 "%% Macros" n
2157 (erlang-skel-separator 2)
2158 n
2159 (erlang-skel-separator 2)
2160 "%% Records" n
2161 (erlang-skel-separator 2)
2162 "-record(state, {})." n
2163 n
2164 (erlang-skel-double-separator 2)
2165 "%% External functions" n
2166 (erlang-skel-double-separator 2)
2167 (erlang-skel-separator 2)
2168 "%% Function: init/1" n
2169 "%% Description: Initiates the server" n
2170 "%% Returns: {ok, State} |" n
2171 "%% {ok, State, Timeout} |" n
2172 "%% ignore |" n
2173 "%% {stop, Reason}" n
2174 (erlang-skel-separator 2)
2175 "init([]) ->" n>
2176 "{ok, #state{}}." n
2177 n
2178 (erlang-skel-separator 2)
2179 "%% Function: terminate/2" n
2180 "%% Description: Shutdown the server" n
2181 "%% Returns: any (ignored by gen_server)" n
2182 (erlang-skel-separator 2)
2183 "terminate(Reason, State) ->" n>
2184 "ok." n
2185 n
2186 (erlang-skel-separator 2)
2187 "%% Function: code_change/3" n
2188 "%% Description: Convert process state when code is changed" n
2189 "%% Returns: {ok, NewState}" n
2190 (erlang-skel-separator 2)
2191 "code_change(OldVsn, State, Extra) ->" n>
2192 "{ok, State}." n
2193 n
2194 (erlang-skel-double-separator 2)
2195 "%% Internal functions" n
2196 (erlang-skel-double-separator 2)
2197 )
2198 "*The template of a library module.
2199Please see the function `tempo-define-template'.")
2200
2201
2202
2203;; Font-lock variables
2204
2205(defvar erlang-font-lock-modern-p
2206 (cond ((>= erlang-emacs-major-version 20) t)
2207 (erlang-xemacs-p (>= erlang-emacs-minor-version 14))
2208 ((= erlang-emacs-major-version 19) (>= erlang-emacs-minor-version 29))
2209 (t nil))
2210 "Non-nil when this version of Emacs uses a modern version of Font Lock.
2211
2212This is determinated by checking the version of Emacs used, the actual
2213font-lock code is not loaded.")
2214
2215
2216;; The next few variables define different Erlang font-lock patterns.
2217;; They could be appended to form a custom font-lock appearence.
2218;;
2219;; The function `erlang-font-lock-set-face' could be used to change
2220;; the face of a pattern.
2221;;
2222;; Note that Erlang strings and atoms are hightlighted with using
2223;; syntactix analysis.
2224
2225(defvar erlang-font-lock-keywords-func
2226 (list
2227 (list (concat "^" erlang-atom-regexp "\\s *(")
2228 1 'font-lock-function-name-face t))
2229 "Font lock keyword highlighting a function header.")
2230
2231(defvar erlang-font-lock-keywords-dollar
2232 (list
2233 (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)"
2234 1 'font-lock-string-face))
2235 "Font lock keyword highlighting numbers in ascii-form (e.g. $A).")
2236
2237(defvar erlang-font-lock-keywords-arrow
2238 (list
2239 (list "\\(->\\|:-\\)\\(\\s \\|$\\)" 2 'font-lock-function-name-face))
2240 "Font lock keyword highlighting clause arrow.")
2241
2242(defvar erlang-font-lock-keywords-lc
2243 (list
2244 (list "\\(<-\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)
2245 (list "\\(||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face))
2246 "Font lock keyword highlighting list comprehension operators.")
2247
2248(defvar erlang-font-lock-keywords-keywords
2249 (list
2250 (list (concat "\\<\\(after\\|begin\\|c\\(atch\\|ase\\)\\|end\\|fun\\|if"
2251 "\\|of\\|receive\\|when\\|query\\)\\([^a-zA-Z0-9_]\\|$\\)")
2252 1 'font-lock-keyword-face))
2253 "Font lock keyword highlighting Erlang keywords.")
2254
2255(defvar erlang-font-lock-keywords-attr
2256 (list
2257 (list (concat "^\\(-" erlang-atom-regexp "\\)\\s *\\(\\.\\|(\\)")
2258 1 'font-lock-function-name-face))
2259 "Font lock keyword highlighting attribues.")
2260
2261(defvar erlang-font-lock-keywords-quotes
2262 (list
2263 (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'"
2264 1
2265 (if erlang-font-lock-modern-p
2266 'font-lock-reference-face
2267 'font-lock-keyword-face)
2268 t))
2269 "Font lock keyword highlighting words in single quotes in comments.
2270
2271This is not the keyword hightlighting Erlang strings and atoms, they
2272are highlighted by syntactic analysis.")
2273
2274;; Note: The guard `float' collides with the bif `float'.
2275(defvar erlang-font-lock-keywords-guards
2276 (list
2277 (list
2278
2279 ;; XXX:
2280; (concat "\\<"
2281; (regexp-opt '("atom" "binary" "constant" "float" "integer" "list"
2282; "number" "pid" "port" "reference" "record" "tuple")
2283; t)
2284; "\\>")
2285
2286 (concat "\\<\\(atom\\|binary\\|constant\\|float\\|integer\\|list\\|"
2287 "number\\|p\\(id\\|ort\\)\\|re\\(ference\\|cord\\)\\|tuple"
2288 "\\)\\s *(")
2289
2290 1
2291 (if erlang-font-lock-modern-p
2292 'font-lock-reference-face
2293 'font-lock-keyword-face)))
2294 "Font lock keyword highlighting guards.")
2295
2296(defvar erlang-font-lock-keywords-bifs
2297 (list
2298 (list
2299 (concat
2300 "\\<\\("
2301 "a\\(bs\\|live\\|pply\\|tom_to_list\\)\\|"
2302 "binary_to_\\(list\\|term\\)\\|"
2303 "concat_binary\\|d\\(ate\\|isconnect_node\\)\\|"
2304 "e\\(lement\\|rase\\|xit\\)\\|"
2305 "float\\(\\|_to_list\\)\\|"
2306 "g\\(arbage_collect\\|et\\(\\|_keys\\)\\|roup_leader\\)\\|"
2307 "h\\(alt\\|d\\)\\|"
2308 "i\\(nte\\(ger_to_list\\|rnal_bif\\)\\|s_alive\\)\\|"
2309 "l\\(ength\\|i\\(nk\\|st_to_\\(atom\\|binary\\|float\\|integer"
2310 "\\|pid\\|tuple\\)\\)\\)\\|"
2311 "make_ref\\|no\\(de\\(\\|_\\(link\\|unlink\\)\\|s\\)\\|talive\\)\\|"
2312 "open_port\\|"
2313 "p\\(id_to_list\\|rocess\\(_\\(flag\\|info\\)\\|es\\)\\|ut\\)\\|"
2314 "r\\(egister\\(\\|ed\\)\\|ound\\)\\|"
2315 "s\\(e\\(lf\\|telement\\)\\|ize\\|"
2316 "p\\(awn\\(\\|_link\\)\\|lit_binary\\)\\|tatistics\\)\\|"
2317 "t\\(erm_to_binary\\|hrow\\|ime\\|l\\|"
2318 "r\\(ace\\|unc\\)\\|uple_to_list\\)\\|"
2319 "un\\(link\\|register\\)\\|whereis"
2320 "\\)\\s *(")
2321 1
2322 'font-lock-keyword-face))
2323 "Font lock keyword highlighting built in functions.")
2324
2325(defvar erlang-font-lock-keywords-macros
2326 (list
2327 (list (concat "?\\s *\\(" erlang-atom-regexp
2328 "\\|" erlang-variable-regexp "\\)\\>")
2329 1 (if erlang-font-lock-modern-p
2330 'font-lock-reference-face
2331 'font-lock-type-face))
2332 (list (concat "^-\\(define\\|ifn?def\\)\\s *(\\s *\\(" erlang-atom-regexp
2333 "\\|" erlang-variable-regexp "\\)\\>")
2334 2 (if erlang-font-lock-modern-p
2335 'font-lock-reference-face
2336 'font-lock-type-face)))
2337 "Font lock keyword highlighting macros.
2338This must be placed in front of `erlang-font-lock-keywords-vars'.")
2339
2340(defvar erlang-font-lock-keywords-records
2341 (list
2342 (list (concat "#\\s *" erlang-atom-regexp "\\>")
2343 1 'font-lock-type-face)
2344 ;; Don't highlight numerical constants.
2345 (list "\\<[0-9][0-9]?#\\([0-9a-fA_F]+\\)\\>"
2346 1 nil t)
2347 (list (concat "^-record(\\s *" erlang-atom-regexp "\\>")
2348 1 'font-lock-type-face))
2349 "Font lock keyword highlighting Erlang records.
2350This must be placed in front of `erlang-font-lock-keywords-vars'.")
2351
2352(defvar erlang-font-lock-keywords-vars
2353 (list
2354 (list (concat "\\<" erlang-variable-regexp "\\>")
2355 1 (if erlang-font-lock-modern-p
2356 'font-lock-variable-name-face
2357 'font-lock-type-face)))
2358 "Font lock keyword highlighting Erlang variables.
2359Must be preceded by `erlang-font-lock-keywords-macros' and `-records'
2360to work properly.")
2361
2362
2363(defvar erlang-font-lock-keywords-1
2364 (append erlang-font-lock-keywords-func
2365 erlang-font-lock-keywords-dollar
2366 erlang-font-lock-keywords-arrow
2367 erlang-font-lock-keywords-keywords)
2368 ;; DocStringOrig: erlang-font-lock-keywords
2369 "Font-lock keywords used by Erlang Mode.
2370
2371There exists three levels of Font Lock keywords for Erlang:
2372 `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
2373 `erlang-font-lock-keywords-2' - Bifs, guards and `singel quotes'.
2374 `erlang-font-lock-keywords-3' - Variables, macros and records.
2375
2376To use a specific level, please set the variable
2377`font-lock-maximum-decoration' to the appropriate level. Note that the
2378variable must be set before Erlang mode is activated.
2379
2380Example:
2381 (setq font-lock-maximum-decoration 2)")
2382
2383
2384(defvar erlang-font-lock-keywords-2
2385 (append erlang-font-lock-keywords-1
2386 erlang-font-lock-keywords-attr
2387 erlang-font-lock-keywords-quotes
2388 erlang-font-lock-keywords-guards
2389 erlang-font-lock-keywords-bifs)
2390 ;; DocStringCopy: erlang-font-lock-keywords
2391 "Font-lock keywords used by Erlang Mode.
2392
2393There exists three levels of Font Lock keywords for Erlang:
2394 `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
2395 `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'.
2396 `erlang-font-lock-keywords-3' - Variables, macros and records.
2397
2398To use a specific level, please set the variable
2399`font-lock-maximum-decoration' to the appropriate level. Note that the
2400variable must be set before Erlang mode is activated.
2401
2402Example:
2403 (setq font-lock-maximum-decoration 2)")
2404
2405
2406(defvar erlang-font-lock-keywords-3
2407 (append erlang-font-lock-keywords-2
2408 erlang-font-lock-keywords-macros
2409 erlang-font-lock-keywords-records
2410 erlang-font-lock-keywords-vars)
2411 ;; DocStringCopy: erlang-font-lock-keywords
2412 "Font-lock keywords used by Erlang Mode.
2413
2414There exists three levels of Font Lock keywords for Erlang:
2415 `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
2416 `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'.
2417 `erlang-font-lock-keywords-3' - Variables, macros and records.
2418
2419To use a specific level, please set the variable
2420`font-lock-maximum-decoration' to the appropriate level. Note that the
2421variable must be set before Erlang mode is activated.
2422
2423Example:
2424 (setq font-lock-maximum-decoration 2)")
2425
2426
2427(defvar erlang-font-lock-keywords erlang-font-lock-keywords-3
2428 ;; DocStringCopy: erlang-font-lock-keywords
2429 "Font-lock keywords used by Erlang Mode.
2430
2431There exists three levels of Font Lock keywords for Erlang:
2432 `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
2433 `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'.
2434 `erlang-font-lock-keywords-3' - Variables, macros and records.
2435
2436To use a specific level, please set the variable
2437`font-lock-maximum-decoration' to the appropriate level. Note that the
2438variable must be set before Erlang mode is activated.
2439
2440Example:
2441 (setq font-lock-maximum-decoration 2)")
2442
2443
2444(defvar erlang-font-lock-syntax-table nil
2445 "Syntax table used by Font Lock mode.
2446
2447The difference between this and the standard Erlang Mode
2448syntax table is that `_' is treated as part of words by
2449this syntax table.
2450
2451Unfortuantely, XEmacs hasn't got support for a special Font
2452Lock syntax table. The effect is that `apply' in the atom
2453`foo_apply' will be highlighted as a bif.")
2454
2455
2456;;; Avoid errors while compiling this file.
2457
2458;; `eval-when-compile' is not defined in Emacs 18. We define it as a
2459;; no-op.
2460(or (fboundp 'eval-when-compile)
2461 (defmacro eval-when-compile (&rest rest) nil))
2462
2463;; These umm...functions are new in Emacs 20. And, yes, until version
2464;; 19.27 Emacs backquotes were this ugly.
2465
2466(or (fboundp 'unless)
2467 (defmacro unless (condition &rest body)
2468 "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil."
2469 (` (if (, condition)
2470 nil
2471 (,@ body)))))
2472
2473(or (fboundp 'when)
2474 (defmacro when (condition &rest body)
2475 "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil."
2476 (` (if (, condition)
2477 (progn (,@ body))
2478 nil))))
2479
2480(or (fboundp 'char-before)
2481 (defmacro char-before (&optional pos)
2482 "Return the character in the current buffer just before POS."
2483 (` (char-after (1- (or (, pos) (point)))))))
2484
2485(or (fboundp 'regexp-opt)
2486 (defun regexp-opt (strings &optional paren)
2487 "Return a regular expression that matches any string in
2488STRINGS. If PAREN is true, it will always enclose the regular
2489expression in parentheses.
2490
2491Unlike its Emacs-20 namesake, it will not optimize the generated
2492expression."
2493 ;; This stop-gap definition is taken from
2494 ;; _GNU_Emacs_Lisp_Reference_Manual_, ed 2.5, for Emacs 20.3.
2495 (let ((open (if paren "\\(" ""))
2496 (close (if paren "\\)" "")))
2497 (concat open
2498 (mapconcat 'regexp-quote strings "\\|")
2499 close))))
2500
2501(eval-when-compile
2502 (if (or (featurep 'bytecomp)
2503 (featurep 'byte-compile))
2504 (progn
2505 (cond ((string-match "Lucid\\|XEmacs" emacs-version)
2506 (put 'comment-indent-hook 'byte-obsolete-variable nil)
2507 ;; Do not warn for unused variables
2508 ;; when compiling under XEmacs.
2509 (setq byte-compile-warnings
2510 '(free-vars unresolved callargs redefine))))
2511 (require 'comint)
2512 (require 'compile))))
2513
2514
2515(defun erlang-version ()
2516 "Return the current version of Erlang mode."
2517 (interactive)
2518 (if (interactive-p)
2519 (message "Erlang mode version %s, written by Anders Lindgren"
2520 erlang-version))
2521 erlang-version)
2522
2523
2524;;;###autoload
2525(defun erlang-mode ()
2526 "Major mode for editing Erlang source files in Emacs.
2527It knows about syntax and comment, it can indent code, it is capable
2528of fontifying the source file, the TAGS commands are aware of Erlang
2529modules, and the Erlang man pages can be accessed.
2530
2531Should this module, \"erlang.el\", be installed properly, Erlang mode
2532is activated whenever an Erlang source or header file is loaded into
2533Emacs. To indicate this, the mode line should contain the word
2534\"Erlang\".
2535
2536The main feature of Erlang mode is indentation, press TAB and the
2537current line will be indented correctly.
2538
2539Comments starting with only one `%' are indented to the column stored
2540in the variable `comment-column'. Comments starting with two `%':s
2541are indented with the same indentation as code. Comments starting
2542with at least three `%':s are indented to the first column.
2543
2544However, Erlang mode contains much more, this is a list of the most
2545useful commands:
2546 TAB - Indent the line.
2547 C-c C-q - Indent current function.
2548 M-; - Create a comment at the end of the line.
2549 M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
2550 will look better.
2551 M-a - Goto the beginning of an Erlang clause.
2552 M-C-a - Ditto for function.
2553 M-e - Goto the end of an Erlang clause.
2554 M-C-e - Ditto for function.
2555 M-h - Mark current Erlang clause.
2556 M-C-h - Ditto for function.
2557 C-c C-z - Start, or switch to, an inferior Erlang shell.
2558 C-c C-k - Compile current file.
2559 C-x ` - Next error.
2560 , - Electric comma.
2561 ; - Electric semicolon.
2562
2563Erlang mode check the name of the file against the module name when
2564saving, whenever a mismatch occurs Erlang mode offers to modify the
2565source.
2566
2567The variable `erlang-electric-commands' controls the electric
2568commands. To deactivate all of them, set it to nil.
2569
2570There exists a large number of commands and variables in the Erlang
2571module. Please press `M-x apropos RET erlang RET' to see a complete
2572list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
2573RET'to see the full description of functions and variables,
2574respectively.
2575
2576On entry to this mode the contents of the hook `erlang-mode-hook' is
2577executed.
2578
2579Please see the beginning of the file `erlang.el' for more information
2580and examples of hooks.
2581
2582Other commands:
2583\\{erlang-mode-map}"
2584 (interactive)
2585 (kill-all-local-variables)
2586 (setq major-mode 'erlang-mode)
2587 (setq mode-name "Erlang")
2588 (erlang-syntax-table-init)
2589 (erlang-keymap-init)
2590 (erlang-electric-init)
2591 (erlang-menu-init)
2592 (erlang-mode-variables)
2593 (erlang-check-module-name-init)
2594 (erlang-add-compilation-alist erlang-error-regexp-alist)
2595 (erlang-man-init)
2596 (erlang-tags-init)
2597 (erlang-font-lock-init)
2598 (erlang-skel-init)
2599 (run-hooks 'erlang-mode-hook)
2600 (if (zerop (buffer-size))
2601 (run-hooks 'erlang-new-file-hook)))
2602
2603
2604(defun erlang-syntax-table-init ()
2605 (if (null erlang-mode-syntax-table)
2606 (let ((table (make-syntax-table)))
2607 (modify-syntax-entry ?\n ">" table)
2608 (modify-syntax-entry ?\" "\"" table)
2609 (modify-syntax-entry ?# "." table)
2610 (modify-syntax-entry ?$ "/" table)
2611 (modify-syntax-entry ?% "<" table)
2612 (modify-syntax-entry ?& "." table)
2613 (modify-syntax-entry ?\' "\"" table)
2614 (modify-syntax-entry ?* "." table)
2615 (modify-syntax-entry ?+ "." table)
2616 (modify-syntax-entry ?- "." table)
2617 (modify-syntax-entry ?/ "." table)
2618 (modify-syntax-entry ?: "." table)
2619 (modify-syntax-entry ?< "." table)
2620 (modify-syntax-entry ?= "." table)
2621 (modify-syntax-entry ?> "." table)
2622 (modify-syntax-entry ?\\ "\\" table)
2623 (modify-syntax-entry ?_ "_" table)
2624 (modify-syntax-entry ?| "." table)
2625 (modify-syntax-entry ?^ "/" table)
2626
2627 ;; Pseudo bit-syntax: Latin1 double angle quotes as parens.
2628 ;;(modify-syntax-entry ?\253 "(?\273" table)
2629 ;;(modify-syntax-entry ?\273 ")?\253" table)
2630
2631 (setq erlang-mode-syntax-table table)))
2632
2633 (set-syntax-table erlang-mode-syntax-table))
2634
2635
2636(defun erlang-keymap-init ()
2637 (if erlang-mode-map
2638 nil
2639 (setq erlang-mode-map (make-sparse-keymap))
2640 (erlang-mode-commands erlang-mode-map))
2641 (use-local-map erlang-mode-map))
2642
2643
2644(defun erlang-mode-commands (map)
2645 (define-key map "\t" 'erlang-indent-command)
2646 (define-key map ";" 'erlang-electric-semicolon)
2647 (define-key map "," 'erlang-electric-comma)
2648 (define-key map "<" 'erlang-electric-lt)
2649 (define-key map ">" 'erlang-electric-gt)
2650 (define-key map "\C-m" 'erlang-electric-newline)
2651 (define-key map "\177" 'backward-delete-char-untabify)
2652 (define-key map "\M-q" 'erlang-fill-paragraph)
2653 (define-key map "\M-\C-a" 'erlang-beginning-of-function)
2654 (define-key map "\M-\C-e" 'erlang-end-of-function)
2655 (define-key map "\M-\C-h" 'erlang-mark-function)
2656 (define-key map "\M-\t" 'erlang-complete-tag)
2657 (define-key map "\C-c\M-\t" 'tempo-complete-tag)
2658 (define-key map "\C-c\M-a" 'erlang-beginning-of-clause)
2659 (define-key map "\C-c\M-b" 'tempo-backward-mark)
2660 (define-key map "\C-c\M-e" 'erlang-end-of-clause)
2661 (define-key map "\C-c\M-f" 'tempo-forward-mark)
2662 (define-key map "\C-c\M-h" 'erlang-mark-clause)
2663 (define-key map "\C-c\C-c" 'comment-region)
2664 (define-key map "\C-c\C-j" 'erlang-generate-new-clause)
2665 (define-key map "\C-c\C-k" 'erlang-compile)
2666 (define-key map "\C-c\C-l" 'erlang-compile-display)
2667 (define-key map "\C-c\C-s" 'erlang-show-syntactic-information)
2668 (define-key map "\C-c\C-q" 'erlang-indent-function)
2669 (define-key map "\C-c\C-u" 'erlang-uncomment-region)
2670 (define-key map "\C-c\C-y" 'erlang-clone-arguments)
2671 (define-key map "\C-c\C-z" 'erlang-shell-display)
2672 (define-key map "\C-x`" 'erlang-next-error))
2673
2674
2675(defun erlang-electric-init ()
2676 ;; Set up electric character functions to work with
2677 ;; delsel/pending-del mode. Also, set up text properties for bit
2678 ;; syntax handling.
2679 (mapcar #'(lambda (cmd)
2680 (put cmd 'delete-selection t) ;for delsel (Emacs)
2681 (put cmd 'pending-delete t)) ;for pending-del (XEmacs)
2682 '(erlang-electric-semicolon
2683 erlang-electric-comma
2684 erlang-electric-gt))
2685
2686 (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>))
2687 (put 'bitsyntax-open-outer 'rear-nonsticky '(category))
2688 (put 'bitsyntax-open-inner 'rear-nonsticky '(category))
2689 (put 'bitsyntax-close-inner 'rear-nonsticky '(category))
2690 (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<))
2691 (put 'bitsyntax-close-outer 'rear-nonsticky '(category))
2692 (setq parse-sexp-lookup-properties 't))
2693
2694
2695
2696(defun erlang-mode-variables ()
2697 (or erlang-mode-abbrev-table
2698 (define-abbrev-table 'erlang-mode-abbrev-table ()))
2699 (setq local-abbrev-table erlang-mode-abbrev-table)
2700 (make-local-variable 'paragraph-start)
2701 (setq paragraph-start (concat "^$\\|" page-delimiter))
2702 (make-local-variable 'paragraph-separate)
2703 (setq paragraph-separate paragraph-start)
2704 (make-local-variable 'paragraph-ignore-fill-prefix)
2705 (setq paragraph-ignore-fill-prefix t)
2706 (make-local-variable 'require-final-newline)
2707 (setq require-final-newline t)
2708 (make-local-variable 'defun-prompt-regexp)
2709 (setq defun-prompt-regexp erlang-defun-prompt-regexp)
2710 (make-local-variable 'comment-start)
2711 (setq comment-start "%")
2712 (make-local-variable 'comment-start-skip)
2713 (setq comment-start-skip "%+\\s *")
2714 (make-local-variable 'comment-column)
2715 (setq comment-column 48)
2716 (make-local-variable 'indent-line-function)
2717 (setq indent-line-function 'erlang-indent-command)
2718 (make-local-variable 'indent-region-function)
2719 (setq indent-region-function 'erlang-indent-region)
2720 (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent)
2721 (if (<= erlang-emacs-major-version 18)
2722 (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent))
2723 (set (make-local-variable 'parse-sexp-ignore-comments) t)
2724 (set (make-local-variable 'dabbrev-case-fold-search) nil)
2725 (set (make-local-variable 'imenu-prev-index-position-function)
2726 'erlang-beginning-of-function)
2727 (set (make-local-variable 'imenu-extract-index-name-function)
2728 'erlang-get-function-name)
2729 (set (make-local-variable 'tempo-match-finder)
2730 "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\="))
2731
2732
2733;; Compilation.
2734;;
2735;; The following code is compatible with the standard package `compilation',
2736;; making it possible to go to errors using `erlang-next-error'.
2737;;
2738;; The normal `compile' command works ofcourse. For best result, please
2739;; execute `make' with the `-w' flag.
2740;;
2741;; Please see the variables named `compiling-..' above.
2742
2743(defun erlang-add-compilation-alist (alist)
2744 (require 'compile)
2745 (cond ((boundp 'compilation-error-regexp-alist) ; Emacs 19
2746 (while alist
2747 (or (assoc (car (car alist)) compilation-error-regexp-alist)
2748 (setq compilation-error-regexp-alist
2749 (cons (car alist) compilation-error-regexp-alist)))
2750 (setq alist (cdr alist))))
2751 ((boundp 'compilation-error-regexp)
2752 ;; Emacs 18, Only one regexp is allowed.
2753 (funcall (symbol-function 'set)
2754 'compilation-error-regexp (car (car alist))))))
2755
2756(defun erlang-font-lock-init ()
2757 "Initialize Font Lock for Erlang mode."
2758 (or erlang-font-lock-syntax-table
2759 (setq erlang-font-lock-syntax-table
2760 (let ((table (copy-syntax-table erlang-mode-syntax-table)))
2761 (modify-syntax-entry ?_ "w" table)
2762 table)))
2763 (set (make-local-variable 'font-lock-syntax-table)
2764 erlang-font-lock-syntax-table)
2765 (set (make-local-variable 'font-lock-beginning-of-syntax-function)
2766 'erlang-beginning-of-clause)
2767 (make-local-variable 'font-lock-keywords)
2768 (let ((level (cond ((boundp 'font-lock-maximum-decoration)
2769 (symbol-value 'font-lock-maximum-decoration))
2770 ((boundp 'font-lock-use-maximal-decoration)
2771 (symbol-value 'font-lock-use-maximal-decoration))
2772 (t nil))))
2773 (if (consp level)
2774 (setq level (cdr-safe (or (assq 'erlang-mode level)
2775 (assq t level)))))
2776 ;; `level' can here be:
2777 ;; A number - The fontification level
2778 ;; nil - Use the default
2779 ;; t - Use maximum
2780 (cond ((eq level nil)
2781 (set 'font-lock-keywords erlang-font-lock-keywords))
2782 ((eq level 1)
2783 (set 'font-lock-keywords erlang-font-lock-keywords-1))
2784 ((eq level 2)
2785 (set 'font-lock-keywords erlang-font-lock-keywords-2))
2786 (t
2787 (set 'font-lock-keywords erlang-font-lock-keywords-3))))
2788
2789 ;; Modern font-locks can handle the above much more elegant:
2790 (set (make-local-variable 'font-lock-defaults)
2791 '((erlang-font-lock-keywords erlang-font-lock-keywords-1
2792 erlang-font-lock-keywords-2 erlang-font-lock-keywords-3)
2793 nil nil ((?_ . "w")) erlang-beginning-of-clause
2794 (font-lock-comment-start-regexp . "%")
2795 (font-lock-mark-block-function . erlang-mark-clause))))
2796
2797
2798
2799;; Useful when definig yout own keywords.
2800(defun erlang-font-lock-set-face (ks &rest faces)
2801 "Replace the face components in a list of keywords.
2802
2803The first argument, KS, is a list of keywords. The rest of the
2804arguments are expressions to replace the face information with. The
2805first expression replaces the face of the first keyword, the second
2806expression the second keyword etc.
2807
2808Should an expression be nil, the face of the corresponding keyword is
2809not changed.
2810
2811Should fewer expressions than keywords be given, the last expression
2812is used for all remaining keywords.
2813
2814Normally, the expressions are just atoms representing the new face.
2815They could however be more complex, returning different faces in
2816different situations.
2817
2818This function does only handle keywords with elements on the forms:
2819 (REGEXP NUMBER FACE)
2820 (REGEXP NUMBER FACE OVERWRITE)
2821
2822This could be used when defining your own special font-lock setup, e.g:
2823
2824\(setq my-font-lock-keywords
2825 (append erlang-font-lock-keywords-func
2826 erlang-font-lock-keywords-dollar
2827 (erlang-font-lock-set-face
2828 erlang-font-lock-keywords-macros 'my-neon-green-face)
2829 (erlang-font-lock-set-face
2830 erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red)
2831 erlang-font-lock-keywords-attr))
2832
2833For a more elaborate example, please see the beginning of the file
2834`erlang.el'."
2835 (let ((res '()))
2836 (while ks
2837 (let* ((regexp (car (car ks)))
2838 (number (car (cdr (car ks))))
2839 (new-face (if (and faces (car faces))
2840 (car faces)
2841 (car (cdr (cdr (car ks))))))
2842 (overwrite (car (cdr (cdr (cdr (car ks))))))
2843 (new-keyword (list regexp number new-face)))
2844 (if overwrite (nconc new-keyword (list overwrite)))
2845 (setq res (cons new-keyword res))
2846 (setq ks (cdr ks))
2847 (if (and faces (cdr faces))
2848 (setq faces (cdr faces)))))
2849 (nreverse res)))
2850
2851
2852(defun erlang-font-lock-level-0 ()
2853 ;; DocStringOrig: font-cmd
2854 "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree).
2855
2856The following fontification level exists:
2857 0 - No fontification
2858 1 - Function headers, reserved keywords, strings and comments.
2859 2 - Bifs, guards and `single quotes'.
2860 3 - Variables, macros and records.
2861
2862To automatically activate font lock mode, place the following lines
2863in your ~/.emacs file:
2864
2865\(defun my-erlang-mode-hook ()
2866 (cond (window-system
2867 (font-lock-mode 1))))
2868\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
2869\(setq font-lock-maximum-decoration t)"
2870 (interactive)
2871 (font-lock-mode 0))
2872
2873
2874(defun erlang-font-lock-level-1 ()
2875 ;; DocStringCopy: font-cmd
2876 "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree).
2877
2878The following fontification level exists:
2879 0 - No fontification
2880 1 - Function headers, reserved keywords, strings and comments.
2881 2 - Bifs, guards and `single quotes'.
2882 3 - Variables, macros and records.
2883
2884To automatically activate font lock mode, place the following lines
2885in your ~/.emacs file:
2886
2887\(defun my-erlang-mode-hook ()
2888 (cond (window-system
2889 (font-lock-mode 1))))
2890\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
2891\(setq font-lock-maximum-decoration t)"
2892 (interactive)
2893 (require 'font-lock)
2894 (set 'font-lock-keywords erlang-font-lock-keywords-1)
2895 (font-lock-mode 1)
2896 (funcall (symbol-function 'font-lock-fontify-buffer)))
2897
2898
2899(defun erlang-font-lock-level-2 ()
2900 ;; DocStringCopy: font-cmd
2901 "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree).
2902
2903The following fontification level exists:
2904 0 - No fontification
2905 1 - Function headers, reserved keywords, strings and comments.
2906 2 - Bifs, guards and `single quotes'.
2907 3 - Variables, macros and records.
2908
2909To automatically activate font lock mode, place the following lines
2910in your ~/.emacs file:
2911
2912\(defun my-erlang-mode-hook ()
2913 (cond (window-system
2914 (font-lock-mode 1))))
2915\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
2916\(setq font-lock-maximum-decoration t)"
2917 (interactive)
2918 (require 'font-lock)
2919 (set 'font-lock-keywords erlang-font-lock-keywords-2)
2920 (font-lock-mode 1)
2921 (funcall (symbol-function 'font-lock-fontify-buffer)))
2922
2923
2924(defun erlang-font-lock-level-3 ()
2925 ;; DocStringCopy: font-cmd
2926 "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree).
2927
2928The following fontification level exists:
2929 0 - No fontification
2930 1 - Function headers, reserved keywords, strings and comments.
2931 2 - Bifs, guards and `single quotes'.
2932 3 - Variables, macros and records.
2933
2934To automatically activate font lock mode, place the following lines
2935in your ~/.emacs file:
2936
2937\(defun my-erlang-mode-hook ()
2938 (cond (window-system
2939 (font-lock-mode 1))))
2940\(add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
2941\(setq font-lock-maximum-decoration t)"
2942 (interactive)
2943 (require 'font-lock)
2944 (set 'font-lock-keywords erlang-font-lock-keywords-3)
2945 (font-lock-mode 1)
2946 (funcall (symbol-function 'font-lock-fontify-buffer)))
2947
2948
2949(defun erlang-menu-init ()
2950 "Init menus for Erlang mode.
2951
2952The variable `erlang-menu-items' contain a description of the Erlang
2953mode menu. Normally, the list contains atoms, representing variables
2954bound to pieces of the menu.
2955
2956Personal extentions could be added to `erlang-menu-personal-items'.
2957
2958Should any variable describing the menu configuration, this function
2959should be called."
2960 (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t))
2961
2962
2963(defun erlang-menu-install (name items keymap &optional popup)
2964 "Install a menu on Emacs 19 or XEmacs based on an abstract description.
2965
2966NAME is the name of the menu.
2967
2968ITEMS is a list. The elements are either nil representing a horisontal
2969line or a list with two or three elements. The first is the name of
2970the menu item, the second the function to call, or a submenu, on the
2971same same form as ITEMS. The third optional element is an expression
2972which is evaluated every time the menu is displayed. Should the
2973expression evaluate to nil the menu item is ghosted.
2974
2975KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu
2976will only be visible when this meny is the global, the local, or an
2977activated minor mode keymap.)
2978
2979If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu'
2980variable, i.e. it will popup when pressing the right mouse button.
2981
2982Please see the variable `erlang-menu-base-items'."
2983 (cond (erlang-xemacs-p
2984 (let ((menu (erlang-menu-xemacs name items keymap)))
2985 ;; We add the menu to the global menubar.
2986 ;;(funcall (symbol-function 'set-buffer-menubar)
2987 ;; (symbol-value 'current-menubar))
2988 (funcall (symbol-function 'add-submenu) nil menu)
2989 (setcdr erlang-xemacs-popup-menu (cdr menu))
2990 (if (and popup (boundp 'mode-popup-menu))
2991 (funcall (symbol-function 'set)
2992 'mode-popup-menu erlang-xemacs-popup-menu))))
2993 ((>= erlang-emacs-major-version 19)
2994 (define-key keymap (vector 'menu-bar (intern name))
2995 (erlang-menu-make-keymap name items)))
2996 (t nil)))
2997
2998
2999(defun erlang-menu-make-keymap (name items)
3000 "Build a menu for Emacs 19."
3001 (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
3002 name))
3003 (count 0)
3004 id def first second third)
3005 (setq items (reverse items))
3006 (while items
3007 ;; Replace any occurence of atoms by their value.
3008 (while (and items (atom (car items)) (not (null (car items))))
3009 (if (and (boundp (car items))
3010 (listp (symbol-value (car items))))
3011 (setq items (append (reverse (symbol-value (car items)))
3012 (cdr items)))
3013 (setq items (cdr items))))
3014 (setq first (car-safe (car items)))
3015 (setq second (car-safe (cdr-safe (car items))))
3016 (setq third (car-safe (cdr-safe (cdr-safe (car items)))))
3017 (cond ((null first)
3018 (setq count (+ count 1))
3019 (setq id (intern (format "separator-%d" count)))
3020 (setq def '("--" . nil)))
3021 ((and (consp second) (eq (car second) 'lambda))
3022 (setq count (+ count 1))
3023 (setq id (intern (format "lambda-%d" count)))
3024 (setq def (cons first second)))
3025 ((symbolp second)
3026 (setq id second)
3027 (setq def (cons first second)))
3028 (t
3029 (setq count (+ count 1))
3030 (setq id (intern (format "submenu-%d" count)))
3031 (setq def (erlang-menu-make-keymap first second))))
3032 (define-key menumap (vector id) def)
3033 (if third
3034 (put id 'menu-enable third))
3035 (setq items (cdr items)))
3036 (cons name menumap)))
3037
3038
3039(defun erlang-menu-xemacs (name items &optional keymap)
3040 "Build a menu for XEmacs."
3041 (let ((res '())
3042 first second third entry)
3043 (while items
3044 ;; Replace any occurence of atoms by their value.
3045 (while (and items (atom (car items)) (not (null (car items))))
3046 (if (and (boundp (car items))
3047 (listp (symbol-value (car items))))
3048 (setq items (append (reverse (symbol-value (car items)))
3049 (cdr items)))
3050 (setq items (cdr items))))
3051 (setq first (car-safe (car items)))
3052 (setq second (car-safe (cdr-safe (car items))))
3053 (setq third (car-safe (cdr-safe (cdr-safe (car items)))))
3054 (cond ((null first)
3055 (setq res (cons "------" res)))
3056 ((symbolp second)
3057 (setq res (cons (vector first second (or third t)) res)))
3058 ((and (consp second) (eq (car second) 'lambda))
3059 (setq res (cons (vector first (list 'call-interactively second)
3060 (or third t)) res)))
3061 (t
3062 (setq res (cons (cons first
3063 (cdr (erlang-menu-xemacs
3064 first second)))
3065 res))))
3066 (setq items (cdr items)))
3067 (setq res (reverse res))
3068 ;; When adding a menu to a minor-mode keymap under Emacs 19,
3069 ;; it disappears when the mode is disabled. The expression
3070 ;; generated below imitates this behaviour.
3071 ;; (This could be expressed much clearer using backquotes,
3072 ;; but I don't want to pull in every package.)
3073 (if keymap
3074 (let ((expr (list 'or
3075 (list 'eq keymap 'global-map)
3076 (list 'eq keymap (list 'current-local-map))
3077 (list 'symbol-value
3078 (list 'car-safe
3079 (list 'rassq
3080 keymap
3081 'minor-mode-map-alist))))))
3082 (setq res (cons ':included (cons expr res)))))
3083 (cons name res)))
3084
3085
3086(defun erlang-menu-substitute (items alist)
3087 "Substitute functions in menu described by ITEMS.
3088
3089The menu ITEMS is updated destructively.
3090
3091ALIST is list of pairs where the car is the old function and cdr the new."
3092 (let (first second pair)
3093 (while items
3094 (setq first (car-safe (car items)))
3095 (setq second (car-safe (cdr-safe (car items))))
3096 (cond ((null first))
3097 ((symbolp second)
3098 (setq pair (and second (assq second alist)))
3099 (if pair
3100 (setcar (cdr (car items)) (cdr pair))))
3101 ((and (consp second) (eq (car second) 'lambda)))
3102 (t
3103 (erlang-menu-substitute second alist)))
3104 (setq items (cdr items)))))
3105
3106
3107(defun erlang-menu-add-above (entry above items)
3108 "Add menu ENTRY above menu entry ABOVE in menu ITEMS.
3109Do nothing if the items already should be in the menu.
3110Should ABOVE not be in the list, the entry is added at
3111the bottom of the menu.
3112
3113The new menu is returned. No guarantee is given that the original
3114menu is left unchanged.
3115
3116The equality test is performed by `eq'.
3117
3118Example: (erlang-menu-add-above 'my-erlang-menu-items
3119 'erlang-menu-man-items)"
3120 (erlang-menu-add-below entry above items t))
3121
3122
3123(defun erlang-menu-add-below (entry below items &optional above-p)
3124 "Add menu ENTRY below menu items BELOW in the Erlang menu.
3125Do nothing if the items already should be in the menu.
3126Should BELOW not be in the list, items is added at the bottom
3127of the menu.
3128
3129The new menu is returned. No guarantee is given that the original
3130menu is left unchanged.
3131
3132The equality test is performed by `eq'.
3133
3134Example:
3135
3136\(setq erlang-menu-items
3137 (erlang-menu-add-below 'my-erlang-menu-items
3138 'erlang-menu-base-items
3139 erlang-menu-items))"
3140 (if (memq entry items)
3141 items ; Return the original menu.
3142 (let ((head '())
3143 (done nil)
3144 res)
3145 (while (not done)
3146 (cond ((null items)
3147 (setq res (append head (list entry)))
3148 (setq done t))
3149 ((eq below (car items))
3150 (setq res
3151 (if above-p
3152 (append head (cons entry items))
3153 (append head (cons (car items)
3154 (cons entry (cdr items))))))
3155 (setq done t))
3156 (t
3157 (setq head (append head (list (car items))))
3158 (setq items (cdr items)))))
3159 res)))
3160
3161(defun erlang-menu-delete (entry items)
3162 "Delete ENTRY from menu ITEMS.
3163
3164The new menu is returned. No guarantee is given that the original
3165menu is left unchanged."
3166 (delq entry items))
3167
3168;; Man code:
3169
3170(defun erlang-man-init ()
3171 "Add menus containing the manual pages of the Erlang.
3172
3173The variable `erlang-man-dirs' contains entries describing
3174the location of the manual pages."
3175 (interactive)
3176 (if erlang-man-inhibit
3177 ()
3178 (setq erlang-menu-man-items
3179 '(nil
3180 ("Man - Function" erlang-man-function)))
3181 (if erlang-man-dirs
3182 (setq erlang-menu-man-items
3183 (append erlang-menu-man-items
3184 (erlang-man-make-top-menu erlang-man-dirs))))
3185 (setq erlang-menu-items
3186 (erlang-menu-add-above 'erlang-menu-man-items
3187 'erlang-menu-version-items
3188 erlang-menu-items))
3189 (erlang-menu-init)))
3190
3191
3192(defun erlang-man-uninstall ()
3193 "Remove the man pages from the Erlang mode."
3194 (interactive)
3195 (setq erlang-menu-items
3196 (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items))
3197 (erlang-menu-init))
3198
3199
3200;; The man menu is a hierarchal structure, with the manual sections
3201;; at the top, described by `erlang-man-dirs'. The next level could
3202;; either be the manual pages if not to many, otherwise it is an index
3203;; menu whose submenus will contain up to `erlang-man-max-menu-size'
3204;; manual pages.
3205
3206(defun erlang-man-make-top-menu (dir-list)
3207 "Create one menu entry per element of DIR-LIST.
3208The format is described in the documentation of `erlang-man-dirs'."
3209 (let ((menu '())
3210 dir)
3211 (while dir-list
3212 (setq dir (cond ((nth 2 (car dir-list))
3213 ;; Relative to `erlang-root-dir'.
3214 (and (stringp erlang-root-dir)
3215 (concat erlang-root-dir (nth 1 (car dir-list)))))
3216 (t
3217 ;; Absolute
3218 (nth 1 (car dir-list)))))
3219 (if (and dir
3220 (file-readable-p dir))
3221 (setq menu (cons (list (car (car dir-list))
3222 (erlang-man-make-middle-menu
3223 (erlang-man-get-files dir)))
3224 menu)))
3225 (setq dir-list (cdr dir-list)))
3226 ;; Should no menus be found, generate a menu item which
3227 ;; will display a help text, when selected.
3228 (if menu
3229 (nreverse menu)
3230 '(("Man Pages"
3231 (("Error! Why?" erlang-man-describe-error)))))))
3232
3233
3234;; Should the menu be to long, let's split it into a number of
3235;; smaller menus. Warning, this code contains beatiful
3236;; destructive operations!
3237(defun erlang-man-make-middle-menu (filelist)
3238 "Create the second level menu from FILELIST.
3239
3240Should the list be longer than `erlang-man-max-menu-size', a tree of
3241menus is created."
3242 (if (<= (length filelist) erlang-man-max-menu-size)
3243 (erlang-man-make-menu filelist)
3244 (let ((menu '())
3245 (filelist (copy-sequence filelist))
3246 segment submenu pair)
3247 (while filelist
3248 (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist))
3249 (setq segment filelist)
3250 (if (null pair)
3251 (setq filelist nil)
3252 (setq filelist (cdr pair))
3253 (setcdr pair nil))
3254 (setq submenu (erlang-man-make-menu segment))
3255 (setq menu (cons (list (concat (car (car submenu))
3256 " -- "
3257 (car (car (reverse submenu))))
3258 submenu)
3259 menu)))
3260 (nreverse menu))))
3261
3262
3263(defun erlang-man-make-menu (filelist)
3264 "Make a leaf menu based on FILELIST."
3265 (let ((menu '())
3266 item)
3267 (while filelist
3268 (setq item (erlang-man-make-menu-item (car filelist)))
3269 (if item
3270 (setq menu (cons item menu)))
3271 (setq filelist (cdr filelist)))
3272 (nreverse menu)))
3273
3274
3275(defun erlang-man-make-menu-item (file)
3276 "Create a menu item containing the name of the man page."
3277 (and (string-match ".*/\\([^/]+\\)\\.[^.]$" file)
3278 (let ((page (substring file (match-beginning 1) (match-end 1))))
3279 (list (capitalize page)
3280 (list 'lambda '()
3281 '(interactive)
3282 (list 'funcall 'erlang-man-display-function
3283 file))))))
3284
3285
3286(defun erlang-man-get-files (dir)
3287 "Return files in directory DIR."
3288 (directory-files dir t ".*\\.[0-9]\\'"))
3289
3290
3291(defun erlang-man-module (&optional module)
3292 "Find manual page for MODULE, defaults to module of function under point.
3293This function is aware of imported functions."
3294 (interactive
3295 (list (let* ((mod (car-safe (erlang-get-function-under-point)))
3296 (input (read-string
3297 (format "Manual entry for module%s: "
3298 (if (or (null mod) (string= mod ""))
3299 ""
3300 (format " (default %s)" mod))))))
3301 (if (string= input "")
3302 mod
3303 input))))
3304 (or module (setq module (car (erlang-get-function-under-point))))
3305 (if (or (null module) (string= module ""))
3306 (error "No Erlang module name given"))
3307 (let ((dir-list erlang-man-dirs)
3308 (pat (concat "\\b" (regexp-quote module) "\\.[^.]$"))
3309 (file nil)
3310 file-list)
3311 (while (and dir-list (null file))
3312 (setq file-list (erlang-man-get-files
3313 (if (nth 2 (car dir-list))
3314 (concat erlang-root-dir (nth 1 (car dir-list)))
3315 (nth 1 (car dir-list)))))
3316 (while (and file-list (null file))
3317 (if (string-match pat (car file-list))
3318 (setq file (car file-list)))
3319 (setq file-list (cdr file-list)))
3320 (setq dir-list (cdr dir-list)))
3321 (if file
3322 (funcall erlang-man-display-function file)
3323 (error "No manual page for module %s found." module))))
3324
3325
3326;; Warning, the function `erlang-man-function' is a hack!
3327;; It links itself into the man code in a non-clean way. I have
3328;; choosed to keep it since it provides a very useful functionality
3329;; which is not possible to achive using a clean approach.
3330;; / AndersL
3331
3332(defvar erlang-man-function-name nil
3333 "Name of function for last `erlang-man-function' call.
3334Used for commnication between `erlang-man-function' and the
3335patch to `Man-notify-when-ready'.")
3336
3337(defun erlang-man-function (&optional name)
3338 "Find manual page for NAME, where NAME is module:function.
3339The entry for `function' is displayed.
3340
3341This function is aware of imported functions."
3342 (interactive
3343 (list (let* ((mod-func (erlang-get-function-under-point))
3344 (mod (car-safe mod-func))
3345 (func (nth 1 mod-func))
3346 (input (read-string
3347 (format
3348 "Manual entry for `module:func' or `module'%s: "
3349 (if (or (null mod) (string= mod ""))
3350 ""
3351 (format " (default %s:%s)" mod func))))))
3352 (if (string= input "")
3353 (if (and mod func)
3354 (concat mod ":" func)
3355 mod)
3356 input))))
3357 ;; Emacs 18 doesn't provide `man'...
3358 (condition-case nil
3359 (require 'man)
3360 (error nil))
3361 (let ((modname nil)
3362 (funcname nil))
3363 (cond ((null name)
3364 (let ((mod-func (erlang-get-function-under-point)))
3365 (setq modname (car-safe mod-func))
3366 (setq funcname (nth 1 mod-func))))
3367 ((string-match ":" name)
3368 (setq modname (substring name 0 (match-beginning 0)))
3369 (setq funcname (substring name (match-end 0) nil)))
3370 ((stringp name)
3371 (setq modname name)))
3372 (if (or (null modname) (string= modname ""))
3373 (error "No Erlang module name given"))
3374 (cond ((fboundp 'Man-notify-when-ready)
3375 ;; Emacs 19: The man command could possibly start an
3376 ;; asyncronous process, i.e. we must hook ourselves into
3377 ;; the system to be activated when the man-process
3378 ;; terminates.
3379 (if (null funcname)
3380 ()
3381 (erlang-man-patch-notify)
3382 (setq erlang-man-function-name funcname))
3383 (condition-case nil
3384 (erlang-man-module modname)
3385 (error (setq erlang-man-function-name nil))))
3386 (t
3387 (erlang-man-module modname)
3388 (if funcname
3389 (erlang-man-find-function
3390 (or (get-buffer "*Manual Entry*") ; Emacs 18
3391 (current-buffer)) ; XEmacs
3392 funcname))))))
3393
3394
3395;; Should the defadvice be at the top level, the package `advice' would
3396;; be required. Now it is only required when this functionality
3397;; is used. (Emacs 19 specific.)
3398(defun erlang-man-patch-notify ()
3399 "Patch the function `Man-notify-when-ready' to search for function.
3400The variable `erlang-man-function-name' is assumed to be bound to
3401the function name, or to nil.
3402
3403The reason for patching a function is that under Emacs 19, the man
3404command is executed asynchronously."
3405 (condition-case nil
3406 (require 'advice)
3407 ;; This should never happend since this is only called when
3408 ;; running under Emacs 19.
3409 (error (error (concat "This commands needs the package `advice', "
3410 "please upgrade your Emacs."))))
3411 (require 'man)
3412 (defadvice Man-notify-when-ready
3413 (after erlang-Man-notify-when-ready activate)
3414 "Sets point at the documentation of the function name in
3415erlang-man-function-name when the man-page is displayed."
3416 (if erlang-man-function-name
3417 (erlang-man-find-function (ad-get-arg 0) erlang-man-function-name))
3418 (setq erlang-man-function-name nil)))
3419
3420
3421(defun erlang-man-find-function (buf func)
3422 "Find manual page for function in `erlang-man-function-name' in buffer BUF."
3423 (if func
3424 (let ((win (get-buffer-window buf)))
3425 (if win
3426 (progn
3427 (set-buffer buf)
3428 (goto-char (point-min))
3429 (if (re-search-forward
3430 (concat "^[ \t]+" func " ?(")
3431 (point-max) t)
3432 (progn
3433 (forward-word -1)
3434 (set-window-point win (point)))
3435 (message "Could not find function `%s'" func)))))))
3436
3437
3438(defun erlang-man-display (file)
3439 "Display FILE as a `man' file.
3440This is de default manual page display function.
3441The variables `erlang-man-display-function' contains the function
3442to be used."
3443 ;; Emacs 18 doesn't `provide' man.
3444 (condition-case nil
3445 (require 'man)
3446 (error nil))
3447 (if file
3448 (let ((process-environment (copy-sequence process-environment)))
3449 (if (string-match "\\(.*\\)/man[^/]*/\\([^/]+\\)\\.[^.]$" file)
3450 (let ((dir (substring file (match-beginning 1) (match-end 1)))
3451 (page (substring file (match-beginning 2) (match-end 2))))
3452 (if (fboundp 'setenv)
3453 (setenv "MANPATH" dir)
3454 ;; Emacs 18
3455 (setq process-environment (cons (concat "MANPATH=" dir)
3456 process-environment)))
3457 (cond ((not (and (not erlang-xemacs-p)
3458 (= erlang-emacs-major-version 19)
3459 (< erlang-emacs-minor-version 29)))
3460 (manual-entry page))
3461 (t
3462 ;; Emacs 19.28 and earlier versions of 19:
3463 ;; The manual-entry command unconditionally prompts
3464 ;; the user :-(
3465 (funcall (symbol-function 'Man-getpage-in-background)
3466 page))))
3467 (error "Can't find man page for %s\n" file)))))
3468
3469
3470(defun erlang-man-describe-error ()
3471 "Describe why the manual pages weren't found."
3472 (interactive)
3473 (with-output-to-temp-buffer "*Erlang Man Error*"
3474 (princ "Normally, this menu should contain Erlang manual pages.
3475
3476In order to find the manual pages, the variable `erlang-root-dir'
3477should be bound to the name of the directory containing the Erlang
3478installation. The name should not include the final slash.
3479
3480Practically, you should add a line on the following form to
3481your ~/.emacs, or ask your system administrator to add it to
3482the site init file:
3483 (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\")
3484
3485For example:
3486 (setq erlang-root-dir \"/usr/local/erlang\")
3487
3488After installing the line, kill and restart Emacs, or restart Erlang
3489mode with the command `M-x erlang-mode RET'.")))
3490
3491;; Skeleton code:
3492
3493;; This code is based on the package `tempo' which is part of modern
3494;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
3495
3496(defun erlang-skel-init ()
3497 "Generate the skeleton functions and menu items.
3498The variable `erlang-skel' contains the name and descriptions of
3499all skeletons.
3500
3501The skeleton routines are based on the `tempo' package. Should this
3502package not be present, this function does nothing."
3503 (interactive)
3504 (condition-case nil
3505 (require 'tempo)
3506 (error t))
3507 (if (featurep 'tempo)
3508 (let ((skel erlang-skel)
3509 (menu '()))
3510 (while skel
3511 (cond ((null (car skel))
3512 (setq menu (cons nil menu)))
3513 (t
3514 (funcall (symbol-function 'tempo-define-template)
3515 (concat "erlang-" (nth 1 (car skel)))
3516 ;; The tempo template used contains an `include'
3517 ;; function call only, hence changes to the
3518 ;; variables describing the templates take effect
3519 ;; immdiately.
3520 (list (list 'erlang-skel-include (nth 2 (car skel))))
3521 (nth 1 (car skel)))
3522 (setq menu (cons (erlang-skel-make-menu-item
3523 (car skel)) menu))))
3524 (setq skel (cdr skel)))
3525 (setq erlang-menu-skel-items
3526 (list nil (list "Skeletons" (nreverse menu))))
3527 (setq erlang-menu-items
3528 (erlang-menu-add-above 'erlang-menu-skel-items
3529 'erlang-menu-version-items
3530 erlang-menu-items))
3531 (erlang-menu-init))))
3532
3533(defun erlang-skel-make-menu-item (skel)
3534 (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel)))))
3535 (cond ((null (nth 3 skel))
3536 (list (car skel) func))
3537 (t
3538 (list (car skel)
3539 (list 'lambda '()
3540 '(interactive)
3541 (list 'funcall
3542 (list 'quote (nth 3 skel))
3543 (list 'quote func))))))))
3544
3545;; Functions designed to be added to the skeleton menu.
3546;; (Not normally used)
3547(defun erlang-skel-insert (func)
3548 "Insert skeleton generated by FUNC and goto first tempo mark."
3549 (save-excursion (funcall func))
3550 (funcall (symbol-function 'tempo-forward-mark)))
3551
3552(defun erlang-skel-header (func)
3553 "Insert the header generated by FUNC at the beginning of the buffer."
3554 (goto-char (point-min))
3555 (save-excursion (funcall func))
3556 (funcall (symbol-function 'tempo-forward-mark)))
3557
3558
3559;; Functions used inside the skeleton descriptions.
3560(defun erlang-skel-skip-blank ()
3561 (skip-chars-backward " \t")
3562 nil)
3563
3564(defun erlang-skel-include (&rest args)
3565 "Include a template inside another template.
3566
3567Example of use, assuming that `erlang-skel-func' is defined:
3568
3569 (defvar foo-skeleton '(\"%%% New function:\"
3570 (erlang-skel-include erlang-skel-func)))
3571
3572Techically, this function returns the `tempo' attribute`(l ...)' which
3573can contain other `tempo' attributes. Please see the function
3574`tempo-define-template' for a description of the `(l ...)' attribute."
3575 (let ((res '())
3576 entry)
3577 (while args
3578 (setq entry (car args))
3579 (while entry
3580 (setq res (cons (car entry) res))
3581 (setq entry (cdr entry)))
3582 (setq args (cdr args)))
3583 (cons 'l (nreverse res))))
3584
3585(defun erlang-skel-separator (&optional percent)
3586 "Return a comment separator."
3587 (let ((percent (or percent 3)))
3588 (concat (make-string percent ?%)
3589 (make-string (- 70 percent) ?-)
3590 "\n")))
3591
3592(defun erlang-skel-double-separator (&optional percent)
3593 "Return a comment separator."
3594 (let ((percent (or percent 3)))
3595 (concat (make-string percent ?%)
3596 (make-string (- 70 percent) ?=)
3597 "\n")))
3598
3599(defun erlang-skel-dd-mmm-yyyy ()
3600 "Return the current date as a string in \"DD Mon YYYY\" form.
3601The first character of DD is space if the value is less than 10."
3602 (let ((date (current-time-string)))
3603 (format "%2d %s %s"
3604 (string-to-int (substring date 8 10))
3605 (substring date 4 7)
3606 (substring date -4))))
3607
3608;; Indentation code:
3609
3610(defun erlang-indent-command (&optional whole-exp)
3611 "Indent current line as Erlang code.
3612With argument, indent any additional lines of the same clause
3613rigidly along with this one."
3614 (interactive "P")
3615 (if whole-exp
3616 ;; If arg, alwys indent this line as Erlang
3617 ;; and shift remaining lines of clause the same amount.
3618 (let ((shift-amt (erlang-indent-line))
3619 beg end)
3620 (save-excursion
3621 (if erlang-tab-always-indent
3622 (beginning-of-line))
3623 (setq beg (point))
3624 (erlang-end-of-clause 1)
3625 (setq end (point))
3626 (goto-char beg)
3627 (forward-line 1)
3628 (setq beg (point)))
3629 (if (> end beg)
3630 (indent-code-rigidly beg end shift-amt "\n")))
3631 (if (and (not erlang-tab-always-indent)
3632 (save-excursion
3633 (skip-chars-backward " \t")
3634 (not (bolp))))
3635 (insert-tab)
3636 (erlang-indent-line))))
3637
3638
3639(defun erlang-indent-line ()
3640 "Indent current line as Erlang code.
3641Return the amount the indentation changed by."
3642 (let ((pos (- (point-max) (point)))
3643 indent beg
3644 shift-amt)
3645 (beginning-of-line 1)
3646 (setq beg (point))
3647 (skip-chars-forward " \t")
3648 (cond ((looking-at "%")
3649 (setq indent (funcall comment-indent-function))
3650 (setq shift-amt (- indent (current-column))))
3651 (t
3652 (setq indent (erlang-calculate-indent))
3653 (cond ((null indent)
3654 (setq indent (current-indentation)))
3655 ((eq indent t)
3656 ;; This should never occur here.
3657 (error "Erlang mode error"))
3658 ((= (char-syntax (following-char)) ?\))
3659 (setq indent (1- indent))))
3660 (setq shift-amt (- indent (current-column)))))
3661 (if (zerop shift-amt)
3662 nil
3663 (delete-region beg (point))
3664 (indent-to indent))
3665 ;; If initial point was within line's indentation, position
3666 ;; after the indentation. Else stay at same point in text.
3667 (if (> (- (point-max) pos) (point))
3668 (goto-char (- (point-max) pos)))
3669 shift-amt))
3670
3671
3672(defun erlang-indent-region (beg end)
3673 "Indent region of erlang code.
3674
3675This is automagically called by the user level function `indent-region'."
3676 (interactive "r")
3677 (save-excursion
3678 (let ((case-fold-search nil)
3679 (continue t)
3680 (from-end (- (point-max) end))
3681 indent-point ;; The beginning of the current line
3682 indent ;; The indent amount
3683 state)
3684 (goto-char beg)
3685 (beginning-of-line)
3686 (setq indent-point (point))
3687 (erlang-beginning-of-clause)
3688 ;; Parse the Erlang code from the beginning of the clause to
3689 ;; the beginning of the region.
3690 (while (< (point) indent-point)
3691 (setq state (erlang-partial-parse (point) indent-point state)))
3692 ;; Indent every line in the region
3693 (while continue
3694 (goto-char indent-point)
3695 (skip-chars-forward " \t")
3696 (cond ((looking-at "%")
3697 ;; Do not use our stack to help the user to customize
3698 ;; comment indentation.
3699 (setq indent (funcall comment-indent-function)))
3700 ((looking-at "$")
3701 ;; Don't indent empty lines.
3702 (setq indent 0))
3703 (t
3704 (setq indent
3705 (save-excursion
3706 (erlang-calculate-stack-indent (point) state)))
3707 (cond ((null indent)
3708 (setq indent (current-indentation)))
3709 ((eq indent t)
3710 ;; This should never occur here.
3711 (error "Erlang mode error"))
3712 ((= (char-syntax (following-char)) ?\))
3713 (setq indent (1- indent))))))
3714 (if (zerop (- indent (current-column)))
3715 nil
3716 (delete-region indent-point (point))
3717 (indent-to indent))
3718 ;; Find the next line in the region
3719 (goto-char indent-point)
3720 (save-excursion
3721 (forward-line 1)
3722 (setq indent-point (point)))
3723 (if (>= from-end (- (point-max) indent-point))
3724 (setq continue nil)
3725 (while (< (point) indent-point)
3726 (setq state (erlang-partial-parse
3727 (point) indent-point state))))))))
3728
3729
3730(defun erlang-indent-current-buffer ()
3731 "Indent current buffer as Erlang code."
3732 (interactive)
3733 (save-excursion
3734 (save-restriction
3735 (widen)
3736 (erlang-indent-region (point-min) (point-max)))))
3737
3738
3739(defun erlang-indent-function ()
3740 "Indent current Erlang function."
3741 (interactive)
3742 (save-excursion
3743 (let ((end (progn (erlang-end-of-function 1) (point)))
3744 (beg (progn (erlang-beginning-of-function 1) (point))))
3745 (erlang-indent-region beg end))))
3746
3747
3748(defun erlang-indent-clause ()
3749 "Indent current Erlang clause."
3750 (interactive)
3751 (save-excursion
3752 (let ((end (progn (erlang-end-of-clause 1) (point)))
3753 (beg (progn (erlang-beginning-of-clause 1) (point))))
3754 (erlang-indent-region beg end))))
3755
3756
3757(defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack)))
3758(defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack)))
3759;; Would much prefer to make caddr a macro but this clashes.
3760(defun erlang-caddr (x) (car (cdr (cdr x))))
3761
3762
3763(defun erlang-calculate-indent (&optional parse-start)
3764 "Compute appropriate indentation for current line as Erlang code.
3765Return nil if line starts inside string, t if in a comment."
3766 (save-excursion
3767 (let ((indent-point (point))
3768 (case-fold-search nil)
3769 (state nil))
3770 (if parse-start
3771 (goto-char parse-start)
3772 (erlang-beginning-of-clause))
3773 (while (< (point) indent-point)
3774 (setq state (erlang-partial-parse (point) indent-point state)))
3775 (erlang-calculate-stack-indent indent-point state))))
3776
3777(defun erlang-show-syntactic-information ()
3778 "Show syntactic information for current line."
3779
3780 (interactive)
3781
3782 (save-excursion
3783 (let ((starting-point (point))
3784 (case-fold-search nil)
3785 (state nil))
3786 (erlang-beginning-of-clause)
3787 (while (< (point) starting-point)
3788 (setq state (erlang-partial-parse (point) starting-point state)))
3789 (message "%S" state))))
3790
3791
3792(defun erlang-partial-parse (from to &optional state)
3793 "Parse Erlang syntax starting at FROM until TO, with an optional STATE.
3794Value is list (stack token-start token-type in-what)."
3795 (goto-char from) ; Start at the beginning
3796 (erlang-skip-blank to)
3797 (let ((cs (char-syntax (following-char)))
3798 (stack (car state))
3799 (token (point))
3800 in-what)
3801 (cond
3802
3803 ;; Done: Return previous state.
3804 ((>= token to)
3805 (setq token (nth 1 state))
3806 (setq cs (nth 2 state))
3807 (setq in-what (nth 3 state)))
3808 ;; Word constituent: check and handle keywords.
3809 ((= cs ?w)
3810 (if (looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]")
3811 ;; Must pop top icr layer, `after' will push a new
3812 ;; layer next.
3813 (progn
3814 (while (and stack (eq (car (car stack)) '->))
3815 (erlang-pop stack))
3816 (if (and stack (memq (car (car stack)) '(icr begin)))
3817 (erlang-pop stack))))
3818 (cond ((looking-at
3819 "\\(if\\|case\\|receive\\|after\\)[^_a-zA-Z0-9]")
3820 ;; Must push a new icr (if/case/receive) layer.
3821 (erlang-push (list 'icr token (current-column)) stack))
3822 ((looking-at "\\(fun\\)[^_a-zA-Z0-9]")
3823 ;; Puch a new icr layer if we are defining a `fun'
3824 ;; expression, not when we are refering an existing
3825 ;; function.
3826 (if (save-excursion
3827 (goto-char (match-end 1))
3828 (erlang-skip-blank to)
3829 (eq (following-char) ?\())
3830 (erlang-push (list 'icr token (current-column)) stack)))
3831 ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]")
3832 (erlang-push (list 'begin token (current-column)) stack))
3833 ((looking-at "when[^_a-zA-Z0-9]")
3834 (erlang-push (list 'when token (current-column)) stack)))
3835 (forward-sexp 1))
3836
3837 ;; String: Try to skip over it. (Catch error if not complete.)
3838 ((= cs ?\")
3839 (condition-case nil
3840 (progn
3841 (forward-sexp 1)
3842 (if (> (point) to)
3843 (progn
3844 (setq in-what 'string)
3845 (goto-char to))))
3846 (error
3847 (setq in-what 'string)
3848 (goto-char to))))
3849
3850 ;; Symbol constituent, punctuation, or expression prefix?
3851 ((memq cs '(?. ?_ ?'))
3852 (cond
3853
3854 ;; Clause end
3855 ((= (following-char) ?\;)
3856 (if (and stack (eq (car (car stack)) '->))
3857 (erlang-pop stack))
3858 (forward-char 1))
3859
3860 ;; Function end
3861 ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")
3862 (setq stack nil)
3863 (forward-char 1))
3864
3865 ;; Function head
3866 ((looking-at "->\\|:-")
3867 (if (and stack (eq (car (car stack)) 'when))
3868 (erlang-pop stack))
3869 (erlang-push (list '-> token (current-column)) stack)
3870 (forward-char 2))
3871
3872 ;; List-comprehension divider
3873 ((looking-at "||")
3874 (erlang-push (list '|| token (current-column)) stack)
3875 (forward-char 2))
3876
3877 ;; Bit-syntax open paren
3878 ((looking-at "<<")
3879 (erlang-push (list '\( token (current-column)) stack)
3880 (forward-char 2))
3881
3882 ;; Bbit-syntax close paren
3883 ((looking-at ">>")
3884 (while (memq (car (car stack)) '(|| ->))
3885 (erlang-pop stack))
3886 (cond ((eq (car (car stack)) '\()
3887 (erlang-pop stack))
3888 ((memq (car (car stack)) '(icr begin))
3889 (error "Missing `end'"))
3890 (t
3891 (error "Unbalanced parentheses")))
3892 (forward-char 2))
3893
3894 ;; Macro
3895 ((= (following-char) ??)
3896 ;; Skip over macro name and any following whitespace.
3897 (forward-word 1)
3898 (skip-syntax-forward "-" to)
3899 ;; Macro might have an argument list. Skip it too.
3900 (when (= (following-char) ?\()
3901 (forward-list 1)))
3902
3903 ;; Other punctuation: Skip over it and any following punctuation
3904 ((= cs ?.)
3905 ;; Skip over all characters in the operand.
3906 (skip-syntax-forward "."))
3907
3908 ;; Other char: Skip over it.
3909 (t
3910 (forward-char 1))))
3911
3912 ;; Open parenthesis
3913 ((= cs ?\()
3914 (erlang-push (list '\( token (current-column)) stack)
3915 (forward-char 1))
3916
3917 ;; Close parenthesis
3918 ((= cs ?\))
3919 (while (memq (car (car stack)) '(|| ->))
3920 (erlang-pop stack))
3921 (cond ((eq (car (car stack)) '\()
3922 (erlang-pop stack))
3923 ((memq (car (car stack)) '(icr begin))
3924 (error "Missing `end'"))
3925 (t
3926 (error "Unbalanced parenthesis")))
3927 (forward-char 1))
3928
3929 ;; Character quote: Skip it and the quoted char.
3930 ((= cs ?/)
3931 (forward-char 2))
3932
3933 ;; Character escape: Skip it and the escape sequence.
3934 ((= cs ?\\)
3935 (forward-char 1)
3936 (skip-syntax-forward "w"))
3937
3938 ;; Everything else
3939 (t
3940 (forward-char 1)))
3941 (list stack token cs in-what)))
3942
3943
3944(defun erlang-calculate-stack-indent (indent-point state)
3945 "From the given last position and state (stack) calculate indentation.
3946Return nil if inside string, t if in a comment."
3947 (let* ((stack (and state (car state)))
3948 (token (nth 1 state))
3949 (stack-top (and stack (car stack))))
3950 (cond ((null state) ;No state
3951 0)
3952 ((nth 3 state)
3953 ;; Return nil or t.
3954 (eq (nth 3 state) 'comment))
3955 ((null stack)
3956 (if (looking-at "when[^_a-zA-Z0-9]")
3957 erlang-indent-guard
3958 0))
3959 ((eq (car stack-top) '\()
3960 ;; Element of list, tuple or part of an expression,
3961 (if (null erlang-argument-indent)
3962 ;; indent to next column.
3963 (1+ (nth 2 stack-top))
3964 (goto-char (nth 1 stack-top))
3965 (cond ((looking-at "[({]\\s *\\($\\|%\\)")
3966 ;; Line ends with parenthesis.
3967 (+ (erlang-indent-find-preceding-expr)
3968 erlang-argument-indent))
3969 (t
3970 ;; Indent to the same column as the first
3971 ;; argument.
3972 (goto-char (1+ (nth 1 stack-top)))
3973 (skip-chars-forward " \t")
3974 (current-column)))))
3975 ((eq (car stack-top) 'icr)
3976 ;; The default indentation is the column of the option
3977 ;; directly following the keyword. (This does not apply to
3978 ;; `case'.) Should no option be on the same line, the
3979 ;; indentation is the indentation of the keyword +
3980 ;; `erlang-indent-level'.
3981 ;;
3982 ;; `after' should be indentated to the save level as the
3983 ;; corresponding receive.
3984 (if (looking-at "after[^_a-zA-Z0-9]")
3985 (nth 2 stack-top)
3986 (save-excursion
3987 (goto-char (nth 1 stack-top))
3988 (if (looking-at "case[^_a-zA-Z0-9]")
3989 (+ (nth 2 stack-top) erlang-indent-level)
3990 (skip-chars-forward "a-z")
3991 (skip-chars-forward " \t")
3992 (if (memq (following-char) '(?% ?\n))
3993 (+ (nth 2 stack-top) erlang-indent-level)
3994 (current-column))))))
3995 ;; Real indentation, where operators create extra indentation etc.
3996 ((memq (car stack-top) '(-> || begin))
3997 (goto-char (nth 1 stack-top))
3998 ;; Check if there is more code after the '->' on the
3999 ;; same line. If so use this indentation as base, else
4000 ;; use parent indentation + 2 * level as base.
4001 (let ((off erlang-indent-level)
4002 (skip 2))
4003 (cond ((null (cdr stack))) ; Top level in function.
4004 ((eq (car stack-top) 'begin)
4005 (setq skip 5))
4006 ((eq (car stack-top) '->)
4007 (setq off (* 2 erlang-indent-level))))
4008 (let ((base (erlang-indent-find-base stack indent-point off skip)))
4009 ;; Look at last thing to see how we are to move relative
4010 ;; to the base.
4011 (goto-char token)
4012 (cond ((looking-at "||\\|,\\|->\\|:-")
4013 base)
4014 ((erlang-at-keyword)
4015 (+ (current-column) erlang-indent-level))
4016 ((or (= (char-syntax (following-char)) ?.)
4017 (erlang-at-operator))
4018 (+ base erlang-indent-level))
4019 (t
4020 (goto-char indent-point)
4021 (cond ((memq (following-char) '(?\( ?{))
4022 ;; Function application or record.
4023 (+ (erlang-indent-find-preceding-expr)
4024 erlang-argument-indent))
4025 ;; Empty line, or end; treat it as the end of
4026 ;; the block. (Here we have a choice: should
4027 ;; the user be forced to reindent continued
4028 ;; lines, or should the "end" be reindented?)
4029 ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]\\|$")
4030 (if (eq (car (car stack)) '->)
4031 (erlang-pop stack))
4032 (if stack
4033 (erlang-caddr (car stack))
4034 0))
4035 ;; Avoid trating comments a continued line.
4036 ((= (following-char) ?%)
4037 base)
4038 ;; Continued line (e.g. line beginning
4039 ;; with an operator.)
4040 (t (+ base erlang-indent-level))))))))
4041 ((eq (car stack-top) 'when)
4042 (goto-char (nth 1 stack-top))
4043 (if (looking-at "when\\s *\\($\\|%\\)")
4044 (progn
4045 (erlang-pop stack)
4046 (if (and stack (eq (nth 0 (car stack)) 'icr))
4047 (progn
4048 (goto-char (nth 1 (car stack)))
4049 (+ (nth 2 (car stack)) erlang-indent-guard
4050 ;; receive XYZ or receive
4051 ;; XYZ
4052 (if (looking-at "[a-z]+\\s *\\($\\|%\\)")
4053 erlang-indent-level
4054 (* 2 erlang-indent-level))))
4055 erlang-indent-guard))
4056 ;; "when" is followed by code, let's indent to the same
4057 ;; column.
4058 (forward-char 4) ; Skip "when"
4059 (skip-chars-forward " \t")
4060 (current-column))))))
4061
4062
4063(defun erlang-indent-find-base (stack indent-point &optional offset skip)
4064 "Find the base column for current stack."
4065 (or skip (setq skip 2))
4066 (or offset (setq offset erlang-indent-level))
4067 (save-excursion
4068 (let* ((stack-top (car stack)))
4069 (goto-char (nth 1 stack-top))
4070 (forward-char skip)
4071 (if (looking-at "\\s *\\($\\|%\\)")
4072 (progn
4073 (if (memq (car stack-top) '(-> ||))
4074 (erlang-pop stack))
4075 ;; Take parent identation + offset,
4076 ;; else just erlang-indent-level if no parent
4077 (if stack
4078 (+ (erlang-caddr (car stack))
4079 offset)
4080 erlang-indent-level))
4081 (erlang-skip-blank indent-point)
4082 (current-column)))))
4083
4084
4085;; Does not handle `begin' .. `end'.
4086(defun erlang-indent-find-preceding-expr ()
4087 "Return the first column of the preceding expression.
4088This assumes that the preceding expression is either simple
4089\(i.e. an atom) or parenthesized."
4090 (save-excursion
4091 (forward-sexp -1)
4092 (let ((col (current-column)))
4093 (skip-chars-backward " \t")
4094 ;; Needed to match the colon in "'foo':'bar'".
4095 (if (not (memq (preceding-char) '(?# ?:)))
4096 col
4097 (backward-char 1)
4098 (forward-sexp -1)
4099 (current-column)))))
4100
4101
4102(defun erlang-skip-blank (&optional lim)
4103 "Skip over whitespace and comments until limit reached."
4104 (or lim (setq lim (point-max)))
4105 (let (stop)
4106 (while (and (not stop) (< (point) lim))
4107 (cond ((= (following-char) ?%)
4108 (skip-chars-forward "^\n" lim))
4109 ((= (following-char) ?\n)
4110 (skip-chars-forward "\n" lim))
4111 ((looking-at "\\s ")
4112 (if (re-search-forward "\\S " lim 'move)
4113 (forward-char -1)))
4114 (t
4115 (setq stop t))))
4116 stop))
4117
4118(defun erlang-at-keyword ()
4119 "Are we looking at an Erlang keyword which will increase indentation?"
4120 (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|query\\|"
4121 "of\\|receive\\|after\\|catch\\)[^_a-zA-Z0-9]")))
4122
4123(defun erlang-at-operator ()
4124 "Are we looking at an Erlang operator?"
4125 (looking-at
4126 "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]"))
4127
4128(defun erlang-comment-indent ()
4129 "Compute erlang comment indentation.
4130
4131Used both by `indent-for-comment' and the erlang specific indentation
4132commands."
4133 (cond ((looking-at "%%%") 0)
4134 ((looking-at "%%")
4135 (or (erlang-calculate-indent)
4136 (current-indentation)))
4137 (t
4138 (save-excursion
4139 (skip-chars-backward " \t")
4140 (max (if (bolp) 0 (1+ (current-column)))
4141 comment-column)))))
4142
4143;;; Erlang movement commands
4144
4145;; All commands below work as movement commands. I.e. if the point is
4146;; at the end of the clause, and the command `erlang-end-of-clause' is
4147;; executed, the point is moved to the end of the NEXT clause. (This
4148;; mimics the behaviour of `end-of-defun'.)
4149;;
4150;; Personally I would like to rewrite them to be "pure", and add a set
4151;; of movement functions, like `erlang-next-clause',
4152;; `erlang-previous-clause', and the same for functions.
4153;;
4154;; The current implementation makes it hopeless to use the functions as
4155;; subroutines in more complex commands. /andersl
4156
4157(defun erlang-beginning-of-clause (&optional arg)
4158 "Move backward to previous start of clause.
4159With argument, do this that many times.
4160Return t unless search stops due to end of buffer."
4161 (interactive "p")
4162 (or arg (setq arg 1))
4163 (if (< arg 0)
4164 ;; Step back to the end of the previous line, unless we are at
4165 ;; the beginning of the buffer. The reason for this move is
4166 ;; that the regexp below includes the last character of the
4167 ;; previous line.
4168 (if (bobp)
4169 (or (looking-at "\n")
4170 (forward-char 1))
4171 (forward-char -1)
4172 (if (looking-at "\\`\n")
4173 (forward-char 1))))
4174 ;; The regexp matches a function header that isn't
4175 ;; included in a string.
4176 (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\([a-z]\\|'\\|-\\)"
4177 nil 'move (- arg))
4178 (let ((beg (match-beginning 2)))
4179 (and beg (goto-char beg))
4180 t)))
4181
4182(defun erlang-end-of-clause (&optional arg)
4183 "Move to the end of the current clause.
4184With argument, do this that many times."
4185 (interactive "p")
4186 (or arg (setq arg 1))
4187 (while (and (looking-at "[ \t]*[%\n]")
4188 (zerop (forward-line 1))))
4189 ;; Move to the next clause.
4190 (erlang-beginning-of-clause (- arg))
4191 (beginning-of-line) ;; Just to be sure...
4192 (let ((continue t))
4193 (while (and (not (bobp)) continue)
4194 (forward-line -1)
4195 (skip-chars-forward " \t")
4196 (if (looking-at "[%\n]")
4197 nil
4198 (end-of-line)
4199 (setq continue nil)))))
4200
4201(defun erlang-mark-clause ()
4202 "Put mark at end of clause, point at beginning."
4203 (interactive)
4204 (push-mark (point))
4205 (erlang-end-of-clause 1)
4206 ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate
4207 ;; the region.
4208 (condition-case nil
4209 (push-mark (point) nil t)
4210 (error (push-mark (point))))
4211 (erlang-beginning-of-clause 1)
4212 ;; The above function deactivates the mark.
4213 (if (boundp 'deactivate-mark)
4214 (funcall (symbol-function 'set) 'deactivate-mark nil)))
4215
4216(defun erlang-beginning-of-function (&optional arg)
4217 "Move backward to previous start of function.
4218With positive argument, do this that many times.
4219With negative argument, search forward.
4220
4221Return t unless search stops due to end of buffer."
4222 (interactive "p")
4223 (or arg (setq arg 1))
4224 (cond
4225 ;; Search backward
4226 ((> arg 0)
4227 (while (and (> arg 0)
4228 (and (erlang-beginning-of-clause 1)
4229 (let ((start (point))
4230 (name (erlang-name-of-function))
4231 (arity (erlang-get-function-arity)))
4232 ;; Note: "arity" is nil for e.g. "-import", hence
4233 ;; two "-import" clauses are not considered to
4234 ;; be part of the same function.
4235 (while (and (erlang-beginning-of-clause 1)
4236 (string-equal name
4237 (erlang-name-of-function))
4238 arity
4239 (equal arity
4240 (erlang-get-function-arity)))
4241 (setq start (point)))
4242 (goto-char start)
4243 t)))
4244 (setq arg (1- arg))))
4245 ;; Search forward
4246 ((< arg 0)
4247 (end-of-line)
4248 (erlang-beginning-of-clause 1)
4249 ;; Step -arg functions forward.
4250 (while (and (< arg 0)
4251 ;; Step one function forward, or stop if the end of
4252 ;; the buffer was reached. Return t if we found the
4253 ;; function.
4254 (let ((name (erlang-name-of-function))
4255 (arity (erlang-get-function-arity))
4256 (found (erlang-beginning-of-clause -1)))
4257 (while (and found
4258 (string-equal name (erlang-name-of-function))
4259 arity
4260 (equal arity
4261 (erlang-get-function-arity)))
4262 (setq found (erlang-beginning-of-clause -1)))
4263 found))
4264 (setq arg (1+ arg)))))
4265 (zerop arg))
4266
4267
4268(defun erlang-end-of-function (&optional arg)
4269 "Move forward to next end of function.
4270
4271With argument, do this that many times.
4272With negative argument go towards the beginning of the buffer."
4273 (interactive "p")
4274 (or arg (setq arg 1))
4275 (let ((first t))
4276 ;; Forward
4277 (while (and (> arg 0) (< (point) (point-max)))
4278 (let ((pos (point)))
4279 (while (progn
4280 (if (and first
4281 (progn
4282 (forward-char 1)
4283 (erlang-beginning-of-clause 1)))
4284 nil
4285 (or (bobp) (forward-char -1))
4286 (erlang-beginning-of-clause -1))
4287 (setq first nil)
4288 (erlang-pass-over-function)
4289 (skip-chars-forward " \t")
4290 (if (looking-at "[%\n]")
4291 (forward-line 1))
4292 (<= (point) pos))))
4293 (setq arg (1- arg)))
4294 ;; Backward
4295 (while (< arg 0)
4296 (let ((pos (point)))
4297 (erlang-beginning-of-clause 1)
4298 (erlang-pass-over-function)
4299 (forward-line 1)
4300 (if (>= (point) pos)
4301 (if (erlang-beginning-of-function 2)
4302 (progn
4303 (erlang-pass-over-function)
4304 (skip-chars-forward " \t")
4305 (if (looking-at "[%\n]")
4306 (forward-line 1)))
4307 (goto-char (point-min)))))
4308 (setq arg (1+ arg)))))
4309
4310(defun erlang-mark-function ()
4311 "Put mark at end of function, point at beginning."
4312 (interactive)
4313 (push-mark (point))
4314 (erlang-end-of-function 1)
4315 ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate
4316 ;; the region.
4317 (condition-case nil
4318 (push-mark (point) nil t)
4319 (error (push-mark (point))))
4320 (erlang-beginning-of-function 1)
4321 ;; The above function deactivates the mark.
4322 (if (boundp 'deactivate-mark)
4323 (funcall (symbol-function 'set) 'deactivate-mark nil)))
4324
4325(defun erlang-pass-over-function ()
4326 (while (progn
4327 (erlang-skip-blank)
4328 (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)"))
4329 (not (eobp))))
4330 (forward-sexp 1))
4331 (if (not (eobp))
4332 (forward-char 1)))
4333
4334(defun erlang-name-of-function ()
4335 (save-excursion
4336 ;; Skip over attribute leader.
4337 (if (looking-at "-[ \t]*")
4338 (re-search-forward "-[ \t]*" nil 'move))
4339 (let ((start (point)))
4340 (forward-sexp 1)
4341 (buffer-substring start (point)))))
4342
4343
4344;;; Miscellaneous
4345
4346(defun erlang-fill-paragraph (&optional justify)
4347 "Like \\[fill-paragraph], but handle Erlang comments.
4348If any of the current line is a comment, fill the comment or the
4349paragraph of it that point is in, preserving the comment's indentation
4350and initial `%':s."
4351 (interactive "P")
4352 (let ((has-comment nil)
4353 ;; If has-comment, the appropriate fill-prefix for the comment.
4354 comment-fill-prefix)
4355 ;; Figure out what kind of comment we are looking at.
4356 (save-excursion
4357 (beginning-of-line)
4358 (cond
4359 ;; Find the command prefix.
4360 ((looking-at (concat "\\s *" comment-start-skip))
4361 (setq has-comment t)
4362 (setq comment-fill-prefix (buffer-substring (match-beginning 0)
4363 (match-end 0))))
4364 ;; A line with some code, followed by a comment? Remember that the
4365 ;; % which starts the comment shouldn't be part of a string or
4366 ;; character.
4367 ((progn
4368 (while (not (looking-at "%\\|$"))
4369 (skip-chars-forward "^%\n\"\\\\")
4370 (cond
4371 ((eq (char-after (point)) ?\\) (forward-char 2))
4372 ((eq (char-after (point)) ?\") (forward-sexp 1))))
4373 (looking-at comment-start-skip))
4374 (setq has-comment t)
4375 (setq comment-fill-prefix
4376 (concat (make-string (current-column) ? )
4377 (buffer-substring (match-beginning 0) (match-end 0)))))))
4378 (if (not has-comment)
4379 (fill-paragraph justify)
4380 ;; Narrow to include only the comment, and then fill the region.
4381 (save-restriction
4382 (narrow-to-region
4383 ;; Find the first line we should include in the region to fill.
4384 (save-excursion
4385 (while (and (zerop (forward-line -1))
4386 (looking-at "^\\s *%")))
4387 ;; We may have gone to far. Go forward again.
4388 (or (looking-at "^\\s *%")
4389 (forward-line 1))
4390 (point))
4391 ;; Find the beginning of the first line past the region to fill.
4392 (save-excursion
4393 (while (progn (forward-line 1)
4394 (looking-at "^\\s *%")))
4395 (point)))
4396 ;; Lines with only % on them can be paragraph boundaries.
4397 (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$"))
4398 (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$"))
4399 (fill-prefix comment-fill-prefix))
4400 (fill-paragraph justify))))))
4401
4402
4403(defun erlang-uncomment-region (beg end)
4404 "Uncomment all commented lines in the region."
4405 (interactive "r")
4406 (comment-region beg end -1))
4407
4408
4409(defun erlang-generate-new-clause ()
4410 "Create additional Erlang clause header.
4411
4412Parses the source file for the name of the current Erlang function.
4413Create the header containing the name, A pair of parentheses,
4414and an arrow. The space between the function name and the
4415first parenthesis is preserved. The point is placed between
4416the parentheses."
4417 (interactive)
4418 (let ((name (save-excursion
4419 (and (erlang-beginning-of-clause)
4420 (erlang-get-function-name t))))
4421 (arrow (save-excursion
4422 (and (erlang-beginning-of-clause)
4423 (erlang-get-function-arrow)))))
4424 (if (or (null arrow) (null name))
4425 (error "Can't find name of current Erlang function."))
4426 (if (and (bolp) (eolp))
4427 nil
4428 (end-of-line)
4429 (newline))
4430 (insert name)
4431 (save-excursion
4432 (insert (concat ") " arrow)))
4433 (if erlang-new-clause-with-arguments
4434 (erlang-clone-arguments))))
4435
4436
4437(defun erlang-clone-arguments ()
4438 "Insert, at the point, the argument list of the previous clause.
4439
4440The mark is set at the beginning of the inserted text, the point
4441at the end."
4442 (interactive)
4443 (let ((args (save-excursion
4444 (beginning-of-line)
4445 (and (erlang-beginning-of-clause)
4446 (erlang-get-function-arguments))))
4447 (p (point)))
4448 (if (null args)
4449 (error "Can't clone argument list."))
4450 (insert args)
4451 (set-mark p)))
4452
4453;;; Information retreival functions.
4454
4455(defun erlang-buffer-substring (beg end)
4456 "Like `buffer-substring-no-properties'.
4457Although, this function works on all versions of Emacs."
4458 (if (fboundp 'buffer-substring-no-properties)
4459 (funcall (symbol-function 'buffer-substring-no-properties) beg end)
4460 (buffer-substring beg end)))
4461
4462
4463(defun erlang-get-module ()
4464 "Return the name of the module as specified by `-module'.
4465
4466Return nil if file contains no `-module' attribute."
4467 (save-excursion
4468 (save-restriction
4469 (widen)
4470 (goto-char (point-min))
4471 (let ((md (match-data)))
4472 (unwind-protect
4473 (if (re-search-forward
4474 (concat "^-module\\s *(\\s *\\(\\("
4475 erlang-atom-regexp
4476 "\\)?\\)\\s *)\\s *\\.")
4477 (point-max) t)
4478 (erlang-remove-quotes
4479 (erlang-buffer-substring (match-beginning 1)
4480 (match-end 1)))
4481 nil)
4482 (store-match-data md))))))
4483
4484
4485(defun erlang-get-module-from-file-name (&optional file)
4486 "Extract the module name from a file name.
4487
4488First, the directory part is removed. Second, the part of the file name
4489matching `erlang-file-name-extension-regexp' is removed.
4490
4491Should the match fail, nil is returned.
4492
4493By modifying `erlang-file-name-extension-regexp' to match files other
4494than Erlang source files, Erlang specific functions could be applied on
4495non-Erlang files. Most notably; the support for Erlang modules in the
4496tags system could be used by files written in other languages."
4497 (or file (setq file buffer-file-name))
4498 (if (null file)
4499 nil
4500 (setq file (file-name-nondirectory file))
4501 (if (string-match erlang-file-name-extension-regexp file)
4502 (substring file 0 (match-beginning 0))
4503 nil)))
4504
4505
4506;; Used by `erlang-get-export' and `erlang-get-import'.
4507
4508(defun erlang-get-function-arity-list ()
4509 "Parses list of `function/arity' as used by `-import' and `-export'.
4510
4511The point must be placed at before the opening bracket. When the
4512function returns the point will be placed after the closing bracket.
4513
4514The function does not return an error if the list is incorrectly
4515formatted.
4516
4517Return list of (function . arity). The order of the returned list
4518corresponds to the order of the parsed Erlang list."
4519 (let ((res '()))
4520 (erlang-skip-blank)
4521 (forward-char 1)
4522 (if (not (eq (preceding-char) ?\[))
4523 '() ; Not looking at an Erlang list.
4524 (while ; Note: `while' has no body.
4525 (progn
4526 (erlang-skip-blank)
4527 (and (looking-at (concat erlang-atom-regexp
4528 "/\\([0-9]+\\)\\>"))
4529 (progn
4530 (setq res (cons
4531 (cons
4532 (erlang-remove-quotes
4533 (erlang-buffer-substring
4534 (match-beginning 1) (match-end 1)))
4535 (string-to-int
4536 (erlang-buffer-substring
4537 (match-beginning
4538 (+ 1 erlang-atom-regexp-matches))
4539 (match-end
4540 (+ 1 erlang-atom-regexp-matches)))))
4541 res))
4542 (goto-char (match-end 0))
4543 (erlang-skip-blank)
4544 (forward-char 1)
4545 ;; Test if there are more exported functions.
4546 (eq (preceding-char) ?,))))))
4547 (nreverse res)))
4548
4549
4550;;; Note that `-export' and the open parenthesis must be written on
4551;;; the same line.
4552
4553(defun erlang-get-export ()
4554 "Return a list of `(function . arity)' as specified by `-export'."
4555 (save-excursion
4556 (goto-char (point-min))
4557 (let ((md (match-data))
4558 (res '()))
4559 (unwind-protect
4560 (progn
4561 (while (re-search-forward "^-export\\s *(" (point-max) t)
4562 (erlang-skip-blank)
4563 (setq res (nconc res (erlang-get-function-arity-list))))
4564 res)
4565 (store-match-data md)))))
4566
4567
4568(defun erlang-get-import ()
4569 "Parse an Erlang source file for imported functions.
4570
4571Return an alist with module name as car part and list of conses containing
4572function and arity as cdr part."
4573 (save-excursion
4574 (goto-char (point-min))
4575 (let ((md (match-data))
4576 (res '()))
4577 (unwind-protect
4578 (progn
4579 (while (re-search-forward "^-import\\s *(" (point-max) t)
4580 (erlang-skip-blank)
4581 (if (looking-at erlang-atom-regexp)
4582 (let ((module (erlang-remove-quotes
4583 (erlang-buffer-substring
4584 (match-beginning 0)
4585 (match-end 0)))))
4586 (goto-char (match-end 0))
4587 (erlang-skip-blank)
4588 (if (eq (following-char) ?,)
4589 (progn
4590 (forward-char 1)
4591 (erlang-skip-blank)
4592 (let ((funcs (erlang-get-function-arity-list))
4593 (pair (assoc module res)))
4594 (if pair
4595 (setcdr pair (nconc (cdr pair) funcs))
4596 (setq res (cons (cons module funcs)
4597 res)))))))))
4598 (nreverse res))
4599 (store-match-data md)))))
4600
4601
4602(defun erlang-get-function-name (&optional arg)
4603 "Return name of current function, or nil.
4604
4605If optional argument is non-nil, everything up to and including
4606the first `(' is returned.
4607
4608Normally used in conjuction with `erlang-beginning-of-clause', e.g.:
4609 (save-excursion
4610 (if (not (eobp)) (forward-char 1))
4611 (and (erlang-beginning-of-clause)
4612 (erlang-get-function-name t)))"
4613 (let ((n (if arg 0 1)))
4614 (and (looking-at (concat "^" erlang-atom-regexp "\\s *("))
4615 (erlang-buffer-substring (match-beginning n) (match-end n)))))
4616
4617
4618(defun erlang-get-function-arrow ()
4619 "Return arrow of current function, could be \"->\", \":-\" or nil.
4620
4621The \":-\" arrow is used by mnesia queries.
4622
4623Normally used in conjuction with `erlang-beginning-of-clause', e.g.:
4624 (save-excursion
4625 (if (not (eobp)) (forward-char 1))
4626 (and (erlang-beginning-of-clause)
4627 (erlang-get-function-arrow)))"
4628 (and (looking-at (concat "^" erlang-atom-regexp "\\s *\\((\\)"))
4629 (condition-case ()
4630 (save-excursion
4631 (goto-char (match-beginning (+ 1 erlang-atom-regexp-matches)))
4632 (forward-sexp 1)
4633 (erlang-skip-blank)
4634 (and (looking-at "->\\|:-")
4635 (erlang-buffer-substring
4636 (match-beginning 0) (match-end 0)))))))
4637
4638
4639(defun erlang-get-function-arity ()
4640 "Return the number of arguments of function at point, or nil."
4641 (and (looking-at (concat "^" erlang-atom-regexp "\\s *("))
4642 (save-excursion
4643 (goto-char (match-end 0))
4644 (condition-case nil
4645 (let ((res 0)
4646 (cont t))
4647 (while cont
4648 (cond ((eobp)
4649 (setq res nil)
4650 (setq cont nil))
4651 ((looking-at "\\s *)")
4652 (setq cont nil))
4653 ((looking-at "\\s *\\($\\|%\\)")
4654 (forward-line 1))
4655 ((looking-at "\\s *,")
4656 (goto-char (match-end 0)))
4657 (t
4658 (setq res (+ 1 res))
4659 (forward-sexp 1))))
4660 res)
4661 (error nil)))))
4662
4663
4664(defun erlang-get-function-arguments ()
4665 "Return arguments of current function, or nil."
4666 (if (not (looking-at (concat "^" erlang-atom-regexp "\\s *(")))
4667 nil
4668 (save-excursion
4669 (condition-case nil
4670 (let ((start (match-end 0)))
4671 (goto-char (- start 1))
4672 (forward-sexp)
4673 (erlang-buffer-substring start (- (point) 1)))
4674 (error nil)))))
4675
4676
4677(defun erlang-get-function-under-point ()
4678 "Return the module and function under the point, or nil.
4679
4680Should no explicit module name be present at the point, the
4681list of imported functions is searched.
4682
4683The following could be retured:
4684 (\"module\" \"function\") -- Both module and function name found.
4685 (nil \"function\") -- No module name was found.
4686 nil -- No function name found
4687
4688In the future the list may contain more elements."
4689 (save-excursion
4690 (let ((md (match-data))
4691 (res nil))
4692 (if (eq (char-syntax (following-char)) ? )
4693 (skip-chars-backward " \t"))
4694 (skip-chars-backward "a-zA-Z0-9_:'")
4695 (cond ((looking-at (concat erlang-atom-regexp ":" erlang-atom-regexp))
4696 (setq res (list
4697 (erlang-remove-quotes
4698 (erlang-buffer-substring
4699 (match-beginning 1) (match-end 1)))
4700 (erlang-remove-quotes
4701 (erlang-buffer-substring
4702 (match-beginning (1+ erlang-atom-regexp-matches))
4703 (match-end (1+ erlang-atom-regexp-matches)))))))
4704 ((looking-at erlang-atom-regexp)
4705 (let ((fk (erlang-remove-quotes
4706 (erlang-buffer-substring
4707 (match-beginning 0) (match-end 0))))
4708 (mod nil)
4709 (imports (erlang-get-import)))
4710 (while (and imports (null mod))
4711 (if (assoc fk (cdr (car imports)))
4712 (setq mod (car (car imports)))
4713 (setq imports (cdr imports))))
4714 (setq res (list mod fk)))))
4715 (store-match-data md)
4716 res)))
4717
4718
4719;; TODO: Escape single quotes inside the string.
4720(defun erlang-add-quotes-if-needed (str)
4721 "Return STR, possibly with quotes."
4722 (if (and (stringp str)
4723 (not (string-match (concat "\\`" erlang-atom-regexp "\\'") str)))
4724 (concat "'" str "'")
4725 str))
4726
4727
4728(defun erlang-remove-quotes (str)
4729 "Return STR without quotes, if present."
4730 (let ((md (match-data)))
4731 (prog1
4732 (if (string-match "\\`'\\(.*\\)'\\'" str)
4733 (substring str (match-beginning 1) (match-end 1))
4734 str)
4735 (store-match-data md))))
4736
4737
4738;;; Check module name
4739
4740;; I don't want to use `advice' since it is not part of Emacs 18.
4741;;
4742;; The function `write-file', bound to C-x C-w, calls
4743;; `set-visited-file-name' which clears the hook. :-(
4744;; To make sure that the hook always is present, we add a piece of
4745;; code to the function `set-visited-file-name'.
4746(defun erlang-check-module-name-init ()
4747 "Initialize the functionality to compare file and module names.
4748
4749We redefines the function `set-visited-file-name' since it clears
4750the variable `local-write-file-hooks'. The original function definition
4751is stored in `erlang-orig-set-visited-file-name'."
4752 (if (fboundp 'erlang-orig-set-visited-file-name)
4753 ()
4754 (fset 'erlang-orig-set-visited-file-name
4755 (symbol-function 'set-visited-file-name))
4756 (defun set-visited-file-name (&rest args)
4757 "Please see the function `erlang-orig-set-visited-file-name'."
4758 (interactive "FSet visited file name: ")
4759 (apply (symbol-function 'erlang-orig-set-visited-file-name) args)
4760 (if (eq major-mode 'erlang-mode)
4761 (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
4762 (add-hook 'local-write-file-hooks 'erlang-check-module-name))
4763
4764
4765(defun erlang-check-module-name ()
4766 "If the module name doesn't match file name, ask for permission to change.
4767
4768The variable `erlang-check-module-name' controls the behaviour of this
4769function. It it is nil, this function does nothing. If it is t, the
4770source is silently changed. If it is set to the atom `ask', the user
4771is prompted.
4772
4773This function is normally placed in the hook `local-write-file-hook'."
4774 (if erlang-check-module-name
4775 (let ((mn (erlang-get-module))
4776 (fn (erlang-get-module-from-file-name (buffer-file-name))))
4777 (if (and (stringp mn) (stringp fn))
4778 (or (string-equal mn fn)
4779 (if (or (eq erlang-check-module-name t)
4780 (y-or-n-p
4781 "Module does not match file name. Modify source? "))
4782 (save-excursion
4783 (save-restriction
4784 (widen)
4785 (goto-char (point-min))
4786 (if (re-search-forward
4787 (concat "^-module\\s *(\\s *\\(\\("
4788 erlang-atom-regexp
4789 "\\)?\\)\\s *)\\s *\\.")
4790 (point-max) t)
4791 (progn
4792 (goto-char (match-beginning 1))
4793 (delete-region (match-beginning 1)
4794 (match-end 1))
4795 (insert fn))))))))))
4796 ;; Must return nil since it is added to `local-write-file-hook'.
4797 nil)
4798
4799
4800;;; Electric functions.
4801
4802(defun erlang-electric-semicolon (&optional arg)
4803 "Insert a semicolon character and possibly a prototype for the next line.
4804
4805The variable `erlang-electric-semicolon-criteria' states a critera,
4806when fulfilled a newline is inserted, the next line is indented and a
4807prototype for the next line is inserted. Normally the prototype
4808consists of \" ->\". Should the semicolon end the clause a new clause
4809header is generated.
4810
4811The variable `erlang-electric-semicolon-insert-blank-lines' controls
4812the number of blank lines inserted between the current line and new
4813function header.
4814
4815Behaves just like the normal semicolon when supplied with a
4816numerical arg, point is inside string or comment, or when there are
4817non-whitespace characters following the point on the current line."
4818 (interactive "P")
4819 (self-insert-command (prefix-numeric-value arg))
4820 (if (or arg
4821 (and (listp erlang-electric-commands)
4822 (not (memq 'erlang-electric-semicolon
4823 erlang-electric-commands)))
4824 (erlang-in-literal)
4825 (not (looking-at "\\s *\\(%.*\\)?$"))
4826 (null (erlang-test-criteria-list
4827 erlang-electric-semicolon-criteria)))
4828 (setq erlang-electric-newline-inhibit nil)
4829 (setq erlang-electric-newline-inhibit t)
4830 (undo-boundary)
4831 (end-of-line)
4832 (newline)
4833 (if (condition-case nil
4834 (progn (erlang-indent-line) t)
4835 (error (if (bolp) (delete-backward-char 1))))
4836 (if (not (bolp))
4837 (save-excursion
4838 (insert " ->"))
4839 (condition-case nil
4840 (progn
4841 (erlang-generate-new-clause)
4842 (if erlang-electric-semicolon-insert-blank-lines
4843 (save-excursion
4844 (beginning-of-line)
4845 (newline
4846 erlang-electric-semicolon-insert-blank-lines))))
4847 (error (if (bolp) (delete-backward-char 1))))))))
4848
4849
4850(defun erlang-electric-comma (&optional arg)
4851 "Insert a comma character and possibly a new indented line.
4852The variable `erlang-electric-comma-criteria' states a critera,
4853when fulfilled a newline is inserted and the next line is indeted.
4854
4855Behaves just like the normal comma when supplied with a
4856numerical arg, point is inside string or comment, or when there are
4857non-whitespace characters following the point on the current line."
4858 (interactive "P")
4859
4860 (self-insert-command (prefix-numeric-value arg))
4861
4862 (if (or arg
4863 (and (listp erlang-electric-commands)
4864 (not (memq 'erlang-electric-comma erlang-electric-commands)))
4865 (erlang-in-literal)
4866 (not (looking-at "\\s *\\(%.*\\)?$"))
4867 (null (erlang-test-criteria-list
4868 erlang-electric-comma-criteria)))
4869 (setq erlang-electric-newline-inhibit nil)
4870 (setq erlang-electric-newline-inhibit t)
4871 (undo-boundary)
4872 (end-of-line)
4873 (newline)
4874 (condition-case nil
4875 (erlang-indent-line)
4876 (error (if (bolp) (delete-backward-char 1))))))
4877
4878(defun erlang-electric-lt (&optional arg)
4879 "Insert a less-than sign, and optionally mark it as an open paren."
4880
4881 (interactive "p")
4882
4883 (self-insert-command arg)
4884
4885 ;; Was this the second char in bit-syntax open (`<<')?
4886 (unless (< (point) 2)
4887 (save-excursion
4888 (backward-char 2)
4889 (when (and (eq (char-after (point)) ?<)
4890 (not (eq (get-text-property (point) 'category)
4891 'bitsyntax-open-inner)))
4892 ;; Then mark the two chars...
4893 (put-text-property (point) (1+ (point))
4894 'category 'bitsyntax-open-outer)
4895 (forward-char 1)
4896 (put-text-property (point) (1+ (point))
4897 'category 'bitsyntax-open-inner)
4898 ;;...and unmark any subsequent less-than chars.
4899 (forward-char 1)
4900 (while (eq (char-after (point)) ?<)
4901 (remove-text-properties (point) (1+ (point))
4902 '(category nil))
4903 (forward-char 1))))))
4904
4905(defun erlang-after-bitsyntax-close ()
4906 "Returns true if point is placed immediately after a bit-syntax close parenthesis (`>>')."
4907 (and (>= (point) 2)
4908 (save-excursion
4909 (backward-char 2)
4910 (and (eq (char-after (point)) ?>)
4911 (not (eq (get-text-property (point) 'category)
4912 'bitsyntax-close-outer))))))
4913
4914(defun erlang-after-arrow ()
4915 "Returns true if point is placed immediately after a function arrow (`->')."
4916 (and (>= (point) 2)
4917 (and
4918 (save-excursion
4919 (backward-char)
4920 (eq (char-before (point)) ?-))
4921 (or (not (listp erlang-electric-commands))
4922 (memq 'erlang-electric-gt
4923 erlang-electric-commands))
4924 (not (erlang-in-literal))
4925 (looking-at "\\s *\\(%.*\\)?$")
4926 (erlang-test-criteria-list erlang-electric-arrow-criteria))))
4927
4928
4929(defun erlang-electric-gt (&optional arg)
4930 "Insert a greater-than sign, and optionally mark it as a close paren."
4931
4932 (interactive "p")
4933
4934 (self-insert-command arg)
4935
4936 (cond
4937 ;; Did we just write a bit-syntax close (`>>')?
4938 ((erlang-after-bitsyntax-close)
4939 (save-excursion
4940 ;; Then mark the two chars...
4941 (backward-char 2)
4942 (put-text-property (point) (1+ (point))
4943 'category 'bitsyntax-close-inner)
4944 (forward-char)
4945 (put-text-property (point) (1+ (point))
4946 'category 'bitsyntax-close-outer)
4947 ;;...and unmark any subsequent greater-than chars.
4948 (forward-char)
4949 (while (eq (char-after (point)) ?>)
4950 (remove-text-properties (point) (1+ (point))
4951 '(category nil))
4952 (forward-char))))
4953
4954 ;; Did we just write a function arrow (`->')?
4955 ((erlang-after-arrow)
4956 (let ((erlang-electric-newline-inhibit t))
4957 (undo-boundary)
4958 (end-of-line)
4959 (newline)
4960 (condition-case nil
4961 (erlang-indent-line)
4962 (error (if (bolp) (delete-backward-char 1))))))
4963
4964 ;; Then it's just a plain greater-than.
4965 (t
4966 nil)))
4967
4968
4969(defun erlang-electric-arrow\ off (&optional arg)
4970 "Insert a '>'-sign and possible a new indented line.
4971
4972This command is only `electric' when the `>' is part of an `->' arrow.
4973The variable `erlang-electric-arrow-criteria' states a sequence of
4974criteria, which decides when a newline should be inserted and the next
4975line indented.
4976
4977It behaves just like the normal greater than sign when supplied with a
4978numerical arg, point is inside string or comment, or when there are
4979non-whitespace characters following the point on the current line.
4980
4981After being split/merged into erlang-after-arrow and
4982erlang-electric-gt, it is now unused and disabled."
4983 (interactive "P")
4984 (let ((prec (preceding-char)))
4985 (self-insert-command (prefix-numeric-value arg))
4986 (if (or arg
4987 (and (listp erlang-electric-commands)
4988 (not (memq 'erlang-electric-arrow
4989 erlang-electric-commands)))
4990 (not (eq prec ?-))
4991 (erlang-in-literal)
4992 (not (looking-at "\\s *\\(%.*\\)?$"))
4993 (null (erlang-test-criteria-list
4994 erlang-electric-arrow-criteria)))
4995 (setq erlang-electric-newline-inhibit nil)
4996 (setq erlang-electric-newline-inhibit t)
4997 (undo-boundary)
4998 (end-of-line)
4999 (newline)
5000 (condition-case nil
5001 (erlang-indent-line)
5002 (error (if (bolp) (delete-backward-char 1)))))))
5003
5004
5005(defun erlang-electric-newline (&optional arg)
5006 "Break line at point and indent, continuing comment if within one.
5007The variable `erlang-electric-newline-criteria' states a critera,
5008when fulfilled a newline is inserted and the next line is indeted.
5009
5010Should the current line begin with a comment, and the variable
5011`comment-multi-line' be non-nil, a new comment start is inserted.
5012
5013Should the previous command be another electric command we assume that
5014the user pressed newline out of old habit, hence we will do nothing."
5015 (interactive "P")
5016 (cond ((and (not arg)
5017 erlang-electric-newline-inhibit
5018 (memq last-command erlang-electric-newline-inhibit-list))
5019 ()) ; Do nothing!
5020 ((or arg
5021 (and (listp erlang-electric-commands)
5022 (not (memq 'erlang-electric-newline
5023 erlang-electric-commands)))
5024 (null (erlang-test-criteria-list
5025 erlang-electric-newline-criteria)))
5026 (newline (prefix-numeric-value arg)))
5027 (t
5028 (if (and comment-multi-line
5029 (save-excursion
5030 (beginning-of-line)
5031 (looking-at (concat "\\s *" comment-start-skip))))
5032 (let ((str (buffer-substring
5033 (or (match-end 1) (match-beginning 0))
5034 (min (match-end 0) (point)))))
5035 (newline)
5036 (undo-boundary)
5037 (insert str))
5038 (newline)
5039 (undo-boundary)
5040 (indent-according-to-mode)))))
5041
5042
5043(defun erlang-test-criteria-list (criteria)
5044 "Given a list of criteria functions, test if criteria is fulfilled.
5045
5046Each element in the criteria list can a function returning nil, t or
5047the atom `stop'. t means that the criteria is fulfilled, `stop' means
5048that it the criteria isn't fulfilled and that the search should stop,
5049and nil means continue searching.
5050
5051Should the list contain the atom t the criteria is assumed to be
5052fulfilled, unless preceded by a function returning `stop', of course.
5053
5054Should the argument be the atom t instead of a list, the criteria is
5055assumed to be trivially true.
5056
5057Should all function return nil, the criteria is assumed not to be
5058fulfilled.
5059
5060Return t if criteria fulfilled, nil otherwise."
5061 (if (eq criteria t)
5062 t
5063 (save-excursion
5064 (let ((answer nil))
5065 (while (and criteria (null answer))
5066 (if (eq (car criteria) t)
5067 (setq answer t)
5068 (setq answer (funcall (car criteria))))
5069 (setq criteria (cdr criteria)))
5070 (if (and answer (not (eq answer 'stop)))
5071 t
5072 nil)))))
5073
5074
5075(defun erlang-in-literal (&optional lim)
5076 "Test if point is in string, quoted atom or comment.
5077
5078Return one of the three atoms `atom', `string', and `comment'.
5079Should the point be inside none of the above mentioned types of
5080context, nil is returned."
5081 (save-excursion
5082 (let* ((lim (or lim (save-excursion
5083 (erlang-beginning-of-clause)
5084 (point))))
5085 (state (parse-partial-sexp lim (point))))
5086 (cond
5087 ((eq (nth 3 state) ?') 'atom)
5088 ((nth 3 state) 'string)
5089 ((nth 4 state) 'comment)
5090 (t nil)))))
5091
5092
5093(defun erlang-at-end-of-function-p ()
5094 "Test if point is at end of an Erlang function.
5095
5096This function is designed to be a member of a criteria list."
5097 (eq (save-excursion (erlang-skip-blank) (point))
5098 (save-excursion
5099 (erlang-beginning-of-function -1) (point))))
5100
5101
5102(defun erlang-stop-when-inside-argument-list ()
5103 "Return `stop' if inside parenthesis list, nil otherwise.
5104
5105Knows about the list comprehension syntax. When the point is
5106after `||', `stop' is not returned.
5107
5108This function is designed to be a member of a criteria list."
5109 (save-excursion
5110 (condition-case nil
5111 (let ((orig-point (point))
5112 (state nil))
5113 (up-list -1)
5114 (if (not (eq (following-char) ?\[))
5115 'stop
5116 ;; Do not return `stop' when inside a list comprehension
5117 ;; construnction. (The point must be after `||').
5118 (while (< (point) orig-point)
5119 (setq state (erlang-partial-parse (point) orig-point state)))
5120 (if (and (car state) (eq (car (car (car state))) '||))
5121 nil
5122 'stop)))
5123 (error
5124 nil))))
5125
5126
5127(defun erlang-stop-when-at-guard ()
5128 "Return `stop' when at function guards.
5129
5130This function is designed to be a member of a criteria list."
5131 (save-excursion
5132 (beginning-of-line)
5133 (if (and (looking-at (concat "^" erlang-atom-regexp "\\s *("))
5134 (not (looking-at
5135 (concat "^" erlang-atom-regexp ".*\\(->\\|:-\\)"))))
5136 'stop
5137 nil)))
5138
5139
5140(defun erlang-next-lines-empty-p ()
5141 "Return non-nil if next lines are empty.
5142
5143The variable `erlang-next-lines-empty-threshold' contains the number
5144of lines required to be empty.
5145
5146A line containing only spaces and tabs is considered empty.
5147
5148This function is designed to be a member of a criteria list."
5149 (and erlang-next-lines-empty-threshold
5150 (save-excursion
5151 (let ((left erlang-next-lines-empty-threshold)
5152 (cont t))
5153 (while (and cont (> left 0))
5154 (forward-line 1)
5155 (setq cont (looking-at "\\s *$"))
5156 (setq left (- left 1)))
5157 cont))))
5158
5159
5160(defun erlang-at-keyword-end-p ()
5161 "Test if next readable token is the keyword end.
5162
5163This function is designed to be a member of a criteria list."
5164 (save-excursion
5165 (erlang-skip-blank)
5166 (looking-at "end[^_a-zA-Z0-9]")))
5167
5168
5169;; Erlang tags support which is aware of erlang modules.
5170;;
5171;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags
5172;; package work under XEmacs.)
5173
5174(eval-when-compile
5175 (if (or (featurep 'bytecomp)
5176 (featurep 'byte-compile))
5177 (progn
5178 (require 'etags))))
5179
5180
5181;; Variables:
5182
5183(defvar erlang-tags-function-alist
5184 '((find-tag . erlang-find-tag)
5185 (find-tag-other-window . erlang-find-tag-other-window)
5186 (find-tag-regexp . erlang-find-tag-regexp)
5187 (find-tag-other-frame . erlang-find-tag-other-frame))
5188 "Alist of old tags commands and the replacement functions.")
5189
5190(defvar erlang-tags-installed nil
5191 "Non-nil when the Erlang tags system is installed.")
5192(defvar erlang-tags-file-list '()
5193 "List of files in tag list. Used when finding tag on form `module:'.")
5194(defvar erlang-tags-completion-table nil
5195 "Like `tags-completion-table', this table contains `tag' and `module:tag'.")
5196(defvar erlang-tags-buffer-installed-p nil
5197 "Non-nil when erlang module recognising functions installed.")
5198(defvar erlang-tags-buffer-list '()
5199 "Temporary list of buffers.")
5200(defvar erlang-tags-orig-completion-table nil
5201 "Temporary storage for `tags-completion-table'.")
5202(defvar erlang-tags-orig-tag-order nil
5203 "Temporary storage for `find-tag-tag-order'.")
5204(defvar erlang-tags-orig-regexp-tag-order nil
5205 "Temporary storage for `find-tag-regexp-tag-order'.")
5206(defvar erlang-tags-orig-search-function nil
5207 "Temporary storage for `find-tag-search-function'.")
5208(defvar erlang-tags-orig-regexp-search-function nil
5209 "Temporary storage for `find-tag-regexp-search-function'.")
5210(defvar erlang-tags-orig-format-hooks nil
5211 "Temporary storage for `tags-table-format-hooks'.")
5212
5213(defun erlang-tags-init ()
5214 "Install an alternate version of tags, aware of Erlang modules.
5215
5216After calling this function, the tags functions are aware of
5217Erlang modules. Tags can be entered on the for `module:tag' aswell
5218as on the old form `tag'.
5219
5220In the completion list, `module:tag' and `module:' shows up.
5221
5222Call this function from an appropriate init file, or add it to
5223Erlang mode hook with the commands:
5224 (add-hook 'erlang-mode-hook 'erlang-tags-init)
5225 (add-hook 'erlang-shell-mode-hook 'erlang-tags-init)
5226
5227This function only works under Emacs 18 and Emacs 19. Currently, It
5228is not implemented under XEmacs. (Hint: The Emacs 19 etags module
5229works under XEmacs.)"
5230 (interactive)
5231 (cond ((= erlang-emacs-major-version 18)
5232 (require 'tags)
5233 (erlang-tags-define-keys (current-local-map))
5234 (setq erlang-tags-installed t))
5235 (t
5236 (require 'etags)
5237 ;; Test on a function available in the Emacs 19 version
5238 ;; of tags but not in the XEmacs version.
5239 (if (not (fboundp 'find-tag-noselect))
5240 ()
5241 (erlang-tags-define-keys (current-local-map))
5242 (setq erlang-tags-installed t)))))
5243
5244
5245;; Set all keys bound to `find-tag' et.al. in the global map and the
5246;; menu to `erlang-find-tag' et.al. in `map'.
5247;;
5248;; The function `substitute-key-definition' does not work properly
5249;; in all version of Emacs.
5250
5251(defun erlang-tags-define-keys (map)
5252 "Bind tags commands to keymap MAP aware of Erlang modules."
5253 (let ((alist erlang-tags-function-alist))
5254 (while alist
5255 (let* ((old (car (car alist)))
5256 (new (cdr (car alist)))
5257 (keys (append (where-is-internal old global-map))))
5258 (while keys
5259 (define-key map (car keys) new)
5260 (setq keys (cdr keys))))
5261 (setq alist (cdr alist))))
5262 ;; Update the menu.
5263 (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist)
5264 (erlang-menu-init))
5265
5266
5267;; There exists a variable `find-tag-default-function'. It is not used
5268;; since `complete-tag' uses it to get current word under point. In that
5269;; situation we doesn't want the module to be prepended.
5270
5271(defun erlang-find-tag-default ()
5272 "Return the default tag, searches `-import' list of imported functions.
5273Single quotes has been stripped away."
5274 (let ((mod-func (erlang-get-function-under-point)))
5275 (cond ((null mod-func)
5276 nil)
5277 ((null (car mod-func))
5278 (nth 1 mod-func))
5279 (t
5280 (concat (car mod-func) ":" (nth 1 mod-func))))))
5281
5282
5283;; Return `t' since it is used inside `tags-loop-form'.
5284;;;###autoload
5285(defun erlang-find-tag (modtagname &optional next-p regexp-p)
5286 "Like `find-tag'. Capable of retreiving Erlang modules.
5287
5288Tags can be given on the forms `tag', `module:', `module:tag'."
5289 (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
5290 (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p))
5291 t)
5292
5293
5294;; Code mainly from `find-tag-other-window' in `etags.el'.
5295;;;###autoload
5296(defun erlang-find-tag-other-window (tagname &optional next-p regexp-p)
5297 "Like `find-tag-other-window' but aware of Erlang modules."
5298 (interactive (erlang-tag-interactive
5299 "Find `module:tag' or `tag' other window: "))
5300
5301 ;; This is to deal with the case where the tag is found in the
5302 ;; selected window's buffer; without this, point is moved in both
5303 ;; windows. To prevent this, we save the selected window's point
5304 ;; before doing find-tag-noselect, and restore it afterwards.
5305 (let* ((window-point (window-point (selected-window)))
5306 (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p))
5307 (tagpoint (progn (set-buffer tagbuf) (point))))
5308 (set-window-point (prog1
5309 (selected-window)
5310 (switch-to-buffer-other-window tagbuf)
5311 ;; We have to set this new window's point; it
5312 ;; might already have been displaying a
5313 ;; different portion of tagbuf, in which case
5314 ;; switch-to-buffer-other-window doesn't set
5315 ;; the window's point from the buffer.
5316 (set-window-point (selected-window) tagpoint))
5317 window-point)))
5318
5319
5320(defun erlang-find-tag-other-frame (tagname &optional next-p)
5321 "Like `find-tag-other-frame' but aware of Erlang modules."
5322 (interactive (erlang-tag-interactive
5323 "Find `module:tag' or `tag' other frame: "))
5324 (let ((pop-up-frames t))
5325 (erlang-find-tag-other-window tagname next-p)))
5326
5327
5328(defun erlang-find-tag-regexp (regexp &optional next-p other-window)
5329 "Like `find-tag-regexp' but aware of Erlang modules."
5330 (interactive (if (fboundp 'find-tag-regexp)
5331 (erlang-tag-interactive
5332 "Find `module:regexp' or `regexp': ")
5333 (error "This version of Emacs can't find tags by regexps.")))
5334 (funcall (if other-window
5335 'erlang-find-tag-other-window
5336 'erlang-find-tag)
5337 regexp next-p t))
5338
5339
5340;; Just like C-u M-. This could be added to the menu.
5341(defun erlang-find-next-tag ()
5342 (interactive)
5343 (let ((current-prefix-arg '(4)))
5344 (if erlang-tags-installed
5345 (call-interactively 'erlang-find-tag)
5346 (call-interactively 'find-tag))))
5347
5348
5349;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to
5350;; be compatible with `tags.el'.
5351;;
5352;; Handles three cases:
5353;; * `module:' Loop over all possible filen-ames. Stop if a file-name
5354;; without extension and directory matches the module.
5355;;
5356;; * `module:tag'
5357;; Emacs 19: Replace testfunctions with functions aware of
5358;; Erlang modules. Tricky because the etags system wasn't
5359;; built for these kind of operations...
5360;;
5361;; Emacs 18: We loop over `find-tag' until we find a file
5362;; whose module matches the requested module. The
5363;; drawback is that a lot of files could be loaded into
5364;; Emacs.
5365;;
5366;; * `tag' Just give it to `find-tag'.
5367
5368(defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p)
5369 "Like `find-tag-noselect' but aware of Erlang modules."
5370 (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
5371 (or modtagname
5372 (setq modtagname (symbol-value 'last-tag)))
5373 (funcall (symbol-function 'set) 'last-tag modtagname)
5374 ;; `tags.el' uses this variable to record how M-, would
5375 ;; know where to restart a tags command.
5376 (if (boundp 'tags-loop-form)
5377 (funcall (symbol-function 'set)
5378 'tags-loop-form '(erlang-find-tag nil t)))
5379 (save-window-excursion
5380 (cond
5381 ((string-match ":$" modtagname)
5382 ;; Only the module name was given. Read all files whose file name
5383 ;; match.
5384 (let ((modname (substring modtagname 0 (match-beginning 0)))
5385 (file nil))
5386 (if (not next-p)
5387 (save-excursion
5388 (visit-tags-table-buffer)
5389 (setq erlang-tags-file-list
5390 (funcall (symbol-function 'tags-table-files)))))
5391 (while (null file)
5392 (or erlang-tags-file-list
5393 (save-excursion
5394 (if (and (featurep 'etags)
5395 (funcall
5396 (symbol-function 'visit-tags-table-buffer) 'same)
5397 (funcall
5398 (symbol-function 'visit-tags-table-buffer) t))
5399 (setq erlang-tags-file-list
5400 (funcall (symbol-function 'tags-table-files)))
5401 (error "No %stags containing %s" (if next-p "more " "")
5402 modtagname))))
5403 (if erlang-tags-file-list
5404 (let ((this-module (erlang-get-module-from-file-name
5405 (car erlang-tags-file-list))))
5406 (if (and (stringp this-module)
5407 (string= modname this-module))
5408 (setq file (car erlang-tags-file-list)))
5409 (setq erlang-tags-file-list (cdr erlang-tags-file-list)))))
5410 (set-buffer (or (get-file-buffer file)
5411 (find-file-noselect file)))))
5412
5413 ((string-match ":" modtagname)
5414 (if (boundp 'find-tag-tag-order)
5415 ;; Method one: Add module-recognising functions to the
5416 ;; list of order functions. However, the tags system
5417 ;; from Emacs 18, and derives thereof (read: XEmacs)
5418 ;; hasn't got this feature.
5419 (progn
5420 (erlang-tags-install-module-check)
5421 (unwind-protect
5422 (funcall (symbol-function 'find-tag)
5423 modtagname next-p regexp-p)
5424 (erlang-tags-remove-module-check)))
5425 ;; Method two: Call the tags system until a file matching
5426 ;; the module is found. This could result in that many
5427 ;; files are read. (e.g. The tag "foo:file" will take a
5428 ;; while to process.)
5429 (let* ((modname (substring modtagname 0 (match-beginning 0)))
5430 (tagname (substring modtagname (match-end 0) nil))
5431 (last-tag tagname)
5432 file)
5433 (while
5434 (progn
5435 (funcall (symbol-function 'find-tag) tagname next-p regexp-p)
5436 (setq next-p t)
5437 ;; Determine the module form the file name. (The
5438 ;; alternative, to check `-module', would make this
5439 ;; code useless for non-Erlang programs.)
5440 (setq file (erlang-get-module-from-file-name buffer-file-name))
5441 (not (and (stringp file)
5442 (string= modname file))))))))
5443 (t
5444 (funcall (symbol-function 'find-tag) modtagname next-p regexp-p)))
5445 (current-buffer))) ; Return the new buffer.
5446
5447
5448;; Process interactive arguments for erlang-find-tag-*.
5449;;
5450;; Negative arguments work only for `etags', not `tags'. This is not
5451;; a problem since negative arguments means step back into the
5452;; history list, a feature not implemented in `tags'.
5453
5454(defun erlang-tag-interactive (prompt)
5455 (condition-case nil
5456 (require 'etags)
5457 (error
5458 (require 'tags)))
5459 (if current-prefix-arg
5460 (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
5461 '-
5462 t))
5463 (let* ((default (erlang-find-tag-default))
5464 (prompt (if default
5465 (format "%s(default %s) " prompt default)
5466 prompt))
5467 (spec (if (featurep 'etags)
5468 (completing-read prompt 'erlang-tags-complete-tag)
5469 (read-string prompt))))
5470 (list (if (equal spec "")
5471 (or default (error "There is no default tag"))
5472 spec)))))
5473
5474
5475;; Search tag functions which are aware of Erlang modules. The tactic
5476;; is to store new search functions into the local variabels of the
5477;; TAGS buffers. The variables are restored directly after the
5478;; search. The situation is complicated by the fact that new TAGS
5479;; files can be loaded during the search.
5480;;
5481;; This code is Emacs 19 `etags' specific.
5482
5483(defun erlang-tags-install-module-check ()
5484 "Install our own tag search functions."
5485 ;; Make sure our functions are installed in TAGS files loaded
5486 ;; into Emacs while searching.
5487 (setq erlang-tags-orig-format-hooks
5488 (symbol-value 'tags-table-format-hooks))
5489 (funcall (symbol-function 'set) 'tags-table-format-hooks
5490 (cons 'erlang-tags-recognize-tags-table
5491 erlang-tags-orig-format-hooks))
5492 (setq erlang-tags-buffer-list '())
5493 ;; Install our functions in the TAGS files already resident.
5494 (save-excursion
5495 (let ((files (symbol-value 'tags-table-computed-list)))
5496 (while files
5497 (if (stringp (car files))
5498 (if (get-file-buffer (car files))
5499 (progn
5500 (set-buffer (get-file-buffer (car files)))
5501 (erlang-tags-install-local))))
5502 (setq files (cdr files))))))
5503
5504
5505(defun erlang-tags-install-local ()
5506 "Install our tag search functions in current buffer."
5507 (if erlang-tags-buffer-installed-p
5508 ()
5509 ;; Mark this buffer as "installed" and record.
5510 (set (make-local-variable 'erlang-tags-buffer-installed-p) t)
5511 (setq erlang-tags-buffer-list
5512 (cons (current-buffer) erlang-tags-buffer-list))
5513
5514 ;; Save the original values.
5515 (set (make-local-variable 'erlang-tags-orig-tag-order)
5516 (symbol-value 'find-tag-tag-order))
5517 (set (make-local-variable 'erlang-tags-orig-regexp-tag-order)
5518 (symbol-value 'find-tag-regexp-tag-order))
5519 (set (make-local-variable 'erlang-tags-orig-search-function)
5520 (symbol-value 'find-tag-search-function))
5521 (set (make-local-variable 'erlang-tags-orig-regexp-search-function)
5522 (symbol-value 'find-tag-regexp-search-function))
5523
5524 ;; Install our own functions.
5525 (set (make-local-variable 'find-tag-search-function)
5526 'erlang-tags-search-forward)
5527 (set (make-local-variable 'find-tag-regexp-search-function)
5528 'erlang-tags-regexp-search-forward)
5529 (set (make-local-variable 'find-tag-tag-order)
5530 '(erlang-tag-match-module-p))
5531 (set (make-local-variable 'find-tag-regexp-tag-order)
5532 '(erlang-tag-match-module-regexp-p))))
5533
5534
5535(defun erlang-tags-remove-module-check ()
5536 "Remove our own tags search functions."
5537 (funcall (symbol-function 'set)
5538 'tags-table-format-hooks
5539 erlang-tags-orig-format-hooks)
5540 ;; Remove our functions from the TAGS files. (Note that
5541 ;; `tags-table-computed-list' need not be the same list as when
5542 ;; the search was started.)
5543 (save-excursion
5544 (let ((buffers erlang-tags-buffer-list))
5545 (while buffers
5546 (if (buffer-name (car buffers))
5547 (progn
5548 (set-buffer (car buffers))
5549 (erlang-tags-remove-local)))
5550 (setq buffers (cdr buffers))))))
5551
5552
5553(defun erlang-tags-remove-local ()
5554 "Remove our tag search functions from current buffer."
5555 (if (null erlang-tags-buffer-installed-p)
5556 ()
5557 (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil)
5558 (funcall (symbol-function 'set)
5559 'find-tag-tag-order erlang-tags-orig-tag-order)
5560 (funcall (symbol-function 'set)
5561 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order)
5562 (funcall (symbol-function 'set)
5563 'find-tag-search-function erlang-tags-orig-search-function)
5564 (funcall (symbol-function 'set)
5565 'find-tag-regexp-search-function
5566 erlang-tags-orig-regexp-search-function)))
5567
5568
5569(defun erlang-tags-recognize-tags-table ()
5570 "Install our functions in all loaded TAGS files.
5571
5572This function is added to `tags-table-format-hooks' when searching
5573for a tag on the form `module:tag'."
5574 (if (null (funcall (symbol-function 'etags-recognize-tags-table)))
5575 nil
5576 (erlang-tags-install-local)
5577 t))
5578
5579
5580(defun erlang-tags-search-forward (tag &optional bound noerror count)
5581 "Forward search function, aware of Erlang module prefix."
5582 (if (string-match ":" tag)
5583 (setq tag (substring tag (match-end 0) nil)))
5584 ;; Avoid uninteded recursion.
5585 (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward)
5586 (search-forward tag bound noerror count)
5587 (funcall erlang-tags-orig-search-function tag bound noerror count)))
5588
5589
5590(defun erlang-tags-regexp-search-forward (tag &optional bound noerror count)
5591 "Forward regexp search function, aware of Erlang module prefix."
5592 (if (string-match ":" tag)
5593 (setq tag (substring tag (match-end 0) nil)))
5594 (if (eq erlang-tags-orig-regexp-search-function
5595 'erlang-tags-regexp-search-forward)
5596 (re-search-forward tag bound noerror count)
5597 (funcall erlang-tags-orig-regexp-search-function
5598 tag bound noerror count)))
5599
5600
5601;; t if point is at a tag line that matches TAG, containing
5602;; module information. Assumes that all other order functions
5603;; are stored in `erlang-tags-orig-[regex]-tag-order'.
5604
5605(defun erlang-tag-match-module-p (tag)
5606 (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order))
5607
5608(defun erlang-tag-match-module-regexp-p (tag)
5609 (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order))
5610
5611(defun erlang-tag-match-module-common-p (tag order)
5612 (let ((mod nil)
5613 (found nil))
5614 (if (string-match ":" tag)
5615 (progn
5616 (setq mod (substring tag 0 (match-beginning 0)))
5617 (setq tag (substring tag (match-end 0) nil))))
5618 (while (and order (not found))
5619 (setq found
5620 (and (not (memq (car order)
5621 '(erlang-tag-match-module-p
5622 erlang-tag-match-module-regexp-p)))
5623 (funcall (car order) tag)))
5624 (setq order (cdr order)))
5625 (and found
5626 (or (null mod)
5627 (string= mod (erlang-get-module-from-file-name
5628 (file-of-tag)))))))
5629
5630
5631;;; Tags completion, Emacs 19 `etags' specific.
5632;;;
5633;;; The basic idea is to create a second completion table `erlang-tags-
5634;;; completion-table' containing all normal tags plus tags on the form
5635;;; `module:tag'.
5636
5637
5638(defun erlang-complete-tag ()
5639 "Perform tags completion on the text around point.
5640Completes to the set of names listed in the current tags table.
5641
5642Should the Erlang tags system be installed this command knows
5643about Erlang modules."
5644 (interactive)
5645 (condition-case nil
5646 (require 'etags)
5647 (error nil))
5648 (cond ((and erlang-tags-installed
5649 (fboundp 'complete-tag)) ; Emacs 19
5650 (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag)))
5651 (fset 'tags-complete-tag
5652 (symbol-function 'erlang-tags-complete-tag))
5653 (unwind-protect
5654 (funcall (symbol-function 'complete-tag))
5655 (fset 'tags-complete-tag orig-tags-complete-tag))))
5656 ((fboundp 'complete-tag) ; Emacs 19
5657 (funcall (symbol-function 'complete-tag)))
5658 ((fboundp 'tag-complete-symbol) ; XEmacs
5659 (funcall (symbol-function 'tag-complete-symbol)))
5660 (t
5661 (error "This version of Emacs can't complete tags."))))
5662
5663
5664;; Based on `tags-complete-tag', but this one uses
5665;; `erlang-tag-completion-table' instead of `tag-completion-table'.
5666;;
5667;; This is the entry-point called by system function `completing-read'.
5668(defun erlang-tags-complete-tag (string predicate what)
5669 (save-excursion
5670 ;; If we need to ask for the tag table, allow that.
5671 (let ((enable-recursive-minibuffers t))
5672 (visit-tags-table-buffer))
5673 (if (eq what t)
5674 (all-completions string (erlang-tags-completion-table) predicate)
5675 (try-completion string (erlang-tags-completion-table) predicate))))
5676
5677
5678;; `tags-completion-table' calls itself recursively, make it
5679;; call our own wedge instead. Note that the recursive call
5680;; is very rare; it only occurs when a tags-file contains
5681;; `include'-statements.
5682(defun erlang-tags-completion-table ()
5683 "Build completion table. Tags on the form `tag' or `module:tag'."
5684 (setq erlang-tags-orig-completion-table
5685 (symbol-function 'tags-completion-table))
5686 (fset 'tags-completion-table
5687 (symbol-function 'erlang-tags-completion-table-1))
5688 (unwind-protect
5689 (erlang-tags-completion-table-1)
5690 (fset 'tags-completion-table
5691 erlang-tags-orig-completion-table)))
5692
5693
5694(defun erlang-tags-completion-table-1 ()
5695 (make-local-variable 'erlang-tags-completion-table)
5696 (or erlang-tags-completion-table
5697 (let ((tags-completion-table nil)
5698 (tags-completion-table-function
5699 'erlang-etags-tags-completion-table))
5700 (funcall erlang-tags-orig-completion-table)
5701 (setq erlang-tags-completion-table tags-completion-table))))
5702
5703
5704;; Based on `etags-tags-completion-table'. The difference is that we
5705;; adds three symbols to the vector, the tag, module: and module:tag.
5706;; The module is extracted from the file name of a tag. (This one
5707;; only works if we are looking at an `etags' file. However, this is
5708;; the only format supported by Emacs, so far.)
5709(defun erlang-etags-tags-completion-table ()
5710 (let ((table (make-vector 511 0))
5711 (file nil))
5712 (save-excursion
5713 (goto-char (point-min))
5714 ;; This monster regexp matches an etags tag line.
5715 ;; \1 is the string to match;
5716 ;; \2 is not interesting;
5717 ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
5718 ;; \4 is not interesting;
5719 ;; \5 is the explicitly-specified tag name.
5720 ;; \6 is the line to start searching at;
5721 ;; \7 is the char to start searching at.
5722 (while (progn
5723 (while (and
5724 (eq (following-char) ?\f)
5725 (looking-at "\f\n\\([^,\n]*\\),.*\n"))
5726 (setq file (buffer-substring
5727 (match-beginning 1) (match-end 1)))
5728 (goto-char (match-end 0)))
5729 (re-search-forward
5730 "\
5731^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
5732\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
5733\\([0-9]+\\)?,\\([0-9]+\\)?\n"
5734 nil t))
5735 (let ((tag (if (match-beginning 5)
5736 ;; There is an explicit tag name.
5737 (buffer-substring (match-beginning 5) (match-end 5))
5738 ;; No explicit tag name. Best guess.
5739 (buffer-substring (match-beginning 3) (match-end 3))))
5740 (module (and file
5741 (erlang-get-module-from-file-name file))))
5742 (intern tag table)
5743 (if (stringp module)
5744 (progn
5745 (intern (concat module ":" tag) table)
5746 ;; Only the first one will be stored in the table.
5747 (intern (concat module ":") table))))))
5748 table))
5749
5750;;;
5751;;; Prepare for other methods to run an Erlang slave process.
5752;;;
5753
5754(defvar erlang-shell-function 'inferior-erlang
5755 "Command to execute start a new Erlang shell.
5756
5757Change this variable to use your favorite
5758Erlang compilation package.")
5759
5760(defvar erlang-shell-display-function 'inferior-erlang-run-or-select
5761 "Command to execute to display Erlang shell.
5762
5763Change this variable to use your favorite
5764Erlang compilation package.")
5765
5766(defvar erlang-compile-function 'inferior-erlang-compile
5767 "Command to execute to compile current buffer.
5768
5769Change this variable to use your favorite
5770Erlang compilation package.")
5771
5772(defvar erlang-compile-display-function 'inferior-erlang-run-or-select
5773 "Command to execute to view last compilation.
5774
5775Change this variable to use your favorite
5776Erlang compilation package.")
5777
5778(defvar erlang-next-error-function 'inferior-erlang-next-error
5779 "Command to execute to go to the next error.
5780
5781Change this variable to use your favorite
5782Erlang compilation package.")
5783
5784
5785;;;###autoload
5786(defun erlang-shell ()
5787 "Start a new Erlang shell.
5788
5789The variable `erlang-shell-function' decides which method to use,
5790default is to start a new Erlang host. It is possible that, in the
5791future, a new shell on an already running host will be started."
5792 (interactive)
5793 (call-interactively erlang-shell-function))
5794
5795
5796;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
5797
5798;; It is customary for Emacs packages to supply a function on this
5799;; form, even though it violates the `erlang-*' name convention.
5800(fset 'run-erlang 'erlang-shell)
5801
5802
5803(defun erlang-shell-display ()
5804 "Display an Erlang shell, or start a new."
5805 (interactive)
5806 (call-interactively erlang-shell-display-function))
5807
5808
5809;;;###autoload
5810(defun erlang-compile ()
5811 "Compile Erlang module in current buffer."
5812 (interactive)
5813 (call-interactively erlang-compile-function))
5814
5815
5816(defun erlang-compile-display ()
5817 "Display compilation output."
5818 (interactive)
5819 (call-interactively erlang-compile-display-function))
5820
5821
5822(defun erlang-next-error ()
5823 "Display next error message from the latest compilation."
5824 (interactive)
5825 (call-interactively erlang-next-error-function))
5826
5827
5828
5829;;;
5830;;; Erlang Shell Mode -- Major mode used for Erlang shells.
5831;;;
5832
5833;; This mode is designed to be implementation independent,
5834;; e.g. it does not assume that we are running an inferior
5835;; Erlang, there exists a lot of other possibilities.
5836
5837
5838(defvar erlang-shell-buffer-name "*erlang*"
5839 "*The name of the Erlang link shell buffer.")
5840
5841
5842(defvar erlang-shell-mode-map nil
5843 "*Keymap used by Erlang shells.")
5844
5845
5846(defvar erlang-shell-mode-hook nil
5847 "*User functions to run when an Erlang shell is started.
5848
5849This hook is used to change the behaviour of Erlang mode. It is
5850normally used by the user to personalise the programming environment.
5851When used in a site init file, it could be used to customise Erlang
5852mode for all users on the system.
5853
5854The functioned added to this hook is runed every time a new Erlang
5855shell is started.
5856
5857See also `erlang-load-hook', a hook which is runed once, when Erlang
5858mode is loaded, and `erlang-mode-hook' which is runed every time a new
5859Erlang source file is loaded into Emacs.")
5860
5861
5862(defvar erlang-input-ring-file-name "~/.erlang_history"
5863 "*When non-nil, file name used to store erlang shell history information.")
5864
5865
5866(defun erlang-shell-mode ()
5867 "Major mode for interacting with an Erlang shell.
5868
5869We assume that we already are in comint-mode.
5870
5871The following special commands are available:
5872\\{erlang-shell-mode-map}"
5873 (interactive)
5874 (setq major-mode 'erlang-shell-mode)
5875 (setq mode-name "Erlang Shell")
5876 (erlang-mode-variables)
5877 (if erlang-shell-mode-map
5878 nil
5879 (setq erlang-shell-mode-map (copy-keymap comint-mode-map))
5880 (erlang-shell-mode-commands erlang-shell-mode-map))
5881 (use-local-map erlang-shell-mode-map)
5882 (set (make-local-variable 'compilation-parsing-end) 1)
5883 (set (make-local-variable 'compilation-error-list) nil)
5884 (set (make-local-variable 'compilation-old-error-list) nil)
5885 ;; Needed when compiling directly from the Erlang shell.
5886 (setq compilation-last-buffer (current-buffer))
5887 (erlang-add-compilation-alist erlang-error-regexp-alist)
5888 (setq comint-prompt-regexp "^[^>=]*> *")
5889 (setq comint-eol-on-send t)
5890 (setq comint-input-ignoredups t)
5891 (setq comint-scroll-show-maximum-output t)
5892 (setq comint-scroll-to-bottom-on-output t)
5893 ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If
5894 ;; the call fails, just call the normal `add-hook'.
5895 (condition-case nil
5896 (progn
5897 (funcall (symbol-function 'add-hook) 'comint-output-filter-functions
5898 'inferior-erlang-strip-delete nil t)
5899 (funcall (symbol-function 'add-hook) 'comint-output-filter-functions
5900 'inferior-erlang-strip-ctrl-m nil t))
5901 (error
5902 (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete)
5903 (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m)))
5904 ;; Some older versions of comint doesn't have an input ring.
5905 (if (fboundp 'comint-read-input-ring)
5906 (progn
5907 (setq comint-input-ring-file-name erlang-input-ring-file-name)
5908 (comint-read-input-ring t)
5909 (make-local-variable 'kill-buffer-hook)
5910 (add-hook 'kill-buffer-hook 'comint-write-input-ring)))
5911 (run-hooks 'erlang-shell-mode-hook))
5912
5913
5914(defun erlang-shell-mode-commands (map)
5915 (define-key map "\M-\t" 'erlang-complete-tag)
5916 (define-key map "\C-a" 'comint-bol) ; Normally the other way around.
5917 (define-key map "\C-c\C-a" 'beginning-of-line)
5918 (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof'
5919 (define-key map "\C-x`" 'erlang-next-error))
5920
5921;;;
5922;;; Inferior Erlang -- Run an Erlang shell as a subprocess.
5923;;;
5924
5925(defvar inferior-erlang-display-buffer-any-frame nil
5926 "*When nil, `inferior-erlang-display-buffer' use only selected frame.
5927When t, all frames are searched. When 'raise, the frame is raised.")
5928
5929(defvar inferior-erlang-shell-type 'newshell
5930 "The type of Erlang shell to use.
5931
5932When this variable is set to the atom `oldshell', the old shell is used.
5933When set to `newshell' the new shell is used. Should the variable be
5934nil, the default shell is used.
5935
5936This variable influence the setting of other variables.")
5937
5938(defvar inferior-erlang-machine "erl"
5939 "*The name of the Erlang shell.")
5940
5941(defvar inferior-erlang-machine-options '()
5942 "*The options used when activating the Erlang shell.
5943
5944This must be a list of strings.")
5945
5946(defvar inferior-erlang-process-name "inferior-erlang"
5947 "*The name of the inferior Erlang process.")
5948
5949(defvar inferior-erlang-buffer-name erlang-shell-buffer-name
5950 "*The name of the inferior erlang buffer.")
5951
5952(defvar inferior-erlang-prompt-timeout 60
5953 "*Number of seconds before `inferior-erlang-wait-prompt' timeouts.
5954
5955The time specified is waited after every output made by the inferior
5956Erlang shell. When this variable is t, we assume that we always have
5957a prompt. When nil, we will wait forever, or until C-g.")
5958
5959(defvar inferior-erlang-process nil
5960 "Process of last invoked inferior Erlang, or nil.")
5961
5962(defvar inferior-erlang-buffer nil
5963 "Buffer of last invoked inferior Erlang, or nil.")
5964
5965;;;###autoload
5966(defun inferior-erlang ()
5967 "Run an inferior Erlang.
5968
5969This is just like running Erlang in a normal shell, except that
5970an Emacs buffer is used for input and output.
5971
5972The command line history can be accessed with M-p and M-n.
5973The history is saved between sessions.
5974
5975Entry to this mode calls the functions in the variables
5976`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
5977
5978The following commands imitate the usual Unix interrupt and
5979editing control characters:
5980\\{erlang-shell-mode-map}"
5981 (interactive)
5982 (require 'comint)
5983 (let ((opts inferior-erlang-machine-options))
5984 (cond ((eq inferior-erlang-shell-type 'oldshell)
5985 (setq opts (cons "-oldshell" opts)))
5986 ((eq inferior-erlang-shell-type 'newshell)
5987 (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts))))
5988 (setq inferior-erlang-buffer
5989 (apply 'make-comint
5990 inferior-erlang-process-name inferior-erlang-machine
5991 nil opts)))
5992 (setq inferior-erlang-process
5993 (get-buffer-process inferior-erlang-buffer))
5994 (process-kill-without-query inferior-erlang-process)
5995 (switch-to-buffer inferior-erlang-buffer)
5996 (if (and (not (eq system-type 'windows-nt))
5997 (eq inferior-erlang-shell-type 'newshell))
5998 (setq comint-process-echoes t))
5999 ;; `rename-buffer' takes only one argument in Emacs 18.
6000 (condition-case nil
6001 (rename-buffer inferior-erlang-buffer-name t)
6002 (error (rename-buffer inferior-erlang-buffer-name)))
6003 (erlang-shell-mode))
6004
6005
6006(defun inferior-erlang-run-or-select ()
6007 "Switch to an inferior Erlang buffer, possibly starting new process."
6008 (interactive)
6009 (if (null (inferior-erlang-running-p))
6010 (inferior-erlang)
6011 (inferior-erlang-display-buffer t)))
6012
6013
6014(defun inferior-erlang-display-buffer (&optional select)
6015 "Make the inferior Erlang process visible.
6016The window is returned.
6017
6018Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is
6019displayed in the current frame. Should it be non-nil, and the buffer
6020already is visible in any other frame, no new window will be created.
6021Should it be the atom 'raise, the frame containing the window will
6022be raised.
6023
6024Should the optional argument SELECT be non-nil, the window is
6025selected. Should the window be in another frame, that frame is raised.
6026
6027Note, should the mouse pointer be places outside the raised frame, that
6028frame will become deselected before the next command."
6029 (interactive)
6030 (or (inferior-erlang-running-p)
6031 (error "No inferior Erlang process is running."))
6032 (let ((win (inferior-erlang-window
6033 inferior-erlang-display-buffer-any-frame))
6034 (frames-p (fboundp 'selected-frame)))
6035 (if (null win)
6036 (let ((old-win (selected-window)))
6037 (save-excursion
6038 (switch-to-buffer-other-window inferior-erlang-buffer)
6039 (setq win (selected-window)))
6040 (select-window old-win))
6041 (if (and window-system
6042 frames-p
6043 (or select
6044 (eq inferior-erlang-display-buffer-any-frame 'raise))
6045 (not (eq (selected-frame) (window-frame win))))
6046 (raise-frame (window-frame win))))
6047 (if select
6048 (select-window win))
6049 (sit-for 0)
6050 win))
6051
6052
6053(defun inferior-erlang-running-p ()
6054 "Non-nil when an inferior Erlang is running."
6055 (and inferior-erlang-process
6056 (memq (process-status inferior-erlang-process) '(run open))
6057 inferior-erlang-buffer
6058 (buffer-name inferior-erlang-buffer)))
6059
6060
6061(defun inferior-erlang-window (&optional all-frames)
6062 "Return the window containing the inferior Erlang, or nil."
6063 (and (inferior-erlang-running-p)
6064 (if (and all-frames (>= erlang-emacs-major-version 19))
6065 (get-buffer-window inferior-erlang-buffer t)
6066 (get-buffer-window inferior-erlang-buffer))))
6067
6068
6069(defun inferior-erlang-wait-prompt ()
6070 "Wait until the inferior Erlang shell prompt appear."
6071 (if (eq inferior-erlang-prompt-timeout t)
6072 ()
6073 (or (inferior-erlang-running-p)
6074 (error "No inferior Erlang shell is running."))
6075 (save-excursion
6076 (set-buffer inferior-erlang-buffer)
6077 (let ((msg nil))
6078 (while (save-excursion
6079 (goto-char (process-mark inferior-erlang-process))
6080 (forward-line 0)
6081 (not (looking-at comint-prompt-regexp)))
6082 (if msg
6083 ()
6084 (setq msg t)
6085 (message "Waiting for Erlang shell prompt (press C-g to abort)."))
6086 (or (accept-process-output inferior-erlang-process
6087 inferior-erlang-prompt-timeout)
6088 (error "No Erlang shell prompt before timeout.")))
6089 (if msg (message ""))))))
6090
6091
6092(defun inferior-erlang-send-command (cmd &optional hist)
6093 "Send command CMD to the inferior Erlang.
6094
6095The contents of the current command line (if any) will
6096be placed at the next prompt.
6097
6098If optional second argument is non-nil the command is inserted into
6099the history list.
6100
6101Return the position after the newly inserted command."
6102 (or (inferior-erlang-running-p)
6103 (error "No inferior Erlang process is running."))
6104 (let ((old-buffer (current-buffer))
6105 (insert-point (marker-position
6106 (process-mark inferior-erlang-process)))
6107 (insert-length (if comint-process-echoes
6108 0
6109 (1+ (length cmd)))))
6110 (set-buffer inferior-erlang-buffer)
6111 (goto-char insert-point)
6112 (insert cmd)
6113 ;; Strange things happend if `comint-eol-on-send' is declared
6114 ;; in the `let' expression above, but setq:d here. The
6115 ;; `set-buffer' statement obviously makes the buffer local
6116 ;; instance of `comint-eol-on-send' shadow this one.
6117 ;; I'm considering this a bug in Elisp.
6118 (let ((comint-eol-on-send nil)
6119 (comint-input-filter (if hist comint-input-filter 'ignore)))
6120 (comint-send-input))
6121 ;; Adjust all windows whose points are incorrect.
6122 (if (null comint-process-echoes)
6123 (walk-windows
6124 (function
6125 (lambda (window)
6126 (if (and (eq (window-buffer window) inferior-erlang-buffer)
6127 (eq (window-point window) insert-point))
6128 (set-window-point window
6129 (+ insert-point insert-length)))))
6130 nil t))
6131 (set-buffer old-buffer)
6132 (+ insert-point insert-length)))
6133
6134
6135(defun inferior-erlang-strip-delete (&optional s)
6136 "Remove `^H' (delete) and the characters it was supposed to remove."
6137 (interactive)
6138 (if (and (boundp 'comint-last-input-end)
6139 (boundp 'comint-last-output-start))
6140 (save-excursion
6141 (goto-char
6142 (if (interactive-p)
6143 (symbol-value 'comint-last-input-end)
6144 (symbol-value 'comint-last-output-start)))
6145 (while (progn (skip-chars-forward "^\C-h")
6146 (not (eq (point) (point-max))))
6147 (delete-char 1)
6148 (or (bolp)
6149 (backward-delete-char 1))))))
6150
6151
6152;; Basically `comint-strip-ctrl-m', with a few extra checks.
6153(defun inferior-erlang-strip-ctrl-m (&optional string)
6154 "Strip trailing `^M' characters from the current output group."
6155 (interactive)
6156 (if (and (boundp 'comint-last-input-end)
6157 (boundp 'comint-last-output-start))
6158 (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
6159 (save-excursion
6160 (goto-char
6161 (if (interactive-p)
6162 (symbol-value 'comint-last-input-end)
6163 (symbol-value 'comint-last-output-start)))
6164 (while (re-search-forward "\r+$" pmark t)
6165 (replace-match "" t t))))))
6166
6167
6168(defun inferior-erlang-compile ()
6169 "Compile the file in the current buffer.
6170
6171Should Erlang return `{error, nofile}' it could not load the object
6172module after completing the compilation. This is due to a bug in the
6173compile command `c' when using the option `outdir'.
6174
6175There exists two workarounds for this bug:
6176
6177 1) Place the directory in the Erlang load path.
6178
6179 2) Set the Emacs variable `erlang-compile-use-outdir' to nil.
6180 To do so, place the following line in your `~/.emacs'-file:
6181 (setq erlang-compile-use-outdir nil)"
6182 (interactive)
6183 (save-some-buffers)
6184 (or (inferior-erlang-running-p)
6185 (save-excursion
6186 (inferior-erlang)))
6187 (or (inferior-erlang-running-p)
6188 (error "Error starting inferior Erlang shell."))
6189 (let ((dir (file-name-directory (buffer-file-name)))
6190 ;;; (file (file-name-nondirectory (buffer-file-name)))
6191 (noext (substring (buffer-file-name) 0 -4))
6192 ;; Hopefully, noone else will ever use these...
6193 (tmpvar "Tmp7236")
6194 (tmpvar2 "Tmp8742")
6195 end)
6196 (inferior-erlang-display-buffer)
6197 (inferior-erlang-wait-prompt)
6198 (setq end (inferior-erlang-send-command
6199 (if erlang-compile-use-outdir
6200 (format "c(\"%s\", [{outdir, \"%s\"}])." noext dir)
6201 (format
6202 (concat
6203 "f(%s), {ok, %s} = file:get_cwd(), "
6204 "file:set_cwd(\"%s\"), "
6205 "%s = c(\"%s\"), file:set_cwd(%s), f(%s), %s.")
6206 tmpvar2 tmpvar
6207 dir
6208 tmpvar2 noext tmpvar tmpvar tmpvar2))
6209 nil))
6210 (save-excursion
6211 (set-buffer inferior-erlang-buffer)
6212 (setq compilation-error-list nil)
6213 (setq compilation-parsing-end end))
6214 (setq compilation-last-buffer inferior-erlang-buffer)))
6215
6216
6217;; `next-error' only accepts buffers with major mode `compilation-mode'
6218;; or with the minor mode `compilation-minor-mode' activated.
6219;; (To activate the minor mode is out of the question, since it will
6220;; ruin the inferior Erlang keymap.)
6221(defun inferior-erlang-next-error (&optional argp)
6222 "Just like `next-error'.
6223Capable of finding error messages in an inferior Erlang buffer."
6224 (interactive "P")
6225 (let ((done nil)
6226 (buf (and (boundp 'compilation-last-buffer)
6227 compilation-last-buffer)))
6228 (if (and (bufferp buf)
6229 (save-excursion
6230 (set-buffer buf)
6231 (and (eq major-mode 'erlang-shell-mode)
6232 (setq major-mode 'compilation-mode))))
6233 (unwind-protect
6234 (progn
6235 (setq done t)
6236 (next-error argp))
6237 (save-excursion
6238 (set-buffer buf)
6239 (setq major-mode 'erlang-shell-mode))))
6240 (or done
6241 (next-error argp))))
6242
6243
6244(defun inferior-erlang-change-directory (&optional dir)
6245 "Make the inferior erlang change directory.
6246The default is to go to the directory of the current buffer."
6247 (interactive)
6248 (or dir (setq dir (file-name-directory (buffer-file-name))))
6249 (or (inferior-erlang-running-p)
6250 (error "No inferior Erlang is running."))
6251 (inferior-erlang-display-buffer)
6252 (inferior-erlang-wait-prompt)
6253 (inferior-erlang-send-command (format "cd('%s')." dir) nil))
6254
6255;; Aliases for backward compatibility with older versions of Erlang Mode.
6256;;
6257;; Unfortuantely, older versions of Emacs doesn't have `defalias' and
6258;; `make-obsolete' so we have to define our own `obsolete' function.
6259
6260(defun erlang-obsolete (sym newdef)
6261 "Make the obsolete function SYM refer to the defined function NEWDEF.
6262
6263Simplified version of a combination `defalias' and `make-obsolete',
6264it assumes that NEWDEF is loaded."
6265 (fset sym (symbol-function newdef))
6266 (if (fboundp 'make-obsolete)
6267 (make-obsolete sym newdef)))
6268
6269
6270(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent)
6271(erlang-obsolete 'calculate-erlang-stack-indent
6272 'erlang-calculate-stack-indent)
6273(erlang-obsolete 'at-erlang-keyword 'erlang-at-keyword)
6274(erlang-obsolete 'at-erlang-operator 'erlang-at-operator)
6275(erlang-obsolete 'beginning-of-erlang-clause 'erlang-beginning-of-clause)
6276(erlang-obsolete 'end-of-erlang-clause 'erlang-end-of-clause)
6277(erlang-obsolete 'mark-erlang-clause 'erlang-mark-clause)
6278(erlang-obsolete 'beginning-of-erlang-function 'erlang-beginning-of-function)
6279(erlang-obsolete 'end-of-erlang-function 'erlang-end-of-function)
6280(erlang-obsolete 'mark-erlang-function 'erlang-mark-function)
6281(erlang-obsolete 'pass-over-erlang-clause 'erlang-pass-over-function)
6282(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function)
6283
6284
6285;; The end...
6286
6287(provide 'erlang)
6288
6289(run-hooks 'erlang-load-hook)
6290
6291;;; erlang.el ends here