+++ /dev/null
-;;; erlang-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "erlang" "erlang.el" (0 0 0 0))
-;;; Generated autoloads from erlang.el
-
-(autoload 'erlang-mode "erlang" "\
-Major mode for editing Erlang source files in Emacs.
-It knows about syntax and comment, it can indent code, it is capable
-of fontifying the source file, the TAGS commands are aware of Erlang
-modules, and the Erlang man pages can be accessed.
-
-Should this module, \"erlang.el\", be installed properly, Erlang mode
-is activated whenever an Erlang source or header file is loaded into
-Emacs. To indicate this, the mode line should contain the word
-\"Erlang\".
-
-The main feature of Erlang mode is indentation, press TAB and the
-current line will be indented correctly.
-
-Comments starting with only one `%' are indented to the column stored
-in the variable `comment-column'. Comments starting with two `%':s
-are indented with the same indentation as code. Comments starting
-with at least three `%':s are indented to the first column.
-
-However, Erlang mode contains much more, this is a list of the most
-useful commands:
- TAB - Indent the line.
- C-c C-q - Indent current function.
- M-; - Create a comment at the end of the line.
- M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
- will look better.
- M-a - Goto the beginning of an Erlang clause.
- M-C-a - Ditto for function.
- M-e - Goto the end of an Erlang clause.
- M-C-e - Ditto for function.
- M-h - Mark current Erlang clause.
- M-C-h - Ditto for function.
- C-c C-z - Start, or switch to, an inferior Erlang shell.
- C-c C-k - Compile current file.
- C-x ` - Next error.
- , - Electric comma.
- ; - Electric semicolon.
-
-Erlang mode check the name of the file against the module name when
-saving, whenever a mismatch occurs Erlang mode offers to modify the
-source.
-
-The variable `erlang-electric-commands' controls the electric
-commands. To deactivate all of them, set it to nil.
-
-There exists a large number of commands and variables in the Erlang
-module. Please press `M-x apropos RET erlang RET' to see a complete
-list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
-RET'to see the full description of functions and variables,
-respectively.
-
-On entry to this mode the contents of the hook `erlang-mode-hook' is
-executed.
-
-Please see the beginning of the file `erlang.el' for more information
-and examples of hooks.
-
-Other commands:
-\\{erlang-mode-map}
-
-\(fn)" t nil)
-
-(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) (add-to-list 'auto-mode-alist (cons r 'erlang-mode)))
-
-(autoload 'erlang-find-tag "erlang" "\
-Like `find-tag'. Capable of retrieving Erlang modules.
-
-Tags can be given on the forms `tag', `module:', `module:tag'.
-
-\(fn MODTAGNAME &optional NEXT-P REGEXP-P)" t nil)
-
-(autoload 'erlang-find-tag-other-window "erlang" "\
-Like `find-tag-other-window' but aware of Erlang modules.
-
-\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
-
-(autoload 'erlang-shell "erlang" "\
-Start a new Erlang shell.
-
-The variable `erlang-shell-function' decides which method to use,
-default is to start a new Erlang host. It is possible that, in the
-future, a new shell on an already running host will be started." t nil)
- (autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
-
-(autoload 'erlang-compile "erlang" "\
-Compile Erlang module in current buffer." t nil)
-
-(autoload 'inferior-erlang "erlang" "\
-Run an inferior Erlang.
-With prefix command, prompt for command to start Erlang with.
-
-This is just like running Erlang in a normal shell, except that
-an Emacs buffer is used for input and output.
-\\<comint-mode-map>
-The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
-The history is saved between sessions.
-
-Entry to this mode calls the functions in the variables
-`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
-
-The following commands imitate the usual Unix interrupt and
-editing control characters:
-\\{erlang-shell-mode-map}
-
-\(fn &optional COMMAND)" t nil)
-
-(register-definition-prefixes "erlang" '("erlang-" "inferior-erlang-" "run-erlang"))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-edoc" "erlang-edoc.el" (0 0 0 0))
-;;; Generated autoloads from erlang-edoc.el
-
-(autoload 'erlang-edoc-mode "erlang-edoc" "\
-Toggle Erlang-EDoc mode on or off.
-
-This is a minor mode. If called interactively, toggle the
-`Erlang-EDoc mode' mode. If the prefix argument is positive,
-enable the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `erlang-edoc-mode'.
-
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
-
-\\{erlang-edoc-mode-map}
-
-\(fn &optional ARG)" t nil)
-
-(register-definition-prefixes "erlang-edoc" '("erlang-edoc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-eunit" "erlang-eunit.el" (0 0 0 0))
-;;; Generated autoloads from erlang-eunit.el
-
-(register-definition-prefixes "erlang-eunit" '("erlang-e" "filename-join"))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-flymake" "erlang-flymake.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from erlang-flymake.el
-
-(register-definition-prefixes "erlang-flymake" '("erlang-flymake-"))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-skels" "erlang-skels.el" (0 0 0 0))
-;;; Generated autoloads from erlang-skels.el
-
-(register-definition-prefixes "erlang-skels" '("erlang-"))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-skels-old" "erlang-skels-old.el" (0
-;;;;;; 0 0 0))
-;;; Generated autoloads from erlang-skels-old.el
-
-(register-definition-prefixes "erlang-skels-old" '("erlang-"))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-start" "erlang-start.el" (0 0 0 0))
-;;; Generated autoloads from erlang-start.el
-
-(let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist))))
-
-(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
-
-(let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext (add-to-list 'completion-ignored-extensions (car erl-ext)) (when (boundp 'dired-omit-extensions) (add-to-list 'dired-omit-extensions (car erl-ext))) (setq erl-ext (cdr erl-ext))))
-
-;;;***
-\f
-;;;### (autoloads nil "erlang-test" "erlang-test.el" (0 0 0 0))
-;;; Generated autoloads from erlang-test.el
-
-(register-definition-prefixes "erlang-test" '("erlang-"))
-
-;;;***
-\f
-;;;### (autoloads nil "erldoc" "erldoc.el" (0 0 0 0))
-;;; Generated autoloads from erldoc.el
-
-(autoload 'erldoc-browse "erldoc" "\
-
-
-\(fn MFA)" t nil)
-
-(autoload 'erldoc-apropos "erldoc" "\
-
-
-\(fn PATTERN)" t nil)
-
-(autoload 'erldoc-eldoc-function "erldoc" "\
-A function suitable for `eldoc-documentation-function'." nil nil)
-
-(autoload 'erldoc-browse-topic "erldoc" "\
-
-
-\(fn TOPIC)" t nil)
-
-(register-definition-prefixes "erldoc" '("erldoc-"))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("erlang-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; erlang-autoloads.el ends here
+++ /dev/null
-;;; erlang-edoc.el --- EDoc support for Erlang mode -*- lexical-binding: t; -*-
-
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 1996-2020. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-
-;;; Commentary:
-
-;; Ref: http://www.erlang.org/doc/apps/edoc/users_guide.html
-;;
-;; To use: (add-hook 'erlang-mode-hook 'erlang-edoc-mode)
-
-;;; Code:
-
-(defcustom erlang-edoc-indent-level 2
- "Indentation level of xhtml in Erlang edoc."
- :type '(integer)
- :safe 'integerp
- :group 'erlang)
-
-(defvar erlang-edoc-generic-tags
- '("clear" "docfile" "end" "headerfile" "todo" "TODO" "type")
- "Tags that can be used anywhere within a module.")
-
-(defvar erlang-edoc-overview-tags
- '("author" "copyright" "doc" "reference" "see" "since" "title" "version")
- "Tags that can be used in an overview file.")
-
-(defvar erlang-edoc-module-tags
- '("author" "copyright" "deprecated" "doc" "hidden" "private" "reference"
- "see" "since" "version")
- "Tags that can be used before a module declaration.")
-
-(defvar erlang-edoc-function-tags
- '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns"
- "see" "since" "spec" "throws" "type")
- "Tags that can be used before a function definition.")
-
-(defvar erlang-edoc-predefined-macros
- '("date" "docRoot" "link" "module" "package" "section" "time"
- "type" "version"))
-
-(defface erlang-edoc-tag '((t (:inherit font-lock-constant-face)))
- "Face used to highlight edoc tags."
- :group 'erlang)
-
-(defface erlang-edoc-macro '((t (:inherit font-lock-preprocessor-face)))
- "Face used to highlight edoc macros."
- :group 'erlang)
-
-(defface erlang-edoc-verbatim
- '((t (:family "Monospace" :inherit font-lock-keyword-face)))
- "Face used to highlight verbatim text."
- :group 'erlang)
-
-(defface erlang-edoc-todo '((t (:inherit font-lock-warning-face)))
- "Face used to highlight edoc macros."
- :group 'erlang)
-
-(defface erlang-edoc-heading '((t (:inherit bold)))
- "Face used to highlight edoc headings."
- :group 'erlang)
-
-(defvar erlang-edoc-font-lock-keywords
- '(("^%+\\s-*\\(@\\w+\\)\\_>" 1 'erlang-edoc-tag prepend)
- ("^%+\\s-*" ("{\\(@\\w+\\)\\_>" nil nil (1 'erlang-edoc-macro prepend)))
- ("^%+\\s-*" ("\\(?:@@\\)*\\(@[@{}]\\)" nil nil (1 'escape-glyph prepend)))
- ("^%+\\s-*\\(@deprecated\\)\\_>" 1 font-lock-warning-face prepend)
- ;; http://www.erlang.org/doc/apps/edoc/chapter.html#Wiki_notation
- ("^%+\\s-*" ("[^`]`\\([^`]?\\|[^`].*?[^']\\)'"
- (forward-char -1) nil (1 'erlang-edoc-verbatim prepend)))
- ("^%+\\s-*" ("\\[\\(\\(?:https?\\|file\\|ftp\\)://[^][]+\\)\\]"
- nil nil (1 'link prepend)))
- ("^%+\\s-*\\(?:\\(?1:@todo\\|@TODO\\)\\_>\\|\\(?1:TODO\\):\\)"
- 1 'erlang-edoc-todo prepend)
- ("^%+\\s-*\\(\\(=\\{2,4\\}\\)[^=\n].*[^=\n]\\2\\)\\s-*$"
- 1 'erlang-edoc-heading prepend)))
-
-(defun erlang-edoc-xml-context ()
- "Parse edoc x(ht)ml context at comment start of current line."
- (eval-and-compile (require 'xmltok))
- (save-excursion
- (beginning-of-line)
- (when (looking-at "^%+\\s-*")
- (let ((pt (match-end 0)) context)
- (forward-comment (- (point)))
- (while (< (point) pt)
- (xmltok-forward)
- (cond ((eq xmltok-type 'start-tag)
- (push (cons xmltok-type xmltok-start) context))
- ((eq xmltok-type 'end-tag)
- (pop context))))
- (goto-char pt)
- (xmltok-forward)
- (push (car (memq xmltok-type '(start-tag end-tag))) context)
- context))))
-
-(defun erlang-edoc-indent-line ()
- (let ((context (erlang-edoc-xml-context)))
- (when context
- (save-excursion
- (beginning-of-line)
- (re-search-forward "^%+\\s-*" (line-end-position))
- (when (or (car context) (cadr context))
- (let ((pad (when (cadr context)
- (save-excursion
- (goto-char (cdr (cadr context)))
- (- (current-column)
- (progn
- (beginning-of-line)
- (skip-chars-forward "%")
- (current-column)))))))
- (just-one-space (cond ((not pad) 1)
- ((eq (car context) 'end-tag) pad)
- (t (+ erlang-edoc-indent-level pad)))))))
- (when (looking-back "^%*\\s-*" (line-beginning-position))
- (re-search-forward "\\=%*\\s-*")))))
-
-(defun erlang-edoc-before-module-declaration-p ()
- (save-excursion
- (beginning-of-line)
- (forward-comment (point-max))
- (or (eobp) (re-search-forward "^-module\\s-*(" nil t))))
-
-(defun erlang-edoc-completion-at-point ()
- (when (eq (syntax-ppss-context (syntax-ppss)) 'comment)
- (save-excursion
- (skip-syntax-backward "w_")
- (when (= (preceding-char) ?@)
- (let* ((is-tag (looking-back "^%+\\s-*@" (line-beginning-position)))
- (beg (point))
- (end (progn (skip-syntax-forward "w_") (point)))
- (table (cond
- ((not is-tag)
- erlang-edoc-predefined-macros)
- ((erlang-edoc-before-module-declaration-p)
- (append erlang-edoc-module-tags
- erlang-edoc-generic-tags))
- (t (append erlang-edoc-function-tags
- erlang-edoc-generic-tags)))))
- (list beg end table))))))
-
-;;;###autoload
-(define-minor-mode erlang-edoc-mode nil
- :lighter " EDoc"
- (cond (erlang-edoc-mode
- (add-hook 'erlang-indent-line-hook #'erlang-edoc-indent-line nil t)
- (font-lock-add-keywords nil erlang-edoc-font-lock-keywords t)
- (add-hook 'completion-at-point-functions
- #'erlang-edoc-completion-at-point nil t))
- (t
- (remove-hook 'erlang-indent-line-hook #'erlang-edoc-indent-line t)
- (font-lock-remove-keywords nil erlang-edoc-font-lock-keywords)
- (remove-hook 'completion-at-point-functions
- #'erlang-edoc-completion-at-point t)))
- (jit-lock-refontify))
-
-(provide 'erlang-edoc)
-
-;; Local variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-
-;;; erlang-edoc.el ends here
+++ /dev/null
-;;
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 2009-2022. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-;;;
-;;; Purpose: Provide EUnit utilities.
-;;;
-;;; Author: Klas Johansson
-
-(eval-when-compile
- (require 'cl-lib))
-(require 'erlang)
-
-(defvar erlang-eunit-src-candidate-dirs '("../src" ".")
- "*Name of directories which to search for source files matching
-an EUnit test file. The first directory in the list will be used,
-if there is no match.")
-
-(defvar erlang-eunit-test-candidate-dirs '("../test" ".")
- "*Name of directories which to search for EUnit test files matching
-a source file. The first directory in the list will be used,
-if there is no match.")
-
-(defvar erlang-eunit-autosave nil
- "*Set to non-nil to automatically save unsaved buffers before running tests.
-This is useful, reducing the save-compile-load-test cycle to one keychord.")
-
-(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
- "Info about the most recent running of an EUnit test representation.")
-
-(defvar erlang-error-regexp-alist
- '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
- "*Patterns for matching Erlang errors.")
-
-;;;
-;;; Switch between src/EUnit test buffers
-;;;
-(defun erlang-eunit-toggle-src-and-test-file-other-window ()
- "Switch to the src file if the EUnit test file is the current
-buffer and vice versa"
- (interactive)
- (if (erlang-eunit-test-file-p buffer-file-name)
- (erlang-eunit-open-src-file-other-window buffer-file-name)
- (erlang-eunit-open-test-file-other-window buffer-file-name)))
-
-;;;
-;;; Open the EUnit test file which corresponds to a src file
-;;;
-(defun erlang-eunit-open-test-file-other-window (src-file-path)
- "Open the EUnit test file which corresponds to a src file"
- (find-file-other-window (erlang-eunit-test-filename src-file-path)))
-
-;;;
-;;; Open the src file which corresponds to the an EUnit test file
-;;;
-(defun erlang-eunit-open-src-file-other-window (test-file-path)
- "Open the src file which corresponds to the an EUnit test file"
- (find-file-other-window (erlang-eunit-src-filename test-file-path)))
-
-;;; Return the name and path of the EUnit test file
-;;, (input may be either the source filename itself or the EUnit test filename)
-(defun erlang-eunit-test-filename (file-path)
- (if (erlang-eunit-test-file-p file-path)
- file-path
- (erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs)))
-
-;;; Return the name and path of the source file
-;;, (input may be either the source filename itself or the EUnit test filename)
-(defun erlang-eunit-src-filename (file-path)
- (if (erlang-eunit-src-file-p file-path)
- file-path
- (erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs)))
-
-;;; Rewrite a filename from the src or test filename to the other
-(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs)
- (or (erlang-eunit-locate-buddy orig-file-path candidate-dirs)
- (erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs))))
-
-;;; Search for a file's buddy file (a source file's EUnit test file,
-;;; or an EUnit test file's source file) in a list of candidate
-;;; directories.
-(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs)
- (when candidate-dirs
- (let ((buddy-file-path (erlang-eunit-buddy-file-path
- orig-file-path
- (car candidate-dirs))))
- (if (file-readable-p buddy-file-path)
- buddy-file-path
- (erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs))))))
-
-(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name)
- (let* ((orig-dir-name (file-name-directory orig-file-path))
- (buddy-dir-name (file-truename
- (filename-join orig-dir-name buddy-dir-name)))
- (buddy-base-name (erlang-eunit-buddy-basename orig-file-path)))
- (filename-join buddy-dir-name buddy-base-name)))
-
-;;; Return the basename of the buddy file:
-;;; /tmp/foo/src/x.erl --> x_tests.erl
-;;; /tmp/foo/test/x_tests.erl --> x.erl
-(defun erlang-eunit-buddy-basename (file-path)
- (let ((src-module-name (erlang-eunit-source-module-name file-path)))
- (cond
- ((erlang-eunit-src-file-p file-path)
- (concat src-module-name "_tests.erl"))
- ((erlang-eunit-test-file-p file-path)
- (concat src-module-name ".erl")))))
-
-;;; Checks whether a file is a source file or not
-(defun erlang-eunit-src-file-p (file-path)
- (not (erlang-eunit-test-file-p file-path)))
-
-;;; Checks whether a file is a EUnit test file or not
-(defun erlang-eunit-test-file-p (file-path)
- (erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path))
-
-;;; Return the module name of the source file
-;;; /tmp/foo/src/x.erl --> x
-;;; /tmp/foo/test/x_tests.erl --> x
-(defun erlang-eunit-source-module-name (file-path)
- (interactive)
- (let ((module-name (erlang-eunit-module-name file-path)))
- (if (string-match "^\\(.+\\)_tests$" module-name)
- (substring module-name (match-beginning 1) (match-end 1))
- module-name)))
-
-;;; Return the module name of the file
-;;; /tmp/foo/src/x.erl --> x
-;;; /tmp/foo/test/x_tests.erl --> x_tests
-(defun erlang-eunit-module-name (file-path)
- (interactive)
- (file-name-sans-extension (file-name-nondirectory file-path)))
-
-;;; Older emacsen don't have string-match-p.
-(defun erlang-eunit-string-match-p (regexp string &optional start)
- (if (fboundp 'string-match-p) ;; appeared in emacs 23
- (string-match-p regexp string start)
- (save-match-data ;; fallback for earlier versions of emacs
- (string-match regexp string start))))
-
-;;; Join filenames
-(defun filename-join (dir file)
- (if (or (= (elt file 0) ?/)
- (= (car (last (append dir nil))) ?/))
- (concat dir file)
- (concat dir "/" file)))
-
-;;; Get info about the most recent running of EUnit
-(defun erlang-eunit-recent (key)
- (cdr (assq key erlang-eunit-recent-info)))
-
-;;; Record info about the most recent running of EUnit
-;;; Known modes are 'module-mode and 'test-mode
-(defun erlang-eunit-record-recent (mode module test)
- (setcdr (assq 'mode erlang-eunit-recent-info) mode)
- (setcdr (assq 'module erlang-eunit-recent-info) module)
- (setcdr (assq 'test erlang-eunit-recent-info) test))
-
-;;; Record whether the most recent running of EUnit included cover
-;;; compilation
-(defun erlang-eunit-record-recent-compile (under-cover)
- (setcdr (assq 'cover erlang-eunit-recent-info) under-cover))
-
-;;; Determine options for EUnit.
-(defun erlang-eunit-opts ()
- (if current-prefix-arg ", [verbose]" ""))
-
-;;; Determine current test function
-(defun erlang-eunit-current-test ()
- (save-excursion
- (erlang-end-of-function 1)
- (erlang-beginning-of-function 1)
- (erlang-name-of-function)))
-
-(defun erlang-eunit-simple-test-p (test-name)
- (if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil))
-
-(defun erlang-eunit-test-generator-p (test-name)
- (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil))
-
-;;; Run one EUnit test
-(defun erlang-eunit-run-test (module-name test-name)
- (let ((command
- (cond ((erlang-eunit-simple-test-p test-name)
- (format "eunit:test({%s, %s}%s)."
- module-name test-name (erlang-eunit-opts)))
- ((erlang-eunit-test-generator-p test-name)
- (format "eunit:test({generator, %s, %s}%s)."
- module-name test-name (erlang-eunit-opts)))
- (t (format "%% WARNING: '%s' is not a test function" test-name)))))
- (erlang-eunit-record-recent 'test-mode module-name test-name)
- (erlang-eunit-inferior-erlang-send-command command)))
-
-;;; Run EUnit tests for the current module
-(defun erlang-eunit-run-module-tests (module-name)
- (let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts))))
- (erlang-eunit-record-recent 'module-mode module-name nil)
- (erlang-eunit-inferior-erlang-send-command command)))
-
-(defun erlang-eunit-compile-and-run-recent ()
- "Compile the source and test files and repeat the most recent EUnit test run.
-
-With prefix arg, compiles for debug and runs tests with the verbose flag set."
- (interactive)
- (cl-case (erlang-eunit-recent 'mode)
- ('test-mode
- (erlang-eunit-compile-and-test
- 'erlang-eunit-run-test (list (erlang-eunit-recent 'module)
- (erlang-eunit-recent 'test))))
- ('module-mode
- (erlang-eunit-compile-and-test
- 'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module))
- (erlang-eunit-recent 'cover)))
- (t (error "EUnit has not yet been run. Please run a test first."))))
-
-(defun erlang-eunit-cover-compile ()
- "Cover compile current module."
- (interactive)
- (let* ((erlang-compile-extra-opts
- (append (list 'debug_info) erlang-compile-extra-opts))
- (module-name
- (erlang-add-quotes-if-needed
- (erlang-eunit-module-name buffer-file-name)))
- (compile-command
- (format "cover:compile_beam(%s)." module-name)))
- (erlang-compile)
- (if (erlang-eunit-last-compilation-successful-p)
- (erlang-eunit-inferior-erlang-send-command compile-command))))
-
-(defun erlang-eunit-analyze-coverage ()
- "Analyze the data collected by cover tool for the module in the
-current buffer.
-
-Assumes that the module has been cover compiled prior to this
-call. This function will do two things: print the number of
-covered and uncovered functions in the erlang shell and display a
-new buffer called *<module name> coverage* which shows the source
-code along with the coverage analysis results."
- (interactive)
- (let* ((module-name (erlang-add-quotes-if-needed
- (erlang-eunit-module-name buffer-file-name)))
- (tmp-filename (make-temp-file "cover"))
- (analyze-command (format "cover:analyze_to_file(%s, \"%s\"). "
- module-name tmp-filename))
- (buf-name (format "*%s coverage*" module-name)))
- (erlang-eunit-inferior-erlang-send-command analyze-command)
- ;; The purpose of the following snippet is to get the result of the
- ;; analysis from a file into a new buffer (or an old, if one with
- ;; the specified name already exists). Also we want the erlang-mode
- ;; *and* view-mode to be enabled.
- (save-excursion
- (let ((buf (get-buffer-create (format "*%s coverage*" module-name))))
- (set-buffer buf)
- (setq buffer-read-only nil)
- (insert-file-contents tmp-filename nil nil nil t)
- (if (= (buffer-size) 0)
- (kill-buffer buf)
- ;; FIXME: this would be a good place to enable (emacs-mode)
- ;; to get some nice syntax highlighting in the
- ;; coverage report, but it doesn't play well with
- ;; flymake. Leave it off for now.
- (view-buffer buf))))
- (delete-file tmp-filename)))
-
-(defun erlang-eunit-compile-and-run-current-test ()
- "Compile the source and test files and run the current EUnit test.
-
-With prefix arg, compiles for debug and runs tests with the verbose flag set."
- (interactive)
- (let ((module-name (erlang-add-quotes-if-needed
- (erlang-eunit-module-name buffer-file-name)))
- (test-name (erlang-eunit-current-test)))
- (erlang-eunit-compile-and-test
- 'erlang-eunit-run-test (list module-name test-name))))
-
-(defun erlang-eunit-compile-and-run-module-tests ()
- "Compile the source and test files and run all EUnit tests in the module.
-
-With prefix arg, compiles for debug and runs tests with the verbose flag set."
- (interactive)
- (let ((module-name (erlang-add-quotes-if-needed
- (erlang-eunit-source-module-name buffer-file-name))))
- (erlang-eunit-compile-and-test
- 'erlang-eunit-run-module-tests (list module-name))))
-
-;;; Compile source and EUnit test file and finally run EUnit tests for
-;;; the current module
-(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover)
- "Compile the source and test files and run the EUnit test suite.
-
-If under-cover is set to t, the module under test is compile for
-code coverage analysis. If under-cover is left out or not set,
-coverage analysis is disabled. The result of the code coverage
-is both printed to the erlang shell (the number of covered vs
-uncovered functions in a module) and written to a buffer called
-*<module> coverage* (which shows the source code for the module
-and the number of times each line is covered).
-With prefix arg, compiles for debug and runs tests with the verbose flag set."
- (erlang-eunit-record-recent-compile under-cover)
- (let ((src-filename (erlang-eunit-src-filename buffer-file-name))
- (test-filename (erlang-eunit-test-filename buffer-file-name)))
-
- ;; The purpose of out-maneuvering `save-some-buffers', as is done
- ;; below, is to ask the question about saving buffers only once,
- ;; instead of possibly several: one for each file to compile,
- ;; for instance for both x.erl and x_tests.erl.
- (save-some-buffers erlang-eunit-autosave)
- (cl-letf (((symbol-function 'save-some-buffers) #'ignore))
-
- ;; Compilation of the source file is mandatory (the file must
- ;; exist, otherwise the procedure is aborted). Compilation of the
- ;; test file on the other hand, is optional, since eunit tests may
- ;; be placed in the source file instead. Any compilation error
- ;; will prevent the subsequent steps to be run (hence the `and')
- (and (erlang-eunit-compile-file src-filename under-cover)
- (if (file-readable-p test-filename)
- (erlang-eunit-compile-file test-filename)
- t)
- (apply test-fun test-args)
- (if under-cover
- (with-current-buffer (find-file-noselect src-filename)
- (erlang-eunit-analyze-coverage)))))))
-
-(defun erlang-eunit-compile-and-run-module-tests-under-cover ()
- "Compile the source and test files and run the EUnit test suite and measure
-code coverage.
-
-With prefix arg, compiles for debug and runs tests with the verbose flag set."
- (interactive)
- (let ((module-name (erlang-add-quotes-if-needed
- (erlang-eunit-source-module-name buffer-file-name))))
- (erlang-eunit-compile-and-test
- 'erlang-eunit-run-module-tests (list module-name) t)))
-
-(defun erlang-eunit-compile-file (file-path &optional under-cover)
- (if (file-readable-p file-path)
- (with-current-buffer (find-file-noselect file-path)
- ;; In order to run a code coverage analysis on a
- ;; module, we have two options:
- ;;
- ;; * either compile the module with cover:compile instead of the
- ;; regular compiler
- ;;
- ;; * or first compile the module with the regular compiler (but
- ;; *with* debug_info) and then compile it for coverage
- ;; analysis using cover:compile_beam.
- ;;
- ;; We could accomplish the first by changing the
- ;; erlang-compile-erlang-function to cover:compile, but there's
- ;; a risk that that's used for other purposes. Therefore, a
- ;; safer alternative (although with more steps) is to add
- ;; debug_info to the list of compiler options and go for the
- ;; second alternative.
- (if under-cover
- (erlang-eunit-cover-compile)
- (erlang-compile))
- (erlang-eunit-last-compilation-successful-p))
- (let ((msg (format "Could not read %s" file-path)))
- (erlang-eunit-inferior-erlang-send-command
- (format "%% WARNING: %s" msg))
- (error msg))))
-
-(defun erlang-eunit-last-compilation-successful-p ()
- (with-current-buffer inferior-erlang-buffer
- (goto-char compilation-parsing-end)
- (erlang-eunit-all-list-elems-fulfill-p
- (lambda (re) (let ((continue t)
- (result t))
- (while continue ; ignore warnings, stop at errors
- (if (re-search-forward re (point-max) t)
- (if (erlang-eunit-is-compilation-warning)
- t
- (setq result nil)
- (setq continue nil))
- (setq result t)
- (setq continue nil)))
- result))
- (mapcar (lambda (e) (car e)) erlang-error-regexp-alist))))
-
-(defun erlang-eunit-is-compilation-warning ()
- (erlang-eunit-string-match-p
- "[0-9]+: Warning:"
- (buffer-substring (line-beginning-position) (line-end-position))))
-
-(defun erlang-eunit-all-list-elems-fulfill-p (pred list)
- (let ((matches-p t))
- (while (and list matches-p)
- (if (not (funcall pred (car list)))
- (setq matches-p nil))
- (setq list (cdr list)))
- matches-p))
-
-;;; Evaluate a command in an erlang buffer
-(defun erlang-eunit-inferior-erlang-send-command (command)
- "Evaluate a command in an erlang buffer."
- (interactive "P")
- (inferior-erlang-prepare-for-input)
- (inferior-erlang-send-command command)
- (sit-for 0) ;; redisplay
- (inferior-erlang-wait-prompt))
-
-
-;;;====================================================================
-;;; Key bindings
-;;;====================================================================
-
-(defconst erlang-eunit-key-bindings
- '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window)
- ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests)
- ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test)
- ("\C-c\C-el" erlang-eunit-compile-and-run-recent)
- ("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover)
- ("\C-c\C-ev" erlang-eunit-cover-compile)
- ("\C-c\C-ea" erlang-eunit-analyze-coverage)))
-
-(defun erlang-eunit-add-key-bindings ()
- (dolist (binding erlang-eunit-key-bindings)
- (erlang-eunit-bind-key (car binding) (cadr binding))))
-
-(defun erlang-eunit-bind-key (key function)
- (erlang-eunit-ensure-keymap-for-key key)
- (local-set-key key function))
-
-(defun erlang-eunit-ensure-keymap-for-key (key-seq)
- (let ((prefix-keys (butlast (append key-seq nil)))
- (prefix-seq ""))
- (while prefix-keys
- (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys))))
- (setq prefix-keys (cdr prefix-keys))
- (if (not (keymapp (lookup-key (current-local-map) prefix-seq)))
- (local-set-key prefix-seq (make-sparse-keymap))))))
-
-(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings)
-
-
-(provide 'erlang-eunit)
-
-;; Local variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-
-;; erlang-eunit.el ends here
+++ /dev/null
-;; erlang-flymake.el
-;;
-;; Syntax check erlang source code on the fly (integrates with flymake).
-;;
-;; Start using flymake with erlang by putting the following somewhere
-;; in your .emacs file:
-;;
-;; (require 'erlang-flymake)
-;;
-;; Flymake is rather eager and does its syntax checks frequently by
-;; default and if you are bothered by this, you might want to put the
-;; following in your .emacs as well:
-;;
-;; (erlang-flymake-only-on-save)
-;;
-;; There are a couple of variables which control the compilation options:
-;; * erlang-flymake-get-code-path-dirs-function
-;; * erlang-flymake-get-include-dirs-function
-;; * erlang-flymake-extra-opts
-;;
-;; This code is inspired by http://www.emacswiki.org/emacs/FlymakeErlang.
-
-(require 'flymake)
-(eval-when-compile
- (require 'cl-lib))
-
-(defvar erlang-flymake-command
- "erlc"
- "The command that will be used to perform the syntax check")
-
-(defvar erlang-flymake-get-code-path-dirs-function
- 'erlang-flymake-get-code-path-dirs
- "Return a list of ebin directories to add to the code path.")
-
-(defvar erlang-flymake-get-include-dirs-function
- 'erlang-flymake-get-include-dirs
- "Return a list of include directories to add to the compiler options.")
-
-(defvar erlang-flymake-extra-opts
- (list "+warn_unused_import"
- "+warn_shadow_vars"
- "+warn_export_vars"
- "+strong_validation"
- "+report")
- "A list of options that will be passed to the compiler")
-
-(defun erlang-flymake-only-on-save ()
- "Trigger flymake only when the buffer is saved (disables syntax
-check on newline and when there are no changes)."
- (interactive)
- ;; There doesn't seem to be a way of disabling this; set to the
- ;; largest int available as a workaround (most-positive-fixnum
- ;; equates to 8.5 years on my machine, so it ought to be enough ;-) )
- (setq flymake-no-changes-timeout most-positive-fixnum)
- (setq flymake-start-syntax-check-on-newline nil))
-
-
-(defun erlang-flymake-get-code-path-dirs ()
- (list (concat (erlang-flymake-get-app-dir) "ebin")))
-
-(defun erlang-flymake-get-include-dirs ()
- (list (concat (erlang-flymake-get-app-dir) "include")
- (concat (erlang-flymake-get-app-dir) "deps")))
-
-(defun erlang-flymake-get-app-dir ()
- (let ((src-path (file-name-directory (buffer-file-name))))
- (file-name-directory (directory-file-name src-path))))
-
-(defun erlang-flymake-init ()
- (let* ((temp-file
- (cl-letf (((symbol-function 'flymake-get-temp-dir) #'erlang-flymake-temp-dir))
- (flymake-init-create-temp-buffer-copy
- 'flymake-create-temp-with-folder-structure)))
- (code-dir-opts
- (erlang-flymake-flatten
- (mapcar (lambda (dir) (list "-pa" dir))
- (funcall erlang-flymake-get-code-path-dirs-function))))
- (inc-dir-opts
- (erlang-flymake-flatten
- (mapcar (lambda (dir) (list "-I" dir))
- (funcall erlang-flymake-get-include-dirs-function))))
- (compile-opts
- (append inc-dir-opts
- code-dir-opts
- erlang-flymake-extra-opts)))
- (list erlang-flymake-command (append compile-opts (list temp-file)))))
-
-(defun erlang-flymake-temp-dir ()
- ;; Squeeze the user's name in there in order to make sure that files
- ;; for two users who are working on the same computer (like a linux
- ;; box) don't collide
- (format "%s/flymake-%s" temporary-file-directory user-login-name))
-
-(defun erlang-flymake-flatten (list)
- (apply #'append list))
-
-(add-to-list 'flymake-allowed-file-name-masks
- '("\\.erl\\'" erlang-flymake-init))
-(add-hook 'erlang-mode-hook 'flymake-mode)
-
-(provide 'erlang-flymake)
-;; erlang-flymake ends here
+++ /dev/null
-(define-package "erlang" "20220215.1844" "Erlang major mode"
- '((emacs "24.1"))
- :commit "ce4ee6e960ece4193fd3031880f8cfc6b50ee69f" :authors
- '(("Anders Lindgren"))
- :maintainer
- '("Anders Lindgren")
- :keywords
- '("erlang" "languages" "processes"))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 2010-2022. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-;;;
-;;; Purpose: Provide Erlang code skeletons.
-;;; See 'erlang-skel-file' variable.
-
-(defvar erlang-tempo-tags nil
- "Tempo tags for erlang mode")
-
-(defvar erlang-skel
- '(("If" "if" erlang-skel-if)
- ("Case" "case" erlang-skel-case)
- ("Receive" "receive" erlang-skel-receive)
- ("Receive After" "after" erlang-skel-receive-after)
- ("Receive Loop" "loop" erlang-skel-receive-loop)
- ("Module" "module" erlang-skel-module)
- ("Author" "author" erlang-skel-author)
- ()
- ("Small Header" "small-header"
- erlang-skel-small-header erlang-skel-header)
- ("Normal Header" "normal-header"
- erlang-skel-normal-header erlang-skel-header)
- ("Large Header" "large-header"
- erlang-skel-large-header erlang-skel-header)
- ()
- ("Small Server" "small-server"
- erlang-skel-small-server erlang-skel-header)
- ()
- ("Application" "application"
- erlang-skel-application erlang-skel-header)
- ("Supervisor" "supervisor"
- erlang-skel-supervisor erlang-skel-header)
- ("supervisor_bridge" "supervisor-bridge"
- erlang-skel-supervisor-bridge erlang-skel-header)
- ("gen_server" "generic-server"
- erlang-skel-generic-server erlang-skel-header)
- ("gen_event" "gen-event"
- erlang-skel-gen-event erlang-skel-header)
- ("gen_fsm" "gen-fsm"
- erlang-skel-gen-fsm erlang-skel-header)
- ("Library module" "gen-lib"
- erlang-skel-lib erlang-skel-header)
- ("Corba callback" "gen-corba-cb"
- erlang-skel-corba-callback erlang-skel-header)
- ("Small Common Test suite" "ct-test-suite-s"
- erlang-skel-ct-test-suite-s erlang-skel-header)
- ("Large Common Test suite" "ct-test-suite-l"
- erlang-skel-ct-test-suite-l erlang-skel-header)
- ("Erlang TS test suite" "ts-test-suite"
- erlang-skel-ts-test-suite erlang-skel-header)
- )
- "*Description of all skeleton templates.
-Both functions and menu entries will be created.
-
-Each entry in `erlang-skel' should be a list with three or four
-elements, or the empty list.
-
-The first element is the name which shows up in the menu. The second
-is the `tempo' identifier (The string \"erlang-\" will be added in
-front of it). The third is the skeleton descriptor, a variable
-containing `tempo' attributes as described in the function
-`tempo-define-template'. The optional fourth elements denotes a
-function which should be called when the menu is selected.
-
-Functions corresponding to every template will be created. The name
-of the function will be `tempo-template-erlang-X' where `X' is the
-tempo identifier as specified in the second argument of the elements
-in this list.
-
-A list with zero elements means that the a horizontal line should
-be placed in the menu.")
-
-;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH!
-;; What's wrong with that? RFC 822 says it's legal. [sverkerw]
-;; This needs to use the customized value. If that's not sane, things like
-;; add-log will lose anyhow. Avoid it if there _is_ a paren.
-(defvar erlang-skel-mail-address
- (if (or (not user-mail-address) (string-match "(" user-mail-address))
- (concat (user-login-name) "@"
- (or (and (boundp 'mail-host-address)
- mail-host-address)
- (system-name)))
- user-mail-address)
- "Mail address of the user.")
-
-;; Expression templates:
-(defvar erlang-skel-case
- '((erlang-skel-skip-blank) o >
- "case " p " of" n> p "_ ->" n> p "ok" n> "end" p)
- "*The skeleton of a `case' expression.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-if
- '((erlang-skel-skip-blank) o >
- "if" n> p " ->" n> p "ok" n> "end" p)
- "The skeleton of an `if' expression.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-receive
- '((erlang-skel-skip-blank) o >
- "receive" n> p "_ ->" n> p "ok" n> "end" p)
- "*The skeleton of a `receive' expression.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-receive-after
- '((erlang-skel-skip-blank) o >
- "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n>
- p "ok" n> "end" p)
- "*The skeleton of a `receive' expression with an `after' clause.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-receive-loop
- '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n>
- "loop(" p ")" n> "end.")
- "*The skeleton of a simple `receive' loop.
-Please see the function `tempo-define-template'.")
-
-
-;; Attribute templates
-
-(defvar erlang-skel-module
- '(& "-module("
- (erlang-add-quotes-if-needed (erlang-get-module-from-file-name))
- ")." n)
- "*The skeleton of a `module' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-author
- '(& "-author('" erlang-skel-mail-address "')." n)
- "*The skeleton of a `author' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-vc nil
- "*The skeleton template to generate a version control attribute.
-The default is to insert nothing. Example of usage:
-
- (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n)
-
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-export
- '(& "-export([" n> "])." n)
- "*The skeleton of an `export' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-import
- '(& "%%-import(Module, [Function/Arity, ...])." n)
- "*The skeleton of an `import' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-compile nil
- ;; '(& "%%-compile(export_all)." n)
- "*The skeleton of a `compile' attribute.
-Please see the function `tempo-define-template'.")
-
-
-;; Comment templates.
-
-(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy
- "*Function which returns date string.
-Look in the module `time-stamp' for a battery of functions.")
-
-(defvar erlang-skel-copyright-comment '()
- "*The template for a copyright line in the header, normally empty.
-This variable should be bound to a `tempo' template, for example:
- '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n)
-
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-created-comment
- '(& "%%% Created : " (funcall erlang-skel-date-function) " by "
- (user-full-name) " <" erlang-skel-mail-address ">" n)
- "*The template for the \"Created:\" comment line.")
-
-(defvar erlang-skel-author-comment
- '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n)
- "*The template for creating the \"Author:\" line in the header.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-file-comment
- '(& "%%% File : " (file-name-nondirectory buffer-file-name) n)
-"*The template for creating the \"Module:\" line in the header.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-small-header
- '(o (erlang-skel-include erlang-skel-module)
- ;; erlang-skel-author)
- n
- (erlang-skel-include erlang-skel-compile
- ;; erlang-skel-export
- erlang-skel-vc))
- "*The template of a small header without any comments.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-normal-header
- '(o (erlang-skel-include erlang-skel-copyright-comment
- erlang-skel-file-comment
- erlang-skel-author-comment)
- "%%% Description : " p n
- (erlang-skel-include erlang-skel-created-comment) n
- (erlang-skel-include erlang-skel-small-header) n)
- "*The template of a normal header.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-large-header
- '(o (erlang-skel-separator)
- (erlang-skel-include erlang-skel-copyright-comment
- erlang-skel-file-comment
- erlang-skel-author-comment)
- "%%% Description : " p n
- "%%%" n
- (erlang-skel-include erlang-skel-created-comment)
- (erlang-skel-separator)
- (erlang-skel-include erlang-skel-small-header) )
- "*The template of a large header.
-Please see the function `tempo-define-template'.")
-
-
-;; Server templates.
-
-(defvar erlang-skel-small-server
- '((erlang-skel-include erlang-skel-large-header)
- "-export([start/0,init/1])." n n n
- "start() ->" n> "spawn(" (erlang-get-module-from-file-name)
- ", init, [self()])." n n
- "init(From) ->" n>
- "loop(From)." n n
- "loop(From) ->" n>
- "receive" n>
- p "_ ->" n>
- "loop(From)" n>
- "end."
- )
- "*Template of a small server.
-Please see the function `tempo-define-template'.")
-
-;; Behaviour templates.
-
-(defvar erlang-skel-application
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(application)." n n
- "%% Application callbacks" n
- "-export([start/2, stop/1])." n n
- (erlang-skel-double-separator 2)
- "%% Application callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: start(Type, StartArgs) -> {ok, Pid} |" n
- "%% {ok, Pid, State} |" n
- "%% {error, Reason}" n
- "%% Description: This function is called whenever an application " n
- "%% is started using application:start/1,2, and should start the processes" n
- "%% of the application. If the application is structured according to the" n
- "%% OTP design principles as a supervision tree, this means starting the" n
- "%% top supervisor of the tree." n
- (erlang-skel-separator 2)
- "start(_Type, StartArgs) ->" n>
- "case 'TopSupervisor':start_link(StartArgs) of" n>
- "{ok, Pid} -> " n>
- "{ok, Pid};" n>
- "Error ->" n>
- "Error" n>
- "end." n
- n
- (erlang-skel-separator 2)
- "%% Function: stop(State) -> void()" n
- "%% Description: This function is called whenever an application" n
- "%% has stopped. It is intended to be the opposite of Module:start/2 and" n
- "%% should do any necessary cleaning up. The return value is ignored. "n
- (erlang-skel-separator 2)
- "stop(_State) ->" n>
- "ok." n
- n
- (erlang-skel-double-separator 2)
- "%% Internal functions" n
- (erlang-skel-double-separator 2)
- )
- "*The template of an application behaviour.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-supervisor
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(supervisor)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% Supervisor callbacks" n
- "-export([init/1])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- (erlang-skel-double-separator 2)
- "%% API functions" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n
- "%% Description: Starts the supervisor" n
- (erlang-skel-separator 2)
- "start_link() ->" n>
- "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n
- n
- (erlang-skel-double-separator 2)
- "%% Supervisor callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} |" n
- "%% ignore |" n
- "%% {error, Reason}" n
- "%% Description: Whenever a supervisor is started using "n
- "%% supervisor:start_link/[2,3], this function is called by the new process "n
- "%% to find out about restart strategy, maximum restart frequency and child "n
- "%% specifications." n
- (erlang-skel-separator 2)
- "init([]) ->" n>
- "AChild = {'AName',{'AModule',start_link,[]}," n>
- "permanent,2000,worker,['AModule']}," n>
- "{ok,{{one_for_all,0,1}, [AChild]}}." n
- n
- (erlang-skel-double-separator 2)
- "%% Internal functions" n
- (erlang-skel-double-separator 2)
- )
- "*The template of an supervisor behaviour.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-supervisor-bridge
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(supervisor_bridge)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% supervisor_bridge callbacks" n
- "-export([init/1, terminate/2])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator 2)
- "%% API" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n
- "%% Description: Starts the supervisor bridge" n
- (erlang-skel-separator 2)
- "start_link() ->" n>
- "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n
- n
- (erlang-skel-double-separator 2)
- "%% supervisor_bridge callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: init(Args) -> {ok, Pid, State} |" n
- "%% ignore |" n
- "%% {error, Reason} " n
- "%% Description:Creates a supervisor_bridge process, linked to the calling" n
- "%% process, which calls Module:init/1 to start the subsystem. To ensure a" n
- "%% synchronized start-up procedure, this function does not return until" n
- "%% Module:init/1 has returned. " n
- (erlang-skel-separator 2)
- "init([]) ->" n>
- "case 'AModule':start_link() of" n>
- "{ok, Pid} ->" n>
- "{ok, Pid, #state{}};" n>
- "Error ->" n>
- "Error" n>
- "end." n
- n
- (erlang-skel-separator 2)
- "%% Func: terminate(Reason, State) -> void()" n
- "%% Description:This function is called by the supervisor_bridge when it is"n
- "%% about to terminate. It should be the opposite of Module:init/1 and stop"n
- "%% the subsystem and do any necessary cleaning up.The return value is ignored."
- (erlang-skel-separator 2)
- "terminate(Reason, State) ->" n>
- "'AModule':stop()," n>
- "ok." n
- n
- (erlang-skel-double-separator 2)
- "%% Internal functions" n
- (erlang-skel-double-separator 2)
- )
- "*The template of an supervisor_bridge behaviour.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-generic-server
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_server)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% gen_server callbacks" n
- "-export([init/1, handle_call/3, handle_cast/2, "
- "handle_info/2," n>
- "terminate/2, code_change/3])." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator 2)
- "%% API" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n
- "%% Description: Starts the server" n
- (erlang-skel-separator 2)
- "start_link() ->" n>
- "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n
- n
- (erlang-skel-double-separator 2)
- "%% gen_server callbacks" n
- (erlang-skel-double-separator 2)
- n
- (erlang-skel-separator 2)
- "%% Function: init(Args) -> {ok, State} |" n
- "%% {ok, State, Timeout} |" n
- "%% ignore |" n
- "%% {stop, Reason}" n
- "%% Description: Initializes the server" n
- (erlang-skel-separator 2)
- "init([]) ->" n>
- "{ok, #state{}}." n
- n
- (erlang-skel-separator 2)
- "%% Function: "
- "%% handle_call(Request, From, State) -> {reply, Reply, State} |" n
- "%% {reply, Reply, State, Timeout} |" n
- "%% {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, Reply, State} |" n
- "%% {stop, Reason, State}" n
- "%% Description: Handling call messages" n
- (erlang-skel-separator 2)
- "handle_call(_Request, _From, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: handle_cast(Msg, State) -> {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, State}" n
- "%% Description: Handling cast messages" n
-
- (erlang-skel-separator 2)
- "handle_cast(_Msg, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: handle_info(Info, State) -> {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, State}" n
- "%% Description: Handling all non call/cast messages" n
- (erlang-skel-separator 2)
- "handle_info(_Info, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: terminate(Reason, State) -> void()" n
- "%% Description: This function is called by a gen_server when it is about to"n
- "%% terminate. It should be the opposite of Module:init/1 and do any necessary"n
- "%% cleaning up. When it returns, the gen_server terminates with Reason." n
- "%% The return value is ignored." n
-
- (erlang-skel-separator 2)
- "terminate(_Reason, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator 2)
- "%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}" n
- "%% Description: Convert process state when code is changed" n
- (erlang-skel-separator 2)
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator 2)
- "%%% Internal functions" n
- (erlang-skel-separator 2)
- )
- "*The template of a generic server.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-gen-event
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_event)." n
-
- "%% API" n
- "-export([start_link/0, add_handler/0])." n n
-
- "%% gen_event callbacks" n
- "-export([init/1, handle_event/2, handle_call/2, " n>
- "handle_info/2, terminate/2, code_change/3])." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator 2)
- "%% gen_event callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: start_link() -> {ok,Pid} | {error,Error} " n
- "%% Description: Creates an event manager." n
- (erlang-skel-separator 2)
- "start_link() ->" n>
- "gen_event:start_link({local, ?SERVER}). " n
- n
- (erlang-skel-separator 2)
- "%% Function: add_handler() -> ok | {'EXIT',Reason} | term()" n
- "%% Description: Adds an event handler" n
- (erlang-skel-separator 2)
- "add_handler() ->" n>
- "gen_event:add_handler(?SERVER, ?MODULE, [])." n
- n
- (erlang-skel-double-separator 2)
- "%% gen_event callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: init(Args) -> {ok, State}" n
- "%% Description: Whenever a new event handler is added to an event manager,"n
- "%% this function is called to initialize the event handler." n
- (erlang-skel-separator 2)
- "init([]) ->" n>
- "{ok, #state{}}." n
- n
- (erlang-skel-separator 2)
- "%% Function: "n
- "%% handle_event(Event, State) -> {ok, State} |" n
- "%% {swap_handler, Args1, State1, Mod2, Args2} |"n
- "%% remove_handler" n
- "%% Description:Whenever an event manager receives an event sent using"n
- "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for"n
- "%% each installed event handler to handle the event. "n
- (erlang-skel-separator 2)
- "handle_event(_Event, State) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: " n
- "%% handle_call(Request, State) -> {ok, Reply, State} |" n
- "%% {swap_handler, Reply, Args1, State1, "n
- "%% Mod2, Args2} |" n
- "%% {remove_handler, Reply}" n
- "%% Description: Whenever an event manager receives a request sent using"n
- "%% gen_event:call/3,4, this function is called for the specified event "n
- "%% handler to handle the request."n
- (erlang-skel-separator 2)
- "handle_call(_Request, State) ->" n>
- "Reply = ok," n>
- "{ok, Reply, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: " n
- "%% handle_info(Info, State) -> {ok, State} |" n
- "%% {swap_handler, Args1, State1, Mod2, Args2} |" n
- "%% remove_handler" n
- "%% Description: This function is called for each installed event handler when"n
- "%% an event manager receives any other message than an event or a synchronous"n
- "%% request (or a system message)."n
- (erlang-skel-separator 2)
- "handle_info(_Info, State) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: terminate(Reason, State) -> void()" n
- "%% Description:Whenever an event handler is deleted from an event manager,"n
- "%% this function is called. It should be the opposite of Module:init/1 and "n
- "%% do any necessary cleaning up. " n
- (erlang-skel-separator 2)
- "terminate(_Reason, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator 2)
- "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n
- "%% Description: Convert process state when code is changed" n
- (erlang-skel-separator 2)
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator 2)
- "%%% Internal functions" n
- (erlang-skel-separator 2)
- )
- "*The template of a gen_event.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-gen-fsm
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_fsm)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% gen_fsm callbacks" n
- "-export([init/1, state_name/2, state_name/3, handle_event/3," n>
- "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator 2)
- "%% API" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: start_link() -> ok,Pid} | ignore | {error,Error}" n
- "%% Description:Creates a gen_fsm process which calls Module:init/1 to"n
- "%% initialize. To ensure a synchronized start-up procedure, this function" n
- "%% does not return until Module:init/1 has returned. " n
- (erlang-skel-separator 2)
- "start_link() ->" n>
- "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n
- n
- (erlang-skel-double-separator 2)
- "%% gen_fsm callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: init(Args) -> {ok, StateName, State} |" n
- "%% {ok, StateName, State, Timeout} |" n
- "%% ignore |" n
- "%% {stop, StopReason} " n
- "%% Description:Whenever a gen_fsm is started using gen_fsm:start/[3,4] or"n
- "%% gen_fsm:start_link/3,4, this function is called by the new process to "n
- "%% initialize. " n
- (erlang-skel-separator 2)
- "init([]) ->" n>
- "{ok, state_name, #state{}}." n
- n
- (erlang-skel-separator 2)
- "%% Function: "n
- "%% state_name(Event, State) -> {next_state, NextStateName, NextState}|" n
- "%% {next_state, NextStateName, " n
- "%% NextState, Timeout} |" n
- "%% {stop, Reason, NewState}" n
- "%% Description:There should be one instance of this function for each possible"n
- "%% state name. Whenever a gen_fsm receives an event sent using" n
- "%% gen_fsm:send_event/2, the instance of this function with the same name as"n
- "%% the current state name StateName is called to handle the event. It is also "n
- "%% called if a timeout occurs. " n
- (erlang-skel-separator 2)
- "state_name(_Event, State) ->" n>
- "{next_state, state_name, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function:" n
- "%% state_name(Event, From, State) -> {next_state, NextStateName, NextState} |"n
- "%% {next_state, NextStateName, " n
- "%% NextState, Timeout} |" n
- "%% {reply, Reply, NextStateName, NextState}|"n
- "%% {reply, Reply, NextStateName, " n
- "%% NextState, Timeout} |" n
- "%% {stop, Reason, NewState}|" n
- "%% {stop, Reason, Reply, NewState}" n
- "%% Description: There should be one instance of this function for each" n
- "%% possible state name. Whenever a gen_fsm receives an event sent using" n
- "%% gen_fsm:sync_send_event/2,3, the instance of this function with the same"n
- "%% name as the current state name StateName is called to handle the event." n
- (erlang-skel-separator 2)
- "state_name(_Event, _From, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, state_name, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: " n
- "%% handle_event(Event, StateName, State) -> {next_state, NextStateName, "n
- "%% NextState} |" n
- "%% {next_state, NextStateName, "n
- "%% NextState, Timeout} |" n
- "%% {stop, Reason, NewState}" n
- "%% Description: Whenever a gen_fsm receives an event sent using"n
- "%% gen_fsm:send_all_state_event/2, this function is called to handle"n
- "%% the event." n
- (erlang-skel-separator 2)
- "handle_event(_Event, StateName, State) ->" n>
- "{next_state, StateName, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: " n
- "%% handle_sync_event(Event, From, StateName, "n
- "%% State) -> {next_state, NextStateName, NextState} |" n
- "%% {next_state, NextStateName, NextState, " n
- "%% Timeout} |" n
- "%% {reply, Reply, NextStateName, NextState}|" n
- "%% {reply, Reply, NextStateName, NextState, " n
- "%% Timeout} |" n
- "%% {stop, Reason, NewState} |" n
- "%% {stop, Reason, Reply, NewState}" n
- "%% Description: Whenever a gen_fsm receives an event sent using"n
- "%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle"n
- "%% the event."n
- (erlang-skel-separator 2)
- "handle_sync_event(Event, From, StateName, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, StateName, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: " n
- "%% handle_info(Info,StateName,State)-> {next_state, NextStateName, NextState}|" n
- "%% {next_state, NextStateName, NextState, "n
- "%% Timeout} |" n
- "%% {stop, Reason, NewState}" n
- "%% Description: This function is called by a gen_fsm when it receives any"n
- "%% other message than a synchronous or asynchronous event"n
- "%% (or a system message)." n
- (erlang-skel-separator 2)
- "handle_info(_Info, StateName, State) ->" n>
- "{next_state, StateName, State}." n
- n
- (erlang-skel-separator 2)
- "%% Function: terminate(Reason, StateName, State) -> void()" n
- "%% Description:This function is called by a gen_fsm when it is about"n
- "%% to terminate. It should be the opposite of Module:init/1 and do any"n
- "%% necessary cleaning up. When it returns, the gen_fsm terminates with"n
- "%% Reason. The return value is ignored." n
- (erlang-skel-separator 2)
- "terminate(_Reason, _StateName, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator 2)
- "%% Function:" n
- "%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}" n
- "%% Description: Convert process state when code is changed" n
- (erlang-skel-separator 2)
- "code_change(_OldVsn, StateName, State, _Extra) ->" n>
- "{ok, StateName, State}." n
- n
- (erlang-skel-separator 2)
- "%%% Internal functions" n
- (erlang-skel-separator 2)
- )
- "*The template of a gen_fsm.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-lib
- '((erlang-skel-include erlang-skel-large-header)
-
- "%% API" n
- "-export([])." n n
-
- (erlang-skel-double-separator 2)
- "%% API" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: " n
- "%% Description:" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-double-separator 2)
- "%% Internal functions" n
- (erlang-skel-double-separator 2)
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-corba-callback
- '((erlang-skel-include erlang-skel-large-header)
- "%% Include files" n n
-
- "%% API" n
- "-export([])." n n
-
- "%% Corba callbacks" n
- "-export([init/1, terminate/2, code_change/3])." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator 2)
- "%% Corba callbacks" n
- (erlang-skel-double-separator 2)
- (erlang-skel-separator 2)
- "%% Function: init(Args) -> {ok, State} |" n
- "%% {ok, State, Timeout} |" n
- "%% ignore |" n
- "%% {stop, Reason}" n
- "%% Description: Initializes the server" n
- (erlang-skel-separator 2)
- "init([]) ->" n>
- "{ok, #state{}}." n
- n
- (erlang-skel-separator 2)
- "%% Function: terminate(Reason, State) -> void()" n
- "%% Description: Shutdown the server" n
- (erlang-skel-separator 2)
- "terminate(_Reason, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator 2)
- "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n
- "%% Description: Convert process state when code is changed" n
- (erlang-skel-separator 2)
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-double-separator 2)
- "%% Internal functions" n
- (erlang-skel-double-separator 2)
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-ts-test-suite
- '((erlang-skel-include erlang-skel-large-header)
- "%% Note: This directive should only be used in test suites." n
- "-compile(export_all)." n n
-
- "-include_lib(\"common_test/include/ct.hrl\")." n n
-
- (erlang-skel-separator 2)
- "%% TEST SERVER CALLBACK FUNCTIONS" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-separator 2)
- "%% Function: init_per_suite(Config0) -> Config1 | {skip,Reason}" n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the suite." n
- "%%" n
- "%% Description: Initialization before the suite." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- (erlang-skel-separator 2)
- "init_per_suite(Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_suite(Config) -> term()" n
- "%%" n
- "%% Config = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% Description: Cleanup after the suite." n
- (erlang-skel-separator 2)
- "end_per_suite(_Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_testcase(TestCase, Config0) -> Config1 |" n
- "%% {skip,Reason}" n
- "%% TestCase = atom()" n
- "%% Name of the test case that is about to run." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%%" n
- "%% Description: Initialization before each test case." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- (erlang-skel-separator 2)
- "init_per_testcase(_TestCase, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_testcase(TestCase, Config) -> term()" n
- "%%" n
- "%% TestCase = atom()" n
- "%% Name of the test case that is finished." n
- "%% Config = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% Description: Cleanup after each test case." n
- (erlang-skel-separator 2)
- "end_per_testcase(_TestCase, _Config) ->" n >
- "ok."n n
-
- (erlang-skel-separator 2)
- "%% Function: all(Clause) -> Descr | Spec | {skip,Reason}" n
- "%%" n
- "%% Clause = doc | suite" n
- "%% Indicates expected return value." n
- "%% Descr = [string()] | []" n
- "%% String that describes the test suite." n
- "%% Spec = [TestCase]" n
- "%% A test specification." n
- "%% TestCase = ConfCase | atom()" n
- "%% Configuration case, or the name of a test case function." n
- "%% ConfCase = {conf,Init,Spec,End} |" n
- "%% {conf,Properties,Init,Spec,End}" n
- "%% Init = End = {Mod,Func} | Func" n
- "%% Initialization and cleanup function." n
- "%% Mod = Func = atom()" n
- "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
- "%% Execution properties of the test cases (may be combined)." n
- "%% Shuffle = shuffle | {shuffle,Seed}" n
- "%% To get cases executed in random order." n
- "%% Seed = {integer(),integer(),integer()}" n
- "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
- "%% repeat_until_any_ok | repeat_until_any_fail" n
- "%% To get execution of cases repeated." n
- "%% N = integer() | forever" n
- "%% Reason = term()" n
- "%% The reason for skipping the test suite." n
- "%%" n
- "%% Description: Returns a description of the test suite when" n
- "%% Clause == doc, and a test specification (list" n
- "%% of the conf and test cases in the suite) when" n
- "%% Clause == suite." n
- (erlang-skel-separator 2)
- "all(doc) -> " n >
- "[\"Describe the main purpose of this suite\"];" n n
- "all(suite) -> " n >
- "[a_test_case]." n n
- n
- (erlang-skel-separator 2)
- "%% TEST CASES" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-separator 2)
- "%% Function: TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n
- "%%" n
- "%% Arg = doc | suite | Config" n
- "%% Indicates expected behaviour and return value." n
- "%% Config = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Descr = [string()] | []" n
- "%% String that describes the test case." n
- "%% Spec = [tuple()] | []" n
- "%% A test specification, see all/1." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%%" n
- "%% Description: Test case function. Returns a description of the test" n
- "%% case (doc), then returns a test specification (suite)," n
- "%% or performs the actual test (Config)." n
- (erlang-skel-separator 2)
- "a_test_case(doc) -> " n >
- "[\"Describe the main purpose of this test case\"];" n n
- "a_test_case(suite) -> " n >
- "[];" n n
- "a_test_case(Config) when is_list(Config) -> " n >
- "ok." n
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-ct-test-suite-l
- '((erlang-skel-include erlang-skel-large-header)
- "%% Note: This directive should only be used in test suites." n
- "-compile(export_all)." n n
-
- "-include_lib(\"common_test/include/ct.hrl\")." n n
-
- (erlang-skel-separator 2)
- "%% COMMON TEST CALLBACK FUNCTIONS" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-separator 2)
- "%% Function: suite() -> Info" n
- "%%" n
- "%% Info = [tuple()]" n
- "%% List of key/value pairs." n
- "%%" n
- "%% Description: Returns list of tuples to set default properties" n
- "%% for the suite." n
- "%%" n
- "%% Note: The suite/0 function is only meant to be used to return" n
- "%% default data values, not perform any other operations." n
- (erlang-skel-separator 2)
- "suite() ->" n >
- "[{timetrap,{minutes,10}}]." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_suite(Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the suite." n
- "%%" n
- "%% Description: Initialization before the suite." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- (erlang-skel-separator 2)
- "init_per_suite(Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_suite(Config0) -> term() | {save_config,Config1}" n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% Description: Cleanup after the suite." n
- (erlang-skel-separator 2)
- "end_per_suite(_Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_group(GroupName, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%%" n
- "%% GroupName = atom()" n
- "%% Name of the test case group that is about to run." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding configuration data for the group." n
- "%% Reason = term()" n
- "%% The reason for skipping all test cases and subgroups in the group." n
- "%%" n
- "%% Description: Initialization before each test case group." n
- (erlang-skel-separator 2)
- "init_per_group(_GroupName, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_group(GroupName, Config0) ->" n
- "%% term() | {save_config,Config1}" n
- "%%" n
- "%% GroupName = atom()" n
- "%% Name of the test case group that is finished." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding configuration data for the group." n
- "%%" n
- "%% Description: Cleanup after each test case group." n
- (erlang-skel-separator 2)
- "end_per_group(_GroupName, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_testcase(TestCase, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%%" n
- "%% TestCase = atom()" n
- "%% Name of the test case that is about to run." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%%" n
- "%% Description: Initialization before each test case." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- (erlang-skel-separator 2)
- "init_per_testcase(_TestCase, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_testcase(TestCase, Config0) ->" n
- "%% term() | {save_config,Config1} | {fail,Reason}" n
- "%%" n
- "%% TestCase = atom()" n
- "%% Name of the test case that is finished." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for failing the test case." n
- "%%" n
- "%% Description: Cleanup after each test case." n
- (erlang-skel-separator 2)
- "end_per_testcase(_TestCase, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: groups() -> [Group]" n
- "%%" n
- "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
- "%% GroupName = atom()" n
- "%% The name of the group." n
- "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
- "%% Group properties that may be combined." n
- "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
- "%% TestCase = atom()" n
- "%% The name of a test case." n
- "%% Shuffle = shuffle | {shuffle,Seed}" n
- "%% To get cases executed in random order." n
- "%% Seed = {integer(),integer(),integer()}" n
- "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
- "%% repeat_until_any_ok | repeat_until_any_fail" n
- "%% To get execution of cases repeated." n
- "%% N = integer() | forever" n
- "%%" n
- "%% Description: Returns a list of test case group definitions." n
- (erlang-skel-separator 2)
- "groups() ->" n >
- "[]." n n
-
- (erlang-skel-separator 2)
- "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n
- "%%" n
- "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
- "%% GroupName = atom()" n
- "%% Name of a test case group." n
- "%% TestCase = atom()" n
- "%% Name of a test case." n
- "%% Reason = term()" n
- "%% The reason for skipping all groups and test cases." n
- "%%" n
- "%% Description: Returns the list of groups and test cases that" n
- "%% are to be executed." n
- (erlang-skel-separator 2)
- "all() -> " n >
- "[my_test_case]." n n
-
- n
- (erlang-skel-separator 2)
- "%% TEST CASES" n
- (erlang-skel-separator 2)
- n
-
- (erlang-skel-separator 2)
- "%% Function: TestCase() -> Info" n
- "%%" n
- "%% Info = [tuple()]" n
- "%% List of key/value pairs." n
- "%%" n
- "%% Description: Test case info function - returns list of tuples to set" n
- "%% properties for the test case." n
- "%%" n
- "%% Note: This function is only meant to be used to return a list of" n
- "%% values, not perform any other operations." n
- (erlang-skel-separator 2)
- "my_test_case() -> " n >
- "[]." n n
-
- (erlang-skel-separator 2)
- "%% Function: TestCase(Config0) ->" n
- "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
- "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%% Comment = term()" n
- "%% A comment about the test case that will be printed in the html log." n
- "%%" n
- "%% Description: Test case function. (The name of it must be specified in" n
- "%% the all/0 list or in a test case group for the test case" n
- "%% to be executed)." n
- (erlang-skel-separator 2)
- "my_test_case(_Config) -> " n >
- "ok." n
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-ct-test-suite-s
- '((erlang-skel-include erlang-skel-large-header)
- "-compile(export_all)." n n
-
- "-include_lib(\"common_test/include/ct.hrl\")." n n
-
- (erlang-skel-separator 2)
- "%% Function: suite() -> Info" n
- "%% Info = [tuple()]" n
- (erlang-skel-separator 2)
- "suite() ->" n >
- "[{timetrap,{seconds,30}}]." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_suite(Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator 2)
- "init_per_suite(Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_suite(Config0) -> term() | {save_config,Config1}" n
- "%% Config0 = Config1 = [tuple()]" n
- (erlang-skel-separator 2)
- "end_per_suite(_Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_group(GroupName, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%% GroupName = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator 2)
- "init_per_group(_GroupName, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_group(GroupName, Config0) ->" n
- "%% term() | {save_config,Config1}" n
- "%% GroupName = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- (erlang-skel-separator 2)
- "end_per_group(_GroupName, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: init_per_testcase(TestCase, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%% TestCase = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator 2)
- "init_per_testcase(_TestCase, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator 2)
- "%% Function: end_per_testcase(TestCase, Config0) ->" n
- "%% term() | {save_config,Config1} | {fail,Reason}" n
- "%% TestCase = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator 2)
- "end_per_testcase(_TestCase, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator 2)
- "%% Function: groups() -> [Group]" n
- "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
- "%% GroupName = atom()" n
- "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
- "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
- "%% TestCase = atom()" n
- "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n
- "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
- "%% repeat_until_any_ok | repeat_until_any_fail" n
- "%% N = integer() | forever" n
- (erlang-skel-separator 2)
- "groups() ->" n >
- "[]." n n
-
- (erlang-skel-separator 2)
- "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n
- "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
- "%% GroupName = atom()" n
- "%% TestCase = atom()" n
- "%% Reason = term()" n
- (erlang-skel-separator 2)
- "all() -> " n >
- "[my_test_case]." n n
-
- (erlang-skel-separator 2)
- "%% Function: TestCase() -> Info" n
- "%% Info = [tuple()]" n
- (erlang-skel-separator 2)
- "my_test_case() -> " n >
- "[]." n n
-
- (erlang-skel-separator 2)
- "%% Function: TestCase(Config0) ->" n
- "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
- "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- "%% Comment = term()" n
- (erlang-skel-separator 2)
- "my_test_case(_Config) -> " n >
- "ok." n
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
+++ /dev/null
-;;
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 2010-2020. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-;;;
-;;; Purpose: Provide Erlang code skeletons.
-;;; See 'erlang-skel-file' variable.
-
-(defvar erlang-tempo-tags nil
- "Tempo tags for erlang mode")
-
-(defvar erlang-skel
- '(("If" "if" erlang-skel-if)
- ("Case" "case" erlang-skel-case)
- ("Receive" "receive" erlang-skel-receive)
- ("Receive After" "after" erlang-skel-receive-after)
- ("Receive Loop" "loop" erlang-skel-receive-loop)
- ("Module" "module" erlang-skel-module)
- ("Author" "author" erlang-skel-author)
- ("Function" "function" erlang-skel-function)
- ("Spec" "spec" erlang-skel-spec)
- ()
- ("Small Header" "small-header"
- erlang-skel-small-header erlang-skel-header)
- ("Normal Header" "normal-header"
- erlang-skel-normal-header erlang-skel-header)
- ("Large Header" "large-header"
- erlang-skel-large-header erlang-skel-header)
- ()
- ("Small Server" "small-server"
- erlang-skel-small-server erlang-skel-header)
- ()
- ("Application" "application"
- erlang-skel-application erlang-skel-header)
- ("Supervisor" "supervisor"
- erlang-skel-supervisor erlang-skel-header)
- ("supervisor_bridge" "supervisor-bridge"
- erlang-skel-supervisor-bridge erlang-skel-header)
- ("gen_server" "generic-server"
- erlang-skel-generic-server erlang-skel-header)
- ("gen_event" "gen-event"
- erlang-skel-gen-event erlang-skel-header)
- ("gen_fsm" "gen-fsm"
- erlang-skel-gen-fsm erlang-skel-header)
- ("gen_statem (StateName/3)" "gen-statem-StateName"
- erlang-skel-gen-statem-StateName erlang-skel-header)
- ("gen_statem (handle_event/4)" "gen-statem-handle-event"
- erlang-skel-gen-statem-handle-event erlang-skel-header)
- ("wx_object" "wx-object"
- erlang-skel-wx-object erlang-skel-header)
- ("Library module" "gen-lib"
- erlang-skel-lib erlang-skel-header)
- ("Corba callback" "gen-corba-cb"
- erlang-skel-corba-callback erlang-skel-header)
- ("Small Common Test suite" "ct-test-suite-s"
- erlang-skel-ct-test-suite-s erlang-skel-header)
- ("Large Common Test suite" "ct-test-suite-l"
- erlang-skel-ct-test-suite-l erlang-skel-header)
- ("Erlang TS test suite" "ts-test-suite"
- erlang-skel-ts-test-suite erlang-skel-header)
- )
- "*Description of all skeleton templates.
-Both functions and menu entries will be created.
-
-Each entry in `erlang-skel' should be a list with three or four
-elements, or the empty list.
-
-The first element is the name which shows up in the menu. The second
-is the `tempo' identifier (The string \"erlang-\" will be added in
-front of it). The third is the skeleton descriptor, a variable
-containing `tempo' attributes as described in the function
-`tempo-define-template'. The optional fourth elements denotes a
-function which should be called when the menu is selected.
-
-Functions corresponding to every template will be created. The name
-of the function will be `tempo-template-erlang-X' where `X' is the
-tempo identifier as specified in the second argument of the elements
-in this list.
-
-A list with zero elements means that the a horizontal line should
-be placed in the menu.")
-
-(defvar erlang-skel-use-separators t
- "A boolean than determines whether the skeletons include horizontal
-separators.
-
-Should this variable be nil, the documentation for functions will not
-include separators of the form %%--...")
-
-;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH!
-;; What's wrong with that? RFC 822 says it's legal. [sverkerw]
-;; This needs to use the customized value. If that's not sane, things like
-;; add-log will lose anyhow. Avoid it if there _is_ a paren.
-(defvar erlang-skel-mail-address
- (if (or (not user-mail-address) (string-match "(" user-mail-address))
- (concat (user-login-name) "@"
- (or (and (boundp 'mail-host-address)
- mail-host-address)
- (system-name)))
- user-mail-address)
- "Mail address of the user.")
-
-;; Expression templates:
-(defvar erlang-skel-case
- '((erlang-skel-skip-blank) o >
- "case " p " of" n> p "_ ->" n> p "ok" n "end" > p)
- "*The skeleton of a `case' expression.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-if
- '((erlang-skel-skip-blank) o >
- "if" n> p " ->" n> p "ok" n "end" > p)
- "The skeleton of an `if' expression.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-receive
- '((erlang-skel-skip-blank) o >
- "receive" n> p "_ ->" n> p "ok" n "end" > p)
- "*The skeleton of a `receive' expression.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-receive-after
- '((erlang-skel-skip-blank) o >
- "receive" n> p "_ ->" n> p "ok" n "after " > p "T ->" n>
- p "ok" n "end" > p)
- "*The skeleton of a `receive' expression with an `after' clause.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-receive-loop
- '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n>
- "loop(" p ")" n "end." >)
- "*The skeleton of a simple `receive' loop.
-Please see the function `tempo-define-template'.")
-
-
-(defvar erlang-skel-function
- '((erlang-skel-separator-start 2)
- "%% @doc" n
- "%% @spec" n
- (erlang-skel-separator-end 2))
- "*The template of a function skeleton.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-spec
- '("-spec " (erlang-skel-get-function-name) "(" (erlang-skel-get-function-args) ") -> undefined.")
- "*The template of a -spec for the function following point.
-Please see the function `tempo-define-template'.")
-
-;; Attribute templates
-
-(defvar erlang-skel-module
- '(& "-module("
- (erlang-add-quotes-if-needed (erlang-get-module-from-file-name))
- ")." n)
- "*The skeleton of a `module' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-author
- '(& "-author('" erlang-skel-mail-address "')." n)
- "*The skeleton of a `author' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-vc nil
- "*The skeleton template to generate a version control attribute.
-The default is to insert nothing. Example of usage:
-
- (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n)
-
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-export
- '(& "-export([" n> "])." n)
- "*The skeleton of an `export' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-import
- '(& "%%-import(Module, [Function/Arity, ...])." n)
- "*The skeleton of an `import' attribute.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-compile nil
- ;; '(& "%%-compile(export_all)." n)
- "*The skeleton of a `compile' attribute.
-Please see the function `tempo-define-template'.")
-
-
-;; Comment templates.
-
-(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy
- "*Function which returns date string.
-Look in the module `time-stamp' for a battery of functions.")
-
-(defvar erlang-skel-copyright-comment
- (if (boundp '*copyright-organization*)
- '(& "%%% @copyright (C) " (format-time-string "%Y") ", "
- *copyright-organization* n)
- '(& "%%% @copyright (C) " (format-time-string "%Y") ", "
- (user-full-name) n))
- "*The template for a copyright line in the header, normally empty.
-This variable should be bound to a `tempo' template, for example:
- '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n)
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-created-comment
- '(& "%%% Created : " (funcall erlang-skel-date-function) " by "
- (user-full-name) " <" erlang-skel-mail-address ">" n)
- "*The template for the \"Created:\" comment line.")
-
-(defvar erlang-skel-author-comment
- '(& "%%% @author " (user-full-name) " <" erlang-skel-mail-address ">" n)
- "*The template for creating the \"Author:\" line in the header.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-small-header
- '(o (erlang-skel-include erlang-skel-module)
- n
- (erlang-skel-include erlang-skel-compile erlang-skel-vc))
- "*The template of a small header without any comments.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-normal-header
- '(o (erlang-skel-include erlang-skel-author-comment)
- (erlang-skel-include erlang-skel-copyright-comment)
- "%%% @doc" n
- "%%%" p n
- "%%% @end" n
- (erlang-skel-include erlang-skel-created-comment) n
- (erlang-skel-include erlang-skel-small-header) n)
- "*The template of a normal header.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-large-header
- '(o (erlang-skel-separator)
- (erlang-skel-include erlang-skel-author-comment)
- (erlang-skel-include erlang-skel-copyright-comment)
- "%%% @doc" n
- "%%%" p n
- "%%% @end" n
- (erlang-skel-include erlang-skel-created-comment)
- (erlang-skel-separator)
- (erlang-skel-include erlang-skel-small-header) )
- "*The template of a large header.
-Please see the function `tempo-define-template'.")
-
-
- ;; Server templates.
-(defvar erlang-skel-small-server
- '((erlang-skel-include erlang-skel-large-header)
- "-export([start/0, init/1])." n n n
- "start() ->" n> "spawn(" (erlang-get-module-from-file-name)
- ", init, [self()])." n n
- "init(From) ->" n>
- "loop(From)." n n
- "loop(From) ->" n>
- "receive" n>
- p "_ ->" n>
- "loop(From)" n
- "end." > n
- )
- "*Template of a small server.
-Please see the function `tempo-define-template'.")
-
-;; Behaviour templates.
-(defvar erlang-skel-application
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(application)." n n
- "%% Application callbacks" n
- "-export([start/2, start_phase/3, stop/1, prep_stop/1," n>
- "config_change/3])." n n
- (erlang-skel-double-separator-start 3)
- "%%% Application callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called whenever an application is started using" n
- "%% application:start/[1,2], and should start the processes of the" n
- "%% application. If the application is structured according to the OTP" n
- "%% design principles as a supervision tree, this means starting the" n
- "%% top supervisor of the tree." n
- (erlang-skel-separator-end 2)
- "-spec start(StartType :: normal |" n>
- "{takeover, Node :: node()} |" n>
- "{failover, Node :: node()}," n>
- "StartArgs :: term()) ->" n>
- "{ok, Pid :: pid()} |" n>
- "{ok, Pid :: pid(), State :: term()} |" n>
- "{error, Reason :: term()}." n
- "start(_StartType, _StartArgs) ->" n>
- "case 'TopSupervisor':start_link() of" n>
- "{ok, Pid} ->" n>
- "{ok, Pid};" n>
- "Error ->" n>
- "Error" n
- "end." > n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% top supervisor of the tree." n
- "%% Starts an application with included applications, when" n
- "%% synchronization is needed between processes in the different" n
- "%% applications during startup."
- (erlang-skel-separator-end 2)
- "-spec start_phase(Phase :: atom()," n>
- "StartType :: normal |" n>
- "{takeover, Node :: node()} |" n>
- "{failover, Node :: node()}," n>
- "PhaseArgs :: term()) -> ok | {error, Reason :: term()}." n
- "start_phase(_Phase, _StartType, _PhaseArgs) ->" n>
- "ok."n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called whenever an application has stopped. It" n
- "%% is intended to be the opposite of Module:start/2 and should do" n
- "%% any necessary cleaning up. The return value is ignored." n
- (erlang-skel-separator-end 2)
- "-spec stop(State :: term()) -> any()." n
- "stop(_State) ->" n>
- "ok." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called when an application is about to be stopped," n
- "%% before shutting down the processes of the application." n
- (erlang-skel-separator-end 2)
- "-spec prep_stop(State :: term()) -> NewState :: term()." n
- "prep_stop(State) ->" n>
- "State." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by an application after a code replacement," n
- "%% if the configuration parameters have changed." n
- (erlang-skel-separator-end 2)
- "-spec config_change(Changed :: [{Par :: atom(), Val :: term()}]," n>
- "New :: [{Par :: atom(), Val :: term()}]," n>
- "Removed :: [Par :: atom()]) -> ok." n
- "config_change(_Changed, _New, _Removed) ->" n>
- "ok." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of an application behaviour.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-supervisor
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(supervisor)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% Supervisor callbacks" n
- "-export([init/1])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API functions" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Starts the supervisor" n
- (erlang-skel-separator-end 2)
- "-spec start_link() -> {ok, Pid :: pid()} |" n>
- "{error, {already_started, Pid :: pid()}} |" n>
- "{error, {shutdown, term()}} |" n>
- "{error, term()} |" n>
- "ignore." n
- "start_link() ->" n>
- "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Supervisor callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a supervisor is started using supervisor:start_link/[2,3]," n
- "%% this function is called by the new process to find out about" n
- "%% restart strategy, maximum restart intensity, and child" n
- "%% specifications." n
- (erlang-skel-separator-end 2)
- "-spec init(Args :: term()) ->" n>
- "{ok, {SupFlags :: supervisor:sup_flags()," n>
- "[ChildSpec :: supervisor:child_spec()]}} |" n>
- "ignore." n
- "init([]) ->" n
- "" n>
- "SupFlags = #{strategy => one_for_one," n>
- "intensity => 1," n>
- "period => 5}," n
- "" n>
- "AChild = #{id => 'AName'," n>
- "start => {'AModule', start_link, []}," n>
- "restart => permanent," n>
- "shutdown => 5000," n>
- "type => worker," n>
- "modules => ['AModule']}," n
- "" n>
- "{ok, {SupFlags, [AChild]}}." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a supervisor behaviour.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-supervisor-bridge
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(supervisor_bridge)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% supervisor_bridge callbacks" n
- "-export([init/1, terminate/2])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Starts the supervisor bridge" n
- (erlang-skel-separator-end 2)
- "-spec start_link() -> {ok, Pid :: pid()} |" n>
- "{error, {already_started, Pid :: pid()}} |" n>
- "{error, term()} |" n>
- "ignore." n
- "start_link() ->" n>
- "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% supervisor_bridge callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Creates a supervisor_bridge process, linked to the calling process," n
- "%% which calls Module:init/1 to start the subsystem. To ensure a" n
- "%% synchronized start-up procedure, this function does not return" n
- "%% until Module:init/1 has returned." n
- (erlang-skel-separator-end 2)
- "-spec init(Args :: term()) -> {ok, Pid :: pid(), State :: term()} |" n>
- "{error, Error :: term()} |" n>
- "ignore." n
- "init([]) ->" n>
- "case 'AModule':start_link() of" n>
- "{ok, Pid} ->" n>
- "{ok, Pid, #state{}};" n>
- "Error ->" n>
- "Error" n
- "end." > n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by the supervisor_bridge when it is about" n
- "%% to terminate. It should be the opposite of Module:init/1 and stop" n
- "%% the subsystem and do any necessary cleaning up.The return value is" n
- "%% ignored." n
- (erlang-skel-separator-end 2)
- "-spec terminate(Reason :: shutdown | term(), State :: term()) -> any()." n
- "terminate(_Reason, _State) ->" n>
- "'AModule':stop()," n>
- "ok." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a supervisor_bridge behaviour.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-generic-server
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_server)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% gen_server callbacks" n
- "-export([init/1, handle_call/3, handle_cast/2, handle_info/2," n>
- "terminate/2, code_change/3, format_status/2])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Starts the server" n
- (erlang-skel-separator-end 2)
- "-spec start_link() -> {ok, Pid :: pid()} |" n>
- "{error, Error :: {already_started, pid()}} |" n>
- "{error, Error :: term()} |" n>
- "ignore." n
- "start_link() ->" n>
- "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% gen_server callbacks" n
- (erlang-skel-double-separator-end 3)
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Initializes the server" n
- (erlang-skel-separator-end 2)
- "-spec init(Args :: term()) -> {ok, State :: term()} |" n>
- "{ok, State :: term(), Timeout :: timeout()} |" n>
- "{ok, State :: term(), hibernate} |" n>
- "{stop, Reason :: term()} |" n>
- "ignore." n
- "init([]) ->" n>
- "process_flag(trap_exit, true)," n>
- "{ok, #state{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling call messages" n
- (erlang-skel-separator-end 2)
- "-spec handle_call(Request :: term(), From :: {pid(), term()}, State :: term()) ->" n>
- "{reply, Reply :: term(), NewState :: term()} |" n>
- "{reply, Reply :: term(), NewState :: term(), Timeout :: timeout()} |" n>
- "{reply, Reply :: term(), NewState :: term(), hibernate} |" n>
- "{noreply, NewState :: term()} |" n>
- "{noreply, NewState :: term(), Timeout :: timeout()} |" n>
- "{noreply, NewState :: term(), hibernate} |" n>
- "{stop, Reason :: term(), Reply :: term(), NewState :: term()} |" n>
- "{stop, Reason :: term(), NewState :: term()}." n
- "handle_call(_Request, _From, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling cast messages" n
- (erlang-skel-separator-end 2)
- "-spec handle_cast(Request :: term(), State :: term()) ->" n>
- "{noreply, NewState :: term()} |" n>
- "{noreply, NewState :: term(), Timeout :: timeout()} |" n>
- "{noreply, NewState :: term(), hibernate} |" n>
- "{stop, Reason :: term(), NewState :: term()}." n
- "handle_cast(_Request, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling all non call/cast messages" n
- (erlang-skel-separator-end 2)
- "-spec handle_info(Info :: timeout() | term(), State :: term()) ->" n>
- "{noreply, NewState :: term()} |" n>
- "{noreply, NewState :: term(), Timeout :: timeout()} |" n>
- "{noreply, NewState :: term(), hibernate} |" n>
- "{stop, Reason :: normal | term(), NewState :: term()}." n
- "handle_info(_Info, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by a gen_server when it is about to" n
- "%% terminate. It should be the opposite of Module:init/1 and do any" n
- "%% necessary cleaning up. When it returns, the gen_server terminates" n
- "%% with Reason. The return value is ignored." n
- (erlang-skel-separator-end 2)
- "-spec terminate(Reason :: normal | shutdown | {shutdown, term()} | term()," n>
- "State :: term()) -> any()." n
- "terminate(_Reason, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- (erlang-skel-separator-end 2)
- "-spec code_change(OldVsn :: term() | {down, term()}," n>
- "State :: term()," n>
- "Extra :: term()) -> {ok, NewState :: term()} |" n>
- "{error, Reason :: term()}." n
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called for changing the form and appearance" n
- "%% of gen_server status when it is returned from sys:get_status/1,2" n
- "%% or when it appears in termination error logs." n
- (erlang-skel-separator-end 2)
- "-spec format_status(Opt :: normal | terminate," n>
- "Status :: list()) -> Status :: term()." n
- "format_status(_Opt, Status) ->" n>
- "Status." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a generic server.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-gen-event
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_event)." n n
-
- "%% API" n
- "-export([start_link/0, add_handler/0])." n n
-
- "%% gen_event callbacks" n
- "-export([init/1, handle_event/2, handle_call/2, handle_info/2," n>
- "terminate/2, code_change/3, format_status/2])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Creates an event manager" n
- (erlang-skel-separator-end 2)
- "-spec start_link() -> {ok, Pid :: pid()} |" n>
- "{error, Error :: {already_started, pid()} | term()}." n
- "start_link() ->" n>
- "gen_event:start_link({local, ?SERVER})." n
- n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Adds an event handler" n
- (erlang-skel-separator-end 2)
- "-spec add_handler() -> ok | {'EXIT', Reason :: term()} | term()." n
- "add_handler() ->" n>
- "gen_event:add_handler(?SERVER, ?MODULE, [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% gen_event callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a new event handler is added to an event manager," n
- "%% this function is called to initialize the event handler." n
- (erlang-skel-separator-end 2)
- "-spec init(Args :: term() | {Args :: term(), Term :: term()}) ->" n>
- "{ok, State :: term()} |" n>
- "{ok, State :: term(), hibernate} |" n>
- "{error, Reason :: term()}." n
- "init([]) ->" n>
- "{ok, #state{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever an event manager receives an event sent using" n
- "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is" n
- "%% called for each installed event handler to handle the event." n
- (erlang-skel-separator-end 2)
- "-spec handle_event(Event :: term(), State :: term()) ->" n>
- "{ok, NewState :: term()} |" n>
- "{ok, NewState :: term(), hibernate} |" n>
- "remove_handler |" n>
- "{swap_handler, Args1 :: term(), NewState :: term()," n>
- "Handler2 :: atom() | {atom(), term()} , Args2 :: term()}." n>
- "handle_event(_Event, State) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever an event manager receives a request sent using" n
- "%% gen_event:call/3,4, this function is called for the specified" n
- "%% event handler to handle the request." n
- (erlang-skel-separator-end 2)
- "-spec handle_call(Request :: term(), State :: term()) ->" n>
- "{ok, Reply :: term(), NewState :: term()} |" n>
- "{ok, Reply :: term(), NewState :: term(), hibernate} |" n>
- "{remove_handler, Reply :: term()} |" n>
- "{swap_handler, Reply :: term(), Args1 :: term(), NewState :: term()," n>
- "Handler2 :: atom() | {atom(), term()}, Args2 :: term()}." n
- "handle_call(_Request, State) ->" n>
- "Reply = ok," n>
- "{ok, Reply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called for each installed event handler when" n
- "%% an event manager receives any other message than an event or a" n
- "%% synchronous request (or a system message)." n
- (erlang-skel-separator-end 2)
- "-spec handle_info(Info :: term(), State :: term()) ->" n>
- "{ok, NewState :: term()} |" n>
- "{ok, NewState :: term(), hibernate} |" n>
- "remove_handler |" n>
- "{swap_handler, Args1 :: term(), NewState :: term()," n>
- "Handler2 :: atom() | {atom(), term()}, Args2 :: term()}." n
- "handle_info(_Info, State) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever an event handler is deleted from an event manager, this" n
- "%% function is called. It should be the opposite of Module:init/1 and" n
- "%% do any necessary cleaning up." n
- (erlang-skel-separator-end 2)
- "-spec terminate(Arg :: {stop, Reason :: term()} |" n>
- "stop |" n>
- "remove_handler |" n>
- "{error, {'EXIT', Reason :: term()}} |" n>
- "{error, Term :: term()} |" n>
- "term()," n>
- "State :: term()) -> any()." n
- "terminate(_Arg, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- (erlang-skel-separator-end 2)
- "-spec code_change(OldVsn :: term() | {down, term()}," n>
- "State :: term()," n>
- "Extra :: term()) -> {ok, NewState :: term()}." n
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called for changing the form and appearance" n
- "%% of gen_event status when it is returned from sys:get_status/1,2" n
- "%% or when it appears in termination error logs." n
- (erlang-skel-separator-end 2)
- "-spec format_status(Opt :: normal | terminate," n>
- "Status :: list()) -> Status :: term()." n
- "format_status(_Opt, Status) ->" n>
- "Status." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a gen_event.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-gen-fsm
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_fsm)." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% gen_fsm callbacks" n
- "-export([init/1, state_name/2, state_name/3, handle_event/3," n>
- "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n
-
- "-define(SERVER, ?MODULE)." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Creates a gen_fsm process which calls Module:init/1 to" n
- "%% initialize. To ensure a synchronized start-up procedure, this" n
- "%% function does not return until Module:init/1 has returned." n
- "%%" n
- "%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}" n
- (erlang-skel-separator-end 2)
- "start_link() ->" n>
- "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% gen_fsm callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a gen_fsm is started using gen_fsm:start/[3,4] or" n
- "%% gen_fsm:start_link/[3,4], this function is called by the new" n
- "%% process to initialize." n
- "%%" n
- "%% @spec init(Args) -> {ok, StateName, State} |" n
- "%% {ok, StateName, State, Timeout} |" n
- "%% ignore |" n
- "%% {stop, StopReason}" n
- (erlang-skel-separator-end 2)
- "init([]) ->" n>
- "process_flag(trap_exit, true)," n>
- "{ok, state_name, #state{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% There should be one instance of this function for each possible" n
- "%% state name. Whenever a gen_fsm receives an event sent using" n
- "%% gen_fsm:send_event/2, the instance of this function with the same" n
- "%% name as the current state name StateName is called to handle" n
- "%% the event. It is also called if a timeout occurs." n
- "%%" n
- "%% @spec state_name(Event, State) ->" n
- "%% {next_state, NextStateName, NextState} |" n
- "%% {next_state, NextStateName, NextState, Timeout} |" n
- "%% {stop, Reason, NewState}" n
- (erlang-skel-separator-end 2)
- "state_name(_Event, State) ->" n>
- "{next_state, state_name, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% There should be one instance of this function for each possible" n
- "%% state name. Whenever a gen_fsm receives an event sent using" n
- "%% gen_fsm:sync_send_event/[2,3], the instance of this function with" n
- "%% the same name as the current state name StateName is called to" n
- "%% handle the event." n
- "%%" n
- "%% @spec state_name(Event, From, State) ->" n
- "%% {next_state, NextStateName, NextState} |"n
- "%% {next_state, NextStateName, NextState, Timeout} |" n
- "%% {reply, Reply, NextStateName, NextState} |" n
- "%% {reply, Reply, NextStateName, NextState, Timeout} |" n
- "%% {stop, Reason, NewState} |" n
- "%% {stop, Reason, Reply, NewState}" n
- (erlang-skel-separator-end 2)
- "state_name(_Event, _From, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, state_name, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a gen_fsm receives an event sent using" n
- "%% gen_fsm:send_all_state_event/2, this function is called to handle" n
- "%% the event." n
- "%%" n
- "%% @spec handle_event(Event, StateName, State) ->" n
- "%% {next_state, NextStateName, NextState} |" n
- "%% {next_state, NextStateName, NextState, Timeout} |" n
- "%% {stop, Reason, NewState}" n
- (erlang-skel-separator-end 2)
- "handle_event(_Event, StateName, State) ->" n>
- "{next_state, StateName, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a gen_fsm receives an event sent using" n
- "%% gen_fsm:sync_send_all_state_event/[2,3], this function is called" n
- "%% to handle the event." n
- "%%" n
- "%% @spec handle_sync_event(Event, From, StateName, State) ->" n
- "%% {next_state, NextStateName, NextState} |" n
- "%% {next_state, NextStateName, NextState, Timeout} |" n
- "%% {reply, Reply, NextStateName, NextState} |" n
- "%% {reply, Reply, NextStateName, NextState, Timeout} |" n
- "%% {stop, Reason, NewState} |" n
- "%% {stop, Reason, Reply, NewState}" n
- (erlang-skel-separator-end 2)
- "handle_sync_event(_Event, _From, StateName, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, StateName, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by a gen_fsm when it receives any" n
- "%% message other than a synchronous or asynchronous event" n
- "%% (or a system message)." n
- "%%" n
- "%% @spec handle_info(Info,StateName,State)->" n
- "%% {next_state, NextStateName, NextState} |" n
- "%% {next_state, NextStateName, NextState, Timeout} |" n
- "%% {stop, Reason, NewState}" n
- (erlang-skel-separator-end 2)
- "handle_info(_Info, StateName, State) ->" n>
- "{next_state, StateName, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by a gen_fsm when it is about to" n
- "%% terminate. It should be the opposite of Module:init/1 and do any" n
- "%% necessary cleaning up. When it returns, the gen_fsm terminates with" n
- "%% Reason. The return value is ignored." n
- "%%" n
- "%% @spec terminate(Reason, StateName, State) -> void()" n
- (erlang-skel-separator-end 2)
- "terminate(_Reason, _StateName, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- "%%" n
- "%% @spec code_change(OldVsn, StateName, State, Extra) ->" n
- "%% {ok, StateName, NewState}" n
- (erlang-skel-separator-end 2)
- "code_change(_OldVsn, StateName, State, _Extra) ->" n>
- "{ok, StateName, State}." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a gen_fsm.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-gen-statem-StateName
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_statem)." n n
-
- "%% API" n
- "-export([start_link/0])." n
- n
- "%% gen_statem callbacks" n
- "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n
- "-export([state_name/3])." n
- n
- "-define(SERVER, ?MODULE)." n
- n
- "-record(data, {})." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Creates a gen_statem process which calls Module:init/1 to" n
- "%% initialize. To ensure a synchronized start-up procedure, this" n
- "%% function does not return until Module:init/1 has returned." n
- "%%" n
- (erlang-skel-separator-end 2)
- "-spec start_link() ->" n>
- "{ok, Pid :: pid()} |" n>
- "ignore |" n>
- "{error, Error :: term()}." n
- "start_link() ->" n>
- "gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% gen_statem callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Define the callback_mode() for this callback module." n
- (erlang-skel-separator-end 2)
- "-spec callback_mode() -> gen_statem:callback_mode_result()." n
- "callback_mode() -> state_functions." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n
- "%% gen_statem:start_link/[3,4], this function is called by the new" n
- "%% process to initialize." n
- (erlang-skel-separator-end 2)
- "-spec init(Args :: term()) ->" n>
- "gen_statem:init_result(atom())." n
- "init([]) ->" n>
- "process_flag(trap_exit, true)," n>
- "{ok, state_name, #data{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% There should be one function like this for each state name." n
- "%% Whenever a gen_statem receives an event, the function " n
- "%% with the name of the current state (StateName) " n
- "%% is called to handle the event." n
- (erlang-skel-separator-end 2)
- "-spec state_name('enter'," n>
- "OldState :: atom()," n>
- "Data :: term()) ->" n>
- "gen_statem:state_enter_result('state_name');" n>
- "(gen_statem:event_type()," n>
- "Msg :: term()," n>
- "Data :: term()) ->" n>
- "gen_statem:event_handler_result(atom())." n
- ;;
- "state_name({call,Caller}, _Msg, Data) ->" n>
- "{next_state, state_name, Data, [{reply,Caller,ok}]}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by a gen_statem when it is about to" n
- "%% terminate. It should be the opposite of Module:init/1 and do any" n
- "%% necessary cleaning up. When it returns, the gen_statem terminates with" n
- "%% Reason. The return value is ignored." n
- (erlang-skel-separator-end 2)
- "-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n>
- "any()." n
- "terminate(_Reason, _State, _Data) ->" n>
- "void." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- (erlang-skel-separator-end 2)
- "-spec code_change(" n>
- "OldVsn :: term() | {down,term()}," n>
- "State :: term(), Data :: term(), Extra :: term()) ->" n>
- "{ok, NewState :: term(), NewData :: term()} |" n>
- "(Reason :: term())." n
- "code_change(_OldVsn, State, Data, _Extra) ->" n>
- "{ok, State, Data}." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a gen_statem (StateName/3).
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-gen-statem-handle-event
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(gen_statem)." n n
-
- "%% API" n
- "-export([start_link/0])." n
- n
- "%% gen_statem callbacks" n
- "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n
- "-export([handle_event/4])." n
- n
- "-define(SERVER, ?MODULE)." n
- n
- "-record(data, {})." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Creates a gen_statem process which calls Module:init/1 to" n
- "%% initialize. To ensure a synchronized start-up procedure, this" n
- "%% function does not return until Module:init/1 has returned." n
- "%%" n
- (erlang-skel-separator-end 2)
- "-spec start_link() ->" n>
- "{ok, Pid :: pid()} |" n>
- "ignore |" n>
- "{error, Error :: term()}." n
- "start_link() ->" n>
- "gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% gen_statem callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Define the callback_mode() for this callback module." n
- (erlang-skel-separator-end 2)
- "-spec callback_mode() -> gen_statem:callback_mode_result()." n
- "callback_mode() -> handle_event_function." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n
- "%% gen_statem:start_link/[3,4], this function is called by the new" n
- "%% process to initialize." n
- (erlang-skel-separator-end 2)
- "-spec init(Args :: term()) ->" n>
- "gen_statem:init_result(term())." n
- "init([]) ->" n>
- "process_flag(trap_exit, true)," n>
- "{ok, state_name, #data{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called for every event a gen_statem receives." n
- (erlang-skel-separator-end 2)
- "-spec handle_event('enter'," n>
- "OldState :: term()," n>
- "State :: term()," n>
- "Data :: term()) ->" n>
- "gen_statem:state_enter_result(term());" n>
- "(gen_statem:event_type()," n>
- "Msg :: term()," n>
- "State :: term()," n>
- "Data :: term()) ->" n>
- "gen_statem:event_handler_result(term())." n
- ;;
- "handle_event({call,From}, _Msg, State, Data) ->" n>
- "{next_state, State, Data, [{reply,From,ok}]}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by a gen_statem when it is about to" n
- "%% terminate. It should be the opposite of Module:init/1 and do any" n
- "%% necessary cleaning up. When it returns, the gen_statem terminates with" n
- "%% Reason. The return value is ignored." n
- (erlang-skel-separator-end 2)
- "-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n>
- "any()." n
- "terminate(_Reason, _State, _Data) ->" n>
- "void." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- (erlang-skel-separator-end 2)
- "-spec code_change(" n>
- "OldVsn :: term() | {down,term()}," n>
- "State :: term(), Data :: term(), Extra :: term()) ->" n>
- "{ok, NewState :: term(), NewData :: term()} |" n>
- "(Reason :: term())." n
- "code_change(_OldVsn, State, Data, _Extra) ->" n>
- "{ok, State, Data}." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a gen_statem (handle_event/4).
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-wx-object
- '((erlang-skel-include erlang-skel-large-header)
- "-behaviour(wx_object)." n n
-
- "-include_lib(\"wx/include/wx.hrl\")." n n
-
- "%% API" n
- "-export([start_link/0])." n n
-
- "%% wx_object callbacks" n
- "-export([init/1, handle_call/3, handle_cast/2, "
- "handle_info/2," n>
- "handle_event/2, terminate/2, code_change/3])." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Starts the server" n
- "%%" n
- "%% @spec start_link() -> wxWindow()" n
- (erlang-skel-separator-end 2)
- "start_link() ->" n>
- "wx_object:start_link(?MODULE, [], [])." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% wx_object callbacks" n
- (erlang-skel-double-separator-end 3)
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Initializes the server" n
- "%%" n
- "%% @spec init(Args) -> {wxWindow(), State} |" n
- "%% {wxWindow(), State, Timeout} |" n
- "%% ignore |" n
- "%% {stop, Reason}" n
- (erlang-skel-separator-end 2)
- "init([]) ->" n>
- "wx:new()," n>
- "Frame = wxFrame:new()," n>
- "{Frame, #state{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling events" n
- "%%" n
- "%% @spec handle_event(wx{}, State) ->" n
- "%% {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, State}" n
- (erlang-skel-separator-end 2)
- "handle_event(#wx{}, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling call messages" n
- "%%" n
- "%% @spec handle_call(Request, From, State) ->" n
- "%% {reply, Reply, State} |" n
- "%% {reply, Reply, State, Timeout} |" n
- "%% {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, Reply, State} |" n
- "%% {stop, Reason, State}" n
- (erlang-skel-separator-end 2)
- "handle_call(_Request, _From, State) ->" n>
- "Reply = ok," n>
- "{reply, Reply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling cast messages" n
- "%%" n
- "%% @spec handle_cast(Msg, State) -> {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, State}" n
- (erlang-skel-separator-end 2)
- "handle_cast(_Msg, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Handling all non call/cast messages" n
- "%%" n
- "%% @spec handle_info(Info, State) -> {noreply, State} |" n
- "%% {noreply, State, Timeout} |" n
- "%% {stop, Reason, State}" n
- (erlang-skel-separator-end 2)
- "handle_info(_Info, State) ->" n>
- "{noreply, State}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% This function is called by a wx_object when it is about to" n
- "%% terminate. It should be the opposite of Module:init/1 and do any" n
- "%% necessary cleaning up. When it returns, the wx_object terminates" n
- "%% with Reason. The return value is ignored." n
- "%%" n
- "%% @spec terminate(Reason, State) -> void()" n
- (erlang-skel-separator-end 2)
- "terminate(_Reason, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- "%%" n
- "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n
- (erlang-skel-separator-end 2)
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a generic server.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-lib
- '((erlang-skel-include erlang-skel-large-header)
-
- "%% API" n
- "-export([])." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% API" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% @spec" n
- (erlang-skel-separator-end 2)
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-corba-callback
- '((erlang-skel-include erlang-skel-large-header)
- "%% Include files" n n
-
- "%% API" n
- "-export([])." n n
-
- "%% Corba callbacks" n
- "-export([init/1, terminate/2, code_change/3])." n n
-
- "-record(state, {})." n n
-
- (erlang-skel-double-separator-start 3)
- "%%% Corba callbacks" n
- (erlang-skel-double-separator-end 3) n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Initializes the server" n
- "%%" n
- "%% @spec init(Args) -> {ok, State} |" n
- "%% {ok, State, Timeout} |" n
- "%% ignore |" n
- "%% {stop, Reason}" n
- (erlang-skel-separator-end 2)
- "init([]) ->" n>
- "{ok, #state{}}." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Shutdown the server" n
- "%%" n
- "%% @spec terminate(Reason, State) -> void()" n
- (erlang-skel-separator-end 2)
- "terminate(_Reason, _State) ->" n>
- "ok." n
- n
- (erlang-skel-separator-start 2)
- "%% @private" n
- "%% @doc" n
- "%% Convert process state when code is changed" n
- "%%" n
- "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n
- (erlang-skel-separator-end 2)
- "code_change(_OldVsn, State, _Extra) ->" n>
- "{ok, State}." n
- n
- (erlang-skel-double-separator-start 3)
- "%%% Internal functions" n
- (erlang-skel-double-separator-end 3)
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-ts-test-suite
- '((erlang-skel-include erlang-skel-large-header)
- "%% Note: This directive should only be used in test suites." n
- "-compile(export_all)." n n
-
- "-include_lib(\"common_test/include/ct.hrl\")." n n
-
- (erlang-skel-separator-start 2)
- "%% TEST SERVER CALLBACK FUNCTIONS" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-separator-start 2)
- "%%" n
- "%% @doc" n
- "%% Initialization before the suite." n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the suite." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- "%%" n
- "%% @spec init_per_suite(Config) -> Config" n
- (erlang-skel-separator-end 2)
- "init_per_suite(Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Cleanup after the suite." n
- "%% Config - [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% @spec end_per_suite(Config) -> _" n
- (erlang-skel-separator-end 2)
- "end_per_suite(_Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Initialization before each test case" n
- "%%" n
- "%% TestCase - atom()" n
- "%% Name of the test case that is about to be run." n
- "%% Config - [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- "%%" n
- "%% @spec init_per_testcase(TestCase, Config) -> Config" n
- (erlang-skel-separator-end 2)
- "init_per_testcase(_TestCase, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Cleanup after each test case" n
- "%%" n
- "%% TestCase = atom()" n
- "%% Name of the test case that is finished." n
- "%% Config = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% @spec end_per_testcase(TestCase, Config) -> _" n
- (erlang-skel-separator-end 2)
- "end_per_testcase(_TestCase, _Config) ->" n >
- "ok."n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Returns a description of the test suite when" n
- "%% Clause == doc, and a test specification (list" n
- "%% of the conf and test cases in the suite) when" n
- "%% Clause == suite." n
- "%% Returns a list of all test cases in this test suite" n
- "%%" n
- "%% Clause = doc | suite" n
- "%% Indicates expected return value." n
- "%% Descr = [string()] | []" n
- "%% String that describes the test suite." n
- "%% Spec = [TestCase]" n
- "%% A test specification." n
- "%% TestCase = ConfCase | atom()" n
- "%% Configuration case, or the name of a test case function." n
- "%% ConfCase = {conf,Init,Spec,End} |" n
- "%% {conf,Properties,Init,Spec,End}" n
- "%% Init = End = {Mod,Func} | Func" n
- "%% Initialization and cleanup function." n
- "%% Mod = Func = atom()" n
- "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
- "%% Execution properties of the test cases (may be combined)." n
- "%% Shuffle = shuffle | {shuffle,Seed}" n
- "%% To get cases executed in random order." n
- "%% Seed = {integer(),integer(),integer()}" n
- "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
- "%% repeat_until_any_ok | repeat_until_any_fail" n
- "%% To get execution of cases repeated." n
- "%% N = integer() | forever" n
- "%% Reason = term()" n
- "%% The reason for skipping the test suite." n
- "%%" n
- "%% @spec all(Clause) -> TestCases" n
- (erlang-skel-separator-end 2)
- "all(doc) ->" n >
- "[\"Describe the main purpose of this suite\"];" n n
- "all(suite) -> " n >
- "[a_test_case]." n n
- n
- (erlang-skel-separator-start 2)
- "%% TEST CASES" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Test case function. Returns a description of the test" n
- "%% case (doc), then returns a test specification (suite)," n
- "%% or performs the actual test (Config)." n
- "%%" n
- "%% Arg = doc | suite | Config" n
- "%% Indicates expected behaviour and return value." n
- "%% Config = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Descr = [string()] | []" n
- "%% String that describes the test case." n
- "%% Spec = [tuple()] | []" n
- "%% A test specification, see all/1." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%%" n
- "%% @spec TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n
-
- (erlang-skel-separator-end 2)
- "a_test_case(doc) -> " n >
- "[\"Describe the main purpose of this test case\"];" n n
- "a_test_case(suite) -> " n >
- "[];" n n
- "a_test_case(Config) when is_list(Config) -> " n >
- "ok." n
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-(defvar erlang-skel-ct-test-suite-s
- '((erlang-skel-include erlang-skel-large-header)
- "-compile(export_all)." n n
-
- "-include_lib(\"common_test/include/ct.hrl\")." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec suite() -> Info" n
- "%% Info = [tuple()]" n
- (erlang-skel-separator-end 2)
- "suite() ->" n >
- "[{timetrap,{seconds,30}}]." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec init_per_suite(Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator-end 2)
- "init_per_suite(Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec end_per_suite(Config0) -> term() | {save_config,Config1}" n
- "%% Config0 = Config1 = [tuple()]" n
- (erlang-skel-separator-end 2)
- "end_per_suite(_Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec init_per_group(GroupName, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%% GroupName = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator-end 2)
- "init_per_group(_GroupName, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec end_per_group(GroupName, Config0) ->" n
- "%% term() | {save_config,Config1}" n
- "%% GroupName = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- (erlang-skel-separator-end 2)
- "end_per_group(_GroupName, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec init_per_testcase(TestCase, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- "%% TestCase = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator-end 2)
- "init_per_testcase(_TestCase, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec end_per_testcase(TestCase, Config0) ->" n
- "%% term() | {save_config,Config1} | {fail,Reason}" n
- "%% TestCase = atom()" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- (erlang-skel-separator-end 2)
- "end_per_testcase(_TestCase, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec groups() -> [Group]" n
- "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
- "%% GroupName = atom()" n
- "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
- "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
- "%% TestCase = atom()" n
- "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n
- "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
- "%% repeat_until_any_ok | repeat_until_any_fail" n
- "%% N = integer() | forever" n
- (erlang-skel-separator-end 2)
- "groups() ->" n >
- "[]." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec all() -> GroupsAndTestCases | {skip,Reason}" n
- "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
- "%% GroupName = atom()" n
- "%% TestCase = atom()" n
- "%% Reason = term()" n
- (erlang-skel-separator-end 2)
- "all() -> " n >
- "[my_test_case]." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec TestCase() -> Info" n
- "%% Info = [tuple()]" n
- (erlang-skel-separator-end 2)
- "my_test_case() -> " n >
- "[]." n n
-
- (erlang-skel-separator-start 2)
- "%% @spec TestCase(Config0) ->" n
- "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
- "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% Reason = term()" n
- "%% Comment = term()" n
- (erlang-skel-separator-end 2)
- "my_test_case(_Config) -> " n >
- "ok." n
- )
- "*The template of a library module.
-Please see the function `tempo-define-template'.")
-
-
-(defvar erlang-skel-ct-test-suite-l
- '((erlang-skel-include erlang-skel-large-header)
- "%% Note: This directive should only be used in test suites." n
- "-compile(export_all)." n n
-
- "-include_lib(\"common_test/include/ct.hrl\")." n n
-
- (erlang-skel-separator-start 2)
- "%% COMMON TEST CALLBACK FUNCTIONS" n
- (erlang-skel-separator 2)
- n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Returns list of tuples to set default properties" n
- "%% for the suite." n
- "%%" n
- "%% Function: suite() -> Info" n
- "%%" n
- "%% Info = [tuple()]" n
- "%% List of key/value pairs." n
- "%%" n
- "%% Note: The suite/0 function is only meant to be used to return" n
- "%% default data values, not perform any other operations." n
- "%%" n
- "%% @spec suite() -> Info" n
- (erlang-skel-separator-end 2)
- "suite() ->" n >
- "[{timetrap,{minutes,10}}]." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Initialization before the whole suite" n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the suite." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- "%%" n
- "%% @spec init_per_suite(Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- (erlang-skel-separator-end 2)
- "init_per_suite(Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Cleanup after the whole suite" n
- "%%" n
- "%% Config - [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% @spec end_per_suite(Config) -> _" n
- (erlang-skel-separator-end 2)
- "end_per_suite(_Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Initialization before each test case group." n
- "%%" n
- "%% GroupName = atom()" n
- "%% Name of the test case group that is about to run." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding configuration data for the group." n
- "%% Reason = term()" n
- "%% The reason for skipping all test cases and subgroups in the group." n
- "%%" n
- "%% @spec init_per_group(GroupName, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- (erlang-skel-separator-end 2)
- "init_per_group(_GroupName, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Cleanup after each test case group." n
- "%%" n
- "%% GroupName = atom()" n
- "%% Name of the test case group that is finished." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding configuration data for the group." n
- "%%" n
- "%% @spec end_per_group(GroupName, Config0) ->" n
- "%% term() | {save_config,Config1}" n
- (erlang-skel-separator-end 2)
- "end_per_group(_GroupName, _Config) ->" n >
- "ok." n n
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Initialization before each test case" n
- "%%" n
- "%% TestCase - atom()" n
- "%% Name of the test case that is about to be run." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%%" n
- "%% Note: This function is free to add any key/value pairs to the Config" n
- "%% variable, but should NOT alter/remove any existing entries." n
- "%%" n
- "%% @spec init_per_testcase(TestCase, Config0) ->" n
- "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
- (erlang-skel-separator-end 2)
- "init_per_testcase(_TestCase, Config) ->" n >
- "Config." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Cleanup after each test case" n
- "%%" n
- "%% TestCase - atom()" n
- "%% Name of the test case that is finished." n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%%" n
- "%% @spec end_per_testcase(TestCase, Config0) ->" n
- "%% term() | {save_config,Config1} | {fail,Reason}" n
- (erlang-skel-separator-end 2)
- "end_per_testcase(_TestCase, _Config) ->" n >
- "ok." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Returns a list of test case group definitions." n
- "%%" n
- "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
- "%% GroupName = atom()" n
- "%% The name of the group." n
- "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
- "%% Group properties that may be combined." n
- "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
- "%% TestCase = atom()" n
- "%% The name of a test case." n
- "%% Shuffle = shuffle | {shuffle,Seed}" n
- "%% To get cases executed in random order." n
- "%% Seed = {integer(),integer(),integer()}" n
- "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
- "%% repeat_until_any_ok | repeat_until_any_fail" n
- "%% To get execution of cases repeated." n
- "%% N = integer() | forever" n
- "%%" n
- "%% @spec: groups() -> [Group]" n
- (erlang-skel-separator-end 2)
- "groups() ->" n >
- "[]." n n
-
- (erlang-skel-separator-start 2)
- "%% @doc" n
- "%% Returns the list of groups and test cases that" n
- "%% are to be executed." n
- "%%" n
- "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
- "%% GroupName = atom()" n
- "%% Name of a test case group." n
- "%% TestCase = atom()" n
- "%% Name of a test case." n
- "%% Reason = term()" n
- "%% The reason for skipping all groups and test cases." n
- "%%" n
- "%% @spec all() -> GroupsAndTestCases | {skip,Reason}" n
- (erlang-skel-separator-end 2)
- "all() -> " n >
- "[my_test_case]." n n
-
- n
- (erlang-skel-separator-start 2)
- "%% TEST CASES" n
- (erlang-skel-separator 2)
- n
-
- (erlang-skel-separator-start 2)
- "%% @doc " n
- "%% Test case info function - returns list of tuples to set" n
- "%% properties for the test case." n
- "%%" n
- "%% Info = [tuple()]" n
- "%% List of key/value pairs." n
- "%%" n
- "%% Note: This function is only meant to be used to return a list of" n
- "%% values, not perform any other operations." n
- "%%" n
- "%% @spec TestCase() -> Info " n
- (erlang-skel-separator-end 2)
- "my_test_case() -> " n >
- "[]." n n
-
- (erlang-skel-separator 2)
- "%% @doc Test case function. (The name of it must be specified in" n
- "%% the all/0 list or in a test case group for the test case" n
- "%% to be executed)." n
- "%%" n
- "%% Config0 = Config1 = [tuple()]" n
- "%% A list of key/value pairs, holding the test case configuration." n
- "%% Reason = term()" n
- "%% The reason for skipping the test case." n
- "%% Comment = term()" n
- "%% A comment about the test case that will be printed in the html log." n
- "%%" n
- "%% @spec TestCase(Config0) ->" n
- "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
- "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
- (erlang-skel-separator-end 2)
- "my_test_case(_Config) -> " n >
- "ok." n
-
- )
- "*The template of a library module.
- Please see the function `tempo-define-template'.")
-
-;; Skeleton code:
-
-;; This code is based on the package `tempo' which is part of modern
-;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
-
-(defun erlang-skel-init ()
- "Generate the skeleton functions and menu items.
-The variable `erlang-skel' contains the name and descriptions of
-all skeletons.
-
-The skeleton routines are based on the `tempo' package. Should this
-package not be present, this function does nothing."
- (interactive)
- (condition-case nil
- (require 'tempo)
- (error t))
- (if (featurep 'tempo)
- (let ((skel erlang-skel)
- (menu '()))
- (while skel
- (cond ((null (car skel))
- (setq menu (cons nil menu)))
- (t
- (funcall (symbol-function 'tempo-define-template)
- (concat "erlang-" (nth 1 (car skel)))
- ;; The tempo template used contains an `include'
- ;; function call only, hence changes to the
- ;; variables describing the templates take effect
- ;; immdiately.
- (list (list 'erlang-skel-include (nth 2 (car skel))))
- (nth 1 (car skel)))
- (setq menu (cons (erlang-skel-make-menu-item
- (car skel)) menu))))
- (setq skel (cdr skel)))
- (setq erlang-menu-skel-items
- (list nil (list "Skeletons" (nreverse menu))))
- (setq erlang-menu-items
- (erlang-menu-add-above 'erlang-menu-skel-items
- 'erlang-menu-version-items
- erlang-menu-items))
- (erlang-menu-init))))
-
-(defun erlang-skel-make-menu-item (skel)
- (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel)))))
- (cond ((null (nth 3 skel))
- (list (car skel) func))
- (t
- (list (car skel)
- (list 'lambda '()
- '(interactive)
- (list 'funcall
- (list 'quote (nth 3 skel))
- (list 'quote func))))))))
-
-;; Functions designed to be added to the skeleton menu.
-;; (Not normally used)
-(defun erlang-skel-insert (func)
- "Insert skeleton generated by FUNC and goto first tempo mark."
- (save-excursion (funcall func))
- (funcall (symbol-function 'tempo-forward-mark)))
-
-(defun erlang-skel-header (func)
- "Insert the header generated by FUNC at the beginning of the buffer."
- (goto-char (point-min))
- (save-excursion (funcall func))
- (funcall (symbol-function 'tempo-forward-mark)))
-
-
-;; Functions used inside the skeleton descriptions.
-(defun erlang-skel-skip-blank ()
- (skip-chars-backward " \t")
- nil)
-
-(defun erlang-skel-include (&rest args)
- "Include a template inside another template.
-
-Example of use, assuming that `erlang-skel-func' is defined:
-
- (defvar foo-skeleton '(\"%%% New function:\"
- (erlang-skel-include erlang-skel-func)))
-
-Technically, this function returns the `tempo' attribute`(l ...)' which
-can contain other `tempo' attributes. Please see the function
-`tempo-define-template' for a description of the `(l ...)' attribute."
- (let ((res '())
- entry)
- (while args
- (setq entry (car args))
- (while entry
- (setq res (cons (car entry) res))
- (setq entry (cdr entry)))
- (setq args (cdr args)))
- (cons 'l (nreverse res))))
-
-(defun erlang-skel-separator (&optional percent)
- "Return a comment separator."
- (let ((percent (or percent 3)))
- (concat (make-string percent ?%)
- (make-string (- 70 percent) ?-)
- "\n")))
-
-(defun erlang-skel-separator-start (&optional percent)
- "Return a comment separator or an empty string if separators
-are configured off."
- (if erlang-skel-use-separators
- (erlang-skel-separator percent)
- ""))
-
-(defun erlang-skel-separator-end (&optional percent)
- "Return a comment separator to end a function comment block or an
-empty string if separators are configured off."
- (if erlang-skel-use-separators
- (concat "%% @end\n" (erlang-skel-separator percent))
- ""))
-
-(defun erlang-skel-double-separator (&optional percent)
- "Return a double line (equals sign) comment separator."
- (let ((percent (or percent 3)))
- (concat (make-string percent ?%)
- (make-string (- 70 percent) ?=)
- "\n")))
-
-(defun erlang-skel-double-separator-start (&optional percent)
- "Return a double separator or a newline if separators are configured off."
- (if erlang-skel-use-separators
- (erlang-skel-double-separator percent)
- "\n"))
-
-(defun erlang-skel-double-separator-end (&optional percent)
- "Return a double separator or an empty string if separators are
-configured off."
- (if erlang-skel-use-separators
- (erlang-skel-double-separator percent)
- ""))
-
-(defun erlang-skel-dd-mmm-yyyy ()
- "Return the current date as a string in \"DD Mon YYYY\" form.
-The first character of DD is space if the value is less than 10."
- (let ((date (current-time-string)))
- (format "%2d %s %s"
- (string-to-number (substring date 8 10))
- (substring date 4 7)
- (substring date -4))))
-
-(defun erlang-skel-get-function-name ()
- (save-excursion
- (erlang-beginning-of-function -1)
- (erlang-get-function-name)))
-
-(defun erlang-skel-get-function-args ()
- (save-excursion
- (erlang-beginning-of-function -1)
- (erlang-get-function-arguments)))
-
-;; Local variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; erlang-skels.el ends here
+++ /dev/null
-;; erlang-start.el --- Load this file to initialize the Erlang package.
-
-;; Copyright (C) 1998 Ericsson Telecom AB
-
-;; Author: Anders Lindgren
-;; Version: 2.3
-;; Keywords: erlang, languages, processes
-;; Created: 1996-09-18
-;; Date: 1998-03-16
-
-;;; Commentary:
-
-;; Introduction:
-;; ------------
-;;
-;; This package provides support for the programming language Erlang.
-;; The package provides an editing mode with lots of bells and
-;; whistles, compilation support, and it makes it possible for the
-;; user to start Erlang shells that run inside Emacs.
-;;
-;; See the Erlang distribution for full documentation of this package.
-
-;; Installation:
-;; ------------
-;;
-;; Place this file in Emacs load path, byte-compile it, and add the
-;; following line to the appropriate init file:
-;;
-;; (require 'erlang-start)
-;;
-;; The full documentation contains much more extensive description of
-;; the installation procedure.
-
-;; Reporting Bugs:
-;; --------------
-;;
-;; Please send bug reports to the following email address:
-;; supportNOSPAMerlang.ericsson.se
-;;
-;; Please state as exactly as possible:
-;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
-;; and of any other relevant software.
-;; - What the expected result was.
-;; - What you did, preferably in a repeatable step-by-step form.
-;; - A description of the unexpected result.
-;; - Relevant pieces of Erlang code causing the problem.
-;; - Personal Emacs customisations, if any.
-;;
-;; Should the Emacs generate an error, please set the emacs variable
-;; `debug-on-error' to `t'. Repeat the error and enclose the debug
-;; information in your bug-report.
-;;
-;; To set the variable you can use the following command:
-;; M-x set-variable RET debug-on-error RET t RET
-
-;;; Code:
-
-;;
-;; Declare functions in "erlang.el".
-;;
-
-(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t)
-(autoload 'erlang-version "erlang"
- "Return the current version of Erlang mode." t)
-(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t)
-(autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
-
-(autoload 'erlang-compile "erlang"
- "Compile Erlang module in current buffer." t)
-
-(autoload 'erlang-man-module "erlang"
- "Find manual page for MODULE." t)
-(autoload 'erlang-man-function "erlang"
- "Find manual page for NAME, where NAME is module:function." t)
-
-(autoload 'erlang-find-tag "erlang"
- "Like `find-tag'. Capable of retrieving Erlang modules.")
-(autoload 'erlang-find-tag-other-window "erlang"
- "Like `find-tag-other-window'. Capable of retrieving Erlang modules.")
-
-;;
-;; Declare functions in "erlang-edoc.el".
-;;
-
-(autoload 'erlang-edoc-mode "erlang-edoc" "Toggle Erlang-Edoc mode on or off." t)
-
-;;
-;; Declare functions in "erldoc.el".
-;;
-
-(autoload 'erldoc-browse "erldoc" "\n\n(fn MFA)" t nil)
-(autoload 'erldoc-browse-topic "erldoc" "\n\n(fn TOPIC)" t nil)
-(autoload 'erldoc-apropos "erldoc" "\n\n(fn PATTERN)" t nil)
-(autoload 'erldoc-eldoc-function "erldoc" "\
-A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil)
-
-;;
-;; Associate files extensions ".erl" and ".hrl" with Erlang mode.
-;;
-
-;;;###autoload
-(let ((a '("\\.erl\\'" . erlang-mode))
- (b '("\\.hrl\\'" . erlang-mode)))
- (or (assoc (car a) auto-mode-alist)
- (setq auto-mode-alist (cons a auto-mode-alist)))
- (or (assoc (car b) auto-mode-alist)
- (setq auto-mode-alist (cons b auto-mode-alist))))
-
-;;
-;; Associate files using interpreter "escript" with Erlang mode.
-;;
-
-;;;###autoload
-(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
-
-;;
-;; Ignore files ending in ".jam", ".vee", and ".beam" when performing
-;; file completion and in dired omit mode.
-;;
-
-;;;###autoload
-(let ((erl-ext '(".jam" ".vee" ".beam")))
- (while erl-ext
- (add-to-list 'completion-ignored-extensions (car erl-ext))
- (when (boundp 'dired-omit-extensions)
- (add-to-list 'dired-omit-extensions (car erl-ext)))
- (setq erl-ext (cdr erl-ext))))
-
-
-;;
-;; The end.
-;;
-
-(provide 'erlang-start)
-
-;; Local variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-
-;; erlang-start.el ends here.
+++ /dev/null
-;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
-
-;;; Unit tests for erlang.el.
-
-;; Author: Johan Claesson
-;; Created: 2016-05-07
-;; Keywords: erlang, languages
-
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 2016-2021. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-
-
-;;; Commentary:
-
-;; This library require GNU Emacs 25 or later.
-;;
-;; There are three ways to run the erlang emacs unit tests.
-;;
-;; 1. Within a running emacs process. Load this file. Then to run
-;; all defined test cases:
-;;
-;; M-x ert RET t RET
-;;
-;; To run only the erlang test cases:
-;;
-;; M-x ert RET "^erlang" RET
-;;
-;;
-;; 2. In a new stand-alone emacs process. This process exits
-;; when it executed the tests. For example:
-;;
-;; emacs -Q -batch -L . -l erlang.el -l erlang-test.el \
-;; -f ert-run-tests-batch-and-exit
-;;
-;; The -L option adds a directory to the load-path. It should be the
-;; directory containing erlang.el and erlang-test.el.
-;;
-;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and
-;; tests_compiled/1 in this suite are using the second method. One
-;; way to run this suite is with the ct_run tool, for example like the
-;; following when standing at the OTP repo top directory:
-;;
-;; ct_run -suite lib/tools/test/emacs_SUITE
-;;
-;; Note that this creates a lot of html log files in the current
-;; directory.
-
-;;; Code:
-
-(require 'ert)
-(require 'erlang)
-
-(defvar erlang-test-code
- '((nil . "-module(erlang_test).")
- (nil . "-import(lists, [map/2]).")
- (nil . "-compile(export_all).")
- ("SYMBOL" . "-define(SYMBOL, value).")
- ("MACRO" . "-define(MACRO(X), X + X).")
- ("struct" . "-record(struct, {until,maps,are,everywhere}).")
- ("function" . "function() -> #struct{}."))
- "Alist of erlang test code.
-Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME
-is nil there is no definitions in the ERLANG_CODE. The
-ERLANG_CODE is a single line of erlang code. These lines will be
-concatenated to form an erlang file to test on.")
-
-
-(ert-deftest erlang-test-tags ()
- (let* ((dir (make-temp-file "erlang-test" t))
- (erlang-file (expand-file-name "erlang_test.erl" dir))
- (tags-file (expand-file-name "TAGS" dir))
- (old-tags-file-name (default-value 'tags-file-name))
- (old-tags-table-list (default-value 'tags-table-list))
- tags-file-name
- tags-table-list
- tags-table-set-list
- tags-add-tables
- tags-completion-table
- erlang-buffer
- erlang-mode-hook
- prog-mode-hook
- erlang-shell-mode-hook)
- (unwind-protect
- (progn
- (setq-default tags-file-name nil)
- (setq-default tags-table-list nil)
- (erlang-test-create-erlang-file erlang-file)
- (erlang-test-compile-tags erlang-file tags-file)
- (setq erlang-buffer (find-file-noselect erlang-file))
- (if (< emacs-major-version 26)
- (progn
- (with-current-buffer erlang-buffer
- (setq-local tags-file-name tags-file))
- ;; Setting global tags-file-name is a workaround for
- ;; GNU Emacs bug#23164.
- (setq tags-file-name tags-file))
- (visit-tags-table tags-file t))
- (erlang-test-complete-at-point tags-file)
- (erlang-test-completion-table)
- (erlang-test-xref-find-definitions erlang-file erlang-buffer))
- (when (buffer-live-p erlang-buffer)
- (kill-buffer erlang-buffer))
- (let ((tags-buffer (find-buffer-visiting tags-file)))
- (when (buffer-live-p tags-buffer)
- (kill-buffer tags-buffer)))
- (when (file-exists-p dir)
- (delete-directory dir t))
- (setq-default tags-file-name old-tags-file-name)
- (setq-default tags-table-list old-tags-table-list))))
-
-(defun erlang-test-create-erlang-file (erlang-file)
- (with-temp-file erlang-file
- (cl-loop for (_ . code) in erlang-test-code
- do (insert code "\n"))))
-
-(defun erlang-test-compile-tags (erlang-file tags-file)
- (should (zerop (call-process "etags" nil nil nil
- "-o" tags-file
- erlang-file))))
-
-(defun erlang-test-completion-table ()
- (let ((erlang-replace-etags-tags-completion-table t))
- (setq tags-completion-table nil)
- (tags-completion-table))
- (should (equal (sort tags-completion-table #'string-lessp)
- (sort (erlang-expected-completion-table) #'string-lessp))))
-
-(defun erlang-expected-completion-table ()
- (append (cl-loop for (symbol . _) in erlang-test-code
- when (stringp symbol)
- append (list symbol (concat "erlang_test:" symbol)))
- (list "erlang_test:" "erlang_test:module_info")))
-
-(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
- (cl-loop for (tagname . code) in erlang-test-code
- for line = 1 then (1+ line)
- do (when tagname
- (switch-to-buffer erlang-buffer)
- (erlang-test-xref-jump tagname erlang-file line)
- (when (string-equal tagname "function")
- (erlang-test-xref-jump (concat "erlang_test:" tagname)
- erlang-file line))))
- (erlang-test-xref-jump "erlang_test:" erlang-file 1))
-
-(defun erlang-test-xref-jump (id expected-file expected-line)
- (goto-char (point-max))
- (insert "\n%% " id)
- (save-buffer)
- (if (fboundp 'xref-find-definitions)
- (xref-find-definitions (erlang-id-to-string
- (erlang-get-identifier-at-point)))
- (error "xref-find-definitions not defined (too old emacs?)"))
- (erlang-test-verify-pos expected-file expected-line))
-
-(defun erlang-test-verify-pos (expected-file expected-line)
- (should (string-equal (file-truename expected-file)
- (file-truename (buffer-file-name))))
- (should (eq expected-line (line-number-at-pos)))
- (should (= (point-at-bol) (point))))
-
-(defun erlang-test-complete-at-point (tags-file)
- (with-temp-buffer
- (erlang-mode)
- (setq-local tags-file-name tags-file)
- (insert "\nerlang_test:fun")
- (erlang-complete-tag)
- (should (looking-back "erlang_test:function" (point-at-bol)))
- (insert "\nfun")
- (erlang-complete-tag)
- (should (looking-back "function" (point-at-bol)))
- (insert "\nerlang_")
- (erlang-complete-tag)
- (should (looking-back "erlang_test:" (point-at-bol)))))
-
-
-(ert-deftest erlang-test-compile-options ()
- (erlang-test-format-opt t
- "t")
- (erlang-test-format-opt nil
- "nil")
- (erlang-test-format-opt (cons 1 2)
- "{1, 2}")
- (erlang-test-format-opt (list 1)
- "[1]")
- (erlang-test-format-opt (list 1 2)
- "[1, 2]")
- (erlang-test-format-opt (list 1 2 3)
- "[1, 2, 3]")
- (erlang-test-format-opt 'symbol
- "symbol")
- (erlang-test-format-opt "string"
- "\"string\"")
- (erlang-test-format-opt []
- "{}")
- (erlang-test-format-opt [1]
- "{1}")
- (erlang-test-format-opt [1 2]
- "{1, 2}")
- (erlang-test-format-opt [1 2 (3 [4 5 6] 7)]
- "{1, 2, [3, {4, 5, 6}, 7]}"))
-
-(defun erlang-test-format-opt (elisp &optional expected-erlang)
- (let ((erlang (inferior-erlang-format-opt elisp)))
- (message "%s -> %s" elisp erlang)
- (when expected-erlang
- (should (equal erlang expected-erlang)))
- erlang))
-
-
-(ert-deftest erlang-test-parse-id ()
- (cl-loop for id-string in '("fun/10"
- "qualified-function module:fun/10"
- "record reko"
- "macro _SYMBOL"
- "macro MACRO/10"
- "module modula"
- "macro"
- nil)
- for id-list in '((nil nil "fun" 10)
- (qualified-function "module" "fun" 10)
- (record nil "reko" nil)
- (macro nil "_SYMBOL" nil)
- (macro nil "MACRO" 10)
- (module nil "modula" nil)
- (nil nil "macro" nil)
- nil)
- for id-list2 = (erlang-id-to-list id-string)
- do (should (equal id-list id-list2))
- for id-string2 = (erlang-id-to-string id-list)
- do (should (equal id-string id-string2))
- collect id-list2))
-
-
-(provide 'erlang-test)
-
-;;; erlang-test.el ends here
+++ /dev/null
-;;; erlang.el --- Major modes for editing and running Erlang -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2004 Free Software Foundation, Inc.
-;; Author: Anders Lindgren
-;; Keywords: erlang, languages, processes
-;; Date: 2011-12-11
-;; Version: 2.8.4
-;; Package-Requires: ((emacs "24.3"))
-
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 1996-2021. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-;;
-
-;; Lars Thorsén's modifications of 2000-06-07 included.
-;; The original version of this package was written by Robert Virding.
-;;
-;;; Commentary:
-
-;; Introduction:
-;; ------------
-;;
-;; This package provides support for the programming language Erlang.
-;; The package provides an editing mode with lots of bells and
-;; whistles, compilation support, and it makes it possible for the
-;; user to start Erlang shells that run inside Emacs.
-;;
-;; See the Erlang distribution for full documentation of this package.
-
-;; Installation:
-;; ------------
-;;
-;; Place this file in Emacs load path, byte-compile it, and add the
-;; following line to the appropriate init file:
-;;
-;; (require 'erlang-start)
-;;
-;; The full documentation contains much more extensive description of
-;; the installation procedure.
-
-;; Reporting Bugs:
-;; --------------
-;;
-;; Please report bugs at:
-;; https://github.com/erlang/otp/issues
-;; Please state as exactly as possible:
-;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
-;; and of any other relevant software.
-;; - What the expected result was.
-;; - What you did, preferably in a repeatable step-by-step form.
-;; - A description of the unexpected result.
-;; - Relevant pieces of Erlang code causing the problem.
-;; - Personal Emacs customisations, if any.
-;; Patch suggestions are welcome at:
-;; https://github.com/erlang/otp/pulls
-;;
-;; Should the Emacs generate an error, please set the Emacs variable
-;; `debug-on-error' to `t'. Repeat the error and enclose the debug
-;; information in your bug-report.
-;;
-;; To toggle the variable you can use the following command:
-;; M-x toggle-debug-on-error RET
-;;; Code:
-
-(require 'align)
-(require 'comint)
-(require 'tempo)
-
-;;; `caddr' is builtin since Emacs 26.
-(eval-and-compile
- (or (fboundp 'caddr)
- (defun caddr (x) (car (cdr (cdr x))))))
-
-;; Variables:
-
-(defgroup erlang nil
- "The Erlang programming language."
- :group 'languages)
-
-(defconst erlang-version "2.8.4"
- "The version number of Erlang mode.")
-
-(defcustom erlang-root-dir nil
- "The directory where the Erlang man pages are installed. The
-name should not contain a trailing slash.
-
-Should this variable be nil, no manual pages will show up in the
-Erlang mode menu unless man pages have been downloaded by Erlang
-mode (see below).
-
-You can download the Erlang man pages automatically by placing
-the following lines in your Emacs init file or by executing the
-Emacs command `M-x erlang-man-download-ask RET' (the download URL
-can be customized with the Emacs variable
-erlang-man-download-url):
-
- (require 'erlang)
- (erlang-man-download)
-
-"
- :group 'erlang
- :type '(restricted-sexp :match-alternatives (stringp 'nil))
- :safe (lambda (val) (or (eq nil val) (stringp val))))
-
-(defvar erlang-menu-items '(erlang-menu-base-items
- erlang-menu-skel-items
- erlang-menu-shell-items
- erlang-menu-compile-items
- erlang-menu-man-items
- erlang-menu-personal-items
- erlang-menu-version-items)
- "List of menu item list to combine to create Erlang mode menu.
-
-External programs which temporarily add menu items to the Erlang mode
-menu may use this variable. Please use the function `add-hook' to add
-items.
-
-Please call the function `erlang-menu-init' after every change to this
-variable.")
-
-(defvar erlang-menu-base-items
- '(("Indent"
- (("Indent Line" erlang-indent-command)
- ("Indent Region " erlang-indent-region mark-active)
- ("Indent Clause" erlang-indent-clause)
- ("Indent Function" erlang-indent-function)
- ("Indent Buffer" erlang-indent-current-buffer)))
- ("Edit"
- (("Fill Comment" erlang-fill-paragraph)
- ("Comment Region" comment-region mark-active)
- ("Uncomment Region" uncomment-region mark-active)
- nil
- ("Beginning of Function" erlang-beginning-of-function)
- ("End of Function" erlang-end-of-function)
- ("Mark Function" erlang-mark-function)
- nil
- ("Beginning of Clause" erlang-beginning-of-clause)
- ("End of Clause" erlang-end-of-clause)
- ("Mark Clause" erlang-mark-clause)
- nil
- ("New Clause" erlang-generate-new-clause)
- ("Clone Arguments" erlang-clone-arguments)
- nil
- ("Align Arrows" erlang-align-arrows)))
- ("Syntax Highlighting"
- (("Level 4" erlang-font-lock-level-4)
- ("Level 3" erlang-font-lock-level-3)
- ("Level 2" erlang-font-lock-level-2)
- ("Level 1" erlang-font-lock-level-1)
- ("Off" erlang-font-lock-level-0)))
- ("TAGS"
- (("Find Tag" find-tag)
- ("Find Next Tag" erlang-find-next-tag)
- ;("Find Regexp" find-tag-regexp)
- ("Complete Word" erlang-complete-tag)
- ("Tags Apropos" tags-apropos)
- ("Search Files" tags-search))))
- "Description of menu used in Erlang mode.
-
-This variable must be a list. The elements are either nil representing
-a horizontal line or a list with two or three elements. The first is
-the name of the menu item, the second is the function to call, or a
-submenu, on the same same form as ITEMS. The third optional argument
-is an expression which is evaluated every time the menu is displayed.
-Should the expression evaluate to nil the menu item is ghosted.
-
-Example:
- '((\"Func1\" function-one)
- (\"SubItem\"
- ((\"Yellow\" function-yellow)
- (\"Blue\" function-blue)))
- nil
- (\"Region Function\" spook-function midnight-variable))
-
-Call the function `erlang-menu-init' after modifying this variable.")
-
-(defvar erlang-menu-shell-items
- '(nil
- ("Shell"
- (("Start New Shell" erlang-shell)
- ("Display Shell" erlang-shell-display))))
- "Description of the Shell menu used by Erlang mode.
-
-Please see the documentation of `erlang-menu-base-items'.")
-
-(defvar erlang-menu-compile-items
- '(("Compile"
- (("Compile Buffer" erlang-compile)
- ("Display Result" erlang-compile-display)
- ("Next Error" erlang-next-error))))
- "Description of the Compile menu used by Erlang mode.
-
-Please see the documentation of `erlang-menu-base-items'.")
-
-(defvar erlang-menu-version-items
- '(nil
- ("Version" erlang-version))
- "Description of the version menu used in Erlang mode.")
-
-(defvar erlang-menu-personal-items nil
- "Description of personal menu items used in Erlang mode.
-
-Please see the variable `erlang-menu-base-items' for a description
-of the format.")
-
-(defvar erlang-menu-man-items nil
- "The menu containing man pages.
-
-The format of the menu should be compatible with `erlang-menu-base-items'.
-This variable is added to the list of Erlang menus stored in
-`erlang-menu-items'.")
-
-(defvar erlang-menu-skel-items '()
- "Description of the menu containing the skeleton entries.
-The menu is in the form described by the variable `erlang-menu-base-items'.")
-
-(defvar erlang-mode-hook nil
- "Functions to run when Erlang mode is activated.
-
-This hook is used to change the behaviour of Erlang mode. It is
-normally used by the user to personalise the programming environment.
-When used in a site init file, it could be used to customise Erlang
-mode for all users on the system.
-
-The functions added to this hook are run every time Erlang mode is
-started. See also `erlang-load-hook', a hook which is run once,
-when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook'
-which is run every time a new inferior Erlang shell is started.
-
-To use a hook, create an Emacs lisp function to perform your actions
-and add the function to the hook by calling `add-hook'.
-
-The following example binds the key sequence C-c C-c to the command
-`erlang-compile' (normally bound to C-c C-k). The example also
-activates Font Lock mode to fontify the buffer and adds a menu
-containing all functions defined in the current buffer.
-
-To use the example, copy the following lines to your `~/.emacs' file:
-
- (add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
-
- (defun my-erlang-mode-hook ()
- (local-set-key \"\\C-c\\C-c\" 'erlang-compile)
- (if window-system
- (progn
- (setq font-lock-maximum-decoration t)
- (font-lock-mode 1)))
- (if (and window-system (fboundp 'imenu-add-to-menubar))
- (imenu-add-to-menubar \"Imenu\")))")
-
-(defvar erlang-load-hook nil
- "Functions to run when Erlang mode is loaded.
-
-This hook is used to change the behaviour of Erlang mode. It is
-normally used by the user to personalise the programming environment.
-When used in a site init file, it could be used to customize Erlang
-mode for all users on the system.
-
-The difference between this hook and `erlang-mode-hook' and
-`erlang-shell-mode-hook' is that the functions in this hook
-is only called once, when the Erlang mode is loaded into Emacs
-the first time.
-
-Natural actions for the functions added to this hook are actions which
-only should be performed once, and actions which should be performed
-before starting Erlang mode. For example, a number of variables are
-used by Erlang mode before `erlang-mode-hook' is run.
-
-The following example sets the variable `erlang-root-dir' so that the
-manual pages can be retrieved (note that you must set the value of
-`erlang-root-dir' to match the location of Erlang on your system):
-
- (add-hook 'erlang-load-hook 'my-erlang-load-hook)
-
- (defun my-erlang-load-hook ()
- (setq erlang-root-dir \"/usr/local/erlang\"))")
-
-(defvar erlang-new-file-hook nil
- "Functions to run when a new Erlang source file is being edited.
-
-A useful function is `tempo-template-erlang-normal-header'.
-\(This function only exists when the `tempo' package is available.)")
-
-(defcustom erlang-check-module-name 'ask
- "Non-nil means check that module name and file name agrees when saving.
-
-If the value of this variable is the symbol `ask', the user is
-prompted. If the value is t the source is silently changed."
- :group 'erlang
- :type '(choice (const :tag "Check on save" 'ask)
- (const :tag "Don't check on save" t)))
-
-(defvar erlang-electric-commands
- '(erlang-electric-comma
- erlang-electric-semicolon
- erlang-electric-gt)
- "List of activated electric commands.
-
-The list should contain the electric commands which should be active.
-Currently, the available electric commands are:
- `erlang-electric-comma'
- `erlang-electric-semicolon'
- `erlang-electric-gt'
- `erlang-electric-newline'
-
-Should the variable be bound to t, all electric commands
-are activated.
-
-To deactivate all electric commands, set this variable to nil.")
-
-(defcustom erlang-electric-newline-inhibit t
- "Set to non-nil to inhibit newline after electric command.
-
-This is useful since a lot of people press return after executing an
-electric command.
-
-In order to work, the command must also be in the
-list `erlang-electric-newline-inhibit-list'.
-
-Note that commands in this list are required to set the variable
-`erlang-electric-newline-inhibit' to nil when the newline shouldn't be
-inhibited."
- :group 'erlang
- :type 'boolean
- :safe 'booleanp)
-
-(defvar erlang-electric-newline-inhibit-list
- '(erlang-electric-semicolon
- erlang-electric-comma
- erlang-electric-gt)
- "Commands which can inhibit the next newline.")
-
-(defcustom erlang-electric-semicolon-insert-blank-lines nil
- "Number of blank lines inserted before header, or nil.
-
-This variable controls the behaviour of `erlang-electric-semicolon'
-when a new function header is generated. When nil, no blank line is
-inserted between the current line and the new header. When bound to a
-number it represents the number of blank lines which should be
-inserted."
- :type '(restricted-sexp :match-alternatives (integerp 'nil))
- :group 'erlang)
-
-(defvar erlang-electric-semicolon-criteria
- '(erlang-next-lines-empty-p
- erlang-at-keyword-end-p
- erlang-at-end-of-function-p)
- "List of functions controlling `erlang-electric-semicolon'.
-The functions in this list are called, in order, whenever a semicolon
-is typed. Each function in the list is called with no arguments,
-and should return one of the following values:
-
- nil -- no determination made, continue checking
- 'stop -- do not create prototype for next line
- (anything else) -- insert prototype, and stop checking
-
-If every function in the list is called with no determination made,
-then no prototype is inserted.
-
-The test is performed by the function `erlang-test-criteria-list'.")
-
-(defvar erlang-electric-comma-criteria
- '(erlang-stop-when-inside-argument-list
- erlang-stop-when-at-guard
- erlang-next-lines-empty-p
- erlang-at-keyword-end-p
- erlang-at-end-of-clause-p
- erlang-at-end-of-function-p)
- "List of functions controlling `erlang-electric-comma'.
-The functions in this list are called, in order, whenever a comma
-is typed. Each function in the list is called with no arguments,
-and should return one of the following values:
-
- nil -- no determination made, continue checking
- 'stop -- do not create prototype for next line
- (anything else) -- insert prototype, and stop checking
-
-If every function in the list is called with no determination made,
-then no prototype is inserted.
-
-The test is performed by the function `erlang-test-criteria-list'.")
-
-(defvar erlang-electric-arrow-criteria
- '(erlang-stop-when-in-type-spec
- erlang-next-lines-empty-p
- erlang-at-end-of-function-p)
- "List of functions controlling the arrow aspect of `erlang-electric-gt'.
-The functions in this list are called, in order, whenever a `>'
-is typed. Each function in the list is called with no arguments,
-and should return one of the following values:
-
- nil -- no determination made, continue checking
- 'stop -- do not create prototype for next line
- (anything else) -- insert prototype, and stop checking
-
-If every function in the list is called with no determination made,
-then no prototype is inserted.
-
-The test is performed by the function `erlang-test-criteria-list'.")
-
-(defvar erlang-electric-newline-criteria
- '(t)
- "List of functions controlling `erlang-electric-newline'.
-
-The electric newline commands indents the next line. Should the
-current line begin with a comment the comment start is copied to
-the newly created line.
-
-The functions in this list are called, in order, whenever a comma
-is typed. Each function in the list is called with no arguments,
-and should return one of the following values:
-
- nil -- no determination made, continue checking
- 'stop -- do not create prototype for next line
- (anything else) -- trigger the electric command.
-
-If every function in the list is called with no determination made,
-then no prototype is inserted. Should the atom t be a member of the
-list, it is treated as a function triggering the electric command.
-
-The test is performed by the function `erlang-test-criteria-list'.")
-
-(defcustom erlang-next-lines-empty-threshold 2
- "Number of blank lines required to activate an electric command.
-
-Actually, this value controls the behaviour of the function
-`erlang-next-lines-empty-p' which normally is a member of the
-criteria lists controlling the electric commands. (Please see
-the variables `erlang-electric-semicolon-criteria' and
-`erlang-electric-comma-criteria'.)
-
-The variable is bound to a threshold value, a number, representing the
-number of lines which must be empty.
-
-Setting this variable to zero, electric commands will always be
-triggered by `erlang-next-lines-empty-p', unless inhibited by other
-rules.
-
-Should this variable be nil, `erlang-next-lines-empty-p' will never
-trigger an electric command. The same effect would be reached if the
-function `erlang-next-lines-empty-p' would be removed from the criteria
-lists.
-
-Note that even if `erlang-next-lines-empty-p' should not trigger an
-electric command, other functions in the criteria list could."
- :group 'erlang
- :type '(restricted-sexp :match-alternatives (integerp 'nil))
- :safe (lambda (val) (or (eq val nil) (integerp val))))
-
-(defcustom erlang-new-clause-with-arguments nil
- "Non-nil means that the arguments are cloned when a clause is generated.
-
-A new function header can be generated by calls to the function
-`erlang-generate-new-clause' and by use of the electric semicolon."
- :group 'erlang
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom erlang-compile-use-outdir t
- "When nil, go to the directory containing source file when compiling.
-
-This is a workaround for a bug in the `outdir' option of compile. If the
-outdir is not in the current load path, Erlang doesn't load the object
-module after it has been compiled.
-
-To activate the workaround, place the following in your `~/.emacs' file:
- (setq erlang-compile-use-outdir nil)"
- :group 'erlang
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom erlang-indent-level 4
- "Indentation of Erlang calls/clauses within blocks."
- :group 'erlang
- :type 'integer
- :safe 'integerp)
-
-(defcustom erlang-icr-indent nil
- "Indentation of Erlang if/case/receive patterns.
-nil means keeping default behavior. When non-nil, indent to the column of
-if/case/receive."
- :group 'erlang
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom erlang-indent-guard 2
- "Indentation of Erlang guards."
- :group 'erlang
- :type 'integer
- :safe 'integerp)
-
-(defcustom erlang-argument-indent 2
- "Indentation of the first argument in a function call.
-When nil, indent to the column after the `(' of the
-function."
- :group 'erlang
- :type '(restricted-sexp :match-alternatives (integerp 'nil))
- :safe (lambda (val) (or (eq val nil) (integerp val))))
-
-(defcustom erlang-tab-always-indent t
- "Non-nil means TAB in Erlang mode should always re-indent the current line,
-regardless of where in the line point is when the TAB command is used."
- :group 'erlang
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom erlang-max-files-to-visit-for-refining-xrefs 32
- "Upper limit how many files to visit for checking arity.
-When `nil' there is no limit."
- :group 'erlang
- :type '(restricted-sexp :match-alternatives (integerp 'nil))
- :safe (lambda (val) (or (eq val nil) (integerp val))))
-
-(defvar erlang-man-inhibit (eq system-type 'windows-nt)
- "Inhibit the creation of the Erlang Manual Pages menu.
-
-The Windows distribution of Erlang does not include man pages, hence
-there is no attempt to create the menu.")
-
-(defvar erlang-man-dirs
- '(("Man - Commands" "/man/man1" t)
- ("Man - Modules" "/man/man3" t)
- ("Man - Files" "/man/man4" t)
- ("Man - Applications" "/man/man6" t))
- "The man directories displayed in the Erlang menu.
-
-Each item in the list should be a list with three elements, the first
-the name of the menu, the second the directory, and the last a flag.
-Should the flag the nil, the directory is absolute, should it be non-nil
-the directory is relative to the variable `erlang-root-dir'.")
-
-(defvar erlang-man-max-menu-size 35
- "The maximum number of menu items in one menu allowed.")
-
-(defvar erlang-man-display-function 'erlang-man-display
- "Function used to display man page.
-
-The function is called with one argument, the name of the file
-containing the man page. Use this variable when the default
-function, `erlang-man-display', does not work on your system.")
-
-(defvar erlang-compile-extra-opts '()
- "Additional options to the compilation command.
-This is an elisp list of options. Each option can be either:
-- an atom
-- a dotted pair
-- a string
-Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))")
-
-(defvar erlang-compile-command-function-alist
- '((".erl\\'" . inferior-erlang-compute-erl-compile-command)
- (".xrl\\'" . inferior-erlang-compute-leex-compile-command)
- (".yrl\\'" . inferior-erlang-compute-yecc-compile-command)
- ("." . inferior-erlang-compute-erl-compile-command))
- "Alist of filename patterns vs corresponding compilation functions.
-Each element looks like (REGEXP . FUNCTION). Compiling a file whose name
-matches REGEXP specifies FUNCTION to use to compute the compilation
-command. The FUNCTION will be called with two arguments: module name and
-default compilation options, like output directory. The FUNCTION
-is expected to return a string.")
-
-(defvar erlang-leex-compile-opts '()
- "Options to pass to leex when compiling xrl files.
-This is an elisp list of options. Each option can be either:
-- an atom
-- a dotted pair
-- a string")
-
-(defvar erlang-yecc-compile-opts '()
- "Options to pass to yecc when compiling yrl files.
-This is an elisp list of options. Each option can be either:
-- an atom
-- a dotted pair
-- a string")
-
-(eval-and-compile
- (defvar erlang-regexp-modern-p t
- "Non-nil when this version of Emacs uses a modern version of regexp.
-Supporting \_< and \_> This is determined by checking the version of Emacs used."))
-
-(eval-and-compile
- (defconst erlang-atom-quoted-regexp
- "'\\(?:[^\\']\\|\\(?:\\\\.\\)\\)*'"
- "Regexp describing a single-quoted atom"))
-
-(eval-and-compile
- (defconst erlang-atom-regular-regexp
- (if erlang-regexp-modern-p
- "\\_<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\_>"
- "\\<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\>")
- "Regexp describing a regular (non-quoted) atom"))
-
-(eval-and-compile
- (defconst erlang-atom-regexp
- (concat "\\(" erlang-atom-quoted-regexp "\\|"
- erlang-atom-regular-regexp "\\)")
- "Regexp describing an Erlang atom."))
-
-(eval-and-compile
- (defconst erlang-atom-regexp-matches 1
- "Number of regexp parenthesis pairs in `erlang-atom-regexp'.
-
-This is used to determine parenthesis matches in complex regexps which
-contains `erlang-atom-regexp'."))
-
-
-(eval-and-compile
- (defconst erlang-variable-regexp
- (if erlang-regexp-modern-p
- "\\_<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\_>"
- "\\<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\>")
- "Regexp which should match an Erlang variable.
-
-The regexp must be surrounded with a pair of regexp parentheses."))
-
-(eval-and-compile
- (defconst erlang-variable-regexp-matches 1
- "Number of regexp parenthesis pairs in `erlang-variable-regexp'.
-
-This is used to determine matches in complex regexps which contains
-`erlang-variable-regexp'."))
-
-(defconst erlang-module-function-regexp
- (eval-when-compile
- (concat erlang-atom-regexp ":" erlang-atom-regexp))
- "Regexp matching an erlang module:function.")
-
-(defconst erlang-name-regexp
- (concat "\\("
- "\\(?:\\sw\\|\\s_\\)+"
- "\\|"
- erlang-atom-quoted-regexp
- "\\)")
- "Matches a name of a function, macro or record")
-
-(defconst erlang-id-regexp
- (concat "\\(?:\\(qualified-function\\|record\\|macro\\|module\\) \\)?"
- "\\(?:" erlang-atom-regexp ":\\)?"
- erlang-name-regexp "?"
- "\\(?:/\\([0-9]+\\)\\)?"))
-
-(eval-and-compile
- (defun erlang-regexp-opt (strings &optional paren)
- "Like `regexp-opt', except if PAREN is `symbols', then the
-resulting regexp is surrounded by \\_< and \\_>."
- (if (eq paren 'symbols)
- (if erlang-regexp-modern-p
- (concat "\\_<" (regexp-opt strings t) "\\_>")
- (concat "\\<" (regexp-opt strings t) "\\>"))
- (regexp-opt strings paren))))
-
-
-(eval-and-compile
- (defvar erlang-keywords
- '("after"
- "begin"
- "catch"
- "case"
- "cond"
- "end"
- "fun"
- "if"
- "let"
- "of"
- "receive"
- "try"
- "maybe"
- "else"
- "when")
- "Erlang reserved keywords"))
-
-(eval-and-compile
- (defconst erlang-keywords-regexp (erlang-regexp-opt erlang-keywords 'symbols)))
-
-(eval-and-compile
- (defvar erlang-operators
- '("and"
- "andalso"
- "band"
- "bnot"
- "bor"
- "bsl"
- "bsr"
- "bxor"
- "div"
- "not"
- "or"
- "orelse"
- "rem"
- "xor")
- "Erlang operators"))
-;; What about these?
-;; '+' '-' '*' '/' '>', '>=', '<', '=<', '=:=', '==', '=/=', '/='
-
-(eval-and-compile
- (defconst erlang-operators-regexp (erlang-regexp-opt erlang-operators 'symbols)))
-
-
-(eval-and-compile
- (defvar erlang-guards
- '("is_atom"
- "is_binary"
- "is_bitstring"
- "is_boolean"
- "is_float"
- "is_function"
- "is_integer"
- "is_list"
- "is_map"
- "is_number"
- "is_pid"
- "is_port"
- "is_record"
- "is_reference"
- "is_tuple"
- "atom"
- "binary"
- "bitstring"
- "boolean"
- ;;"float" ; Not included to avoid clashes with the bif float/1
- "function"
- "integer"
- "list"
- "number"
- "pid"
- "port"
- "record"
- "reference"
- "tuple")
- "Erlang guards"))
-
-(eval-and-compile
- (defconst erlang-guards-regexp (erlang-regexp-opt erlang-guards 'symbols)))
-
-(eval-and-compile
- (defvar erlang-predefined-types
- '("any"
- "arity"
- "boolean"
- "byte"
- "char"
- "cons"
- "deep_string"
- "iodata"
- "iolist"
- "maybe_improper_list"
- "module"
- "mfa"
- "nil"
- "neg_integer"
- "none"
- "non_neg_integer"
- "nonempty_list"
- "nonempty_improper_list"
- "nonempty_maybe_improper_list"
- "nonempty_string"
- "no_return"
- "pos_integer"
- "string"
- "term"
- "timeout"
- "map")
- "Erlang type specs types"))
-
-(eval-and-compile
- (defconst erlang-predefined-types-regexp
- (erlang-regexp-opt erlang-predefined-types 'symbols)))
-
-
-(eval-and-compile
- (defvar erlang-int-bifs
- '("abs"
- "alias"
- "apply"
- "atom_to_binary"
- "atom_to_list"
- "binary_to_atom"
- "binary_to_existing_atom"
- "binary_to_float"
- "binary_to_integer"
- "binary_to_list"
- "binary_to_term"
- "binary_part"
- "bit_size"
- "bitstring_to_list"
- "byte_size"
- "ceil"
- "check_old_code"
- "check_process_code"
- "date"
- "delete_module"
- "demonitor"
- "disconnect_node"
- "element"
- "erase"
- "error"
- "exit"
- "floor"
- "float"
- "float_to_binary"
- "float_to_list"
- "garbage_collect"
- "get"
- "get_keys"
- "group_leader"
- "halt"
- "hd"
- "integer_to_list"
- "integer_to_binary"
- "iolist_size"
- "iolist_to_binary"
- "is_alive"
- "is_atom"
- "is_binary"
- "is_bitstring"
- "is_boolean"
- "is_float"
- "is_function"
- "is_integer"
- "is_list"
- "is_map"
- "is_map_key"
- "is_number"
- "is_pid"
- "is_port"
- "is_process_alive"
- "is_record"
- "is_reference"
- "is_tuple"
- "length"
- "link"
- "list_to_atom"
- "list_to_binary"
- "list_to_bitstring"
- "list_to_existing_atom"
- "list_to_float"
- "list_to_integer"
- "list_to_pid"
- "list_to_port"
- "list_to_ref"
- "list_to_tuple"
- "load_module"
- "make_ref"
- "map_get"
- "map_size"
- "max"
- "min"
- "module_loaded"
- "monitor"
- "monitor_node"
- "node"
- "nodes"
- "now"
- "open_port"
- "pid_to_list"
- "port_close"
- "port_command"
- "port_connect"
- "port_control"
- "port_to_list"
- "pre_loaded"
- "process_flag"
- "process_info"
- "processes"
- "purge_module"
- "put"
- "ref_to_list"
- "register"
- "registered"
- "round"
- "self"
- "setelement"
- "size"
- "spawn"
- "spawn_link"
- "spawn_monitor"
- "spawn_opt"
- "spawn_request"
- "spawn_request_abandon"
- "split_binary"
- "statistics"
- "term_to_binary"
- "term_to_iovec"
- "time"
- "throw"
- "tl"
- "trunc"
- "tuple_size"
- "tuple_to_list"
- "unalias"
- "unlink"
- "unregister"
- "whereis")
- "Erlang built-in functions (BIFs)"))
-
-(eval-and-compile
- (defconst erlang-int-bif-regexp (erlang-regexp-opt erlang-int-bifs 'symbols)))
-
-
-(eval-and-compile
- (defvar erlang-ext-bifs
- '("adler32"
- "adler32_combine"
- "alloc_info"
- "alloc_sizes"
- "append"
- "append_element"
- "bump_reductions"
- "call_on_load_function"
- "cancel_timer"
- "crc32"
- "crc32_combine"
- "decode_packet"
- "delay_trap"
- "delete_element"
- "display"
- "display_nl"
- "display_string"
- "dist_get_stat"
- "dist_ctrl_get_data"
- "dist_ctrl_get_data_notification"
- "dist_ctrl_get_opt"
- "dist_ctrl_input_handler"
- "dist_ctrl_put_data"
- "dist_ctrl_set_opt"
- "dmonitor_node"
- "dt_append_vm_tag_data"
- "dt_get_tag"
- "dt_get_tag_data"
- "dt_prepend_vm_tag_data"
- "dt_put_tag"
- "dt_restore_tag"
- "dt_spread_tag"
- "convert_time_unit"
- "exit_signal"
- "external_size"
- "finish_after_on_load"
- "finish_loading"
- "format_cpu_topology"
- "fun_info"
- "fun_info_mfa"
- "fun_to_list"
- "function_exported"
- "garbage_collect_message_area"
- "gather_gc_info_result"
- "get_cookie"
- "get_module_info"
- "has_prepared_code_on_load"
- "hibernate"
- "insert_element"
- "iolist_to_iovec"
- "is_builtin"
- "load_nif"
- "loaded"
- "localtime"
- "localtime_to_universaltime"
- "make_fun"
- "make_tuple"
- "match_spec_test"
- "md5"
- "md5_final"
- "md5_init"
- "md5_update"
- "memory"
- "module_info"
- "monitor_node"
- "monotonic_time"
- "nif_error"
- "phash"
- "phash2"
- "port_call"
- "port_get_data"
- "port_info"
- "port_set_data"
- "ports"
- "posixtime_to_universaltime"
- "prepare_loading"
- "process_display"
- "raise"
- "read_timer"
- "resume_process"
- "send"
- "send_after"
- "send_nosuspend"
- "seq_trace"
- "seq_trace_info"
- "seq_trace_print"
- "set_cookie"
- "set_cpu_topology"
- "setnode"
- "start_timer"
- "subtract"
- "suspend_process"
- "system_flag"
- "system_info"
- "system_monitor"
- "system_profile"
- "system_time"
- "trace"
- "trace_delivered"
- "trace_info"
- "trace_pattern"
- "time_offset"
- "timestamp"
- "universaltime"
- "universaltime_to_localtime"
- "universaltime_to_posixtime"
- "unique_integer"
- "yield")
- "Erlang built-in functions (BIFs) that needs erlang: prefix"))
-
-(eval-and-compile
- (defconst erlang-ext-bif-regexp
- (erlang-regexp-opt (append erlang-int-bifs erlang-ext-bifs) 'symbols)))
-
-
-(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
- "Regexp which should match beginning of a clause.")
-
-(defvar erlang-file-name-extension-regexp "\\.erl$"
- "Regexp which should match an Erlang file name.
-
-This regexp is used when an Erlang module name is extracted from the
-name of an Erlang source file.
-
-The regexp should only match the section of the file name which should
-be excluded from the module name.
-
-To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\".
-The matches all except the extension. This is useful if the Erlang
-tags system should interpret tags on the form `module:tag' for
-files written in other languages than Erlang.")
-
-(defvar erlang-inferior-shell-split-window t
- "If non-nil, when starting an inferior shell, split windows.
-If nil, the inferior shell replaces the window. This is the traditional
-behaviour.")
-
-(defvar erlang-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map ";" 'erlang-electric-semicolon)
- (define-key map "," 'erlang-electric-comma)
- (define-key map "<" 'erlang-electric-lt)
- (define-key map ">" 'erlang-electric-gt)
- (define-key map "\C-m" 'erlang-electric-newline)
- (define-key map (kbd "DEL") 'backward-delete-char-untabify)
- (define-key map "\M-q" 'erlang-fill-paragraph)
- (define-key map "\M-\t" 'erlang-complete-tag)
- (define-key map "\C-c\M-\t" 'tempo-complete-tag)
- (define-key map "\M-+" 'erlang-find-next-tag)
- (define-key map "\C-c\M-a" 'erlang-beginning-of-clause)
- (define-key map "\C-c\M-b" 'tempo-backward-mark)
- (define-key map "\C-c\M-e" 'erlang-end-of-clause)
- (define-key map "\C-c\M-f" 'tempo-forward-mark)
- (define-key map "\C-c\M-h" 'erlang-mark-clause)
- (define-key map "\C-c\C-c" 'comment-region)
- (define-key map "\C-c\C-j" 'erlang-generate-new-clause)
- (define-key map "\C-c\C-k" 'erlang-compile)
- (define-key map "\C-c\C-l" 'erlang-compile-display)
- (define-key map "\C-c\C-s" 'erlang-show-syntactic-information)
- (define-key map "\C-c\C-q" 'erlang-indent-function)
- (define-key map "\C-c\C-u" 'uncomment-region)
- (define-key map "\C-c\C-y" 'erlang-clone-arguments)
- (define-key map "\C-c\C-a" 'erlang-align-arrows)
- (define-key map "\C-c\C-z" 'erlang-shell-display)
- (define-key map "\C-c\C-d" 'erlang-man-function-no-prompt)
- map)
- "Keymap used in Erlang mode.")
-(defvar erlang-mode-abbrev-table nil
- "Abbrev table in use in Erlang-mode buffers.")
-(defvar erlang-mode-syntax-table nil
- "Syntax table in use in Erlang-mode buffers.")
-
-
-
-(defvar erlang-skel-file "erlang-skels"
- "The type of erlang-skeletons that should be used, default
- uses edoc type, for the old type, standard comments,
- set \"erlang-skels-old\" in your .emacs and restart.
-
- Or define your own and set the variable to that file.")
-
-;; Tempo skeleton templates:
-(load erlang-skel-file)
-
-;; Font-lock variables
-
-;; The next few variables define different Erlang font-lock patterns.
-;; They could be appended to form a custom font-lock appearance.
-;;
-;; The function `erlang-font-lock-set-face' could be used to change
-;; the face of a pattern.
-;;
-;; Note that Erlang strings and atoms are highlighted with using
-;; syntactic analysis.
-
-(defvar erlang-font-lock-keywords-function-header
- (list
- (list (concat "^" erlang-atom-regexp "\\s-*(")
- 1 'font-lock-function-name-face t))
- "Font lock keyword highlighting a function header.")
-
-(defface erlang-font-lock-exported-function-name-face
- '((default (:inherit font-lock-function-name-face)))
- "Face used for highlighting exported functions."
- :group 'erlang)
-
-(defvar erlang-font-lock-exported-function-name-face
- 'erlang-font-lock-exported-function-name-face)
-
-(defvar erlang-inhibit-exported-function-name-face nil
- "Inhibit separate face for exported functions")
-
-(defvar erlang-font-lock-keywords-exported-function-header
- (list
- (list #'erlang-match-next-exported-function
- 1 'erlang-font-lock-exported-function-name-face t))
- "Font lock keyword highlighting an exported function header.")
-
-(defvar erlang-font-lock-keywords-int-bifs
- (list
- (list (concat erlang-int-bif-regexp "\\s-*(")
- 1 'font-lock-builtin-face))
- "Font lock keyword highlighting built in functions.")
-
-(defvar erlang-font-lock-keywords-ext-bifs
- (list
- (list (concat "\\<\\(erlang\\)\\s-*:\\s-*" erlang-ext-bif-regexp "\\s-*(")
- '(1 'font-lock-builtin-face)
- '(2 'font-lock-builtin-face)))
- "Font lock keyword highlighting built in functions.")
-
-(defvar erlang-font-lock-keywords-int-function-calls
- (list
- (list (concat erlang-atom-regexp "\\s-*(")
- 1 'font-lock-type-face))
- "Font lock keyword highlighting an internal function call.")
-
-(defvar erlang-font-lock-keywords-ext-function-calls
- (list
- (list (concat erlang-atom-regexp "\\s-*:\\s-*"
- erlang-atom-regexp "\\s-*(")
- '(1 'font-lock-type-face)
- '(2 'font-lock-type-face)))
- "Font lock keyword highlighting an external function call.")
-
-(defvar erlang-font-lock-keywords-fun-n
- (list
- (list (concat "\\(" erlang-atom-regexp "/[0-9]+\\)")
- 1 'font-lock-type-face))
- "Font lock keyword highlighting a fun descriptor in F/N format.")
-
-(defvar erlang-font-lock-keywords-operators
- (list
- (list erlang-operators-regexp
- 1 'font-lock-builtin-face))
- "Font lock keyword highlighting Erlang operators.")
-
-(defvar erlang-font-lock-keywords-dollar
- (list
- (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)"
- 1 'font-lock-constant-face))
- "Font lock keyword highlighting numbers in ASCII form (e.g. $A).")
-
-(defvar erlang-font-lock-keywords-arrow
- (list
- (list "->\\(\\s \\|$\\)" 1 'font-lock-function-name-face))
- "Font lock keyword highlighting clause arrow.")
-
-(defvar erlang-font-lock-keywords-lc
- (list
- (list "\\(<-\\|<=\\|||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face))
- "Font lock keyword highlighting list comprehension operators.")
-
-(defvar erlang-font-lock-keywords-keywords
- (list
- (list erlang-keywords-regexp 1 'font-lock-keyword-face))
- "Font lock keyword highlighting Erlang keywords.")
-
-(defvar erlang-font-lock-keywords-attr
- (list
- (list (concat "^\\(-" erlang-atom-regexp "\\)\\(\\s-\\|\\.\\|(\\)")
- 1 (if (boundp 'font-lock-preprocessor-face)
- 'font-lock-preprocessor-face
- 'font-lock-constant-face)))
- "Font lock keyword highlighting attributes.")
-
-(defvar erlang-font-lock-keywords-quotes
- (list
- (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'"
- 1
- 'font-lock-keyword-face
- t))
- "Font lock keyword highlighting words in single quotes in comments.
-
-This is not the highlighting of Erlang strings and atoms, which
-are highlighted by syntactic analysis.")
-
-(defvar erlang-font-lock-keywords-guards
- (list
- (list (concat "[^:]" erlang-guards-regexp "\\s-*(")
- 1 'font-lock-builtin-face))
- "Font lock keyword highlighting guards.")
-
-(defvar erlang-font-lock-keywords-predefined-types
- (list
- (list (concat "[^:]" erlang-predefined-types-regexp "\\s-*(")
- 1 'font-lock-builtin-face))
- "Font lock keyword highlighting predefined types.")
-
-
-(defvar erlang-font-lock-keywords-macros
- (list
- (list (concat "?\\s-*\\(" erlang-atom-regexp
- "\\|" erlang-variable-regexp "\\)")
- 1 'font-lock-constant-face)
- (list (concat "^\\(-\\(?:define\\|ifn?def\\)\\)\\s-*(\\s-*\\(" erlang-atom-regexp
- "\\|" erlang-variable-regexp "\\)")
- (if (boundp 'font-lock-preprocessor-face)
- (list 1 'font-lock-preprocessor-face t)
- (list 1 'font-lock-constant-face t))
- (list 3 'font-lock-type-face t t))
- (list "^-e\\(lse\\|ndif\\)\\>" 0 'font-lock-preprocessor-face t))
- "Font lock keyword highlighting macros.
-This must be placed in front of `erlang-font-lock-keywords-vars'.")
-
-(defvar erlang-font-lock-keywords-records
- (list
- (list (concat "#\\s *" erlang-atom-regexp)
- 1 'font-lock-type-face)
- ;; Don't highlight numerical constants.
- (list (if erlang-regexp-modern-p
- "\\_<\\([0-9]+\\(_[0-9]+\\)*#[0-9a-zA-Z]+\\(_[0-9a-zA-Z]+\\)*\\)"
- "\\<\\([0-9]+\\(_[0-9]+\\)*#[0-9a-zA-Z]+\\(_[0-9a-zA-Z]+\\)*\\)")
- 1 nil t)
- (list (concat "^-record\\s-*(\\s-*" erlang-atom-regexp)
- 1 'font-lock-type-face))
- "Font lock keyword highlighting Erlang records.
-This must be placed in front of `erlang-font-lock-keywords-vars'.")
-
-(defvar erlang-font-lock-keywords-vars
- (list
- (list (concat "[^#]" erlang-variable-regexp) ; no numerical constants
- 1 'font-lock-variable-name-face))
- "Font lock keyword highlighting Erlang variables.
-Must be preceded by `erlang-font-lock-keywords-macros' to work properly.")
-
-(defvar erlang-font-lock-descr-string
- "Font-lock keywords used by Erlang Mode.
-
-There exists three levels of Font Lock keywords for Erlang:
- `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
- `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'.
- `erlang-font-lock-keywords-3' - Variables, macros and records.
- `erlang-font-lock-keywords-4' - Exported functions, Function names,
- Funs, LCs (not Atoms).
-
-To use a specific level, please set the variable
-`font-lock-maximum-decoration' to the appropriate level. Note that the
-variable must be set before Erlang mode is activated.
-
-Example:
- (setq font-lock-maximum-decoration 2)")
-
-(defvar erlang-font-lock-keywords-1
- (append erlang-font-lock-keywords-function-header
- erlang-font-lock-keywords-dollar
- erlang-font-lock-keywords-arrow
- erlang-font-lock-keywords-keywords
- )
- ;; DocStringOrig: erlang-font-lock-keywords
- erlang-font-lock-descr-string)
-
-(defvar erlang-font-lock-keywords-2
- (append erlang-font-lock-keywords-1
- erlang-font-lock-keywords-int-bifs
- erlang-font-lock-keywords-ext-bifs
- erlang-font-lock-keywords-attr
- erlang-font-lock-keywords-quotes
- erlang-font-lock-keywords-guards
- )
- ;; DocStringCopy: erlang-font-lock-keywords
- erlang-font-lock-descr-string)
-
-(defvar erlang-font-lock-keywords-3
- (append erlang-font-lock-keywords-2
- erlang-font-lock-keywords-operators
- erlang-font-lock-keywords-macros
- erlang-font-lock-keywords-records
- erlang-font-lock-keywords-vars
- erlang-font-lock-keywords-predefined-types
- )
- ;; DocStringCopy: erlang-font-lock-keywords
- erlang-font-lock-descr-string)
-
-(defvar erlang-font-lock-keywords-4
- (append erlang-font-lock-keywords-3
- erlang-font-lock-keywords-exported-function-header
- erlang-font-lock-keywords-int-function-calls
- erlang-font-lock-keywords-ext-function-calls
- erlang-font-lock-keywords-fun-n
- erlang-font-lock-keywords-lc
- )
- ;; DocStringCopy: erlang-font-lock-keywords
- erlang-font-lock-descr-string)
-
-(defvar erlang-font-lock-keywords erlang-font-lock-keywords-4
- ;; DocStringCopy: erlang-font-lock-keywords
- erlang-font-lock-descr-string)
-
-(defvar erlang-font-lock-syntax-table nil
- "Syntax table used by Font Lock mode.
-
-The difference between this and the standard Erlang Mode
-syntax table is that `_' is treated as part of words by
-this syntax table.")
-
-(defvar erlang-replace-etags-tags-completion-table nil
- "Internal flag used by advice `erlang-replace-tags-table'.
-This is non-nil when `etags-tags-completion-table' should be
-replaced by `erlang-etags-tags-completion-table'.")
-
-
-;;; Avoid errors while compiling this file.
-
-;; defvar some obsolete variables, which we still support for
-;; backwards compatibility reasons.
-(eval-when-compile
- (defvar comment-indent-hook)
- (defvar dabbrev-case-fold-search)
- (defvar tempo-match-finder)
- (defvar compilation-menu-map)
- (defvar next-error-last-buffer))
-
-(eval-when-compile
- (require 'comint)
- (require 'tempo)
- (require 'compile))
-
-
-(defun erlang-version ()
- "Return the current version of Erlang mode."
- (interactive)
- (if (called-interactively-p 'interactive)
- (message "Erlang mode version %s, written by Anders Lindgren"
- erlang-version))
- erlang-version)
-
-;;;###autoload
-(define-derived-mode erlang-mode prog-mode "Erlang"
- "Major mode for editing Erlang source files in Emacs.
-It knows about syntax and comment, it can indent code, it is capable
-of fontifying the source file, the TAGS commands are aware of Erlang
-modules, and the Erlang man pages can be accessed.
-
-Should this module, \"erlang.el\", be installed properly, Erlang mode
-is activated whenever an Erlang source or header file is loaded into
-Emacs. To indicate this, the mode line should contain the word
-\"Erlang\".
-
-The main feature of Erlang mode is indentation, press TAB and the
-current line will be indented correctly.
-
-Comments starting with only one `%' are indented to the column stored
-in the variable `comment-column'. Comments starting with two `%':s
-are indented with the same indentation as code. Comments starting
-with at least three `%':s are indented to the first column.
-
-However, Erlang mode contains much more, this is a list of the most
-useful commands:
- TAB - Indent the line.
- C-c C-q - Indent current function.
- M-; - Create a comment at the end of the line.
- M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
- will look better.
- M-a - Goto the beginning of an Erlang clause.
- M-C-a - Ditto for function.
- M-e - Goto the end of an Erlang clause.
- M-C-e - Ditto for function.
- M-h - Mark current Erlang clause.
- M-C-h - Ditto for function.
- C-c C-z - Start, or switch to, an inferior Erlang shell.
- C-c C-k - Compile current file.
- C-x ` - Next error.
- , - Electric comma.
- ; - Electric semicolon.
-
-Erlang mode check the name of the file against the module name when
-saving, whenever a mismatch occurs Erlang mode offers to modify the
-source.
-
-The variable `erlang-electric-commands' controls the electric
-commands. To deactivate all of them, set it to nil.
-
-There exists a large number of commands and variables in the Erlang
-module. Please press `M-x apropos RET erlang RET' to see a complete
-list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
-RET'to see the full description of functions and variables,
-respectively.
-
-On entry to this mode the contents of the hook `erlang-mode-hook' is
-executed.
-
-Please see the beginning of the file `erlang.el' for more information
-and examples of hooks.
-
-Other commands:
-\\{erlang-mode-map}"
- ;; Use our own syntax table function
- :syntax-table nil
- (erlang-syntax-table-init)
- (erlang-electric-init)
- (erlang-menu-init)
- (erlang-mode-variables)
- (add-hook 'before-save-hook 'erlang-check-module-name nil t)
- (erlang-man-init)
- (erlang-tags-init)
- (erlang-font-lock-init)
- (erlang-skel-init)
- (tempo-use-tag-list 'erlang-tempo-tags)
- (when (and (fboundp 'add-function) (fboundp 'erldoc-eldoc-function))
- (or eldoc-documentation-function
- (setq-local eldoc-documentation-function #'ignore))
- (add-function :before-until (local 'eldoc-documentation-function)
- #'erldoc-eldoc-function))
-
- ;; Align maps.
- (add-to-list 'align-rules-list
- '(erlang-maps
- (regexp . "\\(\\s-*\\)\\(=>\\)\\s-*")
- (modes . '(erlang-mode))
- (repeat . t)))
- ;; Align records and :: specs
- (add-to-list 'align-rules-list
- '(erlang-record-specs
- (regexp . "\\(\\s-*\\)\\(=\\).*\\(::\\)*\\s-*")
- (modes . '(erlang-mode))
- (repeat . t)))
- (if (zerop (buffer-size))
- (run-hooks 'erlang-new-file-hook)))
-
-;;;###autoload
-(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript"
- "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app"))
- (add-to-list 'auto-mode-alist (cons r 'erlang-mode)))
-
-(defun erlang-syntax-table-init ()
- (erlang-ensure-syntax-table-is-initialized)
- (set-syntax-table erlang-mode-syntax-table))
-
-(defun erlang-ensure-syntax-table-is-initialized ()
- (unless erlang-mode-syntax-table
- (let ((table (make-syntax-table)))
- (modify-syntax-entry ?\n ">" table)
- (modify-syntax-entry ?\" "\"" table)
- (modify-syntax-entry ?# "." table)
- ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indentation afterwards
- ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indentation problems
- (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $"
- ;; we have to live with that for now..it is the best alternative
- ;; that can be worked around with "string that ends with \$"
- (modify-syntax-entry ?% "<" table)
- (modify-syntax-entry ?& "." table)
- (modify-syntax-entry ?\' "\"" table)
- (modify-syntax-entry ?* "." table)
- (modify-syntax-entry ?+ "." table)
- (modify-syntax-entry ?- "." table)
- (modify-syntax-entry ?/ "." table)
- (modify-syntax-entry ?: "." table)
- (modify-syntax-entry ?< "." table)
- (modify-syntax-entry ?= "." table)
- (modify-syntax-entry ?> "." table)
- (modify-syntax-entry ?\\ "\\" table)
- (modify-syntax-entry ?_ "_" table)
- (modify-syntax-entry ?| "." table)
- (modify-syntax-entry ?^ "'" table)
-
- ;; Pseudo bit-syntax: Latin1 double angle quotes as parens.
- ;;(modify-syntax-entry ?\253 "(?\273" table)
- ;;(modify-syntax-entry ?\273 ")?\253" table)
-
- (setq erlang-mode-syntax-table table))))
-
-
-
-(defun erlang-electric-init ()
- ;; Set up electric character functions to work with
- ;; delsel/pending-del mode. Also, set up text properties for bit
- ;; syntax handling.
- (mapc #'(lambda (cmd)
- (put cmd 'delete-selection t)) ;for delsel (Emacs)
- '(erlang-electric-semicolon
- erlang-electric-comma
- erlang-electric-gt))
-
- (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>))
- (put 'bitsyntax-open-outer 'rear-nonsticky '(category))
- (put 'bitsyntax-open-inner 'rear-nonsticky '(category))
- (put 'bitsyntax-close-inner 'rear-nonsticky '(category))
- (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<))
- (put 'bitsyntax-close-outer 'rear-nonsticky '(category))
- (make-local-variable 'parse-sexp-lookup-properties)
- (setq parse-sexp-lookup-properties 't))
-
-
-(defun erlang-mode-variables ()
- (or erlang-mode-abbrev-table
- (define-abbrev-table 'erlang-mode-abbrev-table ()))
- (setq local-abbrev-table erlang-mode-abbrev-table)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "^$\\|" page-delimiter))
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
- (make-local-variable 'defun-prompt-regexp)
- (setq defun-prompt-regexp erlang-defun-prompt-regexp)
- (make-local-variable 'comment-start)
- (setq comment-start "%")
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "%+\\s *")
- (make-local-variable 'comment-column)
- (setq comment-column 48)
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'erlang-indent-command)
- (make-local-variable 'indent-region-function)
- (setq indent-region-function 'erlang-indent-region)
- (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'dabbrev-case-fold-search) nil)
- (set (make-local-variable 'imenu-prev-index-position-function)
- 'erlang-beginning-of-function)
- (set (make-local-variable 'imenu-extract-index-name-function)
- 'erlang-get-function-name-and-arity)
- (set (make-local-variable 'tempo-match-finder)
- "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")
- (set (make-local-variable 'beginning-of-defun-function)
- 'erlang-beginning-of-function)
- (set (make-local-variable 'end-of-defun-function) 'erlang-end-of-function)
- (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
- (set (make-local-variable 'fill-paragraph-function) 'erlang-fill-paragraph)
- (set (make-local-variable 'comment-add) 1)
- (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$")
- (set (make-local-variable 'outline-level) (lambda () 1))
- (set (make-local-variable 'add-log-current-defun-function)
- 'erlang-current-defun))
-
-(defun erlang-font-lock-init ()
- "Initialize Font Lock for Erlang mode."
- (or erlang-font-lock-syntax-table
- (setq erlang-font-lock-syntax-table
- (let ((table (copy-syntax-table erlang-mode-syntax-table)))
- (modify-syntax-entry ?_ "w" table)
- table)))
- (set (make-local-variable 'font-lock-syntax-table)
- erlang-font-lock-syntax-table)
- (set (make-local-variable (if (boundp 'syntax-begin-function)
- 'syntax-begin-function
- 'font-lock-beginning-of-syntax-function))
- 'erlang-beginning-of-clause)
- (make-local-variable 'font-lock-keywords)
- (let ((level (cond ((boundp 'font-lock-maximum-decoration)
- (symbol-value 'font-lock-maximum-decoration))
- ((boundp 'font-lock-use-maximal-decoration)
- (symbol-value 'font-lock-use-maximal-decoration))
- (t nil))))
- (if (consp level)
- (setq level (cdr-safe (or (assq 'erlang-mode level)
- (assq t level)))))
- ;; `level' can here be:
- ;; A number - The fontification level
- ;; nil - Use the default
- ;; t - Use maximum
- (cond ((eq level nil)
- (set 'font-lock-keywords erlang-font-lock-keywords))
- ((eq level 1)
- (set 'font-lock-keywords erlang-font-lock-keywords-1))
- ((eq level 2)
- (set 'font-lock-keywords erlang-font-lock-keywords-2))
- ((eq level 3)
- (set 'font-lock-keywords erlang-font-lock-keywords-3))
- (t
- (set 'font-lock-keywords erlang-font-lock-keywords-4))))
-
- ;; Modern font-locks can handle the above much more elegantly:
- (set (make-local-variable 'font-lock-defaults)
- '((erlang-font-lock-keywords erlang-font-lock-keywords-1
- erlang-font-lock-keywords-2
- erlang-font-lock-keywords-3
- erlang-font-lock-keywords-4)
- nil nil ((?_ . "w")) erlang-beginning-of-clause
- (font-lock-mark-block-function . erlang-mark-clause)
- (font-lock-syntactic-keywords
- ;; A dollar sign right before the double quote that ends a
- ;; string is not a character escape.
- ;;
- ;; And a "string" consists of a double quote not escaped by a
- ;; dollar sign, any number of non-backslash non-newline
- ;; characters or escaped backslashes, a dollar sign
- ;; (otherwise we wouldn't care) and a double quote. This
- ;; doesn't match multi-line strings, but this is probably
- ;; the best we can get, since while font-locking we don't
- ;; know whether matching started inside a string: limiting
- ;; search to a single line keeps things sane.
- . (("\\(?:^\\|[^$]\\)\"\\(?:[^\"\n]\\|\\\\\"\\)*\\(\\$\\)\"" 1 "w")
- ;; Likewise for atoms
- ("\\(?:^\\|[^$]\\)'\\(?:[^'\n]\\|\\\\'\\)*\\(\\$\\)'" 1 "w")
- ;; And the dollar sign in $\" or $\' escapes two
- ;; characters, not just one.
- ("\\(\\$\\)\\\\[\"']" 1 "'"))))))
-
-
-
-;; Useful when defining your own keywords.
-(defun erlang-font-lock-set-face (ks &rest faces)
- "Replace the face components in a list of keywords.
-
-The first argument, KS, is a list of keywords. The rest of the
-arguments are expressions to replace the face information with. The
-first expression replaces the face of the first keyword, the second
-expression the second keyword etc.
-
-Should an expression be nil, the face of the corresponding keyword is
-not changed.
-
-Should fewer expressions than keywords be given, the last expression
-is used for all remaining keywords.
-
-Normally, the expressions are just atoms representing the new face.
-They could however be more complex, returning different faces in
-different situations.
-
-This function only handles keywords with elements on the forms:
- (REGEXP NUMBER FACE)
- (REGEXP NUMBER FACE OVERWRITE)
-
-This could be used when defining your own special font-lock setup, e.g:
-
-\(setq my-font-lock-keywords
- (append erlang-font-lock-keywords-function-header
- erlang-font-lock-keywords-dollar
- (erlang-font-lock-set-face
- erlang-font-lock-keywords-macros 'my-neon-green-face)
- (erlang-font-lock-set-face
- erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red)
- erlang-font-lock-keywords-attr))
-
-For a more elaborate example, please see the beginning of the file
-`erlang.el'."
- (let ((res '()))
- (while ks
- (let* ((regexp (car (car ks)))
- (number (car (cdr (car ks))))
- (new-face (if (and faces (car faces))
- (car faces)
- (car (cdr (cdr (car ks))))))
- (overwrite (car (cdr (cdr (cdr (car ks))))))
- (new-keyword (list regexp number new-face)))
- (if overwrite (nconc new-keyword (list overwrite)))
- (setq res (cons new-keyword res))
- (setq ks (cdr ks))
- (if (and faces (cdr faces))
- (setq faces (cdr faces)))))
- (nreverse res)))
-
-
-(defun erlang-font-lock-level-0 ()
- ;; DocStringOrig: font-cmd
- "Unfontify current buffer."
- (interactive)
- (font-lock-mode 0))
-
-
-(defun erlang-font-lock-level-1 ()
- ;; DocStringCopy: font-cmd
- "Fontify current buffer at level 1.
-This highlights function headers, reserved keywords, strings and comments."
- (interactive)
- (require 'font-lock)
- (set 'font-lock-keywords erlang-font-lock-keywords-1)
- (font-lock-mode 1)
- (funcall (symbol-function 'font-lock-fontify-buffer)))
-
-
-(defun erlang-font-lock-level-2 ()
- ;; DocStringCopy: font-cmd
- "Fontify current buffer at level 2.
-This highlights level 1 features (see `erlang-font-lock-level-1')
-plus bifs, guards and `single quotes'."
- (interactive)
- (require 'font-lock)
- (set 'font-lock-keywords erlang-font-lock-keywords-2)
- (font-lock-mode 1)
- (funcall (symbol-function 'font-lock-fontify-buffer)))
-
-
-(defun erlang-font-lock-level-3 ()
- ;; DocStringCopy: font-cmd
- "Fontify current buffer at level 3.
-This highlights level 2 features (see `erlang-font-lock-level-2')
-plus variables, macros and records."
- (interactive)
- (require 'font-lock)
- (set 'font-lock-keywords erlang-font-lock-keywords-3)
- (font-lock-mode 1)
- (funcall (symbol-function 'font-lock-fontify-buffer)))
-
-(defun erlang-font-lock-level-4 ()
- ;; DocStringCopy: font-cmd
- "Fontify current buffer at level 4.
-This highlights level 3 features (see `erlang-font-lock-level-2')
-plus variables, macros and records."
- (interactive)
- (require 'font-lock)
- (set 'font-lock-keywords erlang-font-lock-keywords-4)
- (font-lock-mode 1)
- (funcall (symbol-function 'font-lock-fontify-buffer)))
-
-
-(defun erlang-menu-init ()
- "Init menus for Erlang mode.
-
-The variable `erlang-menu-items' contain a description of the Erlang
-mode menu. Normally, the list contains atoms, representing variables
-bound to pieces of the menu.
-
-Personal extensions could be added to `erlang-menu-personal-items'.
-
-This function should be called if any variable describing the
-menu configuration is changed."
- (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map))
-
-
-(defun erlang-menu-install (name items keymap)
- "Install a menu in Emacs based on an abstract description.
-
-NAME is the name of the menu.
-
-ITEMS is a list. The elements are either nil representing a horizontal
-line or a list with two or three elements. The first is the name of
-the menu item, the second the function to call, or a submenu, on the
-same same form as ITEMS. The third optional element is an expression
-which is evaluated every time the menu is displayed. Should the
-expression evaluate to nil the menu item is ghosted.
-
-KEYMAP is the keymap to add to menu to.
-
-Please see the variable `erlang-menu-base-items'."
- (define-key keymap (vector 'menu-bar (intern name))
- (erlang-menu-make-keymap name items)))
-
-
-(defun erlang-menu-make-keymap (name items)
- "Build a menu."
- (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
- name))
- (count 0)
- id def first second third)
- (setq items (reverse items))
- (while items
- ;; Replace any occurrence of atoms by their value.
- (while (and items (atom (car items)) (not (null (car items))))
- (if (and (boundp (car items))
- (listp (symbol-value (car items))))
- (setq items (append (reverse (symbol-value (car items)))
- (cdr items)))
- (setq items (cdr items))))
- (setq first (car-safe (car items)))
- (setq second (car-safe (cdr-safe (car items))))
- (setq third (car-safe (cdr-safe (cdr-safe (car items)))))
- (cond ((null first)
- (setq count (+ count 1))
- (setq id (intern (format "separator-%d" count)))
- (setq def '("--" . nil)))
- ((and (consp second) (eq (car second) 'lambda))
- (setq count (+ count 1))
- (setq id (intern (format "lambda-%d" count)))
- (setq def (cons first second)))
- ((symbolp second)
- (setq id second)
- (setq def (cons first second)))
- (t
- (setq count (+ count 1))
- (setq id (intern (format "submenu-%d" count)))
- (setq def (erlang-menu-make-keymap first second))))
- (define-key menumap (vector id) def)
- (if third
- (put id 'menu-enable third))
- (setq items (cdr items)))
- (cons name menumap)))
-
-(defun erlang-menu-substitute (items alist)
- "Substitute functions in menu described by ITEMS.
-
-The menu ITEMS is updated destructively.
-
-ALIST is list of pairs where the car is the old function and cdr the new."
- (let (first second pair)
- (while items
- (setq first (car-safe (car items)))
- (setq second (car-safe (cdr-safe (car items))))
- (cond ((null first))
- ((symbolp second)
- (setq pair (and second (assq second alist)))
- (if pair
- (setcar (cdr (car items)) (cdr pair))))
- ((and (consp second) (eq (car second) 'lambda)))
- (t
- (erlang-menu-substitute second alist)))
- (setq items (cdr items)))))
-
-
-(defun erlang-menu-add-above (entry above items)
- "Add menu ENTRY above menu entry ABOVE in menu ITEMS.
-Do nothing if the items already should be in the menu.
-Should ABOVE not be in the list, the entry is added at
-the bottom of the menu.
-
-The new menu is returned. No guarantee is given that the original
-menu is left unchanged.
-
-The equality test is performed by `eq'.
-
-Example: (erlang-menu-add-above 'my-erlang-menu-items
- 'erlang-menu-man-items)"
- (erlang-menu-add-below entry above items t))
-
-
-(defun erlang-menu-add-below (entry below items &optional above-p)
- "Add menu ENTRY below menu items BELOW in the Erlang menu.
-Do nothing if the items already should be in the menu.
-Should BELOW not be in the list, items is added at the bottom
-of the menu.
-
-The new menu is returned. No guarantee is given that the original
-menu is left unchanged.
-
-The equality test is performed by `eq'.
-
-Example:
-
-\(setq erlang-menu-items
- (erlang-menu-add-below 'my-erlang-menu-items
- 'erlang-menu-base-items
- erlang-menu-items))"
- (if (memq entry items)
- items ; Return the original menu.
- (let ((head '())
- (done nil)
- res)
- (while (not done)
- (cond ((null items)
- (setq res (append head (list entry)))
- (setq done t))
- ((eq below (car items))
- (setq res
- (if above-p
- (append head (cons entry items))
- (append head (cons (car items)
- (cons entry (cdr items))))))
- (setq done t))
- (t
- (setq head (append head (list (car items))))
- (setq items (cdr items)))))
- res)))
-
-(defun erlang-menu-delete (entry items)
- "Delete ENTRY from menu ITEMS.
-
-The new menu is returned. No guarantee is given that the original
-menu is left unchanged."
- (delq entry items))
-
-;; Man code:
-
-(defun erlang-man-init ()
- "Add menus containing the manual pages of the Erlang.
-
-The variable `erlang-man-dirs' contains entries describing
-the location of the manual pages."
- (interactive)
- (if (or erlang-man-inhibit
- (and (boundp 'menu-bar-mode)
- (not menu-bar-mode)))
- ()
- (setq erlang-menu-man-items
- '(nil
- ("Man - Function" erlang-man-function)
- ("Man - Function Under Cursor" erlang-man-function-no-prompt)))
- (if erlang-man-dirs
- (setq erlang-menu-man-items
- (append erlang-menu-man-items
- (erlang-man-make-top-menu erlang-man-dirs))))
- (setq erlang-menu-items
- (erlang-menu-add-above 'erlang-menu-man-items
- 'erlang-menu-version-items
- erlang-menu-items))
- (erlang-menu-init)))
-
-
-(defun erlang-man-uninstall ()
- "Remove the man pages from the Erlang mode."
- (interactive)
- (setq erlang-menu-items
- (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items))
- (erlang-menu-init))
-
-
-;; The man menu is a hierarchal structure, with the manual sections
-;; at the top, described by `erlang-man-dirs'. The next level could
-;; either be the manual pages if not to many, otherwise it is an index
-;; menu whose submenus will contain up to `erlang-man-max-menu-size'
-;; manual pages.
-
-(defun erlang-man-make-top-menu (dir-list)
- "Create one menu entry per element of DIR-LIST.
-The format is described in the documentation of `erlang-man-dirs'."
- (let ((menu '())
- dir)
- (while dir-list
- (setq dir (cond ((nth 2 (car dir-list))
- ;; Relative to `erlang-root-dir'.
- (erlang-man-dir (nth 1 (car dir-list)) t))
- (t
- ;; Absolute
- (nth 1 (car dir-list)))))
- (if (and dir
- (file-readable-p dir))
- (setq menu (cons (list (car (car dir-list))
- (erlang-man-make-middle-menu
- (erlang-man-get-files dir)))
- menu)))
- (setq dir-list (cdr dir-list)))
- ;; Should no menus be found, generate a menu item which
- ;; will display a help text, when selected.
- (if menu
- (nreverse menu)
- '(("Man Pages"
- (("Error! Why?" erlang-man-describe-error)))))))
-
-(defcustom erlang-man-download-url "http://erlang.org/download/otp_doc_man_22.1.tar.gz"
- "The URL from which the erlang-man-download function will
- download Erlang man pages "
- :type 'string)
-
-(defun erlang-man-user-local-emacs-dir ()
- "Returns the directory where man pages that are downloaded by
-the functions erlang-man-download and erlang-man-download-ask are
-stored."
- (concat (file-name-as-directory (locate-user-emacs-file "cache"))
- (file-name-as-directory "erlang_mode_man_pages"))
- )
-
-(defun erlang-man-download (&optional download-url-param)
- "Downloads the Erlang man pages into the
-\"cache/erlang_mode_man_pages\" subdirectory under the user's
-Emacs directory, if the man pages haven't been downloaded
-already. The URL from which the man pages are downloaded can be
-configured with the variable \"erlang-man-download-url\""
- (interactive)
- (let* ((download-url (or download-url-param erlang-man-download-url))
- (downloaded-man-dir (erlang-man-user-local-emacs-dir))
- (downloaded-man-url-file (concat
- (file-name-as-directory downloaded-man-dir)
- "erlang_man_download_url")))
- (if (and (file-exists-p downloaded-man-url-file)
- (string= download-url (with-temp-buffer
- (insert-file-contents downloaded-man-url-file)
- (buffer-string))))
- downloaded-man-dir
- (let ((man-file (concat (file-name-as-directory downloaded-man-dir) "man.tar.gz")))
- (message "Downloading: %s to %s" download-url man-file)
- (require 'url)
- (mkdir downloaded-man-dir t)
- (url-copy-file download-url man-file t)
- ;; Write the download URL to a file so that future calls to
- ;; erlang-man-download can check if the man cache should be
- ;; updated
- (write-region download-url nil downloaded-man-url-file)
- ;; url-copy-file unpacks the zip archive (at least on my
- ;; system) but this behavior is undocumented so do a tar with
- ;; the z flag as well
- (message "Note that %s will only be unpacked automatically if your system has the tar tool in its path" man-file)
- (shell-command (format "tar -x -z -f %s -C %s" man-file downloaded-man-dir))
- (message "The error message above can be ignored if everything works fine")
- (message "Unpacking man pages using the command \"%s\""
- (format "tar -x -f %s -C %s" man-file downloaded-man-dir))
- (shell-command (format "tar -x -f %s -C %s" man-file downloaded-man-dir))
- (message "Restarting erlang-mode")
- (erlang-mode)
- downloaded-man-dir
- )
- )
- )
- )
-
-(defun erlang-man-download-ask (&optional subdir)
- "Downloads the Erlang man pages into the
-\"cache/erlang_mode_man_pages\" subdirectory under the user's
-Emacs directory, if the man pages haven't been downloaded
-already. This function ask the user to confirm before downloading
-and lets the user edit the download URL. The function
-erlang-man-download downloads the man pages without prompting the
-user."
- (interactive)
- (if (y-or-n-p "Could not find Erlang man pages on your system. Do you want to download them?")
- (let ((download-url (read-string "URL to download man pages from: " erlang-man-download-url)))
- (concat (directory-file-name (erlang-man-download download-url)) (or subdir "")))))
-
-
-(defun erlang-man-dir (subdir &optional no-download)
- (let ((default-man-dir (if erlang-root-dir
- (concat (directory-file-name (concat
- (file-name-as-directory erlang-root-dir)
- (file-name-as-directory "lib")
- (file-name-as-directory "erlang")))
- subdir)))
- (alt-man-dir (if erlang-root-dir
- (concat (directory-file-name erlang-root-dir) subdir)))
- (downloaded-man-dir (erlang-man-user-local-emacs-dir)))
- (if (and erlang-root-dir (file-directory-p default-man-dir))
- default-man-dir
- (if (and erlang-root-dir (file-directory-p alt-man-dir))
- alt-man-dir
- (if (file-directory-p (concat (directory-file-name downloaded-man-dir) subdir))
- (concat (directory-file-name downloaded-man-dir) subdir)
- (and (not no-download) (erlang-man-download-ask subdir)))))))
-
-;; Should the menu be to long, let's split it into a number of
-;; smaller menus. Warning, this code contains beautiful
-;; destructive operations!
-(defun erlang-man-make-middle-menu (filelist)
- "Create the second level menu from FILELIST.
-
-Should the list be longer than `erlang-man-max-menu-size', a tree of
-menus is created."
- (if (<= (length filelist) erlang-man-max-menu-size)
- (erlang-man-make-menu filelist)
- (let ((menu '())
- (filelist (copy-sequence filelist))
- segment submenu pair)
- (while filelist
- (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist))
- (setq segment filelist)
- (if (null pair)
- (setq filelist nil)
- (setq filelist (cdr pair))
- (setcdr pair nil))
- (setq submenu (erlang-man-make-menu segment))
- (setq menu (cons (list (concat (car (car submenu))
- " -- "
- (car (car (reverse submenu))))
- submenu)
- menu)))
- (nreverse menu))))
-
-
-(defun erlang-man-make-menu (filelist)
- "Make a leaf menu based on FILELIST."
- (let ((menu '())
- item)
- (while filelist
- (setq item (erlang-man-make-menu-item (car filelist)))
- (if item
- (setq menu (cons item menu)))
- (setq filelist (cdr filelist)))
- (nreverse menu)))
-
-
-(defun erlang-man-make-menu-item (file)
- "Create a menu item containing the name of the man page."
- (and (string-match ".+/\\([^/]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file)
- (let ((page (substring file (match-beginning 1) (match-end 1))))
- (list (capitalize page)
- (list 'lambda '()
- '(interactive)
- (list 'funcall 'erlang-man-display-function
- file))))))
-
-
-(defun erlang-man-get-files (dir)
- "Return files in directory DIR."
- (directory-files dir t ".+\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?\\'"))
-
-
-(defun erlang-man-module (&optional module)
- "Find manual page for MODULE, defaults to module of function under point.
-This function is aware of imported functions."
- (interactive
- (list (let* ((mod (erlang-default-module))
- (input (read-string
- (format "Manual entry for module%s: "
- (if (or (null mod) (string= mod ""))
- ""
- (format " (default %s)" mod))))))
- (if (string= input "")
- mod
- input))))
- (setq module (or module
- (erlang-default-module)))
- (when (or (null module) (string= module ""))
- (error "No Erlang module name given"))
- (let ((dir-list erlang-man-dirs)
- (pat (concat "/" (regexp-quote module)
- "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$"))
- (file nil)
- file-list)
- (while (and dir-list (null file))
- (let ((dir (if (nth 2 (car dir-list))
- (erlang-man-dir (nth 1 (car dir-list)))
- (nth 1 (car dir-list)))))
- (when (file-directory-p dir)
- (setq file-list (erlang-man-get-files dir))
- (while (and file-list (null file))
- (if (string-match pat (car file-list))
- (setq file (car file-list)))
- (setq file-list (cdr file-list))))
- (setq dir-list (cdr dir-list))))
- (if file
- (funcall erlang-man-display-function file)
- ;; Did not found the manual file. Fallback to manual-entry.
- (manual-entry module))))
-
-(defun erlang-default-module ()
- (let ((id (erlang-get-identifier-at-point)))
- (if (eq (erlang-id-kind id) 'qualified-function)
- (erlang-id-module id)
- (erlang-id-name id))))
-
-
-;; Warning, the function `erlang-man-function' is a hack!
-;; It links itself into the man code in a non-clean way. I have
-;; chosen to keep it since it provides a very useful functionality
-;; which is not possible to achieve using a clean approach.
-;; / AndersL
-;;
-;; The previous hack seems to have broken in Emacs 25. This is fixed
-;; by trying to find the function in the man buffer a few times with a
-;; delay in between (see function
-;; erlang-man-repeated-search-for-function). This fix is also a hack
-;; but it should be quite robust and will work even if the function
-;; that erlang-man-function-display-man-page tries to hook into
-;; disappears or changes.
-
-(defvar erlang-man-function-name nil
- "Name of function for last `erlang-man-function' call.
-Used for communication between `erlang-man-function' and the
-patch to `Man-notify-when-ready'.")
-
-(defun erlang-man-function-display-man-page (name)
- "Helper function for erlang-man-function. Displays the man page
- text for the Erlang function named name if it can be found."
- (let ((modname nil)
- (funcname nil))
- (cond ((string-match ":" name)
- (setq modname (substring name 0 (match-beginning 0)))
- (setq funcname (substring name (match-end 0) nil)))
- ((stringp name)
- (setq modname name)))
- (when (or (null modname) (string= modname ""))
- (error "No Erlang module name given"))
- (cond ((fboundp 'Man-notify-when-ready)
- ;; From Emacs 19: The man command could possibly start an
- ;; asynchronous process, i.e. we must hook ourselves into
- ;; the system to be activated when the man-process
- ;; terminates.
- (if (null funcname)
- ()
- (erlang-man-patch-notify)
- (setq erlang-man-function-name funcname))
- (condition-case err
- (erlang-man-module modname)
- (error (setq erlang-man-function-name nil)
- (signal (car err) (cdr err)))))
- (t
- (erlang-man-module modname)
- (when funcname
- (erlang-man-repeated-search-for-function nil
- funcname
- modname))))))
-
-(defun erlang-man-function (&optional name)
- "Find manual page for NAME, where NAME is module:function.
-The entry for `function' is displayed.
-
-This function is aware of imported functions."
- (interactive
- (list (let* ((default (erlang-default-function-or-module))
- (input (read-string
- (format
- "Manual entry for `module:func' or `module'%s: "
- (if default
- (format " (default %s)" default)
- "")))))
- (if (string= input "")
- default
- input))))
- (require 'man)
- (setq name (or name
- (erlang-default-function-or-module)))
- (erlang-man-function-display-man-page name))
-
-
-(defun erlang-man-function-no-prompt ()
- "Find manual page for the function under the cursor.
-The man entry for `function' is displayed. This function
-provides the same functionality as erlang-man-function except for
-that it does not ask the user to confirm the function name before
-opening the man page for the function."
- (interactive)
- (let ((name (erlang-default-function-or-module)))
- (if name
- (erlang-man-function name)
- (error "No function name under the cursor"))))
-
-(defun erlang-man-repeated-search-for-function (man-buffer
- function-name
- &optional
- module-name)
- "This function tries to scroll MAN-BUFFER to the documentation
-of function FUNCTION-NAME. The function will try again a few
-times if the documentation for FUNCTION-NAME can't be found. This
-is necessary as the man page is loaded asynchronously from Emacs
-19 and the correct function to hook into depends on the Emacs
-version. The function will automatically try to find the correct
-buffer from the list of opened buffers if MAN-BUFFER is nil. The
-optional parameter MODULE-NAME will make the search for the
-buffer more accurate."
- (let* ((time-between-attempts 0.5)
- (max-wait-time 5.1)
- (search-for-function
- (lambda (self
- time-waited
- time-between-attempts
- max-wait-time
- man-buffer
- function-name
- module-name
- )
- (when (and (not (erlang-man-find-function man-buffer function-name module-name))
- (<= (+ time-waited time-between-attempts)
- max-wait-time))
- (message "Finding function %s..." function-name)
- ; Call this function again later
- (run-at-time time-between-attempts nil
- self
- self
- (+ time-waited time-between-attempts)
- time-between-attempts
- max-wait-time
- man-buffer
- function-name
- module-name)
- ))))
- (funcall search-for-function
- search-for-function
- 0.0
- time-between-attempts
- max-wait-time
- man-buffer
- function-name
- module-name)))
-
-;; Should the defadvice be at the top level, the package `advice' would
-;; be required. Now it is only required when this functionality
-;; is used. (Emacs 19 specific.)
-(defun erlang-man-patch-notify ()
- "Patch the function `Man-notify-when-ready' to search for function.
-The variable `erlang-man-function-name' is assumed to be bound to
-the function name, or to nil.
-
-The reason for patching a function is that under Emacs 19, the man
-command is executed asynchronously."
- (condition-case nil
- (require 'advice)
- ;; This should never happened since this is only called when
- ;; running under Emacs 19.
- (error (error (concat "This command needs the package `advice', "
- "please upgrade your Emacs."))))
- (require 'man)
- (defadvice Man-notify-when-ready
- (after erlang-Man-notify-when-ready activate)
- "Set point at the documentation of the function name in
-`erlang-man-function-name' when the man page is displayed."
- (if erlang-man-function-name
- (erlang-man-repeated-search-for-function (ad-get-arg 0)
- erlang-man-function-name)
- (setq erlang-man-function-name nil))))
-
-
-
-
-(defun erlang-man-find-function (buf func &optional module-name)
- "Find manual page for function `erlang-man-function-name' in buffer BUF.
-The function will automatically try to find the correct buffer among the
-opened buffers if BUF is nil. The optional parameter MODULE-NAME will make
-the search for the buffer more accurate."
- (let ((buffer (or buf
- (progn
- ; find buffer containing man page
- (require 'cl-lib)
- (car (cl-remove-if-not (lambda (buf)
- (string-match
- (or module-name "")
- (format "%s" buf)))
- (cl-remove-if-not
- (lambda (buf)
- (string-match
- "[Mm][Aa][Nn]"
- (format "%s" buf)))
- (buffer-list))))))))
- (if (and func buffer)
- (let ((win (get-buffer-window buffer)))
- (if win
- (progn
- (set-buffer buffer)
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^[ \t]*\\([a-z0-9_]*[ \t]*:\\)?[ \t]*" func "[ \t]*([A-Za-z0-9 \t:,_()]*)[ \t]*->")
- (point-max) t)
- (progn
- (forward-word -1)
- (set-window-point win (point))
- (message "Found documentation for function `%s'" func)
- t)
- (if (re-search-forward
- (concat "^[ \t]*\\([a-z0-9_]*[ \t]*:\\)?[ \t]*" func "[ \t]*\(")
- (point-max) t)
- (progn
- (forward-word -1)
- (set-window-point win (point))
- (message "Found documentation for function `%s'" func)
- t)
- (progn
- (message "Could not find function `%s'" func)
- nil)))))))))
-
-(defvar erlang-man-file-regexp
- "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")
-
-(defun erlang-man-display (file)
- "Display FILE as a `man' file.
-This is the default manual page display function.
-The variables `erlang-man-display-function' contains the function
-to be used."
- (require 'man)
- (if file
- (let ((process-environment (copy-sequence process-environment)))
- (if (string-match erlang-man-file-regexp file)
- (let ((dir (substring file (match-beginning 1) (match-end 1)))
- (page (substring file (match-beginning 2) (match-end 2))))
- (setenv "MANPATH" dir)
- (manual-entry page))
- (error "Can't find man page for %s\n" file)))))
-
-
-(defun erlang-man-describe-error ()
- "Describe why the manual pages weren't found."
- (interactive)
- (with-output-to-temp-buffer "*Erlang Man Error*"
- (princ "Normally, this menu should contain Erlang manual pages.
-
-In order to find the manual pages, the variable `erlang-root-dir'
-should be bound to the name of the directory containing the Erlang
-installation. The name should not include the final slash.
-
-Practically, you should add a line on the following form to
-your ~/.emacs, or ask your system administrator to add it to
-the site init file:
- (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\")
-
-For example:
- (setq erlang-root-dir \"/usr/local/erlang\")
-
-Alternatively, you can download the Erlang man pages
-automatically by placing the following lines in your Emacs init
-file or by executing the Emacs command `M-x
-erlang-man-download-ask RET' (the download URL can be customized
-with the Emacs variable erlang-man-download-url):
-
- (require 'erlang)
- (erlang-man-download)
-
-After installing the line/lines in your Emacs init file or after
-running the command `M-x erlang-man-download-ask RET', kill and
-restart Emacs, or restart Erlang mode with the command `M-x
-erlang-mode RET'.")))
-
-;; Skeleton code:
-
-;; This code is based on the package `tempo' which is part of modern
-;; Emacsen.
-
-(defvar erlang-skel)
-(defun erlang-skel-init ()
- "Generate the skeleton functions and menu items.
-The variable `erlang-skel' contains the name and descriptions of
-all skeletons.
-
-The skeleton routines are based on the `tempo' package. Should this
-package not be present, this function does nothing."
- (interactive)
- (require 'tempo)
- (let ((skel erlang-skel)
- (menu '()))
- (while skel
- (cond ((null (car skel))
- (setq menu (cons nil menu)))
- (t
- (funcall (symbol-function 'tempo-define-template)
- (concat "erlang-" (nth 1 (car skel)))
- ;; The tempo template used contains an `include'
- ;; function call only, hence changes to the
- ;; variables describing the templates take effect
- ;; immediately.
- (list (list 'erlang-skel-include (nth 2 (car skel))))
- (nth 1 (car skel))
- (car (car skel))
- 'erlang-tempo-tags)
- (setq menu (cons (erlang-skel-make-menu-item
- (car skel)) menu))))
- (setq skel (cdr skel)))
- (setq erlang-menu-skel-items
- (list nil (list "Skeletons" (nreverse menu))))
- (setq erlang-menu-items
- (erlang-menu-add-above 'erlang-menu-skel-items
- 'erlang-menu-version-items
- erlang-menu-items))
- (erlang-menu-init)))
-
-(defun erlang-skel-make-menu-item (skel)
- (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel)))))
- (cond ((null (nth 3 skel))
- (list (car skel) func))
- (t
- (list (car skel)
- (list 'lambda '()
- '(interactive)
- (list 'funcall
- (list 'quote (nth 3 skel))
- (list 'quote func))))))))
-
-;; Functions designed to be added to the skeleton menu.
-;; (Not normally used)
-(defun erlang-skel-insert (func)
- "Insert skeleton generated by FUNC and goto first tempo mark."
- (save-excursion (funcall func))
- (funcall (symbol-function 'tempo-forward-mark)))
-
-(defun erlang-skel-header (func)
- "Insert the header generated by FUNC at the beginning of the buffer."
- (goto-char (point-min))
- (save-excursion (funcall func))
- (funcall (symbol-function 'tempo-forward-mark)))
-
-
-;; Functions used inside the skeleton descriptions.
-(defun erlang-skel-skip-blank ()
- (skip-chars-backward " \t")
- nil)
-
-(defun erlang-skel-include (&rest args)
- "Include a template inside another template.
-
-Example of use, assuming that `erlang-skel-func' is defined:
-
- (defvar foo-skeleton '(\"%%% New function:\"
- (erlang-skel-include erlang-skel-func)))
-
-Technically, this function returns the `tempo' attribute`(l ...)' which
-can contain other `tempo' attributes. Please see the function
-`tempo-define-template' for a description of the `(l ...)' attribute."
- (let ((res '())
- entry)
- (while args
- (setq entry (car args))
- (while entry
- (setq res (cons (car entry) res))
- (setq entry (cdr entry)))
- (setq args (cdr args)))
- (cons 'l (nreverse res))))
-
-(defvar erlang-skel-separator-length 70)
-
-(defun erlang-skel-separator (&optional percent)
- "Return a comment separator."
- (let ((percent (or percent 3)))
- (concat (make-string percent ?%)
- (make-string (- erlang-skel-separator-length percent) ?-)
- "\n")))
-
-(defun erlang-skel-double-separator (&optional percent)
- "Return a comment separator."
- (let ((percent (or percent 3)))
- (concat (make-string percent ?%)
- (make-string (- erlang-skel-separator-length percent) ?=)
- "\n")))
-
-(defun erlang-skel-dd-mmm-yyyy ()
- "Return the current date as a string in \"DD Mon YYYY\" form.
-The first character of DD is space if the value is less than 10."
- (let ((date (current-time-string)))
- (format "%2d %s %s"
- (string-to-number (substring date 8 10))
- (substring date 4 7)
- (substring date -4))))
-
-;; Indentation code:
-
-(defun erlang-indent-command (&optional whole-exp)
- "Indent current line as Erlang code.
-With argument, indent any additional lines of the same clause
-rigidly along with this one."
- (interactive "P")
- (if whole-exp
- ;; If arg, always indent this line as Erlang
- ;; and shift remaining lines of clause the same amount.
- (let ((shift-amt (erlang-indent-line))
- beg end)
- (save-excursion
- (if erlang-tab-always-indent
- (beginning-of-line))
- (setq beg (point))
- (erlang-end-of-clause 1)
- (setq end (point))
- (goto-char beg)
- (forward-line 1)
- (setq beg (point)))
- (if (> end beg)
- (indent-code-rigidly beg end shift-amt "\n")))
- (if (and (not erlang-tab-always-indent)
- (save-excursion
- (skip-chars-backward " \t")
- (not (bolp))))
- (insert-tab)
- (erlang-indent-line))))
-
-
-(defun erlang-indent-line ()
- "Indent current line as Erlang code.
-Return the amount the indentation changed by."
- (let ((pos (- (point-max) (point)))
- indent beg
- shift-amt)
- (beginning-of-line 1)
- (setq beg (point))
- (skip-chars-forward " \t")
- (cond ((looking-at "%")
- (setq indent (funcall comment-indent-function))
- (setq shift-amt (- indent (current-column))))
- (t
- (setq indent (erlang-calculate-indent))
- (cond ((null indent)
- (setq indent (current-indentation)))
- ((eq indent t)
- ;; This should never occur here.
- (error "Erlang mode error"))
- ;;((= (char-syntax (following-char)) ?\))
- ;; (setq indent (1- indent)))
- )
- (setq shift-amt (- indent (current-column)))))
- (if (zerop shift-amt)
- nil
- (delete-region beg (point))
- (indent-to indent))
- ;; If initial point was within line's indentation, position
- ;; after the indentation. Else stay at same point in text.
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
- (run-hooks 'erlang-indent-line-hook)
- shift-amt))
-
-
-(defun erlang-indent-region (beg end)
- "Indent region of Erlang code.
-
-This is automagically called by the user level function `indent-region'."
- (interactive "r")
- (save-excursion
- (let ((case-fold-search nil)
- (continue t)
- (from-end (- (point-max) end))
- indent-point;; The beginning of the current line
- indent;; The indent amount
- state)
- (goto-char beg)
- (beginning-of-line)
- (setq indent-point (point))
- (erlang-beginning-of-clause)
- ;; Parse the Erlang code from the beginning of the clause to
- ;; the beginning of the region.
- (while (< (point) indent-point)
- (let ((pt (point)))
- (setq state (erlang-partial-parse pt indent-point state))
- (if (= pt (point))
- (error "Illegal syntax"))))
- ;; Indent every line in the region
- (while continue
- (goto-char indent-point)
- (skip-chars-forward " \t")
- (cond ((looking-at "%")
- ;; Do not use our stack to help the user to customize
- ;; comment indentation.
- (setq indent (funcall comment-indent-function)))
- ((looking-at "$")
- ;; Don't indent empty lines.
- (setq indent 0))
- (t
- (setq indent
- (save-excursion
- (erlang-calculate-stack-indent (point) state)))
- (cond ((null indent)
- (setq indent (current-indentation)))
- ((eq indent t)
- ;; This should never occur here.
- (error "Erlang mode error"))
- ;;((= (char-syntax (following-char)) ?\))
- ;; (setq indent (1- indent)))
- )))
- (if (zerop (- indent (current-column)))
- nil
- (delete-region indent-point (point))
- (indent-to indent))
- ;; Find the next line in the region
- (goto-char indent-point)
- (save-excursion
- (forward-line 1)
- (setq indent-point (point)))
- (if (>= from-end (- (point-max) indent-point))
- (setq continue nil)
- (while (< (point) indent-point)
- (let ((pt (point)))
- (setq state (erlang-partial-parse
- pt indent-point state))
- (if (= pt (point))
- (error "Illegal syntax")))))))))
-
-
-(defun erlang-indent-current-buffer ()
- "Indent current buffer as Erlang code."
- (interactive)
- (save-excursion
- (save-restriction
- (widen)
- (erlang-indent-region (point-min) (point-max)))))
-
-
-(defun erlang-indent-function ()
- "Indent current Erlang function."
- (interactive)
- (save-excursion
- (let ((end (progn (erlang-end-of-function 1) (point)))
- (beg (progn (erlang-beginning-of-function 1) (point))))
- (erlang-indent-region beg end))))
-
-
-(defun erlang-indent-clause ()
- "Indent current Erlang clause."
- (interactive)
- (save-excursion
- (let ((end (progn (erlang-end-of-clause 1) (point)))
- (beg (progn (erlang-beginning-of-clause 1) (point))))
- (erlang-indent-region beg end))))
-
-
-(defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack)))
-(defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack)))
-
-
-(defun erlang-calculate-indent (&optional parse-start)
- "Compute appropriate indentation for current line as Erlang code.
-Return nil if line starts inside string, t if in a comment."
- (save-excursion
- (let ((indent-point (point))
- (case-fold-search nil)
- (state nil))
- (if parse-start
- (goto-char parse-start)
- (erlang-beginning-of-clause))
- (while (< (point) indent-point)
- (let ((pt (point)))
- (setq state (erlang-partial-parse pt indent-point state))
- (if (= pt (point))
- (error "Illegal syntax"))))
- (erlang-calculate-stack-indent indent-point state))))
-
-(defun erlang-show-syntactic-information ()
- "Show syntactic information for current line."
-
- (interactive)
-
- (save-excursion
- (let ((starting-point (point))
- (case-fold-search nil)
- (state nil))
- (erlang-beginning-of-clause)
- (while (< (point) starting-point)
- (setq state (erlang-partial-parse (point) starting-point state)))
- (message "%S" state))))
-
-
-(defun erlang-partial-parse (from to &optional state)
- "Parse Erlang syntax starting at FROM until TO, with an optional STATE.
-Value is list (stack token-start token-type in-what)."
- (goto-char from) ; Start at the beginning
- (erlang-skip-blank to)
- (let ((cs (char-syntax (following-char)))
- (stack (car state))
- (token (point))
- in-what)
- (cond
-
- ;; Done: Return previous state.
- ((>= token to)
- (setq token (nth 1 state))
- (setq cs (nth 2 state))
- (setq in-what (nth 3 state)))
-
- ;; Word constituent: check and handle keywords.
- ((= cs ?w)
- (cond ((looking-at "\\(end\\|after\\|else\\)[^_a-zA-Z0-9]")
- ;; Must pop top icr layer, `after' will push a new
- ;; layer next.
- (progn
- (while (and stack (eq (car (car stack)) '->))
- (erlang-pop stack))
- (if (and stack (memq (car (car stack)) '(icr begin fun try maybe)))
- (erlang-pop stack))))
- ((looking-at "catch\\b.*of")
- t)
- ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)")
- ;; Must pop top icr layer, `catch' in try/catch
- ;;will push a new layer next.
- (progn
- (while (and stack (eq (car (car stack)) '->))
- (erlang-pop stack))
- (if (and stack (memq (car (car stack)) '(icr begin try maybe)))
- (erlang-pop stack))))
- )
- (cond ((looking-at "\\(if\\|case\\|receive\\)[^_a-zA-Z0-9]")
- ;; Must push a new icr (if/case/receive) layer.
- (erlang-push (list 'icr token (current-column)) stack))
- ((looking-at "\\(try\\|after\\)[^_a-zA-Z0-9]")
- ;; Must handle separately, try catch or try X of -> catch
- ;; same for `after', it could be
- ;; receive after Time -> X end, or
- ;; try after X end
- (erlang-push (list 'try token (current-column)) stack))
- ((looking-at "\\(of\\)[^_a-zA-Z0-9]")
- ;; Must handle separately, try X of -> catch
- (if (and stack (eq (car (car stack)) 'try))
- (let ((try-column (nth 2 (car stack)))
- (try-pos (nth 1 (car stack))))
- (erlang-pop stack)
- (erlang-push (list 'icr try-pos try-column) stack))))
-
- ((looking-at "\\(fun\\)[^_a-zA-Z0-9]")
- ;; Push a new layer if we are defining a `fun'
- ;; expression, not when we are referring an existing
- ;; function. 'fun's defines are only indented one level now.
- (if (save-excursion
- (goto-char (match-end 1))
- (erlang-skip-blank to)
- ;; Use erlang-variable-regexp here to look for an
- ;; optional variable name to match EEP37 named funs.
- (if (looking-at erlang-variable-regexp)
- (progn
- (goto-char (match-end 0))
- (erlang-skip-blank to)))
- (eq (following-char) ?\())
- (erlang-push (list 'fun token (current-column)) stack)))
- ((looking-at "\\(begin\\)[^_a-zA-Z0-9]")
- (erlang-push (list 'begin token (current-column)) stack))
- ((looking-at "\\(maybe\\)[^_a-zA-Z0-9]")
- (erlang-push (list 'begin token (current-column)) stack))
- ((looking-at "\\(else\\)[^_a-zA-Z0-9]")
- (erlang-push (list 'icr token (current-column)) stack))
-
- ;; Normal when case
- ;;((looking-at "when\\s ")
- ;;((looking-at "when\\s *\\($\\|%\\)")
- ((looking-at "when[^_a-zA-Z0-9]")
- (erlang-push (list 'when token (current-column)) stack))
- ((looking-at "catch\\b.*of")
- t)
- ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)")
- (erlang-push (list 'icr token (current-column)) stack))
- ;;(erlang-push (list '-> token (current-column)) stack))
- ;;((looking-at "^of$")
- ;; (erlang-push (list 'icr token (current-column)) stack)
- ;;(erlang-push (list '-> token (current-column)) stack))
- )
- (forward-sexp 1))
- ;; String: Try to skip over it. (Catch error if not complete.)
- ((= cs ?\")
- (condition-case nil
- (progn
- (forward-sexp 1)
- (if (> (point) to)
- (progn
- (setq in-what 'string)
- (goto-char to))))
- (error
- (setq in-what 'string)
- (goto-char to))))
-
- ;; Expression prefix e.i. $ or ^ (Note ^ can be in the character
- ;; literal $^ or part of string and $ outside of a string denotes
- ;; a character literal)
- ((= cs ?')
- (cond
- ((= (following-char) ?\") ;; $ or ^ was the last char in a string
- (forward-char 1))
- (t
- ;; Maybe a character literal, quote the next char to avoid
- ;; situations as $" being seen as the beginning of a string.
- ;; Note the quoting something in the middle of a string is harmless.
- (quote (following-char))
- (forward-char 1))))
-
- ;; Symbol constituent or punctuation
-
- ((memq cs '(?. ?_))
- (cond
-
- ;; Clause end
- ((= (following-char) ?\;)
- (if (eq (car (car (last stack))) 'spec)
- (while (memq (car (car stack)) '(when ::))
- (erlang-pop stack)))
- (if (and stack (eq (car (car stack)) '->))
- (erlang-pop stack))
- (forward-char 1))
-
- ;; Parameter separator
- ((looking-at ",")
- (forward-char 1)
- (if (and stack (eq (car (car stack)) '::))
- ;; Type or spec
- (erlang-pop stack)))
-
- ;; Function end
- ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")
- (setq stack nil)
- (forward-char 1))
-
- ;; Function head
- ((looking-at "->")
- (if (and stack (eq (car (car stack)) 'when))
- (erlang-pop stack))
- (erlang-push (list '-> token (current-column)) stack)
- (forward-char 2))
-
- ;; List-comprehension divider
- ((looking-at "||")
- (erlang-push (list '|| token (current-column)) stack)
- (forward-char 2))
-
- ;; Bit-syntax open. Note that map syntax allows "<<" to follow ":="
- ;; or "=>" without intervening whitespace, so handle that case here
- ((looking-at "\\(:=\\|=>\\)?<<")
- (erlang-push (list '<< token (current-column)) stack)
- (forward-char (- (match-end 0) (match-beginning 0))))
-
- ;; Bit-syntax close
- ((looking-at ">>")
- (while (memq (car (car stack)) '(|| ->))
- (erlang-pop stack))
- (cond ((eq (car (car stack)) '<<)
- (erlang-pop stack))
- ((memq (car (car stack)) '(icr begin maybe fun))
- (error "Missing `end'"))
- (t
- (error "Unbalanced parentheses")))
- (forward-char 2))
-
- ;; Macro
- ((= (following-char) ??)
- ;; Skip over the ?
- (forward-char 1)
- )
-
- ;; Type spec's
- ((looking-at "-type\\s \\|-opaque\\s ")
- (if stack
- (forward-char 1)
- (erlang-push (list 'type token (current-column)) stack)
- (forward-char 6)))
- ((looking-at "-spec\\s ")
- (if stack
- (forward-char 1)
- (forward-char 6)
- (erlang-push (list 'spec (point) (current-column)) stack)
- (skip-chars-forward "^(\n")
- (erlang-push (list 'spec_arg (point) (current-column)) stack)
- ))
-
- ;; Type spec delimiter
- ((looking-at "::")
- (erlang-push (list ':: token (current-column)) stack)
- (forward-char 2))
-
- ;; Don't follow through in the clause below
- ;; '|' don't need spaces around it
- ((looking-at "|")
- (forward-char 1))
-
- ;; Other punctuation: Skip over it and any following punctuation
- ((= cs ?.)
- ;; Skip over all characters in the operand.
- (skip-syntax-forward "."))
-
- ;; Other char: Skip over it.
- (t
- (forward-char 1))))
-
- ;; Open parenthesis
- ((= cs ?\()
- (erlang-push (list '\( token (current-column)) stack)
- (forward-char 1))
-
- ;; Close parenthesis
- ((= cs ?\))
- (while (memq (car (car stack)) '(|| -> :: when))
- (erlang-pop stack))
- (cond ((eq (car (car stack)) '\()
- (erlang-pop stack)
- (if (and (eq (car (car stack)) 'fun)
- (or (eq (car (car (last stack))) 'spec)
- (eq (car (car (last stack))) 'type))) ;; -type()
- ;; Inside fun type def ') closes fun definition
- (erlang-pop stack)))
- ((eq (car (car stack)) 'icr)
- (erlang-pop stack)
- ;; Normal catch not try-catch might have caused icr
- ;; and then incr should be removed and is not an error.
- (if (eq (car (car stack)) '\()
- (erlang-pop stack)
- (error "Missing `end'")
- ))
- ((eq (car (car stack)) 'begin)
- (error "Missing `end'"))
- ((eq (car (car stack)) 'maybe)
- (error "Missing `end'"))
- (t
- (error "Unbalanced parenthesis"))
- )
- (forward-char 1))
-
- ;; Character quote: Skip it and the quoted char.
- ((= cs ?/)
- (forward-char 2))
-
- ;; Character escape: Skip it and the escape sequence.
- ((= cs ?\\)
- (forward-char 1)
- (skip-syntax-forward "w"))
-
- ;; Everything else
- (t
- (forward-char 1)))
- (list stack token cs in-what)))
-
-(defun erlang-calculate-stack-indent (indent-point state)
- "From the given last position and state (stack) calculate indentation.
-Return nil if inside string, t if in a comment."
- (let* ((stack (and state (car state)))
- (token (nth 1 state))
- (stack-top (and stack (car stack))))
- (cond ((null state) ;No state
- 0)
- ((nth 3 state)
- ;; Return nil or t.
- (eq (nth 3 state) 'comment))
- ((null stack)
- (if (looking-at "when[^_a-zA-Z0-9]")
- erlang-indent-guard
- 0))
- ((eq (car stack-top) '\()
- ;; Element of list, tuple or part of an expression,
- (cond ((null erlang-argument-indent)
- ;; indent to next column.
- (1+ (nth 2 stack-top)))
- ((= (char-syntax (following-char)) ?\))
- (goto-char (nth 1 stack-top))
- (cond ((erlang-record-or-function-args-p)
- ;; Line ends with parenthesis.
- (let ((previous (erlang-indent-find-preceding-expr))
- (stack-pos (nth 2 stack-top)))
- (if (>= previous stack-pos) stack-pos
- (- (+ previous erlang-argument-indent) 1))))
- (t
- (nth 2 stack-top))))
- ((looking-at "||")
- (erlang-indent-element stack-top indent-point token))
- ((memq (following-char) '(?, ?|))
- ;; a comma at the start of the line: line up with opening parenthesis.
- (min (nth 2 stack-top)
- (erlang-indent-element stack-top indent-point token)))
- (t
- (erlang-indent-element stack-top indent-point token))))
- ;;
- ((eq (car stack-top) '<<)
- ;; Element of binary (possible comprehension) expression,
- (cond ((null erlang-argument-indent)
- ;; indent to next column.
- (+ 2 (nth 2 stack-top)))
- ((looking-at "\\(>>\\)[^_a-zA-Z0-9]")
- (nth 2 stack-top))
- ((= (following-char) ?,)
- (min (+ (nth 2 stack-top) 1)
- (- (erlang-indent-to-first-element stack-top 2) 1)))
- (t
- (erlang-indent-to-first-element stack-top 2))))
-
- ((memq (car stack-top) '(icr fun spec_arg))
- ;; The default indentation is the column of the option
- ;; directly following the keyword. (This does not apply to
- ;; `case'.) Should no option be on the same line, the
- ;; indentation is the indentation of the keyword +
- ;; `erlang-indent-level'.
- ;;
- ;; `after' should be indented to the same level as the
- ;; corresponding receive.
- (cond ((looking-at "\\(after\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)")
- (nth 2 stack-top))
- ((looking-at "when[^_a-zA-Z0-9]")
- ;; Handling one when part
- (+ (nth 2 stack-top) erlang-indent-level erlang-indent-guard))
- (t
- (save-excursion
- (goto-char (nth 1 stack-top))
- (if (and erlang-icr-indent
- (looking-at "\\(if\\|case\\|receive\\|try\\)[^_a-zA-Z0-9]"))
- (+ (nth 2 stack-top) erlang-icr-indent)
- (if (looking-at "\\(case\\|receive\\|try\\)[^_a-zA-Z0-9]")
- (+ (nth 2 stack-top) erlang-indent-level)
- (skip-chars-forward "a-z")
- (skip-chars-forward " \t")
- (if (memq (following-char) '(?% ?\n))
- (+ (nth 2 stack-top) erlang-indent-level)
- (current-column))))))))
- ((and (eq (car stack-top) '||) (looking-at "\\(]\\|>>\\)[^_a-zA-Z0-9]"))
- (nth 2 (car (cdr stack))))
- ;; Real indentation, where operators create extra indentation etc.
- ((memq (car stack-top) '(-> || try begin maybe))
- (if (looking-at "\\(of\\)[^_a-zA-Z0-9]")
- (nth 2 stack-top)
- (goto-char (nth 1 stack-top))
- ;; Check if there is more code after the '->' on the
- ;; same line. If so use this indentation as base, else
- ;; use parent indentation + 2 * level as base.
- (let ((off erlang-indent-level)
- (skip 2))
- (cond ((null (cdr stack))) ; Top level in function.
- ((eq (car stack-top) 'begin)
- (setq skip 5))
- ((eq (car stack-top) 'maybe)
- (setq skip 5))
- ((eq (car stack-top) 'try)
- (setq skip 5))
- ((eq (car stack-top) '->)
- ;; If in fun definition use standard indent level not double
- ;;(if (not (eq (car (car (cdr stack))) 'fun))
- ;; Removed it made multi clause Named fun's look too bad
- (setq off (+ erlang-indent-level
- (if (not erlang-icr-indent)
- erlang-indent-level
- erlang-icr-indent)))))
- (let ((base (erlang-indent-find-base stack indent-point off skip)))
- ;; Special cases
- (goto-char indent-point)
- (cond ((looking-at "\\(;\\|end\\|after\\|else\\)\\($\\|[^_a-zA-Z0-9]\\)")
- (if (eq (car stack-top) '->)
- (erlang-pop stack))
- (cond ((and stack (looking-at ";"))
- (+ (caddr (car stack)) (- erlang-indent-level 2)))
- (stack (caddr (car stack)))
- (t off)))
- ((looking-at "catch\\b\\($\\|[^_a-zA-Z0-9]\\)")
- ;; Are we in a try
- (let ((start (if (eq (car stack-top) '->)
- (car (cdr stack))
- stack-top)))
- (if (null start) nil
- (goto-char (nth 1 start)))
- (cond ((looking-at "try\\($\\|[^_a-zA-Z0-9]\\)")
- (progn
- (if (eq (car stack-top) '->)
- (erlang-pop stack))
- (if stack
- (caddr (car stack))
- 0)))
- (t (erlang-indent-standard indent-point token base 'nil))))) ;; old catch
- ;; Indent result types
- ((eq (car (car (cdr stack))) 'spec_arg)
- (setq base (+ (caddr (car (last stack))) erlang-indent-level))
- (erlang-indent-standard indent-point token base 'nil))
- (t
- (erlang-indent-standard indent-point token base 'nil)
- ))))
- ))
- ((eq (car stack-top) 'when)
- (goto-char (nth 1 stack-top))
- (if (looking-at "when\\s *\\($\\|%\\)")
- (progn
- (erlang-pop stack)
- (if (and stack (memq (nth 0 (car stack)) '(icr fun)))
- (progn
- (goto-char (nth 1 (car stack)))
- (+ (nth 2 (car stack)) erlang-indent-guard
- ;; receive XYZ or receive
- ;; XYZ
- ;; This if thing does not seem to be needed
- ;;(if (looking-at "[a-z]+\\s *\\($\\|%\\)")
- ;; erlang-indent-level
- ;; (* 2 erlang-indent-level))))
- (* 2 erlang-indent-level)))
- ;;erlang-indent-level))
- (+ erlang-indent-level erlang-indent-guard)))
- ;; "when" is followed by code, let's indent to the same
- ;; column.
- (forward-char 4) ; Skip "when"
- (skip-chars-forward " \t")
- (current-column)))
- ;; Type and Spec indentation
- ((eq (car stack-top) '::)
- (if (looking-at "[},)]")
- ;; Closing function spec, record definition with types,
- ;; or a comma at the start of the line
- ;; pop stack and recurse
- (erlang-calculate-stack-indent indent-point
- (cons (erlang-pop stack) (cdr state)))
- (cond ((null erlang-argument-indent)
- ;; indent to next column.
- (+ 2 (nth 2 stack-top)))
- ((looking-at "::[^_a-zA-Z0-9]")
- (nth 2 stack-top))
- (t
- (let ((start-alternativ (if (looking-at "|") 2 0)))
- (goto-char (nth 1 stack-top))
- (- (cond ((looking-at "::\\s *\\($\\|%\\)")
- ;; Line ends with ::
- (if (eq (car (car (last stack))) 'spec)
- (+ (erlang-indent-find-preceding-expr 1)
- erlang-argument-indent)
- (+ (erlang-indent-find-preceding-expr 2)
- erlang-argument-indent)))
- (t
- ;; Indent to the same column as the first
- ;; argument.
- (goto-char (+ 2 (nth 1 stack-top)))
- (skip-chars-forward " \t")
- (current-column))) start-alternativ))))))
- )))
-
-(defun erlang-indent-to-first-element (stack-top extra)
- ;; Indent to the same column as the first
- ;; argument. extra should be 1 for lists tuples or 2 for binaries
- (goto-char (+ (nth 1 stack-top) extra))
- (skip-chars-forward " \t")
- (current-column))
-
-(defun erlang-indent-element (stack-top indent-point token)
- (goto-char (nth 1 stack-top))
- (let ((base (cond ((erlang-record-or-function-args-p)
- ;; Line ends with parenthesis.
- (erlang-indent-parenthesis (nth 2 stack-top)))
- (t
- (erlang-indent-to-first-element stack-top 1)))))
- (erlang-indent-standard indent-point token base 't)))
-
-(defun erlang-indent-standard (indent-point token base inside-parenthesis)
- "Standard indent when in blocks or tuple or arguments.
- Look at last thing to see in what state we are, move relative to the base."
- (goto-char token)
- (cond ((looking-at "||\\|,\\|->\\||")
- base)
- ((erlang-at-keyword)
- (+ (current-column) erlang-indent-level))
- ((or (= (char-syntax (following-char)) ?.)
- (erlang-at-operator))
- (+ base erlang-indent-level))
- (t
- (goto-char indent-point)
- (cond ((memq (following-char) '(?\( ))
- ;; Function application.
- (+ (erlang-indent-find-preceding-expr)
- erlang-argument-indent))
- ;; Empty line, or end; treat it as the end of
- ;; the block. (Here we have a choice: should
- ;; the user be forced to reindent continued
- ;; lines, or should the "end" be reindented?)
-
- ;; Avoid treating comments a continued line.
- ((= (following-char) ?%)
- base)
- ((and (= (following-char) ?,) inside-parenthesis)
- ;; a comma at the start of the line line up with parenthesis
- (- base 1))
- ;; Continued line (e.g. line beginning
- ;; with an operator.)
- (t
- (if (or (erlang-at-operator) (not inside-parenthesis))
- (+ base erlang-indent-level)
- base))))))
-
-(defun erlang-indent-find-base (stack indent-point &optional offset skip)
- "Find the base column for current stack."
- (or skip (setq skip 2))
- (or offset (setq offset erlang-indent-level))
- (save-excursion
- (let* ((stack-top (car stack)))
- (goto-char (nth 1 stack-top))
- (if (< skip (- (point-max) (point)))
- (progn
- (forward-char skip)
- (if (looking-at "\\s *\\($\\|%\\)")
- (progn
- (if (memq (car stack-top) '(-> ||))
- (erlang-pop stack))
- ;; Take parent indentation + offset,
- ;; else just erlang-indent-level if no parent
- (if stack
- (+ (caddr (car stack))
- offset)
- erlang-indent-level))
- (erlang-skip-blank indent-point)
- (current-column)))
- (+ (current-column) skip)))))
-
-
-;; Does not handle `begin' .. `end'.
-(defun erlang-indent-find-preceding-expr (&optional arg)
- "Return the first column of the preceding expression.
-This assumes that the preceding expression is either simple
-\(i.e. an atom) or parenthesized."
- (save-excursion
- (or arg (setq arg 1))
- (ignore-errors (forward-sexp (- arg)))
- (let ((col (current-column)))
- (skip-chars-backward " \t")
- ;; Special hack to handle: (note line break)
- ;; [#myrecord{
- ;; foo = foo}]
- ;; where the call (forward-sexp -1) will fail when point is at the `#'.
- (or
- (ignore-errors
- ;; Needed to match the colon in "'foo':'bar'".
- (cond ((eq (preceding-char) ?:)
- (backward-char 1)
- (forward-sexp -1)
- (current-column))
- ((eq (preceding-char) ?#)
- ;; We may now be at:
- ;; - either a construction of a new record
- ;; - or update of a record, in which case we want
- ;; the column of the expression to be updated.
- ;;
- ;; To see which of the two cases we are at, we first
- ;; move an expression backwards, check for keywords,
- ;; then immediately an expression forwards. Moving
- ;; backwards skips past tokens like `,' or `->', but
- ;; when moving forwards again, we won't skip past such
- ;; tokens. We use this: if, after having moved
- ;; forwards, we're back where we started, then it was
- ;; a record update.
- ;; The check for keywords is to detect cases like:
- ;; case Something of #record_construction{...}
- (backward-char 1)
- (let ((record-start (point))
- (record-start-col (current-column)))
- (forward-sexp -1)
- (let ((preceding-expr-col (current-column))
- ;; white space definition according to erl_scan
- (white-space "\000-\040\200-\240"))
- (if (erlang-at-keyword)
- ;; The (forward-sexp -1) call moved past a keyword
- (1+ record-start-col)
- (forward-sexp 1)
- (skip-chars-forward white-space record-start)
- ;; Are we back where we started? If so, it was an update.
- (if (= (point) record-start)
- preceding-expr-col
- (goto-char record-start)
- (1+ (current-column)))))))
- (t col)))
- col))))
-
-(defun erlang-record-or-function-args-p ()
- (and (looking-at "[({]\\s *\\($\\|%\\)")
- (or (eq (following-char) ?\( )
- (save-excursion
- (ignore-errors (forward-sexp (- 1)))
- (eq (preceding-char) ?#)))))
-
-(defun erlang-indent-parenthesis (stack-position)
- (let ((previous (erlang-indent-find-preceding-expr)))
- (cond ((eq previous stack-position) ;; tuple or map not a record
- (1+ stack-position))
- ((> previous stack-position)
- (+ stack-position erlang-argument-indent))
- (t
- (+ previous erlang-argument-indent)))))
-
-(defun erlang-skip-blank (&optional lim)
- "Skip over whitespace and comments until limit reached."
- (or lim (setq lim (point-max)))
- (let (stop)
- (while (and (not stop) (< (point) lim))
- (cond ((= (following-char) ?%)
- (skip-chars-forward "^\n" lim))
- ((= (following-char) ?\n)
- (skip-chars-forward "\n" lim))
- ((looking-at "\\s ")
- (if (re-search-forward "\\S " lim 'move)
- (forward-char -1)))
- (t
- (setq stop t))))
- stop))
-
-(defun erlang-at-keyword ()
- "Are we looking at an Erlang keyword which will increase indentation?"
- (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|maybe\\|"
- "of\\|receive\\|after\\|catch\\|try\\|else\\)\\b")))
-
-(defun erlang-at-operator ()
- "Are we looking at an Erlang operator?"
- (looking-at
- "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)\\b"))
-
-(defun erlang-comment-indent ()
- "Compute Erlang comment indentation.
-
-Used both by `indent-for-comment' and the Erlang specific indentation
-commands."
- (cond ((looking-at "%%%") 0)
- ((looking-at "%%")
- (or (erlang-calculate-indent)
- (current-indentation)))
- (t
- (save-excursion
- (skip-chars-backward " \t")
- (max (if (bolp) 0 (1+ (current-column)))
- comment-column)))))
-
-;;; Erlang movement commands
-
-;; All commands below work as movement commands. I.e. if the point is
-;; at the end of the clause, and the command `erlang-end-of-clause' is
-;; executed, the point is moved to the end of the NEXT clause. (This
-;; mimics the behaviour of `end-of-defun'.)
-;;
-;; Personally I would like to rewrite them to be "pure", and add a set
-;; of movement functions, like `erlang-next-clause',
-;; `erlang-previous-clause', and the same for functions.
-;;
-;; The current implementation makes it hopeless to use the functions as
-;; subroutines in more complex commands. /andersl
-
-(defun erlang-beginning-of-clause (&optional arg)
- "Move backward to previous start of clause.
-With argument, do this that many times.
-Return t unless search stops due to end of buffer."
- (interactive "p")
- (or arg (setq arg 1))
- (if (< arg 0)
- ;; Step back to the end of the previous line, unless we are at
- ;; the beginning of the buffer. The reason for this move is
- ;; that the regexp below includes the last character of the
- ;; previous line.
- (if (bobp)
- (or (looking-at "\n")
- (forward-char 1))
- (forward-char -1)
- (if (looking-at "\\`\n")
- (forward-char 1))))
- ;; The regexp matches a function header that isn't
- ;; included in a string.
- (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\(-?[a-z]\\|'\\|-\\)"
- nil 'move (- arg))
- (let ((beg (match-beginning 2)))
- (and beg (goto-char beg))
- t)))
-
-(defun erlang-end-of-clause (&optional arg)
- "Move to the end of the current clause.
-With argument, do this that many times."
- (interactive "p")
- (or arg (setq arg 1))
- (while (and (looking-at "[ \t]*[%\n]")
- (zerop (forward-line 1))))
- ;; Move to the next clause.
- (erlang-beginning-of-clause (- arg))
- (beginning-of-line);; Just to be sure...
- (let ((continue t))
- (while (and (not (bobp)) continue)
- (forward-line -1)
- (unless (looking-at "[ \t]*[%\n]")
- (end-of-line)
- (setq continue nil)))))
-
-(defun erlang-mark-clause ()
- "Put mark at end of clause, point at beginning."
- (interactive)
- (push-mark (point))
- (erlang-end-of-clause 1)
- ;; Sets the region.
- (push-mark (point) nil t)
- (erlang-beginning-of-clause 1)
- ;; The above function deactivates the mark.
- (if (boundp 'deactivate-mark)
- (funcall (symbol-function 'set) 'deactivate-mark nil)))
-
-(defun erlang-beginning-of-function (&optional arg)
- "Move backward to previous start of function.
-With positive argument, do this that many times.
-With negative argument, search forward.
-
-Return t unless search stops due to end of buffer."
- (interactive "p")
- (or arg (setq arg 1))
- (cond
- ;; Search backward
- ((> arg 0)
- (while (and (> arg 0)
- (and (erlang-beginning-of-clause 1)
- (let ((start (point))
- (name (erlang-name-of-function))
- (arity (erlang-get-function-arity)))
- ;; Note: "arity" is nil for e.g. "-import", hence
- ;; two "-import" clauses are not considered to
- ;; be part of the same function.
- (while (and (erlang-beginning-of-clause 1)
- (string-equal name
- (erlang-name-of-function))
- arity
- (equal arity
- (erlang-get-function-arity)))
- (setq start (point)))
- (goto-char start)
- t)))
- (setq arg (1- arg))))
- ;; Search forward
- ((< arg 0)
- (end-of-line)
- (erlang-beginning-of-clause 1)
- ;; Step -arg functions forward.
- (while (and (< arg 0)
- ;; Step one function forward, or stop if the end of
- ;; the buffer was reached. Return t if we found the
- ;; function.
- (let ((name (erlang-name-of-function))
- (arity (erlang-get-function-arity))
- (found (erlang-beginning-of-clause -1)))
- (while (and found
- (string-equal name (erlang-name-of-function))
- arity
- (equal arity
- (erlang-get-function-arity)))
- (setq found (erlang-beginning-of-clause -1)))
- found))
- (setq arg (1+ arg)))))
- (zerop arg))
-
-
-(defun erlang-end-of-function (&optional arg)
- "Move forward to next end of function.
-
-With argument, do this that many times.
-With negative argument go towards the beginning of the buffer."
- (interactive "p")
- (or arg (setq arg 1))
- (let ((first t))
- ;; Forward
- (while (and (> arg 0) (< (point) (point-max)))
- (let ((pos (point)))
- (while (progn
- (if (and first
- (progn
- (forward-char 1)
- (erlang-beginning-of-clause 1)))
- nil
- (or (bobp) (forward-char -1))
- (erlang-beginning-of-clause -1))
- (setq first nil)
- (erlang-pass-over-function)
- (skip-chars-forward " \t")
- (if (looking-at "[%\n]")
- (forward-line 1))
- (<= (point) pos))))
- (setq arg (1- arg)))
- ;; Backward
- (while (< arg 0)
- (let ((pos (point)))
- (erlang-beginning-of-clause 1)
- (erlang-pass-over-function)
- (forward-line 1)
- (if (>= (point) pos)
- (if (erlang-beginning-of-function 2)
- (progn
- (erlang-pass-over-function)
- (skip-chars-forward " \t")
- (if (looking-at "[%\n]")
- (forward-line 1)))
- (goto-char (point-min)))))
- (setq arg (1+ arg)))))
-
-(eval-and-compile
- (if (default-boundp 'beginning-of-defun-function)
- (defalias 'erlang-mark-function 'mark-defun)
- (defun erlang-mark-function ()
- "Put mark at end of function, point at beginning."
- (interactive)
- (push-mark (point))
- (erlang-end-of-function 1)
- ;; Sets the region.
- (push-mark (point) nil t)
- (erlang-beginning-of-function 1)
- ;; The above function deactivates the mark.
- (if (boundp 'deactivate-mark)
- (funcall (symbol-function 'set) 'deactivate-mark nil)))))
-
-(defun erlang-pass-over-function ()
- (while (progn
- (erlang-skip-blank)
- (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)"))
- (not (eobp))))
- (forward-sexp 1))
- (if (not (eobp))
- (forward-char 1)))
-
-(defun erlang-name-of-function ()
- (save-excursion
- ;; Skip over attribute leader.
- (if (looking-at "-[ \t]*")
- (re-search-forward "-[ \t]*" nil 'move))
- (let ((start (point)))
- (forward-sexp 1)
- (buffer-substring start (point)))))
-
-
-;;; Miscellaneous
-
-(defun erlang-fill-paragraph (&optional justify)
- "Like \\[fill-paragraph], but handle Erlang comments.
-If any of the current line is a comment, fill the comment or the
-paragraph of it that point is in, preserving the comment's indentation
-and initial `%':s."
- (interactive "P")
- (let ((has-comment nil)
- ;; If has-comment, the appropriate fill-prefix for the comment.
- comment-fill-prefix)
- ;; Figure out what kind of comment we are looking at.
- (save-excursion
- (beginning-of-line)
- (cond
- ;; Find the command prefix.
- ((looking-at (concat "\\s *" comment-start-skip))
- (setq has-comment t)
- (setq comment-fill-prefix (buffer-substring (match-beginning 0)
- (match-end 0))))
- ;; A line with some code, followed by a comment? Remember that the
- ;; % which starts the comment shouldn't be part of a string or
- ;; character.
- ((progn
- (while (not (looking-at "%\\|$"))
- (skip-chars-forward "^%\n\"\\\\")
- (cond
- ((eq (char-after (point)) ?\\) (forward-char 2))
- ((eq (char-after (point)) ?\") (forward-sexp 1))))
- (looking-at comment-start-skip))
- (setq has-comment t)
- (setq comment-fill-prefix
- (concat (make-string (current-column) ? )
- (buffer-substring (match-beginning 0) (match-end 0)))))))
- (if (not has-comment)
- (fill-paragraph justify)
- ;; Narrow to include only the comment, and then fill the region.
- (save-restriction
- (narrow-to-region
- ;; Find the first line we should include in the region to fill.
- (save-excursion
- (while (and (zerop (forward-line -1))
- (looking-at "^\\s *%")))
- ;; We may have gone to far. Go forward again.
- (or (looking-at "^\\s *%")
- (forward-line 1))
- (point))
- ;; Find the beginning of the first line past the region to fill.
- (save-excursion
- (while (progn (forward-line 1)
- (looking-at "^\\s *%")))
- (point)))
- ;; Lines with only % on them can be paragraph boundaries.
- (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$"))
- (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$"))
- (fill-prefix comment-fill-prefix))
- (fill-paragraph justify))))))
-
-(defun erlang-generate-new-clause ()
- "Create additional Erlang clause header.
-
-Parses the source file for the name of the current Erlang function.
-Create the header containing the name, A pair of parentheses,
-and an arrow. The space between the function name and the
-first parenthesis is preserved. The point is placed between
-the parentheses."
- (interactive)
- (let ((name (save-excursion
- (and (erlang-beginning-of-clause)
- (erlang-get-function-name t))))
- (arrow (save-excursion
- (and (erlang-beginning-of-clause)
- (erlang-get-function-arrow)))))
- (if (or (null arrow) (null name))
- (error "Can't find name of current Erlang function"))
- (if (and (bolp) (eolp))
- nil
- (end-of-line)
- (newline))
- (insert name)
- (save-excursion
- (insert ") " arrow))
- (if erlang-new-clause-with-arguments
- (erlang-clone-arguments))))
-
-
-(defun erlang-clone-arguments ()
- "Insert, at the point, the argument list of the previous clause.
-
-The mark is set at the beginning of the inserted text, the point
-at the end."
- (interactive)
- (let ((args (save-excursion
- (beginning-of-line)
- (and (erlang-beginning-of-clause)
- (erlang-get-function-arguments))))
- (p (point)))
- (if (null args)
- (error "Can't clone argument list"))
- (insert args)
- (set-mark p)))
-
-;;; Information retrieval functions.
-
-(defun erlang-get-module ()
- "Return the name of the module as specified by `-module'.
-
-Return nil if file contains no `-module' attribute."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((md (match-data)))
- (unwind-protect
- (if (re-search-forward
- (eval-when-compile
- (concat "^-module\\s *(\\s *\\(\\("
- erlang-atom-regexp
- "\\)?\\)\\s *)\\s *\\."))
- (point-max) t)
- (erlang-remove-quotes
- (buffer-substring-no-properties (match-beginning 1)
- (match-end 1)))
- nil)
- (store-match-data md))))))
-
-
-(defun erlang-get-module-from-file-name (&optional file)
- "Extract the module name from a file name.
-
-First, the directory part is removed. Second, the part of the file name
-matching `erlang-file-name-extension-regexp' is removed.
-
-Should the match fail, nil is returned.
-
-By modifying `erlang-file-name-extension-regexp' to match files other
-than Erlang source files, Erlang specific functions could be applied on
-non-Erlang files. Most notably; the support for Erlang modules in the
-tags system could be used by files written in other languages."
- (or file (setq file buffer-file-name))
- (if (null file)
- nil
- (setq file (file-name-nondirectory file))
- (if (string-match erlang-file-name-extension-regexp file)
- (substring file 0 (match-beginning 0))
- nil)))
-
-
-;; Used by `erlang-get-export' and `erlang-get-import'.
-
-(defun erlang-get-function-arity-list ()
- "Parse list of `function/arity' as used by `-import' and `-export'.
-
-Point must be before the opening bracket. When the
-function returns the point will be placed after the closing bracket.
-
-The function does not return an error if the list is incorrectly
-formatted.
-
-Return list of (function . arity). The order of the returned list
-corresponds to the order of the parsed Erlang list."
- (let ((res '()))
- (erlang-skip-blank)
- (forward-char 1)
- (if (not (eq (preceding-char) ?\[))
- '() ; Not looking at an Erlang list.
- (while ; Note: `while' has no body.
- (progn
- (erlang-skip-blank)
- (and (looking-at (eval-when-compile
- (concat erlang-atom-regexp "/\\([0-9]+\\)\\>")))
- (progn
- (setq res (cons
- (cons
- (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 1)))
- (string-to-number
- (buffer-substring-no-properties
- (match-beginning
- (+ 1 erlang-atom-regexp-matches))
- (match-end
- (+ 1 erlang-atom-regexp-matches)))))
- res))
- (goto-char (match-end 0))
- (erlang-skip-blank)
- (forward-char 1)
- ;; Test if there are more exported functions.
- (eq (preceding-char) ?,))))))
- (nreverse res)))
-
-
-;;; Note that `-export' and the open parenthesis must be written on
-;;; the same line.
-
-(defun erlang-get-export ()
- "Return a list of `(function . arity)' as specified by `-export'."
- (save-excursion
- (goto-char (point-min))
- (let ((md (match-data))
- (res '()))
- (unwind-protect
- (progn
- (while (re-search-forward "^-export\\s *(" (point-max) t)
- (erlang-skip-blank)
- (setq res (nconc res (erlang-get-function-arity-list))))
- res)
- (store-match-data md)))))
-
-
-(defun erlang-get-import ()
- "Parse an Erlang source file for imported functions.
-
-Return an alist with module name as car part and list of conses containing
-function and arity as cdr part."
- (save-excursion
- (goto-char (point-min))
- (let ((md (match-data))
- (res '()))
- (unwind-protect
- (progn
- (while (re-search-forward "^-import\\s *(" (point-max) t)
- (erlang-skip-blank)
- (if (looking-at erlang-atom-regexp)
- (let ((module (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning 0)
- (match-end 0)))))
- (goto-char (match-end 0))
- (erlang-skip-blank)
- (if (eq (following-char) ?,)
- (progn
- (forward-char 1)
- (erlang-skip-blank)
- (let ((funcs (erlang-get-function-arity-list))
- (pair (assoc module res)))
- (if pair
- (setcdr pair (nconc (cdr pair) funcs))
- (setq res (cons (cons module funcs)
- res)))))))))
- (nreverse res))
- (store-match-data md)))))
-
-
-(defun erlang-get-function-name (&optional arg)
- "Return name of current function, or nil.
-
-If optional argument is non-nil, everything up to and including
-the first `(' is returned.
-
-Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
- (save-excursion
- (if (not (eobp)) (forward-char 1))
- (and (erlang-beginning-of-clause)
- (erlang-get-function-name t)))"
- (let ((n (if arg 0 1)))
- (and (looking-at (eval-when-compile
- (concat "^" erlang-atom-regexp "\\s *(")))
- (buffer-substring-no-properties (match-beginning n) (match-end n)))))
-
-
-(defun erlang-get-function-arrow ()
- "Return arrow of current function, could be \"->\" or nil.
-
-Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
- (save-excursion
- (if (not (eobp)) (forward-char 1))
- (and (erlang-beginning-of-clause)
- (erlang-get-function-arrow)))"
- (and
- (save-excursion
- (re-search-forward "->" (point-max) t)
- (buffer-substring-no-properties (- (point) 2) (+ (point) 1)))))
-
-(defun erlang-get-function-arity ()
- "Return the number of arguments of function at point, or nil."
- (erlang-get-arity-after-regexp (concat "^" erlang-atom-regexp "\\s *(")))
-
-(defun erlang-get-argument-list-arity ()
- "Return the number of arguments in argument list at point, or nil.
-The point should be before the opening parenthesis of the
-argument list before calling this function."
- (erlang-get-arity-after-regexp "\\s *("))
-
-(defun erlang-get-arity-after-regexp (regexp)
- "Return the number of arguments in argument list after REGEXP, or nil."
- (when (looking-at regexp)
- (save-excursion
- (goto-char (match-end 0))
- (erlang-get-arity))))
-
-(defun erlang-get-arity ()
- "Return the number of arguments in argument list at point, or nil.
-The point should be after the opening parenthesis of the argument
-list before calling this function."
- (condition-case nil
- (let ((res 0)
- (cont t))
- (while cont
- (cond ((eobp)
- (setq res nil)
- (setq cont nil))
- ((looking-at "\\s *)")
- (setq cont nil))
- ((looking-at "\\s *\\($\\|%\\)")
- (forward-line 1))
- ((looking-at "\\s *<<[^>]*?>>")
- (when (zerop res)
- (setq res (+ 1 res)))
- (goto-char (match-end 0)))
- ((looking-at "\\s *,")
- (setq res (+ 1 res))
- (goto-char (match-end 0)))
- (t
- (when (zerop res)
- (setq res (+ 1 res)))
- (forward-sexp 1))))
- res)
- (error nil)))
-
-
-(defun erlang-get-function-name-and-arity ()
- "Return the name and arity of the function at point, or nil.
-The return value is a string of the form \"foo/1\"."
- (let ((name (erlang-get-function-name))
- (arity (erlang-get-function-arity)))
- (and name arity (format "%s/%d" name arity))))
-
-(defun erlang-get-function-arguments ()
- "Return arguments of current function, or nil."
- (if (not (looking-at (eval-when-compile
- (concat "^" erlang-atom-regexp "\\s *("))))
- nil
- (save-excursion
- (condition-case nil
- (let ((start (match-end 0)))
- (goto-char (- start 1))
- (forward-sexp)
- (buffer-substring-no-properties start (- (point) 1)))
- (error nil)))))
-
-
-;; erlang-get-function-under-point is replaced by
-;; erlang-get-identifier-at-point as far as internal erlang.el usage
-;; is concerned. But it is kept for backward compatibility. It is
-;; used by erldoc.el and maybe other code out there.
-(defun erlang-get-function-under-point ()
- "Return the module and function under the point, or nil.
-
-Should no explicit module name be present at the point, the
-list of imported functions is searched.
-
-The following could be returned:
- (\"module\" \"function\") -- Both module and function name found.
- (nil \"function\") -- No module name was found.
- nil -- No function name found.
-
-See also `erlang-get-identifier-at-point'."
- (let* ((id (erlang-get-identifier-at-point))
- (kind (erlang-id-kind id))
- (module (erlang-id-module id))
- (name (erlang-id-name id)))
- (cond ((eq kind 'qualified-function)
- (list module name))
- (name
- (list nil name)))))
-
-(defun erlang-get-identifier-at-point ()
- "Return the erlang identifier at point, or nil.
-
-Should no explicit module name be present at the point, the
-list of imported functions is searched.
-
-When an identifier is found return a list with 4 elements:
-
-1. Kind - One of the symbols qualified-function, record, macro,
-module or nil.
-
-2. Module - Module name string or nil. In case of a
-qualified-function the module is explicitly specified (like
-module:fun()) and the search fails if no entries with correct
-module are found. For other kinds the module is guessed: either
-fetched from import statements or it is assumed to be the local
-module. In these cases the module is just a preference. If no
-matching entries are found the search will be retried without
-regard to module.
-
-3. Name - String name of function, module, record or macro.
-
-4. Arity - Integer in case of functions and macros if the number
-of arguments could be found, otherwise nil."
- (save-excursion
- (let (case-fold-search)
- (save-match-data
- (if (eq (char-syntax (following-char)) ? )
- (skip-chars-backward " \t"))
- (skip-chars-backward "[:word:]_:'")
- (cond ((and (eq (preceding-char) ??)
- (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp)))
- (erlang-get-qualified-function-id-at-point (erlang-get-module)))
- ((looking-at erlang-module-function-regexp)
- (erlang-get-qualified-function-id-at-point))
- ((looking-at (concat erlang-atom-regexp ":"))
- (erlang-get-module-id-at-point))
- ((looking-at erlang-name-regexp)
- (erlang-get-some-other-id-at-point)))))))
-
-(defun erlang-get-qualified-function-id-at-point (&optional module)
- (let ((kind 'qualified-function)
- (module (or module
- (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 1)))))
- (name (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning (1+ erlang-atom-regexp-matches))
- (match-end (1+ erlang-atom-regexp-matches)))))
- (arity (progn
- (goto-char (match-end 0))
- (erlang-get-argument-list-arity))))
- (list kind module name arity)))
-
-(defun erlang-get-module-id-at-point ()
- (let ((kind 'module)
- (module nil)
- (name (erlang-remove-quotes
- (buffer-substring-no-properties (match-beginning 1)
- (match-end 1))))
- (arity nil))
- (list kind module name arity)))
-
-(defun erlang-get-some-other-id-at-point ()
- (let ((name (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning 0) (match-end 0))))
- (imports (erlang-get-import))
- kind module arity)
- (while (and imports (null module))
- (if (assoc name (cdr (car imports)))
- (setq module (car (car imports)))
- (setq imports (cdr imports))))
- (cond ((eq (preceding-char) ?#)
- (setq kind 'record))
- ((eq (preceding-char) ??)
- (setq kind 'macro))
- ((and (null module) (not (member name erlang-int-bifs)))
- (setq module (erlang-get-module))))
- (setq arity (progn
- (goto-char (match-end 0))
- (erlang-get-argument-list-arity)))
- (list kind module name arity)))
-
-(defmacro erlang-with-id (slots id-string &rest body)
- (declare (indent 2))
- (let ((id-var (make-symbol "id")))
- `(let* ((,id-var (erlang-id-to-list ,id-string))
- ,@(mapcar (lambda (slot)
- (list slot
- (list (intern (format "erlang-id-%s" slot))
- id-var)))
- slots))
- ,@body)))
-
-(defun erlang-id-to-string (id)
- (when id
- (erlang-with-id (kind module name arity) id
- (format "%s%s%s%s"
- (if kind (format "%s " kind) "")
- (if module (format "%s:" module) "")
- name
- (if arity (format "/%s" arity) "")))))
-
-(defun erlang-id-to-list (id)
- (if (listp id)
- id
- (save-match-data
- (erlang-ensure-syntax-table-is-initialized)
- (with-syntax-table erlang-mode-syntax-table
- (let (case-fold-search)
- (when (string-match erlang-id-regexp id)
- (list (when (match-string 1 id)
- (intern (match-string 1 id)))
- (match-string 2 id)
- (match-string 3 id)
- (when (match-string 4 id)
- (string-to-number (match-string 4 id))))))))))
-
-(defun erlang-id-kind (id)
- (car (erlang-id-to-list id)))
-
-(defun erlang-id-module (id)
- (nth 1 (erlang-id-to-list id)))
-
-(defun erlang-id-name (id)
- (nth 2 (erlang-id-to-list id)))
-
-(defun erlang-id-arity (id)
- (nth 3 (erlang-id-to-list id)))
-
-
-(defun erlang-default-function-or-module ()
- (erlang-with-id (kind module name) (erlang-get-identifier-at-point)
- (let ((x (cond ((eq kind 'module)
- (format "%s:" name))
- ((eq kind 'record)
- (format "-record(%s" name))
- ((eq kind 'macro)
- (format "-define(%s" name))
- (t
- name))))
- (if module
- (format "%s:%s" module x)
- x))))
-
-
-;; TODO: Escape single quotes inside the string without
-;; replace-regexp-in-string.
-(defun erlang-add-quotes-if-needed (str)
- "Return STR, possibly with quotes."
- (let ((case-fold-search nil)) ; force string matching to be case sensitive
- (if (and (stringp str)
- (not (string-match (eval-when-compile
- (concat "\\`" erlang-atom-regexp "\\'"))
- str)))
- (progn
- (setq str (replace-regexp-in-string "'" "\\'" str t t ))
- (concat "'" str "'"))
- str)))
-
-
-(defun erlang-remove-quotes (str)
- "Return STR without quotes, if present."
- (let ((md (match-data)))
- (prog1
- (if (string-match "\\`'\\(.*\\)'\\'" str)
- (substring str 1 -1)
- str)
- (store-match-data md))))
-
-(defun erlang-match-next-exported-function (max)
- "Returns non-nil if there is an exported function in the current
-buffer between point and MAX."
- (catch 'return
- (while (and (not erlang-inhibit-exported-function-name-face)
- (erlang-match-next-function max))
- (when (erlang-last-match-exported-p)
- (throw 'return (match-data))))))
-
-(defun erlang-match-next-function (max)
- "Searches forward in current buffer for the next erlang function,
-bounded by position MAX."
- (re-search-forward erlang-defun-prompt-regexp max 'move-point))
-
-(defun erlang-last-match-exported-p ()
- "Returns non-nil if match-data describes the name and arity of an
-exported function."
- (save-excursion
- (save-match-data
- (goto-char (match-beginning 1))
- (erlang-function-exported-p
- (erlang-remove-quotes (erlang-get-function-name))
- (erlang-get-function-arity)))))
-
-(defun erlang-function-exported-p (name arity)
- "Returns non-nil if function of name and arity is exported in current buffer."
- (save-excursion
- (let* ((old-match-data (match-data))
- (exports (erlang-get-export)))
- (store-match-data old-match-data)
- (member (cons name arity) exports))))
-
-
-;;; Check module name
-
-(defun erlang-check-module-name ()
- "If the module name doesn't match file name, ask for permission to change.
-
-The variable `erlang-check-module-name' controls the behaviour of this
-function. It it is nil, this function does nothing. If it is t, the
-source is silently changed. If it is set to the atom `ask', the user
-is prompted.
-
-This function is normally placed in the hook `before-save-hook'."
- (if erlang-check-module-name
- (let ((mn (erlang-add-quotes-if-needed
- (erlang-get-module)))
- (fn (erlang-add-quotes-if-needed
- (erlang-get-module-from-file-name (buffer-file-name)))))
- (if (and (stringp mn) (stringp fn))
- (or (string-equal mn fn)
- (if (or (eq erlang-check-module-name t)
- (y-or-n-p
- "Module does not match file name. Modify source? "))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (re-search-forward
- (eval-when-compile
- (concat "^-module\\s *(\\s *\\(\\("
- erlang-atom-regexp
- "\\)?\\)\\s *)\\s *\\."))
- (point-max) t)
- (progn
- (goto-char (match-beginning 1))
- (delete-region (match-beginning 1)
- (match-end 1))
- (insert fn))))))))))
- ;; Must return nil since it is added to `local-write-file-hook'.
- nil)
-
-
-;;; Electric functions.
-
-(defun erlang-electric-semicolon (&optional arg)
- "Insert a semicolon character and possibly a prototype for the next line.
-
-The variable `erlang-electric-semicolon-criteria' states a criterion,
-when fulfilled a newline is inserted, the next line is indented and a
-prototype for the next line is inserted. Normally the prototype
-consists of \" ->\". Should the semicolon end the clause a new clause
-header is generated.
-
-The variable `erlang-electric-semicolon-insert-blank-lines' controls
-the number of blank lines inserted between the current line and new
-function header.
-
-Behaves just like the normal semicolon when supplied with a
-numerical arg, point is inside string or comment, or when there are
-non-whitespace characters following the point on the current line."
- (interactive "P")
- (self-insert-command (prefix-numeric-value arg))
- (if (or arg
- (and (listp erlang-electric-commands)
- (not (memq 'erlang-electric-semicolon
- erlang-electric-commands)))
- (erlang-in-literal)
- (not (looking-at "\\s *\\(%.*\\)?$"))
- (null (erlang-test-criteria-list
- erlang-electric-semicolon-criteria)))
- (setq erlang-electric-newline-inhibit nil)
- (setq erlang-electric-newline-inhibit t)
- (undo-boundary)
- (erlang-indent-line)
- (end-of-line)
- (newline)
- (if (condition-case nil
- (progn (erlang-indent-line) t)
- (error (if (bolp) (delete-char -1))))
- (if (not (bolp))
- (save-excursion
- (insert " ->"))
- (condition-case nil
- (progn
- (erlang-generate-new-clause)
- (if erlang-electric-semicolon-insert-blank-lines
- (save-excursion
- (beginning-of-line)
- (newline
- erlang-electric-semicolon-insert-blank-lines))))
- (error (if (bolp) (delete-char -1))))))))
-
-
-(defun erlang-electric-comma (&optional arg)
- "Insert a comma character and possibly a new indented line.
-The variable `erlang-electric-comma-criteria' states a criterion,
-when fulfilled a newline is inserted and the next line is indented.
-
-Behaves just like the normal comma when supplied with a
-numerical arg, point is inside string or comment, or when there are
-non-whitespace characters following the point on the current line."
- (interactive "P")
-
- (self-insert-command (prefix-numeric-value arg))
-
- (if (or arg
- (and (listp erlang-electric-commands)
- (not (memq 'erlang-electric-comma erlang-electric-commands)))
- (erlang-in-literal)
- (not (looking-at "\\s *\\(%.*\\)?$"))
- (null (erlang-test-criteria-list
- erlang-electric-comma-criteria)))
- (setq erlang-electric-newline-inhibit nil)
- (setq erlang-electric-newline-inhibit t)
- (undo-boundary)
- (erlang-indent-line)
- (end-of-line)
- (newline)
- (condition-case nil
- (erlang-indent-line)
- (error (if (bolp) (delete-char -1))))))
-
-(defun erlang-electric-lt (&optional arg)
- "Insert a less-than sign, and optionally mark it as an open paren."
-
- (interactive "p")
-
- (self-insert-command arg)
-
- ;; Was this the second char in bit-syntax open (`<<')?
- (unless (<= (point) 2)
- (save-excursion
- (backward-char 2)
- (when (and (eq (char-after (point)) ?<)
- (not (eq (get-text-property (point) 'category)
- 'bitsyntax-open-inner)))
- ;; Then mark the two chars...
- (put-text-property (point) (1+ (point))
- 'category 'bitsyntax-open-outer)
- (forward-char 1)
- (put-text-property (point) (1+ (point))
- 'category 'bitsyntax-open-inner)
- ;;...and unmark any subsequent less-than chars.
- (forward-char 1)
- (while (eq (char-after (point)) ?<)
- (remove-text-properties (point) (1+ (point))
- '(category nil))
- (forward-char 1))))))
-
-(defun erlang-after-bitsyntax-close ()
- "Return t if point is immediately after a bit-syntax close parenthesis (`>>')."
- (and (>= (point) 3)
- (save-excursion
- (backward-char 2)
- (and (eq (char-after (point)) ?>)
- (not (eq (get-text-property (point) 'category)
- 'bitsyntax-close-outer))))))
-
-(defun erlang-after-arrow ()
- "Return true if point is immediately after a function arrow (`->')."
- (and (>= (point) 2)
- (and
- (save-excursion
- (backward-char)
- (eq (char-before (point)) ?-))
- (or (not (listp erlang-electric-commands))
- (memq 'erlang-electric-gt
- erlang-electric-commands))
- (not (erlang-in-literal))
- (looking-at "\\s *\\(%.*\\)?$")
- (erlang-test-criteria-list erlang-electric-arrow-criteria))))
-
-
-(defun erlang-electric-gt (&optional arg)
- "Insert a greater-than sign, and optionally mark it as a close paren."
-
- (interactive "p")
-
- (self-insert-command arg)
-
- (cond
- ;; Did we just write a bit-syntax close (`>>')?
- ((erlang-after-bitsyntax-close)
- (save-excursion
- ;; Then mark the two chars...
- (backward-char 2)
- (put-text-property (point) (1+ (point))
- 'category 'bitsyntax-close-inner)
- (forward-char)
- (put-text-property (point) (1+ (point))
- 'category 'bitsyntax-close-outer)
- ;;...and unmark any subsequent greater-than chars.
- (forward-char)
- (while (eq (char-after (point)) ?>)
- (remove-text-properties (point) (1+ (point))
- '(category nil))
- (forward-char))))
-
- ;; Did we just write a function arrow (`->')?
- ((erlang-after-arrow)
- (let ((erlang-electric-newline-inhibit t))
- (undo-boundary)
- (end-of-line)
- (newline)
- (condition-case nil
- (erlang-indent-line)
- (error (if (bolp) (delete-char -1))))))
-
- ;; Then it's just a plain greater-than.
- (t
- nil)))
-
-
-(defun erlang-electric-arrow (&optional arg)
- "Insert a '>'-sign and possibly a new indented line.
-
-This command is only `electric' when the `>' is part of an `->' arrow.
-The variable `erlang-electric-arrow-criteria' states a sequence of
-criteria, which decides when a newline should be inserted and the next
-line indented.
-
-It behaves just like the normal greater than sign when supplied with a
-numerical arg, point is inside string or comment, or when there are
-non-whitespace characters following the point on the current line.
-
-After being split/merged into `erlang-after-arrow' and
-`erlang-electric-gt', it is now unused and disabled."
- (interactive "P")
- (let ((prec (preceding-char)))
- (self-insert-command (prefix-numeric-value arg))
- (if (or arg
- (and (listp erlang-electric-commands)
- (not (memq 'erlang-electric-arrow
- erlang-electric-commands)))
- (not (eq prec ?-))
- (erlang-in-literal)
- (not (looking-at "\\s *\\(%.*\\)?$"))
- (null (erlang-test-criteria-list
- erlang-electric-arrow-criteria)))
- (setq erlang-electric-newline-inhibit nil)
- (setq erlang-electric-newline-inhibit t)
- (undo-boundary)
- (end-of-line)
- (newline)
- (condition-case nil
- (erlang-indent-line)
- (error (if (bolp) (delete-char -1)))))))
-
-
-(defun erlang-electric-newline (&optional arg)
- "Break line at point and indent, continuing comment if within one.
-The variable `erlang-electric-newline-criteria' states a criterion,
-when fulfilled a newline is inserted and the next line is indented.
-
-Should the current line begin with a comment, and the variable
-`comment-multi-line' be non-nil, a new comment start is inserted.
-
-Should the previous command be another electric command we assume that
-the user pressed newline out of old habit, hence we will do nothing."
- (interactive "P")
- (cond ((and (not arg)
- erlang-electric-newline-inhibit
- (memq last-command erlang-electric-newline-inhibit-list))
- ()) ; Do nothing!
- ((or arg
- (and (listp erlang-electric-commands)
- (not (memq 'erlang-electric-newline
- erlang-electric-commands)))
- (null (erlang-test-criteria-list
- erlang-electric-newline-criteria)))
- (newline (prefix-numeric-value arg)))
- (t
- (if (and comment-multi-line
- (save-excursion
- (beginning-of-line)
- (looking-at (concat "\\s *" comment-start-skip))))
- (let ((str (buffer-substring
- (or (match-end 1) (match-beginning 0))
- (min (match-end 0) (point)))))
- (newline)
- (undo-boundary)
- (insert str))
- (newline)
- (undo-boundary)
- (indent-according-to-mode)))))
-
-
-(defun erlang-test-criteria-list (criteria)
- "Given a list of criterion functions, test if criteria are fulfilled.
-
-Each element in the criteria list can a function returning nil, t or
-the atom `stop'. t means that the criterion is fulfilled, `stop' means
-that it isn't fulfilled and that the search should stop,
-and nil means continue searching.
-
-Should the list contain the atom t the criterion is assumed to be
-fulfilled, unless preceded by a function returning `stop', of course.
-
-Should the argument be the atom t instead of a list, the criterion is
-assumed to be trivially true.
-
-Should all functions return nil, the criteria are assumed not to be
-fulfilled.
-
-Return t if criteria fulfilled, nil otherwise."
- (if (eq criteria t)
- t
- (save-excursion
- (let ((answer nil))
- (while (and criteria (null answer))
- (if (eq (car criteria) t)
- (setq answer t)
- (setq answer (funcall (car criteria))))
- (setq criteria (cdr criteria)))
- (if (and answer (not (eq answer 'stop)))
- t
- nil)))))
-
-
-(defun erlang-in-literal ()
- "Test if point is in string, quoted atom or comment.
-
-Return one of the three atoms `atom', `string', and `comment'.
-Should the point be inside none of the above mentioned types of
-context, nil is returned."
- (save-excursion
- (let ((state (funcall (symbol-function 'syntax-ppss))))
- (cond ((eq (nth 3 state) ?') 'atom)
- ((nth 3 state) 'string)
- ((nth 4 state) 'comment)
- (t nil)))))
-
-
-(defun erlang-at-end-of-function-p ()
- "Test if point is at end of an Erlang function.
-
-This function is designed to be a member of a criteria list."
- (eq (save-excursion (erlang-skip-blank) (point))
- (save-excursion
- (erlang-beginning-of-function -1) (point))))
-
-
-(defun erlang-at-end-of-clause-p ()
- "Test if point is at end of an Erlang clause.
-
-This function is designed to be a member of a criteria list."
- (eq (save-excursion (erlang-skip-blank) (point))
- (save-excursion
- (erlang-beginning-of-clause -1) (point))))
-
-
-(defun erlang-stop-when-inside-argument-list ()
- "Return `stop' if inside parenthesis list, nil otherwise.
-
-Knows about the list comprehension syntax. When the point is
-after `||', `stop' is not returned.
-
-This function is designed to be a member of a criteria list."
- (save-excursion
- (condition-case nil
- (let ((orig-point (point))
- (state nil))
- (up-list -1)
- (if (not (eq (following-char) ?\[))
- 'stop
- ;; Do not return `stop' when inside a list comprehension
- ;; construction. (The point must be after `||').
- (while (< (point) orig-point)
- (let ((pt (point)))
- (setq state (erlang-partial-parse pt orig-point state))
- (if (= pt (point))
- (error "Illegal syntax"))))
- (if (and (car state) (eq (car (car (car state))) '||))
- nil
- 'stop)))
- (error
- nil))))
-
-
-(defun erlang-stop-when-at-guard ()
- "Return `stop' when at function guards.
-
-This function is designed to be a member of a criteria list."
- (save-excursion
- (beginning-of-line)
- (if (and (looking-at (eval-when-compile
- (concat "^" erlang-atom-regexp "\\s *(")))
- (not (looking-at
- (eval-when-compile
- (concat "^" erlang-atom-regexp ".*->")))))
- 'stop
- nil)))
-
-
-(defun erlang-stop-when-in-type-spec ()
- "Return `stop' when in a type spec line.
-
-This function is designed to be a member of a criteria list."
- (save-excursion
- (beginning-of-line)
- (when (save-match-data (looking-at "-\\(spec\\|type\\|callback\\)"))
- 'stop)))
-
-
-(defun erlang-next-lines-empty-p ()
- "Return non-nil if next lines are empty.
-
-The variable `erlang-next-lines-empty-threshold' contains the number
-of lines required to be empty.
-
-A line containing only spaces and tabs is considered empty.
-
-This function is designed to be a member of a criteria list."
- (and erlang-next-lines-empty-threshold
- (save-excursion
- (let ((left erlang-next-lines-empty-threshold)
- (cont t))
- (while (and cont (> left 0))
- (forward-line 1)
- (setq cont (looking-at "\\s *$"))
- (setq left (- left 1)))
- cont))))
-
-
-(defun erlang-at-keyword-end-p ()
- "Test if next readable token is the keyword end.
-
-This function is designed to be a member of a criteria list."
- (save-excursion
- (erlang-skip-blank)
- (looking-at "end[^_a-zA-Z0-9]")))
-
-
-;;; Erlang tags support which is aware of erlang modules.
-
-(eval-when-compile
- (require 'etags))
-
-
-;; Variables:
-
-(defvar erlang-tags-function-alist
- '((find-tag . erlang-find-tag)
- (find-tag-other-window . erlang-find-tag-other-window)
- (find-tag-regexp . erlang-find-tag-regexp)
- (find-tag-other-frame . erlang-find-tag-other-frame))
- "Alist of old tags commands and the replacement functions.")
-
-(defvar erlang-tags-installed nil
- "Non-nil when the Erlang tags system is installed.")
-(defvar erlang-tags-file-list '()
- "List of files in tag list. Used when finding tag on form `module:'.")
-(defvar erlang-tags-completion-table nil
- "Like `tags-completion-table', this table contains `tag' and `module:tag'.")
-(defvar erlang-tags-buffer-installed-p nil
- "Non-nil when Erlang module recognising functions installed.")
-(defvar erlang-tags-buffer-list '()
- "Temporary list of buffers.")
-(defvar erlang-tags-orig-completion-table nil
- "Temporary storage for `tags-completion-table'.")
-(defvar erlang-tags-orig-tag-order nil
- "Temporary storage for `find-tag-tag-order'.")
-(defvar erlang-tags-orig-regexp-tag-order nil
- "Temporary storage for `find-tag-regexp-tag-order'.")
-(defvar erlang-tags-orig-search-function nil
- "Temporary storage for `find-tag-search-function'.")
-(defvar erlang-tags-orig-regexp-search-function nil
- "Temporary storage for `find-tag-regexp-search-function'.")
-(defvar erlang-tags-orig-format-hooks nil
- "Temporary storage for `tags-table-format-hooks'.") ;v19
-(defvar erlang-tags-orig-format-functions nil
- "Temporary storage for `tags-table-format-functions'.") ;v > 19
-
-(defun erlang-tags-init ()
- "Install an alternate version of tags, aware of Erlang modules.
-
-After calling this function, the tags functions are aware of
-Erlang modules. Tags can be entered on the for `module:tag' as well
-as on the old form `tag'.
-
-In the completion list, `module:tag' and `module:' shows up."
- (interactive)
- (require 'etags)
- (set (make-local-variable 'find-tag-default-function)
- 'erlang-find-tag-for-completion)
- (if (>= emacs-major-version 25)
- (add-hook 'xref-backend-functions
- #'erlang-etags--xref-backend nil t)
- (erlang-tags-define-keys (current-local-map))
- (setq erlang-tags-installed t)))
-
-
-
-;; Set all keys bound to `find-tag' et.al. in the global map and the
-;; menu to `erlang-find-tag' et.al. in `map'.
-;;
-;; The function `substitute-key-definition' does not work properly
-;; in all version of Emacs.
-
-(defun erlang-tags-define-keys (map)
- "Bind tags commands to keymap MAP aware of Erlang modules."
- (let ((alist erlang-tags-function-alist))
- (while alist
- (let* ((old (car (car alist)))
- (new (cdr (car alist)))
- (keys (append (where-is-internal old global-map))))
- (while keys
- (define-key map (car keys) new)
- (setq keys (cdr keys))))
- (setq alist (cdr alist))))
- ;; Update the menu.
- (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist)
- (erlang-menu-init))
-
-;; Return `t' since it is used inside `tags-loop-form'.
-;;;###autoload
-(defun erlang-find-tag (modtagname &optional next-p regexp-p)
- "Like `find-tag'. Capable of retrieving Erlang modules.
-
-Tags can be given on the forms `tag', `module:', `module:tag'."
- (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
- (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p))
- t)
-
-
-;; Code mainly from `find-tag-other-window' in `etags.el'.
-;;;###autoload
-(defun erlang-find-tag-other-window (tagname &optional next-p regexp-p)
- "Like `find-tag-other-window' but aware of Erlang modules."
- (interactive (erlang-tag-interactive
- "Find `module:tag' or `tag' other window: "))
-
- ;; This is to deal with the case where the tag is found in the
- ;; selected window's buffer; without this, point is moved in both
- ;; windows. To prevent this, we save the selected window's point
- ;; before doing find-tag-noselect, and restore it afterwards.
- (let* ((window-point (window-point (selected-window)))
- (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p))
- (tagpoint (progn (set-buffer tagbuf) (point))))
- (set-window-point (prog1
- (selected-window)
- (switch-to-buffer-other-window tagbuf)
- ;; We have to set this new window's point; it
- ;; might already have been displaying a
- ;; different portion of tagbuf, in which case
- ;; switch-to-buffer-other-window doesn't set
- ;; the window's point from the buffer.
- (set-window-point (selected-window) tagpoint))
- window-point)))
-
-
-(defun erlang-find-tag-other-frame (tagname &optional next-p)
- "Like `find-tag-other-frame' but aware of Erlang modules."
- (interactive (erlang-tag-interactive
- "Find `module:tag' or `tag' other frame: "))
- (let ((pop-up-frames t))
- (erlang-find-tag-other-window tagname next-p)))
-
-
-(defun erlang-find-tag-regexp (regexp &optional next-p other-window)
- "Like `find-tag-regexp' but aware of Erlang modules."
- (interactive (if (fboundp 'find-tag-regexp)
- (erlang-tag-interactive
- "Find `module:regexp' or `regexp': ")
- (error "This version of Emacs can't find tags by regexps")))
- (funcall (if other-window
- 'erlang-find-tag-other-window
- 'erlang-find-tag)
- regexp next-p t))
-
-
-;; Just like C-u M-. This could be added to the menu.
-(defun erlang-find-next-tag ()
- "Find next tag, like \\[find-tag] with prefix arg."
- (interactive)
- (let ((current-prefix-arg '(4)))
- (if erlang-tags-installed
- (call-interactively 'erlang-find-tag)
- (call-interactively 'find-tag))))
-
-
-;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to
-;; be compatible with `tags.el'.
-;;
-;; Handles three cases:
-;; * `module:' Loop over all possible file names. Stop if a file-name
-;; without extension and directory matches the module.
-;;
-;; * `module:tag'
-;; Emacs 19: Replace test functions with functions aware of
-;; Erlang modules. Tricky because the etags system wasn't
-;; built for these kind of operations...
-;;
-;; Emacs 18: We loop over `find-tag' until we find a file
-;; whose module matches the requested module. The
-;; drawback is that a lot of files could be loaded into
-;; Emacs.
-;;
-;; * `tag' Just give it to `find-tag'.
-
-(defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p)
- "Like `find-tag-noselect' but aware of Erlang modules."
- (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
- (or modtagname
- (setq modtagname (symbol-value 'last-tag)))
- (funcall (symbol-function 'set) 'last-tag modtagname)
- ;; `tags.el' uses this variable to record how M-, would
- ;; know where to restart a tags command.
- (if (boundp 'tags-loop-form)
- (funcall (symbol-function 'set)
- 'tags-loop-form '(erlang-find-tag nil t)))
- (save-window-excursion
- (cond
- ((string-match ":$" modtagname)
- ;; Only the module name was given. Read all files whose file name
- ;; match.
- (let ((modname (substring modtagname 0 (match-beginning 0)))
- (file nil))
- (if (not next-p)
- (save-excursion
- (visit-tags-table-buffer)
- (setq erlang-tags-file-list
- (funcall (symbol-function 'tags-table-files)))))
- (while (null file)
- (or erlang-tags-file-list
- (save-excursion
- (if (and (funcall
- (symbol-function 'visit-tags-table-buffer) 'same)
- (funcall
- (symbol-function 'visit-tags-table-buffer) t))
- (setq erlang-tags-file-list
- (funcall (symbol-function 'tags-table-files)))
- (error "No %stags containing %s" (if next-p "more " "")
- modtagname))))
- (if erlang-tags-file-list
- (let ((this-module (erlang-get-module-from-file-name
- (car erlang-tags-file-list))))
- (if (and (stringp this-module)
- (string= modname this-module))
- (setq file (car erlang-tags-file-list)))
- (setq erlang-tags-file-list (cdr erlang-tags-file-list)))))
- (set-buffer (or (get-file-buffer file)
- (find-file-noselect file)))))
-
- ((string-match ":" modtagname)
- (progn
- (erlang-tags-install-module-check)
- (unwind-protect
- (funcall (symbol-function 'find-tag)
- modtagname next-p regexp-p)
- (erlang-tags-remove-module-check))))
- (t
- (funcall (symbol-function 'find-tag) modtagname next-p regexp-p)))
- (current-buffer))) ; Return the new buffer.
-
-
-
-
-
-
-
-;; Process interactive arguments for erlang-find-tag-*.
-;;
-;; Negative arguments work only for `etags', not `tags'. This is not
-;; a problem since negative arguments means step back into the
-;; history list, a feature not implemented in `tags'.
-
-(defun erlang-tag-interactive (prompt)
- (condition-case nil
- (require 'etags)
- (error
- (require 'tags)))
- (if current-prefix-arg
- (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
- '-
- t))
- (let* ((default (erlang-default-function-or-module))
- (prompt (if default
- (format "%s(default %s) " prompt default)
- prompt))
- (spec (completing-read prompt 'erlang-tags-complete-tag)))
- (list (if (equal spec "")
- (or default (error "There is no default tag"))
- spec)))))
-
-
-;; Search tag functions which are aware of Erlang modules. The tactic
-;; is to store new search functions into the local variables of the
-;; TAGS buffers. The variables are restored directly after the
-;; search. The situation is complicated by the fact that new TAGS
-;; files can be loaded during the search.
-;;
-
-(defun erlang-tags-install-module-check ()
- "Install our own tag search functions."
- ;; Make sure our functions are installed in TAGS files loaded
- ;; into Emacs while searching.
- (setq erlang-tags-orig-format-functions
- (symbol-value 'tags-table-format-functions))
- (funcall (symbol-function 'set) 'tags-table-format-functions
- (cons 'erlang-tags-recognize-tags-table
- erlang-tags-orig-format-functions))
- (setq erlang-tags-buffer-list '())
-
- ;; Install our functions in the TAGS files already resident.
- (save-excursion
- (let ((files (symbol-value 'tags-table-computed-list)))
- (while files
- (if (stringp (car files))
- (if (get-file-buffer (car files))
- (progn
- (set-buffer (get-file-buffer (car files)))
- (erlang-tags-install-local))))
- (setq files (cdr files))))))
-
-
-(defun erlang-tags-install-local ()
- "Install our tag search functions in current buffer."
- (if erlang-tags-buffer-installed-p
- ()
- ;; Mark this buffer as "installed" and record.
- (set (make-local-variable 'erlang-tags-buffer-installed-p) t)
- (setq erlang-tags-buffer-list
- (cons (current-buffer) erlang-tags-buffer-list))
-
- ;; Save the original values.
- (set (make-local-variable 'erlang-tags-orig-tag-order)
- (symbol-value 'find-tag-tag-order))
- (set (make-local-variable 'erlang-tags-orig-regexp-tag-order)
- (symbol-value 'find-tag-regexp-tag-order))
- (set (make-local-variable 'erlang-tags-orig-search-function)
- (symbol-value 'find-tag-search-function))
- (set (make-local-variable 'erlang-tags-orig-regexp-search-function)
- (symbol-value 'find-tag-regexp-search-function))
-
- ;; Install our own functions.
- (set (make-local-variable 'find-tag-search-function)
- 'erlang-tags-search-forward)
- (set (make-local-variable 'find-tag-regexp-search-function)
- 'erlang-tags-regexp-search-forward)
- (set (make-local-variable 'find-tag-tag-order)
- (mapcar #'erlang-make-order-function-aware-of-modules
- erlang-tags-orig-tag-order))
- (set (make-local-variable 'find-tag-regexp-tag-order)
- (mapcar #'erlang-make-order-function-aware-of-modules
- erlang-tags-orig-regexp-tag-order))))
-
-(defun erlang-make-order-function-aware-of-modules (f)
- `(lambda (tag)
- (let (mod)
- (when (string-match ":" tag)
- (setq mod (substring tag 0 (match-beginning 0)))
- (setq tag (substring tag (match-end 0) nil)))
- (and (funcall ',f tag)
- (or (null mod)
- (erlang-tag-at-point-match-module-p mod))))))
-
-(defun erlang-tag-at-point-match-module-p (mod)
- (string-equal mod (erlang-get-module-from-file-name
- (funcall (symbol-function 'file-of-tag)))))
-
-
-(defun erlang-tags-remove-module-check ()
- "Remove our own tags search functions."
- (funcall (symbol-function 'set)
- 'tags-table-format-functions
- erlang-tags-orig-format-functions)
-
- ;; Remove our functions from the TAGS files. (Note that
- ;; `tags-table-computed-list' need not be the same list as when
- ;; the search was started.)
- (save-excursion
- (let ((buffers erlang-tags-buffer-list))
- (while buffers
- (if (buffer-name (car buffers))
- (progn
- (set-buffer (car buffers))
- (erlang-tags-remove-local)))
- (setq buffers (cdr buffers))))))
-
-
-(defun erlang-tags-remove-local ()
- "Remove our tag search functions from current buffer."
- (if (null erlang-tags-buffer-installed-p)
- ()
- (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil)
- (funcall (symbol-function 'set)
- 'find-tag-tag-order erlang-tags-orig-tag-order)
- (funcall (symbol-function 'set)
- 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order)
- (funcall (symbol-function 'set)
- 'find-tag-search-function erlang-tags-orig-search-function)
- (funcall (symbol-function 'set)
- 'find-tag-regexp-search-function
- erlang-tags-orig-regexp-search-function)))
-
-
-(defun erlang-tags-recognize-tags-table ()
- "Install our functions in all loaded TAGS files.
-
-This function is added to `tags-table-format-hooks/functions' when searching
-for a tag on the form `module:tag'."
- (if (null (funcall (symbol-function 'etags-recognize-tags-table)))
- nil
- (erlang-tags-install-local)
- t))
-
-
-(defun erlang-tags-search-forward (tag &optional bound noerror count)
- "Forward search function, aware of Erlang module prefix."
- (if (string-match ":" tag)
- (setq tag (substring tag (match-end 0) nil)))
- ;; Avoid unintended recursion.
- (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward)
- (search-forward tag bound noerror count)
- (funcall erlang-tags-orig-search-function tag bound noerror count)))
-
-
-(defun erlang-tags-regexp-search-forward (tag &optional bound noerror count)
- "Forward regexp search function, aware of Erlang module prefix."
- (if (string-match ":" tag)
- (setq tag (substring tag (match-end 0) nil)))
- (if (eq erlang-tags-orig-regexp-search-function
- 'erlang-tags-regexp-search-forward)
- (re-search-forward tag bound noerror count)
- (funcall erlang-tags-orig-regexp-search-function
- tag bound noerror count)))
-
-;;; Tags completion, Emacs 19 `etags' specific.
-;;;
-;;; The basic idea is to create a second completion table `erlang-tags-
-;;; completion-table' containing all normal tags plus tags on the form
-;;; `module:tag' and `module:'.
-
-(if (fboundp 'advice-add)
- ;; Emacs 24.4+
- (progn
- (require 'etags)
- (advice-add 'etags-tags-completion-table :around
- #'erlang-etags-tags-completion-table-advice))
- ;; Emacs 23.1-24.3
- (defadvice etags-tags-completion-table (around
- erlang-replace-tags-table
- activate)
- (if erlang-replace-etags-tags-completion-table
- (setq ad-return-value (erlang-etags-tags-completion-table))
- ad-do-it)))
-
-(defun erlang-etags-tags-completion-table-advice (oldfun)
- (if erlang-replace-etags-tags-completion-table
- (erlang-etags-tags-completion-table)
- (funcall oldfun)))
-
-(defun erlang-complete-tag ()
- "Perform tags completion on the text around point.
-Completes to the set of names listed in the current tags table.
-
-Should the Erlang tags system be installed this command knows
-about Erlang modules."
- (interactive)
- (require 'etags)
- (let ((erlang-replace-etags-tags-completion-table t))
- (complete-tag)))
-
-
-(defun erlang-find-tag-for-completion ()
- (let ((start (save-excursion
- (skip-chars-backward "[:word:][:digit:]_:'")
- (point))))
- (unless (eq start (point))
- (buffer-substring-no-properties start (point)))))
-
-
-;; Based on `tags-complete-tag', but this one uses
-;; `erlang-tags-completion-table' instead of `tags-completion-table'.
-;;
-;; This is the entry-point called by system function `completing-read'.
-;;
-;; Used for minibuffer completion in Emacs 19-24 and completion in
-;; erlang buffers in Emacs 19-22.
-(defun erlang-tags-complete-tag (string predicate what)
- (with-current-buffer (window-buffer (minibuffer-selected-window))
- (save-excursion
- ;; If we need to ask for the tag table, allow that.
- (let ((enable-recursive-minibuffers t))
- (visit-tags-table-buffer))
- (if (eq what t)
- (all-completions string (erlang-tags-completion-table) predicate)
- (try-completion string (erlang-tags-completion-table) predicate)))))
-
-
-;; `tags-completion-table' calls itself recursively, make it
-;; call our own wedge instead. Note that the recursive call
-;; is very rare; it only occurs when a tags-file contains
-;; `include'-statements.
-(defun erlang-tags-completion-table ()
- "Build completion table. Tags on the form `tag' or `module:tag'."
- (setq erlang-tags-orig-completion-table
- (symbol-function 'tags-completion-table))
- (fset 'tags-completion-table
- (symbol-function 'erlang-tags-completion-table-1))
- (unwind-protect
- (erlang-tags-completion-table-1)
- (fset 'tags-completion-table
- erlang-tags-orig-completion-table)))
-
-(defun erlang-tags-completion-table-1 ()
- (make-local-variable 'erlang-tags-completion-table)
- (or erlang-tags-completion-table
- (let ((tags-completion-table nil)
- (tags-completion-table-function
- 'erlang-etags-tags-completion-table))
- (funcall erlang-tags-orig-completion-table)
- (setq erlang-tags-completion-table tags-completion-table))))
-
-
-
-;; Emacs 25 expects this function to return a list (and it is ok for
-;; it to include duplicates). Older emacsen expects an obarray.
-(defun erlang-etags-tags-completion-table ()
- (if (>= emacs-major-version 25)
- (erlang-etags-tags-completion-table-list)
- (let ((obarray (make-vector 511 0)))
- (dolist (tag (erlang-etags-tags-completion-table-list))
- (intern tag obarray))
- obarray)))
-
-;; Based on `etags-tags-completion-table'. The difference is that we
-;; add three strings to the list, the tag, module: and module:tag.
-;; The module is extracted from the file name of a tag. (This one
-;; only works if we are looking at an `etags' file. However, this is
-;; the only format supported by Emacs, so far.)
-(defun erlang-etags-tags-completion-table-list ()
- (let ((progress-reporter
- (make-progress-reporter
- (format "Making tags completion table for %s..." buffer-file-name)
- (point-min) (point-max)))
- table module)
- (save-excursion
- (goto-char (point-min))
- (while (progn
- (while (and (eq (following-char) ?\f)
- (looking-at "\f\n\\([^,\n]*\\),.*\n"))
- (let ((file (buffer-substring (match-beginning 1)
- (match-end 1))))
- (setq module (erlang-get-module-from-file-name file))
- (when module
- (push (concat module ":") table)
- (push (concat module ":module_info") table))
- (forward-line 2)))
- ;; This regexp matches an explicit tag name or the
- ;; place where it would start.
- (re-search-forward
- "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?"
- nil t))
- (let ((tag (if (match-beginning 1)
- ;; There is an explicit tag name.
- (buffer-substring (match-beginning 1) (match-end 1))
- ;; No explicit tag name. Backtrack a little,
- ;; and look for the implicit one.
- (goto-char (match-beginning 0))
- (skip-chars-backward "^\f\t\n\r()=,; ")
- (buffer-substring (point) (match-beginning 0)))))
- (forward-line 1)
- (push tag table)
- (when (stringp module)
- (push (concat module ":" tag) table))
- (progress-reporter-update progress-reporter (point)))))
- table))
-
-
-
-
-;;; Xref backend erlang-etags
-
-;; In GNU Emacs 25 xref was introduced. It is a framework for cross
-;; referencing commands, in particular commands for finding
-;; definitions. It does not replace etags. It rather resides on top
-;; of it and provides user-friendly commands. The idea is that the
-;; user commands should be the same regardless of what backend does
-;; the actual finding of definitions.
-
-;; The backend below is a wrapper around the built-in etags backend.
-;; It adds awareness of the module:tag syntax in a similar way that is
-;; done above for the old etags commands.
-;;
-;; In addition arity is also considered when jumping to definitions.
-;; There is however currently no information about arity in the TAGS
-;; file. Also two functions with the same name but different arity
-;; _sometimes_ get one TAGS entry each and sometimes are joined in one
-;; single entry. If they are directly consecutive they will be
-;; joined. If there are other functions etc in between then they will
-;; get one entry each.
-;;
-;; These limitations are present in both the etags program shipped
-;; with GNU Emacs and the tags.erl program in this repository.
-;;
-;; Therefore erlang.el must complement the information in TAGS by
-;; visiting files and checking arity. When searching for popular
-;; function names (like init, handle_call etc) in a big TAGS file
-;; (like one indexing this repository) this may be quite
-;; time-consuming. There exists therefore an upper limit for the
-;; number of files to visit (called
-;; `erlang-max-files-to-visit-for-refining-xrefs').
-;;
-;; As mentioned this xref implementation is based on the etags xref
-;; implementation. But in the cases where arity is considered the
-;; etags information structures (struct xref-etags-location) will be
-;; translated to our own structures which include arity (struct
-;; erlang-xref-location). This translation is started in the function
-;; `erlang-refine-xrefs'.
-
-;; I mention this as a head up that some of the functions below deal
-;; with xref items with xref-etags-location and some deal with xref
-;; items with erlang-xref-location.
-
-;; NOTE: Around Sept 2021, the xrefs package changed all of its defined types
-;; (i.e. xref-location, xref-file-location) from EIEIO classes to CL-Lib
-;; structures. These are both supported. Older Emacsen with earlier versions of
-;; xref will continue to use defclass. Newer Emacsen will use cl-defstruct.
-
-(defun erlang-etags--xref-backend () 'erlang-etags)
-
-(defun erlang-soft-require (feature)
- (when (locate-library (symbol-name feature))
- (require feature)))
-
-(when (and (erlang-soft-require 'xref)
- (erlang-soft-require 'cl-generic)
- (erlang-soft-require 'cl-lib)
- (erlang-soft-require 'eieio)
- (erlang-soft-require 'etags))
- ;; The purpose of using eval here is to avoid compilation
- ;; warnings in emacsen without cl-defmethod etc.
- (eval
- '(progn
- (cl-defmethod xref-backend-identifier-at-point ((_backend
- (eql erlang-etags)))
- (if (eq this-command 'xref-find-references)
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning)
- (region-end))
- (thing-at-point 'symbol))
- (erlang-id-to-string (erlang-get-identifier-at-point))))
-
- (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags))
- identifier)
- (erlang-xref-find-definitions identifier))
-
- (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags))
- identifier)
- (erlang-xref-find-definitions identifier t))
-
- (cl-defmethod xref-backend-identifier-completion-table
- ((_backend (eql erlang-etags)))
- (let ((erlang-replace-etags-tags-completion-table t))
- (tags-completion-table)))
-
- ;; Xref 1.3.1 bundled with Emacs 28+ switched from using EIEIO classes to
- ;; using CL-Lib structs.
- (if (find-class 'xref-file-location)
- (progn
- (defclass erlang-xref-location (xref-file-location)
- ((arity :type fixnum :initarg :arity
- :reader erlang-xref-location-arity))
- :documentation "An erlang location is a file location plus arity.")
- ;; Make a constructor with the same name that a CL structure would have.
- (defalias 'make-erlang-xref-location 'erlang-xref-location))
- (cl-defstruct (erlang-xref-location
- (:include xref-file-location))
- "An erlang location is a file location plus arity."
- (arity 0 :type fixnum)))
-
- ;; This method definition only calls the superclass which is
- ;; the default behaviour if it was not defined. It is only
- ;; needed for "upgrade" purposes. In version 2.8.1 of
- ;; erlang.el this method was defined differently and in case
- ;; user switch to a new erlang.el without restarting Emacs
- ;; this method needs to be redefined.
- (cl-defmethod xref-location-marker ((locus erlang-xref-location))
- (cl-call-next-method locus)))))
-
-;; If this function returns a single xref the user will jump to that
-;; directly. If two or more xrefs are returned a *xref* window is
-;; displayed and the user can choose where to jump. Hence we want to
-;; return a single xref when we are pretty sure that is where the user
-;; wants to go. Otherwise return all possible xrefs but sort them so
-;; that xrefs in the local file is first and if arity is known sort
-;; the xrefs with matching arity before others.
-
-;; Note that the arity sorting work may partly be undone later when
-;; the hits are presented in the *xref* buffer since they then will be
-;; grouped together by file. Ie when one file have one hit with
-;; correct arity and others with wrong arity these hits will be
-;; grouped together and may end up before hits with correct arity.
-(defun erlang-xref-find-definitions (identifier &optional is-regexp)
- (erlang-with-id (kind module name arity) identifier
- (cond ((eq kind 'module)
- (erlang-xref-find-definitions-module name))
- ((eq kind 'qualified-function)
- (erlang-xref-find-definitions-qualified-function module
- name
- arity
- is-regexp))
- (module
- (erlang-xref-find-definitions-module-tag kind
- module
- name
- arity
- is-regexp))
- (t
- (erlang-xref-find-definitions-tag kind name arity is-regexp)))))
-
-(defun erlang-xref-find-definitions-module (module)
- (and (fboundp 'xref-make)
- (fboundp 'xref-make-file-location)
- (let* ((first-time t)
- (cbuf (current-buffer))
- xrefs matching-files)
- (save-excursion
- (while (erlang-visit-tags-table-buffer (not first-time) cbuf)
- (setq first-time nil)
- (let ((files (tags-table-files)))
- (while files
- (let* ((file (car files))
- (m (erlang-get-module-from-file-name file)))
- (when (and m (string-equal m module))
- (unless (member file matching-files)
- (push file
- matching-files)
- (push (xref-make file
- (xref-make-file-location file 1 0))
- xrefs))))
- (setq files (cdr files))))))
- (nreverse xrefs))))
-
-(defun erlang-xref-find-definitions-qualified-function (module
- tag
- arity
- is-regexp)
- "Find definitions of TAG in MODULE preferably with arity ARITY.
-If one single perfect match was found return only that (ignoring
-other definitions matching TAG). If IS-REGEXP is non-nil then
-TAG is a regexp."
- (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
- (etags--xref-find-definitions tag is-regexp)))
- (xrefs-split (erlang-split-xrefs-on-module xrefs module))
- (module-xrefs (car xrefs-split))
- (module-xrefs (erlang-refine-xrefs module-xrefs
- 'qualified-function
- tag
- is-regexp)))
- (or (erlang-single-arity-match module-xrefs arity)
- (erlang-sort-by-arity module-xrefs arity))))
-
-
-;; We will end up here when erlang-get-some-other-id-at-point either
-;; found module among the import statements or module is just the
-;; current local file.
-(defun erlang-xref-find-definitions-module-tag (kind
- module
- tag
- arity
- is-regexp)
- "Find definitions of TAG preferably in MODULE and with arity ARITY.
-Return definitions outside MODULE if none are found inside. If
-IS-REGEXP is non-nil then TAG is a regexp.
-
-If one single perfect match was found return only that (ignoring
-other definitions matching TAG)."
- (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
- (etags--xref-find-definitions tag is-regexp)))
- (xrefs-split (erlang-split-xrefs-on-module xrefs module))
- (module-xrefs (car xrefs-split))
- (module-xrefs (erlang-refine-xrefs module-xrefs
- kind
- tag
- is-regexp)))
- (or (erlang-single-arity-match module-xrefs arity)
- (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs))))
-
-(defun erlang-xref-find-definitions-tag (kind
- tag
- arity
- is-regexp
- &optional xrefs)
- "Find definitions of TAG preferably in local file and with arity ARITY.
-If one single perfect match was found return only that (ignoring
-other definitions matching TAG). If no such local match was
-found then look for a matching BIF in the same way. If IS-REGEXP
-is non-nil then TAG is a regexp."
- (let* ((regexp (erlang-etags-regexp kind tag is-regexp))
- (xrefs (or xrefs
- (when (fboundp 'etags--xref-find-definitions)
- (etags--xref-find-definitions regexp t))))
- (xrefs-split (erlang-split-xrefs xrefs))
- (local-xrefs (car xrefs-split))
- (local-xrefs (erlang-refine-xrefs local-xrefs
- kind
- tag
- is-regexp))
- (bif-xrefs (cadr xrefs-split))
- (other-xrefs (caddr xrefs-split)))
- (or (erlang-single-arity-match local-xrefs arity)
- ;; No local match, look for a matching BIF.
- (progn
- (setq bif-xrefs (erlang-refine-xrefs bif-xrefs
- kind
- tag
- is-regexp))
- (erlang-single-arity-match bif-xrefs arity))
- (progn
- (setq other-xrefs (erlang-refine-xrefs other-xrefs
- kind
- tag
- is-regexp))
- (and (null local-xrefs)
- (null bif-xrefs)
- ;; No local of BIF matches at all. Is there a single
- ;; arity match among the rest?
- (erlang-single-arity-match other-xrefs arity)))
- (append (erlang-sort-by-arity local-xrefs arity)
- (erlang-sort-by-arity bif-xrefs arity)
- (erlang-sort-by-arity other-xrefs arity)))))
-
-
-(defun erlang-refine-xrefs (xrefs kind tag is-regexp)
- (if (or (memq kind '(record module))
- ;; No support for apropos here.
- is-regexp
- (erlang-too-many-files-in-xrefs xrefs))
- xrefs
- (when (and xrefs
- (fboundp 'xref-item-location)
- (fboundp 'xref-location-group))
- (let (files)
- (cl-loop for xref in xrefs
- for loc = (xref-item-location xref)
- for file = (xref-location-group loc)
- do (cl-pushnew file files :test 'string-equal))
- (or (cl-loop for file in files
- append (erlang-xrefs-in-file file kind tag is-regexp))
- ;; Failed for some reason. Pretend like it is raining and
- ;; return the unrefined xrefs.
- xrefs)))))
-
-(defun erlang-too-many-files-in-xrefs (xrefs)
- (and erlang-max-files-to-visit-for-refining-xrefs
- (let ((files-to-visit (delete-dups
- (mapcar #'erlang-xref-truename-file
- xrefs))))
- (if (< (length files-to-visit)
- erlang-max-files-to-visit-for-refining-xrefs)
- nil
- (message (concat "Too many hits to consider arity (see "
- "`erlang-max-files-to-visit-for-refining-xrefs')"))
- t))))
-
-(defun erlang-xrefs-in-file (file kind tag is-regexp)
- (when (and (fboundp 'make-erlang-xref-location)
- (fboundp 'xref-make))
- (with-current-buffer (find-file-noselect file)
- (save-excursion
- (goto-char (point-min))
- (let ((regexp (concat ; "^"
- (erlang-etags-regexp kind tag is-regexp)
- "\\s *("))
- last-arity)
- (cl-loop while (re-search-forward regexp nil t)
- for name = (match-string-no-properties 1)
- for arity = (save-excursion
- (erlang-get-arity))
- for loc = (make-erlang-xref-location
- :file file
- :line (line-number-at-pos)
- :column 0
- :arity arity)
- for sum = (erlang-xref-summary kind name arity)
- when (and arity
- (not (eq arity last-arity)))
- collect (xref-make sum loc)
- do (setq last-arity arity)))))))
-
-(defun erlang-xref-summary (kind tag arity)
- (format "%s%s%s"
- (if (memq kind '(record macro module))
- (format "%s " kind)
- "")
- tag
- (if arity (format "/%s" arity) "")))
-
-(defun erlang-single-arity-match (xrefs wanted-arity)
- "Attempt to find one perfect match.
-
-If we have all information needed to consider arity then return a
-single perfect match or nothing. If there are more than one
-match nothing is returned.
-
-If we don't have all information needed to consider arity just
-return XREFS as is."
- (if (erlang-should-consider-arity-p xrefs wanted-arity)
- (let ((nr-matches 0)
- match)
- (while (and xrefs
- (< nr-matches 2))
- (let* ((xref (car xrefs))
- (arity (erlang-xref-arity xref)))
- (when (eq arity wanted-arity)
- (setq match xref
- nr-matches (1+ nr-matches)))
- (setq xrefs (cdr xrefs))))
- (when (eq nr-matches 1)
- (list match)))
- (when (eq (length xrefs) 1)
- xrefs)))
-
-(defun erlang-sort-by-arity (xrefs wanted-arity)
- (if (erlang-should-consider-arity-p xrefs wanted-arity)
- (let (matches non-matches)
- (while xrefs
- (let* ((xref (car xrefs))
- (arity (erlang-xref-arity xref)))
- (push xref (if (eq arity wanted-arity)
- matches
- non-matches))
- (setq xrefs (cdr xrefs))))
- (append (reverse matches) (reverse non-matches) xrefs))
- xrefs))
-
-(defun erlang-should-consider-arity-p (xrefs wanted-arity)
- (and wanted-arity
- xrefs
- (fboundp 'erlang-xref-location-p)
- (fboundp 'xref-item-location)
- (erlang-xref-location-p (xref-item-location (car xrefs)))))
-
-(defun erlang-etags-regexp (kind tag is-regexp)
- (let ((tag-regexp (concat "\\("
- (if is-regexp
- tag
- (regexp-quote tag))
- "\\)")))
- (concat (if is-regexp "" "^")
- (cond ((eq kind 'record)
- (concat "-record\\s-*(\\s-*" tag-regexp))
- ((eq kind 'macro)
- (concat "-define\\s-*(\\s-*" tag-regexp))
- (t
- tag-regexp))
- (if is-regexp "" "\\_>"))))
-
-(defun erlang-xref-arity (xref)
- (and (fboundp 'erlang-xref-location-arity)
- (fboundp 'xref-item-location)
- (erlang-xref-location-arity (xref-item-location xref))))
-
-(defun erlang-split-xrefs-on-module (xrefs module)
- (let (local-xrefs non-local-xrefs)
- (dolist (xref xrefs)
- (if (string-equal (erlang-xref-module xref)
- module)
- (push xref local-xrefs)
- (push xref non-local-xrefs)))
- (cons (reverse local-xrefs)
- (reverse non-local-xrefs))))
-
-(defun erlang-split-xrefs (xrefs)
- (let ((current-file (and (buffer-file-name)
- (file-truename (buffer-file-name))))
- local-xrefs bif-xrefs other-xrefs)
- (dolist (xref xrefs)
- (cond ((string-equal (erlang-xref-truename-file xref) current-file)
- (push xref local-xrefs))
- ((string-equal (erlang-xref-module xref) "erlang")
- (push xref bif-xrefs))
- (t
- (push xref other-xrefs))))
- (list (reverse local-xrefs)
- (reverse bif-xrefs)
- (reverse other-xrefs))))
-
-(defun erlang-xref-module (xref)
- (erlang-get-module-from-file-name (erlang-xref-file xref)))
-
-(defun erlang-xref-truename-file (xref)
- (let ((file (erlang-xref-file xref)))
- (and file
- (file-truename file))))
-
-(defun erlang-xref-file (xref)
- (and (fboundp 'xref-location-group)
- (fboundp 'xref-item-location)
- (xref-location-group (xref-item-location xref))))
-
-(defun erlang-visit-tags-table-buffer (cont cbuf)
- (if (< emacs-major-version 26)
- (visit-tags-table-buffer cont)
- ;; Remove this with-no-warnings when Emacs 26 is the required
- ;; version minimum.
- (with-no-warnings
- (visit-tags-table-buffer cont cbuf))))
-
-;;;
-;;; Prepare for other methods to run an Erlang slave process.
-;;;
-
-(defvar erlang-shell-function 'inferior-erlang
- "Command to execute start a new Erlang shell.
-
-Change this variable to use your favorite
-Erlang compilation package.")
-
-(defvar erlang-shell-display-function 'inferior-erlang-run-or-select
- "Command to execute to display Erlang shell.
-
-Change this variable to use your favorite
-Erlang compilation package.")
-
-(defvar erlang-compile-function 'inferior-erlang-compile
- "Command to execute to compile current buffer.
-
-Change this variable to use your favorite
-Erlang compilation package.")
-
-(defvar erlang-compile-erlang-function "c"
- "Erlang function to call to compile an erlang file.")
-
-(defvar erlang-compile-display-function 'inferior-erlang-run-or-select
- "Command to execute to view last compilation.
-
-Change this variable to use your favorite
-Erlang compilation package.")
-
-(defvar erlang-next-error-function 'inferior-erlang-next-error
- "Command to execute to go to the next error.
-
-Change this variable to use your favorite Erlang compilation
-package.")
-
-
-;;;###autoload
-(defun erlang-shell ()
- "Start a new Erlang shell.
-
-The variable `erlang-shell-function' decides which method to use,
-default is to start a new Erlang host. It is possible that, in the
-future, a new shell on an already running host will be started."
- (interactive)
- (call-interactively erlang-shell-function))
-
-
-;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
-
-;; It is customary for Emacs packages to supply a function on this
-;; form, even though it violates the `erlang-*' name convention.
-(defalias 'run-erlang 'erlang-shell)
-
-
-(defun erlang-shell-display ()
- "Display an Erlang shell, or start a new."
- (interactive)
- (call-interactively erlang-shell-display-function))
-
-
-;;;###autoload
-(defun erlang-compile ()
- "Compile Erlang module in current buffer."
- (interactive)
- (call-interactively erlang-compile-function))
-
-
-(defun erlang-compile-display ()
- "Display compilation output."
- (interactive)
- (call-interactively erlang-compile-display-function))
-
-
-(defun erlang-next-error ()
- "Display next error message from the latest compilation."
- (interactive)
- (call-interactively erlang-next-error-function))
-
-
-
-;;;
-;;; Erlang Shell Mode -- Major mode used for Erlang shells.
-;;;
-
-;; This mode is designed to be implementation independent,
-;; e.g. it does not assume that we are running an inferior
-;; Erlang, there exists a lot of other possibilities.
-
-(defvar erlang-shell-buffer-name "*erlang*"
- "The name of the Erlang link shell buffer.")
-
-(defcustom erlang-shell-prompt-read-only t
- "If non-nil, the prompt will be read-only.
-
-Also see the description of `ielm-prompt-read-only'."
- :type 'boolean
- :package-version '(erlang . "2.8.0"))
-
-(defvar erlang-shell-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\M-\t" 'erlang-complete-tag)
-
- ;; Normally the other way around.
- (define-key map "\C-a" 'comint-bol)
- (define-key map "\C-c\C-a" 'beginning-of-line)
-
- (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof'
- (define-key map "\M-\C-m" 'compile-goto-error)
- map)
- "Keymap used by Erlang shells.")
-
-(defvar erlang-input-ring-file-name "~/.erlang_history"
- "When non-nil, file name used to store Erlang shell history information.")
-
-(define-derived-mode erlang-shell-mode comint-mode "Erlang Shell"
- "Major mode for interacting with an Erlang shell.
-
-The following special commands are available:
-\\{erlang-shell-mode-map}"
- (erlang-mode-variables)
- ;; Needed when compiling directly from the Erlang shell.
- (setq compilation-last-buffer (current-buffer))
- (setq comint-prompt-regexp "^[^>=]*> *")
- (make-local-variable 'comint-prompt-read-only)
- (setq comint-prompt-read-only erlang-shell-prompt-read-only)
- (setq comint-eol-on-send t)
- (setq comint-input-ignoredups t)
- (setq comint-scroll-show-maximum-output t)
- (setq comint-scroll-to-bottom-on-output t)
- (add-hook 'comint-output-filter-functions
- 'inferior-erlang-strip-delete nil t)
- (add-hook 'comint-output-filter-functions
- 'inferior-erlang-strip-ctrl-m nil t)
- (setq comint-input-ring-file-name erlang-input-ring-file-name)
- (comint-read-input-ring t)
- (make-local-variable 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'comint-write-input-ring)
- (compilation-minor-mode 1)
- (set (make-local-variable 'minor-mode-overriding-map-alist)
- `((compilation-minor-mode
- . ,(let ((map (make-sparse-keymap)))
- ;; It would be useful to put keymap properties on the
- ;; error lines so that we could use RET and mouse-2
- ;; on them directly.
- (when (boundp 'compilation-skip-threshold) ; new compile.el
- (define-key map [mouse-2] #'erlang-mouse-2-command)
- (define-key map "\C-m" #'erlang-RET-command))
- (if (boundp 'compilation-menu-map)
- (define-key map [menu-bar compilation]
- (cons "Errors" compilation-menu-map)))
- map))))
- (erlang-tags-init))
-
-
-(defun erlang-mouse-2-command (event)
- "Command bound to `mouse-2' in inferior Erlang buffer.
-Selects Comint or Compilation mode command as appropriate."
- (interactive "e")
- (if (save-window-excursion
- (save-excursion
- (mouse-set-point event)
- (consp (get-text-property (line-beginning-position) 'message))))
- (call-interactively (lookup-key compilation-mode-map [mouse-2]))
- (call-interactively (lookup-key comint-mode-map [mouse-2]))))
-
-(defun erlang-RET-command ()
- "Command bound to `RET' in inferior Erlang buffer.
-Selects Comint or Compilation mode command as appropriate."
- (interactive)
- (if (consp (get-text-property (line-beginning-position) 'message))
- (call-interactively (lookup-key compilation-mode-map "\C-m"))
- (call-interactively (lookup-key comint-mode-map "\C-m"))))
-
-;;;
-;;; Inferior Erlang -- Run an Erlang shell as a subprocess.
-;;;
-
-(defvar inferior-erlang-display-buffer-any-frame nil
- "When nil, `inferior-erlang-display-buffer' use only selected frame.
-When t, all frames are searched. When 'raise, the frame is raised.")
-
-(defvar inferior-erlang-shell-type 'newshell
- "The type of Erlang shell to use.
-
-When this variable is set to the atom `oldshell', the old shell is used.
-When set to `newshell' the new shell is used. Should the variable be
-nil, the default shell is used.
-
-This variable influence the setting of other variables.")
-
-(defvar inferior-erlang-machine "erl"
- "The name of the Erlang shell.")
-
-(defvar inferior-erlang-machine-options '()
- "The options used when activating the Erlang shell.
-
-This must be a list of strings.")
-
-(defvar inferior-erlang-process-name "inferior-erlang"
- "The name of the inferior Erlang process.")
-
-(defvar inferior-erlang-buffer-name erlang-shell-buffer-name
- "The name of the inferior Erlang buffer.")
-
-(defvar inferior-erlang-prompt-timeout 60
- "Number of seconds before `inferior-erlang-wait-prompt' timeouts.
-
-The time specified is waited after every output made by the inferior
-Erlang shell. When this variable is t, we assume that we always have
-a prompt. When nil, we will wait forever, or until \\[keyboard-quit].")
-
-(defvar inferior-erlang-process nil
- "Process of last invoked inferior Erlang, or nil.")
-
-(defvar inferior-erlang-buffer nil
- "Buffer of last invoked inferior Erlang, or nil.")
-
-;; Enable uniquifying Erlang shell buffers based on directory name.
-(eval-after-load "uniquify"
- '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode))
-
-;;;###autoload
-(defun inferior-erlang (&optional command)
- "Run an inferior Erlang.
-With prefix command, prompt for command to start Erlang with.
-
-This is just like running Erlang in a normal shell, except that
-an Emacs buffer is used for input and output.
-\\<comint-mode-map>
-The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
-The history is saved between sessions.
-
-Entry to this mode calls the functions in the variables
-`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
-
-The following commands imitate the usual Unix interrupt and
-editing control characters:
-\\{erlang-shell-mode-map}"
- (interactive
- (when current-prefix-arg
- (list (read-shell-command "Erlang command: "))))
- (require 'comint)
- (let (cmd opts)
- (if command
- (setq cmd "sh"
- opts (list "-c" command))
- (setq cmd inferior-erlang-machine
- opts inferior-erlang-machine-options)
- (cond ((eq inferior-erlang-shell-type 'oldshell)
- (setq opts (cons "-oldshell" opts)))
- ((eq inferior-erlang-shell-type 'newshell)
- (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))))
-
- ;; Using create-file-buffer and list-buffers-directory in this way
- ;; makes uniquify give each buffer a unique name based on the
- ;; directory.
- (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory)))
- (setq inferior-erlang-buffer (create-file-buffer fake-file-name))
- (apply 'make-comint-in-buffer
- inferior-erlang-process-name
- inferior-erlang-buffer
- cmd
- nil opts)
- (with-current-buffer inferior-erlang-buffer
- (setq list-buffers-directory fake-file-name))))
-
- (setq inferior-erlang-process
- (get-buffer-process inferior-erlang-buffer))
- (funcall (symbol-function 'set-process-query-on-exit-flag)
- inferior-erlang-process nil)
- (if erlang-inferior-shell-split-window
- (switch-to-buffer-other-window inferior-erlang-buffer)
- (switch-to-buffer inferior-erlang-buffer))
- (if (and (not (eq system-type 'windows-nt))
- (eq inferior-erlang-shell-type 'newshell))
- (setq comint-process-echoes t))
- (erlang-shell-mode))
-
-
-(defun inferior-erlang-run-or-select ()
- "Switch to an inferior Erlang buffer, possibly starting new process."
- (interactive)
- (if (null (inferior-erlang-running-p))
- (inferior-erlang)
- (inferior-erlang-display-buffer t)))
-
-
-(defun inferior-erlang-display-buffer (&optional select)
- "Make the inferior Erlang process visible.
-The window is returned.
-
-Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is
-displayed in the current frame. Should it be non-nil, and the buffer
-already is visible in any other frame, no new window will be created.
-Should it be the atom 'raise, the frame containing the window will
-be raised.
-
-Should the optional argument SELECT be non-nil, the window is
-selected. Should the window be in another frame, that frame is raised.
-
-Note, should the mouse pointer be places outside the raised frame, that
-frame will become deselected before the next command."
- (interactive)
- (or (inferior-erlang-running-p)
- (error "No inferior Erlang process is running"))
- (let ((win (inferior-erlang-window
- inferior-erlang-display-buffer-any-frame))
- (frames-p (fboundp 'selected-frame)))
- (if (null win)
- (let ((old-win (selected-window)))
- (save-excursion
- (switch-to-buffer-other-window inferior-erlang-buffer)
- (setq win (selected-window)))
- (select-window old-win))
- (if (and window-system
- frames-p
- (or select
- (eq inferior-erlang-display-buffer-any-frame 'raise))
- (not (eq (selected-frame) (window-frame win))))
- (raise-frame (window-frame win))))
- (if select
- (select-window win))
- (sit-for 0)
- win))
-
-
-(defun inferior-erlang-running-p ()
- "Non-nil when an inferior Erlang is running."
- (and inferior-erlang-process
- (memq (process-status inferior-erlang-process) '(run open))
- inferior-erlang-buffer
- (buffer-name inferior-erlang-buffer)))
-
-
-(defun inferior-erlang-window (&optional all-frames)
- "Return the window containing the inferior Erlang, or nil."
- (and (inferior-erlang-running-p)
- (if all-frames
- (get-buffer-window inferior-erlang-buffer t)
- (get-buffer-window inferior-erlang-buffer))))
-
-
-(defun inferior-erlang-wait-prompt ()
- "Wait until the inferior Erlang shell prompt appears."
- (if (eq inferior-erlang-prompt-timeout t)
- ()
- (or (inferior-erlang-running-p)
- (error "No inferior Erlang shell is running"))
- (with-current-buffer inferior-erlang-buffer
- (let ((msg nil))
- (while (save-excursion
- (goto-char (process-mark inferior-erlang-process))
- (forward-line 0)
- (not (looking-at comint-prompt-regexp)))
- (if msg
- ()
- (setq msg t)
- (message "Waiting for Erlang shell prompt (press C-g to abort)."))
- (or (accept-process-output inferior-erlang-process
- inferior-erlang-prompt-timeout)
- (error "No Erlang shell prompt before timeout")))
- (if msg (message ""))))))
-
-(defun inferior-erlang-send-empty-cmd-unless-already-at-prompt ()
- "If not already at a prompt, try to send an empty cmd to get a prompt.
-The empty command resembles hitting RET. This is useful in some
-situations, for instance if a crash or error report from sasl
-has been printed after the last prompt."
- (with-current-buffer inferior-erlang-buffer
- (if (> (point-max) 1)
- ;; make sure we get a prompt if buffer contains data
- (if (save-excursion
- (goto-char (process-mark inferior-erlang-process))
- (forward-line 0)
- (not (looking-at comint-prompt-regexp)))
- (inferior-erlang-send-command "")))))
-
-(autoload 'comint-send-input "comint")
-
-(defun inferior-erlang-send-command (cmd &optional hist)
- "Send command CMD to the inferior Erlang.
-
-The contents of the current command line (if any) will
-be placed at the next prompt.
-
-If optional second argument is non-nil the command is inserted into
-the history list.
-
-Return the position after the newly inserted command."
- (or (inferior-erlang-running-p)
- (error "No inferior Erlang process is running"))
- (let ((old-buffer (current-buffer))
- (insert-point (marker-position (process-mark inferior-erlang-process)))
- (insert-length (if comint-process-echoes
- 0
- (1+ (length cmd)))))
- (set-buffer inferior-erlang-buffer)
- (goto-char insert-point)
- (insert cmd)
- ;; Strange things happened if `comint-eol-on-send' is declared
- ;; in the `let' expression above, but setq:d here. The
- ;; `set-buffer' statement obviously makes the buffer local
- ;; instance of `comint-eol-on-send' shadow this one.
- ;; I'm considering this a bug in Elisp.
- ;;
- ;; This was previously cautioned against in the Lisp manual. It
- ;; has been sorted out in Emacs 21. -- fx
- (let ((comint-eol-on-send nil)
- (comint-input-filter (if hist comint-input-filter 'ignore)))
- (comint-send-input nil t))
- ;; Adjust all windows whose points are incorrect.
- (if (null comint-process-echoes)
- (walk-windows
- (function
- (lambda (window)
- (if (and (eq (window-buffer window) inferior-erlang-buffer)
- (= (window-point window) insert-point))
- (set-window-point window
- (+ insert-point insert-length)))))
- nil t))
- (set-buffer old-buffer)
- (+ insert-point insert-length)))
-
-
-(defun inferior-erlang-strip-delete (&optional _s)
- "Remove `^H' (delete) and the characters it was supposed to remove."
- (interactive)
- (if (and (boundp 'comint-last-input-end)
- (boundp 'comint-last-output-start))
- (save-excursion
- (goto-char
- (if (called-interactively-p 'interactive)
- (symbol-value 'comint-last-input-end)
- (symbol-value 'comint-last-output-start)))
- (while (progn (skip-chars-forward "^\C-h")
- (not (eq (point) (point-max))))
- (delete-char 1)
- (or (bolp)
- (backward-delete-char 1))))))
-
-
-;; Basically `comint-strip-ctrl-m', with a few extra checks.
-(defun inferior-erlang-strip-ctrl-m (&optional _string)
- "Strip trailing `^M' characters from the current output group."
- (interactive)
- (if (and (boundp 'comint-last-input-end)
- (boundp 'comint-last-output-start))
- (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
- (save-excursion
- (goto-char
- (if (called-interactively-p 'interactive)
- (symbol-value 'comint-last-input-end)
- (symbol-value 'comint-last-output-start)))
- (while (re-search-forward "\r+$" pmark t)
- (replace-match "" t t))))))
-
-
-(defun inferior-erlang-compile (arg)
- "Compile the file in the current buffer.
-
-With prefix arg, compiles for debug.
-
-Should Erlang return `{error, nofile}' it could not load the object
-module after completing the compilation. This is due to a bug in the
-compile command `c' when using the option `outdir'.
-
-There exists two workarounds for this bug:
-
- 1) Place the directory in the Erlang load path.
-
- 2) Set the Emacs variable `erlang-compile-use-outdir' to nil.
- To do so, place the following line in your `~/.emacs'-file:
- (setq erlang-compile-use-outdir nil)"
- (interactive "P")
- (save-some-buffers)
- (inferior-erlang-prepare-for-input)
- (let* ((dir (inferior-erlang-compile-outdir))
- (noext (substring (erlang-local-buffer-file-name) 0 -4))
- (opts (append (list (cons 'outdir dir))
- (when arg
- (list 'debug_info 'export_all))
- erlang-compile-extra-opts))
- end)
- (with-current-buffer inferior-erlang-buffer
- (when (fboundp 'compilation-forget-errors)
- (compilation-forget-errors)))
- (setq end (inferior-erlang-send-command
- (inferior-erlang-compute-compile-command noext opts)
- nil))
- (sit-for 0)
- (inferior-erlang-wait-prompt)
- (with-current-buffer inferior-erlang-buffer
- (setq compilation-error-list nil)
- (set-marker compilation-parsing-end end))
- (setq compilation-last-buffer inferior-erlang-buffer)))
-
-(defun inferior-erlang-prepare-for-input (&optional no-display)
- "Create an inferior erlang buffer if needed and ready it for input.
-The buffer is displayed, according to `inferior-erlang-display-buffer'
-unless the optional NO-DISPLAY is non-nil."
- (or (inferior-erlang-running-p)
- (save-excursion
- (inferior-erlang)))
- (or (inferior-erlang-running-p)
- (error "Error starting inferior Erlang shell"))
- (if (not no-display)
- (inferior-erlang-display-buffer))
- (inferior-erlang-send-empty-cmd-unless-already-at-prompt)
- (sit-for 0)
- (inferior-erlang-wait-prompt))
-
-(defun inferior-erlang-compile-outdir ()
- "Return the directory to compile the current buffer into."
- (let* ((buffer-dir (directory-file-name
- (file-name-directory (erlang-local-buffer-file-name))))
- (parent-dir (directory-file-name
- (file-name-directory buffer-dir)))
- (ebin-dir (concat (file-name-as-directory parent-dir) "ebin"))
- (buffer-dir-base-name (file-name-nondirectory
- (expand-file-name
- (concat (file-name-as-directory buffer-dir)
- ".")))))
- (if (and (string= buffer-dir-base-name "src")
- (file-directory-p ebin-dir))
- (file-name-as-directory ebin-dir)
- (file-name-as-directory buffer-dir))))
-
-(defun inferior-erlang-compute-compile-command (module-name opts)
- (let ((ccfn erlang-compile-command-function-alist)
- ccfn-entry
- done
- result)
- (if (not (null (erlang-local-buffer-file-name)))
- (while (and (not done) (not (null ccfn)))
- (setq ccfn-entry (car ccfn))
- (setq ccfn (cdr ccfn))
- (if (string-match (car ccfn-entry) (erlang-local-buffer-file-name))
- (let ((c-fn (cdr ccfn-entry)))
- (setq done t)
- (if (not (null c-fn))
- (setq result (funcall c-fn module-name opts)))))))
- result))
-
-(defun inferior-erlang-compute-erl-compile-command (module-name opts)
- (let* ((out-dir-opt (assoc 'outdir opts))
- (out-dir (cdr out-dir-opt)))
- (if erlang-compile-use-outdir
- (format "%s(\"%s\"%s)."
- erlang-compile-erlang-function
- module-name
- (inferior-erlang-format-comma-opts opts))
- (let (;; Hopefully, no one else will ever use these...
- (tmpvar "Tmp7236")
- (tmpvar2 "Tmp8742"))
- (format
- (concat
- "f(%s), {ok, %s} = file:get_cwd(), "
- "file:set_cwd(\"%s\"), "
- "%s = %s(\"%s\"%s), file:set_cwd(%s), f(%s), %s.")
- tmpvar2 tmpvar
- out-dir
- tmpvar2
- erlang-compile-erlang-function
- module-name (inferior-erlang-format-comma-opts
- (remq out-dir-opt opts))
- tmpvar tmpvar tmpvar2)))))
-
-(defun inferior-erlang-compute-leex-compile-command (module-name opts)
- (let ((file-name (erlang-local-buffer-file-name))
- (erl-compile-expr (inferior-erlang-remove-any-trailing-dot
- (inferior-erlang-compute-erl-compile-command
- module-name opts))))
- (format (concat "f(LErr1__), f(LErr2__), "
- "case case leex:file(\"%s\", [%s]) of"
- " ok -> ok;"
- " {ok,_} -> ok;"
- " {ok,_,_} -> ok;"
- " LErr1__ -> LErr1__ "
- "end of"
- " ok -> %s;"
- " LErr2__ -> LErr2__ "
- "end.")
- file-name
- (inferior-erlang-format-comma-opts erlang-leex-compile-opts)
- erl-compile-expr)))
-
-(defun inferior-erlang-compute-yecc-compile-command (module-name opts)
- (let ((file-name (erlang-local-buffer-file-name))
- (erl-compile-expr (inferior-erlang-remove-any-trailing-dot
- (inferior-erlang-compute-erl-compile-command
- module-name opts))))
- (format (concat "f(YErr1__), f(YErr2__), "
- "case case yecc:file(\"%s\", [%s]) of"
- " {ok,_} -> ok;"
- " {ok,_,_} -> ok;"
- " YErr1__ -> YErr1__ "
- "end of"
- " ok -> %s;"
- " YErr2__ -> YErr2__ "
- "end.")
- file-name
- (inferior-erlang-format-comma-opts erlang-yecc-compile-opts)
- erl-compile-expr)))
-
-(defun inferior-erlang-remove-any-trailing-dot (str)
- (if (string= (substring str -1) ".")
- (substring str 0 (1- (length str)))
- str))
-
-(defun inferior-erlang-format-comma-opts (opts)
- (if (null opts)
- ""
- (concat ", " (inferior-erlang-format-opt opts))))
-
-(defun inferior-erlang-format-opt (opt)
- (cond ((stringp opt) (concat "\"" opt "\""))
- ((vectorp opt) (inferior-erlang-tuple (append opt nil)))
- ((atom opt) (format "%s" opt))
- ((consp opt) (if (listp (cdr opt))
- (inferior-erlang-list opt)
- (inferior-erlang-tuple (list (car opt) (cdr opt)))))
- (t (error "Unexpected erlang compile option %s" opt))))
-
-(defun inferior-erlang-tuple (opts)
- (concat "{" (mapconcat 'inferior-erlang-format-opt
- opts
- ", ")
- "}"))
-
-(defun inferior-erlang-list (opts)
- (concat "[" (mapconcat 'inferior-erlang-format-opt
- opts
- ", ")
- "]"))
-
-
-(defun erlang-local-buffer-file-name ()
- ;; When editing a file remotely via tramp,
- ;; the buffer's file name may be for example
- ;; "/ssh:host.example.com:/some/path/x.erl"
- ;;
- ;; If I try to compile such a file using C-c C-k, an
- ;; erlang shell on the remote host is automatically
- ;; started if needed, but for it to successfully compile
- ;; the file, the c(...) command that is sent must contain
- ;; the file name "/some/path/x.erl" without the
- ;; tramp-prefix "/ssh:host.example.com:".
- (cond ((null (buffer-file-name))
- nil)
- ((erlang-tramp-remote-file-p)
- (erlang-tramp-get-localname))
- (t
- (buffer-file-name))))
-
-(defun erlang-tramp-remote-file-p ()
- (and (fboundp 'tramp-tramp-file-p)
- (tramp-tramp-file-p (buffer-file-name))))
-
-(defun erlang-tramp-get-localname ()
- (when (fboundp 'tramp-dissect-file-name)
- (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
- (if (fboundp 'tramp-file-name-localname)
- (tramp-file-name-localname tramp-info)
- ;; In old versions of tramp, it was `tramp-file-name-path'
- ;; instead of the newer `tramp-file-name-localname'
- (when (fboundp 'tramp-file-name-path)
- (tramp-file-name-path tramp-info))))))
-
-;; `next-error' only accepts buffers with major mode `compilation-mode'
-;; or with the minor mode `compilation-minor-mode' activated.
-;; (To activate the minor mode is out of the question, since it will
-;; ruin the inferior Erlang keymap.)
-;; This is done differently in Emacs 21.
-(defun inferior-erlang-next-error (&optional argp)
- "Just like `next-error'.
-Capable of finding error messages in an inferior Erlang buffer."
- (interactive "P")
- (let ((done nil)
- (buf (or (and (boundp 'next-error-last-buffer)
- next-error-last-buffer)
- (and (boundp 'compilation-last-buffer)
- compilation-last-buffer))))
- (if (and (bufferp buf)
- (with-current-buffer buf
- (and (eq major-mode 'erlang-shell-mode)
- (setq major-mode 'compilation-mode))))
- (unwind-protect
- (progn
- (setq done t)
- (next-error argp))
- (with-current-buffer buf
- (setq major-mode 'erlang-shell-mode))))
- (or done
- (next-error argp))))
-
-
-(defun inferior-erlang-change-directory (&optional dir)
- "Make the inferior Erlang change directory.
-The default is to go to the directory of the current buffer."
- (interactive)
- (or dir (setq dir (file-name-directory (erlang-local-buffer-file-name))))
- (or (inferior-erlang-running-p)
- (error "No inferior Erlang is running"))
- (inferior-erlang-display-buffer)
- (inferior-erlang-send-empty-cmd-unless-already-at-prompt)
- (inferior-erlang-wait-prompt)
- (inferior-erlang-send-command (format "cd('%s')." dir) nil))
-
-(defun erlang-align-arrows (start end)
- "Align arrows (\"->\") in function clauses from START to END.
-When called interactively, aligns arrows after function clauses inside
-the region.
-
-With a prefix argument, aligns all arrows, not just those in function
-clauses.
-
-Example:
-
-sum(L) -> sum(L, 0).
-sum([H|T], Sum) -> sum(T, Sum + H);
-sum([], Sum) -> Sum.
-
-becomes:
-
-sum(L) -> sum(L, 0).
-sum([H|T], Sum) -> sum(T, Sum + H);
-sum([], Sum) -> Sum."
- (interactive "r")
- (save-excursion
- (let (;; regexp for matching arrows. without a prefix argument,
- ;; the regexp matches function heads. With a prefix, it
- ;; matches any arrow.
- (re (if current-prefix-arg
- "^.*\\(\\)->"
- (eval-when-compile
- (concat "^" erlang-atom-regexp ".*\\(\\)->"))))
- ;; part of regexp matching directly before the arrow
- (arrow-match-pos (if current-prefix-arg
- 1
- (1+ erlang-atom-regexp-matches)))
- ;; accumulator for positions where arrows are found, ordered
- ;; by buffer position (from greatest to smallest)
- (arrow-positions '())
- ;; accumulator for longest distance from start of line to arrow
- (most-indent 0)
- ;; marker to track the end of the region we're aligning
- (end-marker (progn (goto-char end)
- (point-marker))))
- ;; Pass 1: Find the arrow positions, adjust the whitespace
- ;; before each arrow to one space, and find the greatest
- ;; indentation level.
- (goto-char start)
- (while (re-search-forward re end-marker t)
- (goto-char (match-beginning arrow-match-pos))
- (just-one-space) ; adjust whitespace
- (setq arrow-positions (cons (point) arrow-positions))
- (setq most-indent (max most-indent (erlang-column-number))))
- (set-marker end-marker nil) ; free the marker
- ;; Pass 2: Insert extra padding so that all arrow indentation is
- ;; equal. This is done last-to-first by buffer position, so that
- ;; inserting spaces before one arrow doesn't change the
- ;; positions of the next ones.
- (mapc (lambda (arrow-pos)
- (goto-char arrow-pos)
- (let* ((pad (- most-indent (erlang-column-number))))
- (when (> pad 0)
- (insert-char ?\ pad))))
- arrow-positions))))
-
-(defun erlang-column-number ()
- "Return the column number of the current position in the buffer.
-Tab characters are counted by their visual width."
- (string-width (buffer-substring (line-beginning-position) (point))))
-
-(defun erlang-current-defun ()
- "`add-log-current-defun-function' for Erlang."
- (save-excursion
- (erlang-beginning-of-function)
- (if (looking-at "[a-z0-9_]+")
- (match-string 0))))
-
-(defconst erlang-unload-hook
- (list (lambda ()
- (ad-unadvise 'Man-notify-when-ready)
- (ad-unadvise 'set-visited-file-name))))
-
-;; The end...
-
-(provide 'erlang)
-
-(run-hooks 'erlang-load-hook)
-
-;; Local variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-
-;;; erlang.el ends here
+++ /dev/null
-;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*-
-
-;; %CopyrightBegin%
-;;
-;; Copyright Ericsson AB 2016-2021. All Rights Reserved.
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License");
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;; http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-;;
-;; %CopyrightEnd%
-
-;;; Commentary:
-
-;; Crawl Erlang/OTP HTML documentation and generate lookup tables.
-;;
-;; This package depends on `cl-lib', `pcase' and
-;; `libxml-parse-html-region'. Emacs 24+ compiled with libxml2 should
-;; work. On Emacs 24.1 and 24.2 do `M-x package-install RET cl-lib
-;; RET' to install `cl-lib'.
-;;
-;; Please customise `erldoc-man-index' to point to your local OTP
-;; documentation.
-;;
-;; To use:
-;;
-;; (define-key help-map "u" 'erldoc-browse)
-;; (define-key help-map "t" 'erldoc-browse-topic)
-;; (define-key help-map "a" 'erldoc-apropos)
-;;
-;; Note: these commands trigger indexing OTP documentation on first
-;; run with cache to disk which may take 1-2 minutes.
-
-
-;;; Examples:
-
-;; 1. `M-x erldoc-browse RET erlang:integer_to_binary/2 RET' opens the
-;; `erlang' manual anchored on the entry for `integer_to_binary/2'.
-;;
-;; 2. `M-x erldoc-apropos RET first RET' list all MFAs matching
-;; substring `first'.
-;;
-;; 3. `M-x erldoc-browse-topic RET efficiency_guide#Introduction RET'
-;; opens chapter `Introduction' of the `Efficiency Guide' in the
-;; browser.
-
-;;; History:
-
-;; Written in December 2013 as a temporary solution to help me browse
-;; the rich Erlang/OTP documentation. Three years on I find myself
-;; still using it every day. - Leo (2016)
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'json)
-(require 'erlang)
-(eval-when-compile (require 'url-parse))
-
-(eval-and-compile ;for emacs < 24.3
- (or (fboundp 'user-error) (defalias 'user-error 'error)))
-
-(defgroup erldoc nil
- "Browse Erlang document."
- :group 'help)
-
-(defcustom erldoc-man-index "http://www.erlang.org/doc/man_index.html"
- "The URL to the man_index.html page.
-Note it is advisable to customise this to a local URL for example
-`file:///usr/local/19.1/lib/erlang/doc/man_index.html' to speed
-up the indexing."
- :type 'string
- :group 'erldoc)
-
-(defcustom erldoc-verify-man-path nil
- "If non-nil verify man path existence for `file://'."
- :type 'boolean
- :group 'erldoc)
-
-(defcustom erldoc-output-file (locate-user-emacs-file "cache/erldoc")
- "File to store the parsed results."
- :type 'file
- :group 'erldoc)
-
-(defcustom erldoc-no-signature-function #'ignore
- "Notification function called if no function signature was found."
- :type '(choice (function-item :tag "Ignore" ignore)
- (function-item :tag "Warn" warn)
- (function-item :tag "Error" error))
- :group 'erldoc)
-
-(defun erldoc-strip-string (s)
- (let* ((re "[ \t\n\r\f\v\u00a0]+")
- (from (if (string-match (concat "\\`" re) s) (match-end 0) 0))
- (to (and (string-match (concat re "\\'") s) (match-beginning 0))))
- (substring s from (and to (max to from)))))
-
-;; Note: don't know how to get the BASE-URL to
-;; `libxml-parse-html-region' to work.
-(defun erldoc-expand-url (url base-url)
- (if (url-type (url-generic-parse-url url))
- url
- (let* ((base (url-generic-parse-url base-url))
- (dir (directory-file-name (file-name-directory (url-filename base)))))
- (setf (url-filename base) (expand-file-name url dir))
- (url-recreate-url base))))
-
-(defun erldoc-parse-html (url)
- (with-temp-buffer
- (url-insert-file-contents url)
- (libxml-parse-html-region (point-min) (point-max))))
-
-(defalias 'erldoc-dom-text-node-p #'stringp)
-
-(defun erldoc-dom-attributes (dom)
- (and (not (erldoc-dom-text-node-p dom)) (cadr dom)))
-
-(defun erldoc-dom-get-attribute (dom attrib-name)
- (cdr (assq attrib-name (erldoc-dom-attributes dom))))
-
-(defun erldoc-dom-children (dom)
- (and (not (erldoc-dom-text-node-p dom)) (cddr dom)))
-
-(defun erldoc-dom-get-text (dom)
- (let ((text (car (last (erldoc-dom-children dom)))))
- (and (erldoc-dom-text-node-p text) text)))
-
-(defvar erldoc-dom-walk-parent nil)
-(defvar erldoc-dom-walk-siblings nil)
-
-(defun erldoc-dom-walk (dom k)
- (funcall k dom)
- (let ((erldoc-dom-walk-parent dom)
- (erldoc-dom-walk-siblings (unless (erldoc-dom-text-node-p dom)
- (cddr dom))))
- (dolist (child erldoc-dom-walk-siblings)
- (erldoc-dom-walk child k))))
-
-(defun erldoc-dom-get-element (dom element-name)
- (catch 'return
- (erldoc-dom-walk dom (lambda (d)
- (when (eq (car-safe d) element-name)
- (throw 'return d))))))
-
-(defun erldoc-dom-get-element-by-id (dom id)
- (catch 'return
- (erldoc-dom-walk dom (lambda (d)
- (when (equal (erldoc-dom-get-attribute d 'id) id)
- (throw 'return d))))))
-
-(defun erldoc-dom-get-elements-by-id (dom id)
- (let (result)
- (erldoc-dom-walk dom (lambda (d)
- (when (equal (erldoc-dom-get-attribute d 'id) id)
- (push d result))))
- (nreverse result)))
-
-(defun erldoc-fix-path (url)
- (if (and erldoc-verify-man-path
- ;; Could only verify local files
- (equal (url-type (url-generic-parse-url url)) "file"))
- (let* ((obj (url-generic-parse-url url))
- (new (car (file-expand-wildcards
- (replace-regexp-in-string
- "-[0-9]+\\(?:[.][0-9]+\\)*" "*"
- (url-filename obj))))))
- (or new (error "File %s does not exist" (url-filename obj)))
- (setf (url-filename obj) new)
- (url-recreate-url obj))
- url))
-
-(defun erldoc-parse-man-index (url)
- (let ((table (erldoc-dom-get-element (erldoc-parse-html url) 'table))
- (mans))
- (erldoc-dom-walk
- table
- (lambda (d)
- (when (eq (car-safe d) 'a)
- (let ((href (erldoc-dom-get-attribute d 'href)))
- (when (and href (not (string-match-p "index\\.html\\'" href)))
- (with-demoted-errors "erldoc-parse-man-index: %S"
- (push (cons (erldoc-dom-get-text d)
- (erldoc-fix-path (erldoc-expand-url href url)))
- mans)))))))
- (nreverse mans)))
-
-(defun erldoc-parse-man (man)
- (let ((dom (erldoc-parse-html (cdr man)))
- (table (make-hash-table :test #'equal)))
- (erldoc-dom-walk
- (erldoc-dom-get-element-by-id dom "loadscrollpos")
- (lambda (d)
- (let ((href (erldoc-dom-get-attribute d 'href)))
- (when (and href (string-match "#" href))
- (puthash (substring href (match-end 0))
- (list (concat (car man) ":" (erldoc-strip-string
- (erldoc-dom-get-text d)))
- (erldoc-expand-url href (cdr man)))
- table)))))
- (let ((span-content
- (lambda (span)
- (let ((texts))
- (erldoc-dom-walk span
- (lambda (d)
- (and (erldoc-dom-text-node-p d)
- (push (erldoc-strip-string d) texts))))
- (and texts (mapconcat 'identity (nreverse texts) " ")))))
- entries)
- (erldoc-dom-walk
- dom
- (lambda (d)
- ;; Get the full function signature.
- (when (and (eq (car-safe d) 'a)
- (gethash (erldoc-dom-get-attribute d 'name) table))
- (let* ((name (erldoc-dom-get-attribute d 'name))
- (mfa-url (gethash name table))
- (mfa (car mfa-url))
- (sig (or (funcall span-content d)
- (funcall span-content
- (or (erldoc-dom-get-element d 'span)
- (cadr
- (memq d erldoc-dom-walk-siblings))))
- (progn
- (funcall erldoc-no-signature-function
- "erldoc-parse-man: no sig for %s"
- mfa)
- nil))))
- (push (append mfa-url (list sig))
- entries)))
- ;; Get data types
- (when (and (eq (car-safe d) 'a)
- (string-prefix-p "type-"
- (or (erldoc-dom-get-attribute d 'name) "")))
- (push (list (concat (car man) ":" (funcall span-content d))
- (concat (cdr man) "#" (erldoc-dom-get-attribute d 'name))
- (funcall span-content erldoc-dom-walk-parent))
- entries))))
- entries)))
-
-(defun erldoc-parse-all (man-index output &optional json)
- (let* ((output (expand-file-name output))
- (table (make-hash-table :size 11503 :test #'equal))
- (mans (erldoc-parse-man-index man-index))
- (progress 1)
- (reporter (make-progress-reporter "Parsing Erlang/OTP documentation"
- progress (length mans)))
- fails all)
- (dolist (man mans)
- (condition-case err
- (push (erldoc-parse-man man) all)
- (error (push (error-message-string err) fails)))
- (accept-process-output nil 0.01)
- (progress-reporter-update reporter (cl-incf progress)))
- (when fails
- (display-warning 'erldoc-parse-all
- (format "\n\n%s" (mapconcat #'identity fails "\n"))
- :error))
- (progress-reporter-done reporter)
- (mapc (lambda (x) (puthash (car x) (cdr x) table))
- (apply #'nconc (nreverse all)))
- (with-temp-buffer
- (if (not json)
- (pp table (current-buffer))
- (let ((json-encoding-pretty-print t))
- (insert (json-encode table))))
- (unless (file-directory-p (file-name-directory output))
- (make-directory (file-name-directory output) t))
- (write-region nil nil output nil nil nil 'ask))))
-
-(defun erldoc-otp-release ()
- "Get the otp release version (as string) or nil if not found."
- (let ((otp (erldoc-dom-get-text
- (erldoc-dom-get-element
- (erldoc-parse-html
- (erldoc-expand-url "index.html" erldoc-man-index))
- 'title))))
- (and (string-match "[0-9.]+\\'" otp) (match-string 0 otp))))
-
-(defvar erldoc-browse-history nil)
-(defvar erldoc-lookup-table nil)
-
-(defun erldoc-lookup-table ()
- (or erldoc-lookup-table
- (progn
- (unless (file-exists-p erldoc-output-file)
- (let ((of (pcase (erldoc-otp-release)
- (`nil erldoc-output-file)
- (ver (concat erldoc-output-file "-" ver)))))
- (unless (file-exists-p of)
- (erldoc-parse-all erldoc-man-index of))
- (unless (string= erldoc-output-file of)
- (make-symbolic-link (expand-file-name of) erldoc-output-file))))
- (setq erldoc-lookup-table
- (with-temp-buffer
- (insert-file-contents erldoc-output-file)
- (read (current-buffer)))))))
-
-(defun erldoc-best-matches (mfa)
- (pcase mfa
- ((and `(,m ,f) (let a (erlang-get-function-arity)))
- (let ((mfa (format "%s:%s/%s" m f a)))
- (cond ((gethash mfa (erldoc-lookup-table)) (list mfa))
- (m (all-completions (concat m ":" f "/") (erldoc-lookup-table)))
- (t (let* ((mod (erlang-get-module))
- (mf1 (and mod (concat mod ":" f "/")))
- (mf2 (concat "erlang:" f "/"))
- (re (concat ":" (regexp-quote f) "/")))
- (or (and mf1 (all-completions mf1 (erldoc-lookup-table)))
- (all-completions mf2 (erldoc-lookup-table))
- (cl-loop for k being the hash-keys of (erldoc-lookup-table)
- when (string-match-p re k)
- collect k)))))))))
-
-;;;###autoload
-(defun erldoc-browse (mfa)
- (interactive
- (let ((default
- ;; `erlang-mode-syntax-table' is lazily initialised.
- (with-syntax-table (or erlang-mode-syntax-table (standard-syntax-table))
- (ignore-errors
- (erldoc-best-matches
- (or (erlang-get-function-under-point)
- (save-excursion
- (goto-char (or (cadr (syntax-ppss)) (point)))
- (erlang-get-function-under-point))))))))
- (list (completing-read (format (if default "Function {%d %s} (default %s): "
- "Function: ")
- (length default)
- (if (= (length default) 1) "guess" "guesses")
- (car default))
- (erldoc-lookup-table)
- nil t nil 'erldoc-browse-history default))))
- (or (stringp mfa)
- (signal 'wrong-type-argument (list 'string mfa 'mfa)))
- (browse-url (or (car (gethash mfa (erldoc-lookup-table)))
- (user-error "No documentation for %s" mfa))))
-
-;;;###autoload
-(defun erldoc-apropos (pattern)
- (interactive "sPattern: ")
- (with-help-window (help-buffer)
- (with-current-buffer standard-output
- (princ (concat "Erldoc apropos pattern: " pattern "\n\n"))
- (maphash (lambda (k v)
- (when (string-match-p pattern k)
- (insert-text-button k :type 'help-url
- 'help-args (list (car v)))
- (insert "\n")))
- (erldoc-lookup-table)))))
-
-(defun erldoc-tokenize-signature (sig)
- ;; Divide SIG into (MF ARGLIST RETTYPE)
- (let ((from (if (string-match "\\`.+?(" sig)
- (1- (match-end 0))
- 0))
- (to (and (string-match "\\s-*->\\s-*.*?\\'" sig) (match-beginning 0))))
- (list (erldoc-strip-string (substring sig 0 from))
- (erldoc-strip-string (substring sig from (and to (max from to))))
- (and to (erldoc-strip-string (substring sig to))))))
-
-(defun erldoc-format-signature (mod fn)
- (when (and mod fn (or erldoc-lookup-table
- (file-exists-p erldoc-output-file)))
- (let ((re (concat "\\`" mod ":" fn "/\\([0-9]+\\)\\'"))
- (sigs))
- (maphash (lambda (k v)
- (when (string-match re k)
- (if (cadr v)
- (push (cons (string-to-number (match-string 1 k))
- (cdr (erldoc-tokenize-signature (cadr v))))
- sigs)
- (funcall erldoc-no-signature-function
- "erldoc-format-signature: No sig for %s" k))))
- (erldoc-lookup-table))
- (when sigs
- ;; Mostly single return type but there are exceptions such as
- ;; `beam_lib:chunks/2,3'.
- (let ((single-rettype
- (cl-reduce (lambda (x1 x2) (and x1 x2 (equal x1 x2) x1))
- sigs :key #'cl-caddr))
- (sigs (sort sigs #'car-less-than-car)))
- (if single-rettype
- (concat mod ":" fn (mapconcat #'cadr sigs " | ") " " single-rettype)
- (mapconcat (lambda (x) (concat mod ":" fn (nth 1 x) " " (nth 2 x)))
- sigs "\n")))))))
-
-;;;###autoload
-(defun erldoc-eldoc-function ()
- "A function suitable for `eldoc-documentation-function'."
- (save-excursion
- (pcase (erlang-get-function-under-point)
- (`(,_ nil) )
- (`(nil ,fn) (erldoc-format-signature "erlang" fn))
- (`(,mod ,fn) (erldoc-format-signature mod fn)))))
-
-(defun erldoc-parse-eeps-index ()
- (let* ((url "http://www.erlang.org/eeps/")
- (table (catch 'return
- (erldoc-dom-walk (erldoc-parse-html url)
- (lambda (d)
- (and (eq (car-safe d) 'table)
- (equal (erldoc-dom-get-attribute d 'summary)
- "Numerical Index of EEPs")
- (throw 'return d))))))
- (fix-title (lambda (title)
- (replace-regexp-in-string
- "`` *" "" (replace-regexp-in-string " *``, *" " by " title))))
- (result))
- (erldoc-dom-walk
- table (lambda (d)
- (when (eq (car-safe d) 'a)
- (push (cons (funcall fix-title (erldoc-dom-get-attribute d 'title))
- (erldoc-expand-url
- (erldoc-dom-get-attribute d 'href)
- url))
- result))))
- (nreverse result)))
-
-(defvar erldoc-user-guides nil)
-
-(defvar erldoc-missing-user-guides
- '("compiler" "kernel" "os_mon" "parsetools")
- "List of standard Erlang applications with no user guides.")
-
-;; Search in `code:lib_dir/0' using find LIB_DIR -type f -name
-;; '*_app.html'.
-(defvar erldoc-app-manuals '("crypto" "diameter" "erl_docgen"
- "kernel" "observer" "os_mon"
- "runtime_tools" "sasl" "snmp"
- "ssl" "test_server"
- ("ssh" . "SSH") ("stdlib" . "STDLIB"))
- "List of applications that come with a manual.")
-
-(defun erldoc-user-guide-chapters (user-guide)
- (pcase-let ((`(,name . ,url) user-guide))
- (unless (member name erldoc-missing-user-guides)
- (let ((chaps (erldoc-dom-get-elements-by-id
- (erldoc-dom-get-element-by-id (erldoc-parse-html url) "leftnav")
- "no")))
- (or chaps (warn "erldoc-user-guide-chapters no chapters found for `%s'"
- (cdr user-guide)))
- (mapcar (lambda (li)
- (cons (concat name "#" (erldoc-dom-get-attribute li 'title))
- (erldoc-expand-url (erldoc-dom-get-attribute
- (erldoc-dom-get-element li 'a) 'href)
- url)))
- chaps)))))
-
-(defun erldoc-user-guides-1 ()
- (let ((url (erldoc-expand-url "applications.html" erldoc-man-index))
- app-guides app-mans)
- (erldoc-dom-walk
- (erldoc-parse-html url)
- (lambda (d)
- (when (and (eq (car-safe d) 'a)
- (not (string-match-p "\\`[0-9.]+\\'" (erldoc-dom-get-text d))))
- (with-demoted-errors "erldoc-user-guides-1: %S"
- (let ((name (erldoc-strip-string (erldoc-dom-get-text d)))
- (index-page (erldoc-fix-path (erldoc-expand-url
- (erldoc-dom-get-attribute d 'href) url))))
- (push (cons name (if (member name erldoc-missing-user-guides)
- index-page
- (erldoc-expand-url "users_guide.html" index-page)))
- app-guides)
- ;; Collect application manuals.
- (pcase (assoc name (mapcar (lambda (x) (if (consp x) x (cons x x)))
- erldoc-app-manuals))
- (`(,_ . ,manual)
- (push (cons name
- (erldoc-expand-url (format "%s_app.html" manual)
- index-page))
- app-mans))))))))
- (list (nreverse app-guides)
- (nreverse app-mans))))
-
-(defun erldoc-user-guides ()
- (or erldoc-user-guides
- (let ((file (concat erldoc-output-file "-topics")))
- (unless (file-exists-p file)
- (unless (file-directory-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (with-temp-buffer
- (pcase-let ((`(,guides ,mans) (erldoc-user-guides-1)))
- (pp (append (cl-mapcan #'erldoc-user-guide-chapters
- (append (mapcar
- (lambda (dir)
- (cons dir (erldoc-expand-url
- (concat dir "/users_guide.html")
- erldoc-man-index)))
- '("design_principles"
- "efficiency_guide"
- "embedded"
- "getting_started"
- "installation_guide"
- "oam"
- "programming_examples"
- "reference_manual"
- "system_architecture_intro"
- "system_principles"
- "tutorial"))
- guides))
- (mapcar (lambda (man)
- (pcase-let ((`(,name . ,url) man))
- (cons (concat name " (App)") url)))
- mans)
- (erldoc-parse-eeps-index))
- (current-buffer)))
- (write-region nil nil file nil nil nil 'ask)))
- (setq erldoc-user-guides (with-temp-buffer (insert-file-contents file)
- (read (current-buffer)))))))
-
-;;;###autoload
-(defun erldoc-browse-topic (topic)
- (interactive
- (list (completing-read "User guide: " (erldoc-user-guides) nil t)))
- (browse-url (cdr (assoc topic (erldoc-user-guides)))))
-
-(provide 'erldoc)
-
-;; Local variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-
-;;; erldoc.el ends here
--- /dev/null
+;;; erlang-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "erlang" "erlang.el" (0 0 0 0))
+;;; Generated autoloads from erlang.el
+
+(autoload 'erlang-mode "erlang" "\
+Major mode for editing Erlang source files in Emacs.
+It knows about syntax and comment, it can indent code, it is capable
+of fontifying the source file, the TAGS commands are aware of Erlang
+modules, and the Erlang man pages can be accessed.
+
+Should this module, \"erlang.el\", be installed properly, Erlang mode
+is activated whenever an Erlang source or header file is loaded into
+Emacs. To indicate this, the mode line should contain the word
+\"Erlang\".
+
+The main feature of Erlang mode is indentation, press TAB and the
+current line will be indented correctly.
+
+Comments starting with only one `%' are indented to the column stored
+in the variable `comment-column'. Comments starting with two `%':s
+are indented with the same indentation as code. Comments starting
+with at least three `%':s are indented to the first column.
+
+However, Erlang mode contains much more, this is a list of the most
+useful commands:
+ TAB - Indent the line.
+ C-c C-q - Indent current function.
+ M-; - Create a comment at the end of the line.
+ M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
+ will look better.
+ M-a - Goto the beginning of an Erlang clause.
+ M-C-a - Ditto for function.
+ M-e - Goto the end of an Erlang clause.
+ M-C-e - Ditto for function.
+ M-h - Mark current Erlang clause.
+ M-C-h - Ditto for function.
+ C-c C-z - Start, or switch to, an inferior Erlang shell.
+ C-c C-k - Compile current file.
+ C-x ` - Next error.
+ , - Electric comma.
+ ; - Electric semicolon.
+
+Erlang mode check the name of the file against the module name when
+saving, whenever a mismatch occurs Erlang mode offers to modify the
+source.
+
+The variable `erlang-electric-commands' controls the electric
+commands. To deactivate all of them, set it to nil.
+
+There exists a large number of commands and variables in the Erlang
+module. Please press `M-x apropos RET erlang RET' to see a complete
+list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
+RET'to see the full description of functions and variables,
+respectively.
+
+On entry to this mode the contents of the hook `erlang-mode-hook' is
+executed.
+
+Please see the beginning of the file `erlang.el' for more information
+and examples of hooks.
+
+Other commands:
+\\{erlang-mode-map}
+
+\(fn)" t nil)
+
+(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) (add-to-list 'auto-mode-alist (cons r 'erlang-mode)))
+
+(autoload 'erlang-find-tag "erlang" "\
+Like `find-tag'. Capable of retrieving Erlang modules.
+
+Tags can be given on the forms `tag', `module:', `module:tag'.
+
+\(fn MODTAGNAME &optional NEXT-P REGEXP-P)" t nil)
+
+(autoload 'erlang-find-tag-other-window "erlang" "\
+Like `find-tag-other-window' but aware of Erlang modules.
+
+\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
+
+(autoload 'erlang-shell "erlang" "\
+Start a new Erlang shell.
+
+The variable `erlang-shell-function' decides which method to use,
+default is to start a new Erlang host. It is possible that, in the
+future, a new shell on an already running host will be started." t nil)
+ (autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
+
+(autoload 'erlang-compile "erlang" "\
+Compile Erlang module in current buffer." t nil)
+
+(autoload 'inferior-erlang "erlang" "\
+Run an inferior Erlang.
+With prefix command, prompt for command to start Erlang with.
+
+This is just like running Erlang in a normal shell, except that
+an Emacs buffer is used for input and output.
+\\<comint-mode-map>
+The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
+The history is saved between sessions.
+
+Entry to this mode calls the functions in the variables
+`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
+
+The following commands imitate the usual Unix interrupt and
+editing control characters:
+\\{erlang-shell-mode-map}
+
+\(fn &optional COMMAND)" t nil)
+
+(register-definition-prefixes "erlang" '("erlang-" "inferior-erlang-" "run-erlang"))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-edoc" "erlang-edoc.el" (0 0 0 0))
+;;; Generated autoloads from erlang-edoc.el
+
+(autoload 'erlang-edoc-mode "erlang-edoc" "\
+Toggle Erlang-EDoc mode on or off.
+
+This is a minor mode. If called interactively, toggle the
+`Erlang-EDoc mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `erlang-edoc-mode'.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
+
+\\{erlang-edoc-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(register-definition-prefixes "erlang-edoc" '("erlang-edoc-"))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-eunit" "erlang-eunit.el" (0 0 0 0))
+;;; Generated autoloads from erlang-eunit.el
+
+(register-definition-prefixes "erlang-eunit" '("erlang-e" "filename-join"))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-flymake" "erlang-flymake.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from erlang-flymake.el
+
+(register-definition-prefixes "erlang-flymake" '("erlang-flymake-"))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-skels" "erlang-skels.el" (0 0 0 0))
+;;; Generated autoloads from erlang-skels.el
+
+(register-definition-prefixes "erlang-skels" '("erlang-"))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-skels-old" "erlang-skels-old.el" (0
+;;;;;; 0 0 0))
+;;; Generated autoloads from erlang-skels-old.el
+
+(register-definition-prefixes "erlang-skels-old" '("erlang-"))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-start" "erlang-start.el" (0 0 0 0))
+;;; Generated autoloads from erlang-start.el
+
+(let ((a '("\\.erl\\'" . erlang-mode)) (b '("\\.hrl\\'" . erlang-mode))) (or (assoc (car a) auto-mode-alist) (setq auto-mode-alist (cons a auto-mode-alist))) (or (assoc (car b) auto-mode-alist) (setq auto-mode-alist (cons b auto-mode-alist))))
+
+(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
+
+(let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext (add-to-list 'completion-ignored-extensions (car erl-ext)) (when (boundp 'dired-omit-extensions) (add-to-list 'dired-omit-extensions (car erl-ext))) (setq erl-ext (cdr erl-ext))))
+
+;;;***
+\f
+;;;### (autoloads nil "erlang-test" "erlang-test.el" (0 0 0 0))
+;;; Generated autoloads from erlang-test.el
+
+(register-definition-prefixes "erlang-test" '("erlang-"))
+
+;;;***
+\f
+;;;### (autoloads nil "erldoc" "erldoc.el" (0 0 0 0))
+;;; Generated autoloads from erldoc.el
+
+(autoload 'erldoc-browse "erldoc" "\
+
+
+\(fn MFA)" t nil)
+
+(autoload 'erldoc-apropos "erldoc" "\
+
+
+\(fn PATTERN)" t nil)
+
+(autoload 'erldoc-eldoc-function "erldoc" "\
+A function suitable for `eldoc-documentation-function'." nil nil)
+
+(autoload 'erldoc-browse-topic "erldoc" "\
+
+
+\(fn TOPIC)" t nil)
+
+(register-definition-prefixes "erldoc" '("erldoc-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("erlang-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; erlang-autoloads.el ends here
--- /dev/null
+;;; erlang-edoc.el --- EDoc support for Erlang mode -*- lexical-binding: t; -*-
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 1996-2020. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+
+;;; Commentary:
+
+;; Ref: http://www.erlang.org/doc/apps/edoc/users_guide.html
+;;
+;; To use: (add-hook 'erlang-mode-hook 'erlang-edoc-mode)
+
+;;; Code:
+
+(defcustom erlang-edoc-indent-level 2
+ "Indentation level of xhtml in Erlang edoc."
+ :type '(integer)
+ :safe 'integerp
+ :group 'erlang)
+
+(defvar erlang-edoc-generic-tags
+ '("clear" "docfile" "end" "headerfile" "todo" "TODO" "type")
+ "Tags that can be used anywhere within a module.")
+
+(defvar erlang-edoc-overview-tags
+ '("author" "copyright" "doc" "reference" "see" "since" "title" "version")
+ "Tags that can be used in an overview file.")
+
+(defvar erlang-edoc-module-tags
+ '("author" "copyright" "deprecated" "doc" "hidden" "private" "reference"
+ "see" "since" "version")
+ "Tags that can be used before a module declaration.")
+
+(defvar erlang-edoc-function-tags
+ '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns"
+ "see" "since" "spec" "throws" "type")
+ "Tags that can be used before a function definition.")
+
+(defvar erlang-edoc-predefined-macros
+ '("date" "docRoot" "link" "module" "package" "section" "time"
+ "type" "version"))
+
+(defface erlang-edoc-tag '((t (:inherit font-lock-constant-face)))
+ "Face used to highlight edoc tags."
+ :group 'erlang)
+
+(defface erlang-edoc-macro '((t (:inherit font-lock-preprocessor-face)))
+ "Face used to highlight edoc macros."
+ :group 'erlang)
+
+(defface erlang-edoc-verbatim
+ '((t (:family "Monospace" :inherit font-lock-keyword-face)))
+ "Face used to highlight verbatim text."
+ :group 'erlang)
+
+(defface erlang-edoc-todo '((t (:inherit font-lock-warning-face)))
+ "Face used to highlight edoc macros."
+ :group 'erlang)
+
+(defface erlang-edoc-heading '((t (:inherit bold)))
+ "Face used to highlight edoc headings."
+ :group 'erlang)
+
+(defvar erlang-edoc-font-lock-keywords
+ '(("^%+\\s-*\\(@\\w+\\)\\_>" 1 'erlang-edoc-tag prepend)
+ ("^%+\\s-*" ("{\\(@\\w+\\)\\_>" nil nil (1 'erlang-edoc-macro prepend)))
+ ("^%+\\s-*" ("\\(?:@@\\)*\\(@[@{}]\\)" nil nil (1 'escape-glyph prepend)))
+ ("^%+\\s-*\\(@deprecated\\)\\_>" 1 font-lock-warning-face prepend)
+ ;; http://www.erlang.org/doc/apps/edoc/chapter.html#Wiki_notation
+ ("^%+\\s-*" ("[^`]`\\([^`]?\\|[^`].*?[^']\\)'"
+ (forward-char -1) nil (1 'erlang-edoc-verbatim prepend)))
+ ("^%+\\s-*" ("\\[\\(\\(?:https?\\|file\\|ftp\\)://[^][]+\\)\\]"
+ nil nil (1 'link prepend)))
+ ("^%+\\s-*\\(?:\\(?1:@todo\\|@TODO\\)\\_>\\|\\(?1:TODO\\):\\)"
+ 1 'erlang-edoc-todo prepend)
+ ("^%+\\s-*\\(\\(=\\{2,4\\}\\)[^=\n].*[^=\n]\\2\\)\\s-*$"
+ 1 'erlang-edoc-heading prepend)))
+
+(defun erlang-edoc-xml-context ()
+ "Parse edoc x(ht)ml context at comment start of current line."
+ (eval-and-compile (require 'xmltok))
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at "^%+\\s-*")
+ (let ((pt (match-end 0)) context)
+ (forward-comment (- (point)))
+ (while (< (point) pt)
+ (xmltok-forward)
+ (cond ((eq xmltok-type 'start-tag)
+ (push (cons xmltok-type xmltok-start) context))
+ ((eq xmltok-type 'end-tag)
+ (pop context))))
+ (goto-char pt)
+ (xmltok-forward)
+ (push (car (memq xmltok-type '(start-tag end-tag))) context)
+ context))))
+
+(defun erlang-edoc-indent-line ()
+ (let ((context (erlang-edoc-xml-context)))
+ (when context
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward "^%+\\s-*" (line-end-position))
+ (when (or (car context) (cadr context))
+ (let ((pad (when (cadr context)
+ (save-excursion
+ (goto-char (cdr (cadr context)))
+ (- (current-column)
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward "%")
+ (current-column)))))))
+ (just-one-space (cond ((not pad) 1)
+ ((eq (car context) 'end-tag) pad)
+ (t (+ erlang-edoc-indent-level pad)))))))
+ (when (looking-back "^%*\\s-*" (line-beginning-position))
+ (re-search-forward "\\=%*\\s-*")))))
+
+(defun erlang-edoc-before-module-declaration-p ()
+ (save-excursion
+ (beginning-of-line)
+ (forward-comment (point-max))
+ (or (eobp) (re-search-forward "^-module\\s-*(" nil t))))
+
+(defun erlang-edoc-completion-at-point ()
+ (when (eq (syntax-ppss-context (syntax-ppss)) 'comment)
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (when (= (preceding-char) ?@)
+ (let* ((is-tag (looking-back "^%+\\s-*@" (line-beginning-position)))
+ (beg (point))
+ (end (progn (skip-syntax-forward "w_") (point)))
+ (table (cond
+ ((not is-tag)
+ erlang-edoc-predefined-macros)
+ ((erlang-edoc-before-module-declaration-p)
+ (append erlang-edoc-module-tags
+ erlang-edoc-generic-tags))
+ (t (append erlang-edoc-function-tags
+ erlang-edoc-generic-tags)))))
+ (list beg end table))))))
+
+;;;###autoload
+(define-minor-mode erlang-edoc-mode nil
+ :lighter " EDoc"
+ (cond (erlang-edoc-mode
+ (add-hook 'erlang-indent-line-hook #'erlang-edoc-indent-line nil t)
+ (font-lock-add-keywords nil erlang-edoc-font-lock-keywords t)
+ (add-hook 'completion-at-point-functions
+ #'erlang-edoc-completion-at-point nil t))
+ (t
+ (remove-hook 'erlang-indent-line-hook #'erlang-edoc-indent-line t)
+ (font-lock-remove-keywords nil erlang-edoc-font-lock-keywords)
+ (remove-hook 'completion-at-point-functions
+ #'erlang-edoc-completion-at-point t)))
+ (jit-lock-refontify))
+
+(provide 'erlang-edoc)
+
+;; Local variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;;; erlang-edoc.el ends here
--- /dev/null
+;;
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2009-2022. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+;;;
+;;; Purpose: Provide EUnit utilities.
+;;;
+;;; Author: Klas Johansson
+
+(eval-when-compile
+ (require 'cl-lib))
+(require 'erlang)
+
+(defvar erlang-eunit-src-candidate-dirs '("../src" ".")
+ "*Name of directories which to search for source files matching
+an EUnit test file. The first directory in the list will be used,
+if there is no match.")
+
+(defvar erlang-eunit-test-candidate-dirs '("../test" ".")
+ "*Name of directories which to search for EUnit test files matching
+a source file. The first directory in the list will be used,
+if there is no match.")
+
+(defvar erlang-eunit-autosave nil
+ "*Set to non-nil to automatically save unsaved buffers before running tests.
+This is useful, reducing the save-compile-load-test cycle to one keychord.")
+
+(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
+ "Info about the most recent running of an EUnit test representation.")
+
+(defvar erlang-error-regexp-alist
+ '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
+ "*Patterns for matching Erlang errors.")
+
+;;;
+;;; Switch between src/EUnit test buffers
+;;;
+(defun erlang-eunit-toggle-src-and-test-file-other-window ()
+ "Switch to the src file if the EUnit test file is the current
+buffer and vice versa"
+ (interactive)
+ (if (erlang-eunit-test-file-p buffer-file-name)
+ (erlang-eunit-open-src-file-other-window buffer-file-name)
+ (erlang-eunit-open-test-file-other-window buffer-file-name)))
+
+;;;
+;;; Open the EUnit test file which corresponds to a src file
+;;;
+(defun erlang-eunit-open-test-file-other-window (src-file-path)
+ "Open the EUnit test file which corresponds to a src file"
+ (find-file-other-window (erlang-eunit-test-filename src-file-path)))
+
+;;;
+;;; Open the src file which corresponds to the an EUnit test file
+;;;
+(defun erlang-eunit-open-src-file-other-window (test-file-path)
+ "Open the src file which corresponds to the an EUnit test file"
+ (find-file-other-window (erlang-eunit-src-filename test-file-path)))
+
+;;; Return the name and path of the EUnit test file
+;;, (input may be either the source filename itself or the EUnit test filename)
+(defun erlang-eunit-test-filename (file-path)
+ (if (erlang-eunit-test-file-p file-path)
+ file-path
+ (erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs)))
+
+;;; Return the name and path of the source file
+;;, (input may be either the source filename itself or the EUnit test filename)
+(defun erlang-eunit-src-filename (file-path)
+ (if (erlang-eunit-src-file-p file-path)
+ file-path
+ (erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs)))
+
+;;; Rewrite a filename from the src or test filename to the other
+(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs)
+ (or (erlang-eunit-locate-buddy orig-file-path candidate-dirs)
+ (erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs))))
+
+;;; Search for a file's buddy file (a source file's EUnit test file,
+;;; or an EUnit test file's source file) in a list of candidate
+;;; directories.
+(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs)
+ (when candidate-dirs
+ (let ((buddy-file-path (erlang-eunit-buddy-file-path
+ orig-file-path
+ (car candidate-dirs))))
+ (if (file-readable-p buddy-file-path)
+ buddy-file-path
+ (erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs))))))
+
+(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name)
+ (let* ((orig-dir-name (file-name-directory orig-file-path))
+ (buddy-dir-name (file-truename
+ (filename-join orig-dir-name buddy-dir-name)))
+ (buddy-base-name (erlang-eunit-buddy-basename orig-file-path)))
+ (filename-join buddy-dir-name buddy-base-name)))
+
+;;; Return the basename of the buddy file:
+;;; /tmp/foo/src/x.erl --> x_tests.erl
+;;; /tmp/foo/test/x_tests.erl --> x.erl
+(defun erlang-eunit-buddy-basename (file-path)
+ (let ((src-module-name (erlang-eunit-source-module-name file-path)))
+ (cond
+ ((erlang-eunit-src-file-p file-path)
+ (concat src-module-name "_tests.erl"))
+ ((erlang-eunit-test-file-p file-path)
+ (concat src-module-name ".erl")))))
+
+;;; Checks whether a file is a source file or not
+(defun erlang-eunit-src-file-p (file-path)
+ (not (erlang-eunit-test-file-p file-path)))
+
+;;; Checks whether a file is a EUnit test file or not
+(defun erlang-eunit-test-file-p (file-path)
+ (erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path))
+
+;;; Return the module name of the source file
+;;; /tmp/foo/src/x.erl --> x
+;;; /tmp/foo/test/x_tests.erl --> x
+(defun erlang-eunit-source-module-name (file-path)
+ (interactive)
+ (let ((module-name (erlang-eunit-module-name file-path)))
+ (if (string-match "^\\(.+\\)_tests$" module-name)
+ (substring module-name (match-beginning 1) (match-end 1))
+ module-name)))
+
+;;; Return the module name of the file
+;;; /tmp/foo/src/x.erl --> x
+;;; /tmp/foo/test/x_tests.erl --> x_tests
+(defun erlang-eunit-module-name (file-path)
+ (interactive)
+ (file-name-sans-extension (file-name-nondirectory file-path)))
+
+;;; Older emacsen don't have string-match-p.
+(defun erlang-eunit-string-match-p (regexp string &optional start)
+ (if (fboundp 'string-match-p) ;; appeared in emacs 23
+ (string-match-p regexp string start)
+ (save-match-data ;; fallback for earlier versions of emacs
+ (string-match regexp string start))))
+
+;;; Join filenames
+(defun filename-join (dir file)
+ (if (or (= (elt file 0) ?/)
+ (= (car (last (append dir nil))) ?/))
+ (concat dir file)
+ (concat dir "/" file)))
+
+;;; Get info about the most recent running of EUnit
+(defun erlang-eunit-recent (key)
+ (cdr (assq key erlang-eunit-recent-info)))
+
+;;; Record info about the most recent running of EUnit
+;;; Known modes are 'module-mode and 'test-mode
+(defun erlang-eunit-record-recent (mode module test)
+ (setcdr (assq 'mode erlang-eunit-recent-info) mode)
+ (setcdr (assq 'module erlang-eunit-recent-info) module)
+ (setcdr (assq 'test erlang-eunit-recent-info) test))
+
+;;; Record whether the most recent running of EUnit included cover
+;;; compilation
+(defun erlang-eunit-record-recent-compile (under-cover)
+ (setcdr (assq 'cover erlang-eunit-recent-info) under-cover))
+
+;;; Determine options for EUnit.
+(defun erlang-eunit-opts ()
+ (if current-prefix-arg ", [verbose]" ""))
+
+;;; Determine current test function
+(defun erlang-eunit-current-test ()
+ (save-excursion
+ (erlang-end-of-function 1)
+ (erlang-beginning-of-function 1)
+ (erlang-name-of-function)))
+
+(defun erlang-eunit-simple-test-p (test-name)
+ (if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil))
+
+(defun erlang-eunit-test-generator-p (test-name)
+ (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil))
+
+;;; Run one EUnit test
+(defun erlang-eunit-run-test (module-name test-name)
+ (let ((command
+ (cond ((erlang-eunit-simple-test-p test-name)
+ (format "eunit:test({%s, %s}%s)."
+ module-name test-name (erlang-eunit-opts)))
+ ((erlang-eunit-test-generator-p test-name)
+ (format "eunit:test({generator, %s, %s}%s)."
+ module-name test-name (erlang-eunit-opts)))
+ (t (format "%% WARNING: '%s' is not a test function" test-name)))))
+ (erlang-eunit-record-recent 'test-mode module-name test-name)
+ (erlang-eunit-inferior-erlang-send-command command)))
+
+;;; Run EUnit tests for the current module
+(defun erlang-eunit-run-module-tests (module-name)
+ (let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts))))
+ (erlang-eunit-record-recent 'module-mode module-name nil)
+ (erlang-eunit-inferior-erlang-send-command command)))
+
+(defun erlang-eunit-compile-and-run-recent ()
+ "Compile the source and test files and repeat the most recent EUnit test run.
+
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (interactive)
+ (cl-case (erlang-eunit-recent 'mode)
+ ('test-mode
+ (erlang-eunit-compile-and-test
+ 'erlang-eunit-run-test (list (erlang-eunit-recent 'module)
+ (erlang-eunit-recent 'test))))
+ ('module-mode
+ (erlang-eunit-compile-and-test
+ 'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module))
+ (erlang-eunit-recent 'cover)))
+ (t (error "EUnit has not yet been run. Please run a test first."))))
+
+(defun erlang-eunit-cover-compile ()
+ "Cover compile current module."
+ (interactive)
+ (let* ((erlang-compile-extra-opts
+ (append (list 'debug_info) erlang-compile-extra-opts))
+ (module-name
+ (erlang-add-quotes-if-needed
+ (erlang-eunit-module-name buffer-file-name)))
+ (compile-command
+ (format "cover:compile_beam(%s)." module-name)))
+ (erlang-compile)
+ (if (erlang-eunit-last-compilation-successful-p)
+ (erlang-eunit-inferior-erlang-send-command compile-command))))
+
+(defun erlang-eunit-analyze-coverage ()
+ "Analyze the data collected by cover tool for the module in the
+current buffer.
+
+Assumes that the module has been cover compiled prior to this
+call. This function will do two things: print the number of
+covered and uncovered functions in the erlang shell and display a
+new buffer called *<module name> coverage* which shows the source
+code along with the coverage analysis results."
+ (interactive)
+ (let* ((module-name (erlang-add-quotes-if-needed
+ (erlang-eunit-module-name buffer-file-name)))
+ (tmp-filename (make-temp-file "cover"))
+ (analyze-command (format "cover:analyze_to_file(%s, \"%s\"). "
+ module-name tmp-filename))
+ (buf-name (format "*%s coverage*" module-name)))
+ (erlang-eunit-inferior-erlang-send-command analyze-command)
+ ;; The purpose of the following snippet is to get the result of the
+ ;; analysis from a file into a new buffer (or an old, if one with
+ ;; the specified name already exists). Also we want the erlang-mode
+ ;; *and* view-mode to be enabled.
+ (save-excursion
+ (let ((buf (get-buffer-create (format "*%s coverage*" module-name))))
+ (set-buffer buf)
+ (setq buffer-read-only nil)
+ (insert-file-contents tmp-filename nil nil nil t)
+ (if (= (buffer-size) 0)
+ (kill-buffer buf)
+ ;; FIXME: this would be a good place to enable (emacs-mode)
+ ;; to get some nice syntax highlighting in the
+ ;; coverage report, but it doesn't play well with
+ ;; flymake. Leave it off for now.
+ (view-buffer buf))))
+ (delete-file tmp-filename)))
+
+(defun erlang-eunit-compile-and-run-current-test ()
+ "Compile the source and test files and run the current EUnit test.
+
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (interactive)
+ (let ((module-name (erlang-add-quotes-if-needed
+ (erlang-eunit-module-name buffer-file-name)))
+ (test-name (erlang-eunit-current-test)))
+ (erlang-eunit-compile-and-test
+ 'erlang-eunit-run-test (list module-name test-name))))
+
+(defun erlang-eunit-compile-and-run-module-tests ()
+ "Compile the source and test files and run all EUnit tests in the module.
+
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (interactive)
+ (let ((module-name (erlang-add-quotes-if-needed
+ (erlang-eunit-source-module-name buffer-file-name))))
+ (erlang-eunit-compile-and-test
+ 'erlang-eunit-run-module-tests (list module-name))))
+
+;;; Compile source and EUnit test file and finally run EUnit tests for
+;;; the current module
+(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover)
+ "Compile the source and test files and run the EUnit test suite.
+
+If under-cover is set to t, the module under test is compile for
+code coverage analysis. If under-cover is left out or not set,
+coverage analysis is disabled. The result of the code coverage
+is both printed to the erlang shell (the number of covered vs
+uncovered functions in a module) and written to a buffer called
+*<module> coverage* (which shows the source code for the module
+and the number of times each line is covered).
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (erlang-eunit-record-recent-compile under-cover)
+ (let ((src-filename (erlang-eunit-src-filename buffer-file-name))
+ (test-filename (erlang-eunit-test-filename buffer-file-name)))
+
+ ;; The purpose of out-maneuvering `save-some-buffers', as is done
+ ;; below, is to ask the question about saving buffers only once,
+ ;; instead of possibly several: one for each file to compile,
+ ;; for instance for both x.erl and x_tests.erl.
+ (save-some-buffers erlang-eunit-autosave)
+ (cl-letf (((symbol-function 'save-some-buffers) #'ignore))
+
+ ;; Compilation of the source file is mandatory (the file must
+ ;; exist, otherwise the procedure is aborted). Compilation of the
+ ;; test file on the other hand, is optional, since eunit tests may
+ ;; be placed in the source file instead. Any compilation error
+ ;; will prevent the subsequent steps to be run (hence the `and')
+ (and (erlang-eunit-compile-file src-filename under-cover)
+ (if (file-readable-p test-filename)
+ (erlang-eunit-compile-file test-filename)
+ t)
+ (apply test-fun test-args)
+ (if under-cover
+ (with-current-buffer (find-file-noselect src-filename)
+ (erlang-eunit-analyze-coverage)))))))
+
+(defun erlang-eunit-compile-and-run-module-tests-under-cover ()
+ "Compile the source and test files and run the EUnit test suite and measure
+code coverage.
+
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (interactive)
+ (let ((module-name (erlang-add-quotes-if-needed
+ (erlang-eunit-source-module-name buffer-file-name))))
+ (erlang-eunit-compile-and-test
+ 'erlang-eunit-run-module-tests (list module-name) t)))
+
+(defun erlang-eunit-compile-file (file-path &optional under-cover)
+ (if (file-readable-p file-path)
+ (with-current-buffer (find-file-noselect file-path)
+ ;; In order to run a code coverage analysis on a
+ ;; module, we have two options:
+ ;;
+ ;; * either compile the module with cover:compile instead of the
+ ;; regular compiler
+ ;;
+ ;; * or first compile the module with the regular compiler (but
+ ;; *with* debug_info) and then compile it for coverage
+ ;; analysis using cover:compile_beam.
+ ;;
+ ;; We could accomplish the first by changing the
+ ;; erlang-compile-erlang-function to cover:compile, but there's
+ ;; a risk that that's used for other purposes. Therefore, a
+ ;; safer alternative (although with more steps) is to add
+ ;; debug_info to the list of compiler options and go for the
+ ;; second alternative.
+ (if under-cover
+ (erlang-eunit-cover-compile)
+ (erlang-compile))
+ (erlang-eunit-last-compilation-successful-p))
+ (let ((msg (format "Could not read %s" file-path)))
+ (erlang-eunit-inferior-erlang-send-command
+ (format "%% WARNING: %s" msg))
+ (error msg))))
+
+(defun erlang-eunit-last-compilation-successful-p ()
+ (with-current-buffer inferior-erlang-buffer
+ (goto-char compilation-parsing-end)
+ (erlang-eunit-all-list-elems-fulfill-p
+ (lambda (re) (let ((continue t)
+ (result t))
+ (while continue ; ignore warnings, stop at errors
+ (if (re-search-forward re (point-max) t)
+ (if (erlang-eunit-is-compilation-warning)
+ t
+ (setq result nil)
+ (setq continue nil))
+ (setq result t)
+ (setq continue nil)))
+ result))
+ (mapcar (lambda (e) (car e)) erlang-error-regexp-alist))))
+
+(defun erlang-eunit-is-compilation-warning ()
+ (erlang-eunit-string-match-p
+ "[0-9]+: Warning:"
+ (buffer-substring (line-beginning-position) (line-end-position))))
+
+(defun erlang-eunit-all-list-elems-fulfill-p (pred list)
+ (let ((matches-p t))
+ (while (and list matches-p)
+ (if (not (funcall pred (car list)))
+ (setq matches-p nil))
+ (setq list (cdr list)))
+ matches-p))
+
+;;; Evaluate a command in an erlang buffer
+(defun erlang-eunit-inferior-erlang-send-command (command)
+ "Evaluate a command in an erlang buffer."
+ (interactive "P")
+ (inferior-erlang-prepare-for-input)
+ (inferior-erlang-send-command command)
+ (sit-for 0) ;; redisplay
+ (inferior-erlang-wait-prompt))
+
+
+;;;====================================================================
+;;; Key bindings
+;;;====================================================================
+
+(defconst erlang-eunit-key-bindings
+ '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window)
+ ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests)
+ ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test)
+ ("\C-c\C-el" erlang-eunit-compile-and-run-recent)
+ ("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover)
+ ("\C-c\C-ev" erlang-eunit-cover-compile)
+ ("\C-c\C-ea" erlang-eunit-analyze-coverage)))
+
+(defun erlang-eunit-add-key-bindings ()
+ (dolist (binding erlang-eunit-key-bindings)
+ (erlang-eunit-bind-key (car binding) (cadr binding))))
+
+(defun erlang-eunit-bind-key (key function)
+ (erlang-eunit-ensure-keymap-for-key key)
+ (local-set-key key function))
+
+(defun erlang-eunit-ensure-keymap-for-key (key-seq)
+ (let ((prefix-keys (butlast (append key-seq nil)))
+ (prefix-seq ""))
+ (while prefix-keys
+ (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys))))
+ (setq prefix-keys (cdr prefix-keys))
+ (if (not (keymapp (lookup-key (current-local-map) prefix-seq)))
+ (local-set-key prefix-seq (make-sparse-keymap))))))
+
+(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings)
+
+
+(provide 'erlang-eunit)
+
+;; Local variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;; erlang-eunit.el ends here
--- /dev/null
+;; erlang-flymake.el
+;;
+;; Syntax check erlang source code on the fly (integrates with flymake).
+;;
+;; Start using flymake with erlang by putting the following somewhere
+;; in your .emacs file:
+;;
+;; (require 'erlang-flymake)
+;;
+;; Flymake is rather eager and does its syntax checks frequently by
+;; default and if you are bothered by this, you might want to put the
+;; following in your .emacs as well:
+;;
+;; (erlang-flymake-only-on-save)
+;;
+;; There are a couple of variables which control the compilation options:
+;; * erlang-flymake-get-code-path-dirs-function
+;; * erlang-flymake-get-include-dirs-function
+;; * erlang-flymake-extra-opts
+;;
+;; This code is inspired by http://www.emacswiki.org/emacs/FlymakeErlang.
+
+(require 'flymake)
+(eval-when-compile
+ (require 'cl-lib))
+
+(defvar erlang-flymake-command
+ "erlc"
+ "The command that will be used to perform the syntax check")
+
+(defvar erlang-flymake-get-code-path-dirs-function
+ 'erlang-flymake-get-code-path-dirs
+ "Return a list of ebin directories to add to the code path.")
+
+(defvar erlang-flymake-get-include-dirs-function
+ 'erlang-flymake-get-include-dirs
+ "Return a list of include directories to add to the compiler options.")
+
+(defvar erlang-flymake-extra-opts
+ (list "+warn_unused_import"
+ "+warn_shadow_vars"
+ "+warn_export_vars"
+ "+strong_validation"
+ "+report")
+ "A list of options that will be passed to the compiler")
+
+(defun erlang-flymake-only-on-save ()
+ "Trigger flymake only when the buffer is saved (disables syntax
+check on newline and when there are no changes)."
+ (interactive)
+ ;; There doesn't seem to be a way of disabling this; set to the
+ ;; largest int available as a workaround (most-positive-fixnum
+ ;; equates to 8.5 years on my machine, so it ought to be enough ;-) )
+ (setq flymake-no-changes-timeout most-positive-fixnum)
+ (setq flymake-start-syntax-check-on-newline nil))
+
+
+(defun erlang-flymake-get-code-path-dirs ()
+ (list (concat (erlang-flymake-get-app-dir) "ebin")))
+
+(defun erlang-flymake-get-include-dirs ()
+ (list (concat (erlang-flymake-get-app-dir) "include")
+ (concat (erlang-flymake-get-app-dir) "deps")))
+
+(defun erlang-flymake-get-app-dir ()
+ (let ((src-path (file-name-directory (buffer-file-name))))
+ (file-name-directory (directory-file-name src-path))))
+
+(defun erlang-flymake-init ()
+ (let* ((temp-file
+ (cl-letf (((symbol-function 'flymake-get-temp-dir) #'erlang-flymake-temp-dir))
+ (flymake-init-create-temp-buffer-copy
+ 'flymake-create-temp-with-folder-structure)))
+ (code-dir-opts
+ (erlang-flymake-flatten
+ (mapcar (lambda (dir) (list "-pa" dir))
+ (funcall erlang-flymake-get-code-path-dirs-function))))
+ (inc-dir-opts
+ (erlang-flymake-flatten
+ (mapcar (lambda (dir) (list "-I" dir))
+ (funcall erlang-flymake-get-include-dirs-function))))
+ (compile-opts
+ (append inc-dir-opts
+ code-dir-opts
+ erlang-flymake-extra-opts)))
+ (list erlang-flymake-command (append compile-opts (list temp-file)))))
+
+(defun erlang-flymake-temp-dir ()
+ ;; Squeeze the user's name in there in order to make sure that files
+ ;; for two users who are working on the same computer (like a linux
+ ;; box) don't collide
+ (format "%s/flymake-%s" temporary-file-directory user-login-name))
+
+(defun erlang-flymake-flatten (list)
+ (apply #'append list))
+
+(add-to-list 'flymake-allowed-file-name-masks
+ '("\\.erl\\'" erlang-flymake-init))
+(add-hook 'erlang-mode-hook 'flymake-mode)
+
+(provide 'erlang-flymake)
+;; erlang-flymake ends here
--- /dev/null
+(define-package "erlang" "20230628.1002" "Erlang major mode"
+ '((emacs "24.1"))
+ :commit "d051172925a5c84b2f21850a188a533f885f201c" :authors
+ '(("Anders Lindgren"))
+ :maintainer
+ '("Anders Lindgren")
+ :keywords
+ '("erlang" "languages" "processes"))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2010-2022. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+;;;
+;;; Purpose: Provide Erlang code skeletons.
+;;; See 'erlang-skel-file' variable.
+
+(defvar erlang-tempo-tags nil
+ "Tempo tags for erlang mode")
+
+(defvar erlang-skel
+ '(("If" "if" erlang-skel-if)
+ ("Case" "case" erlang-skel-case)
+ ("Receive" "receive" erlang-skel-receive)
+ ("Receive After" "after" erlang-skel-receive-after)
+ ("Receive Loop" "loop" erlang-skel-receive-loop)
+ ("Module" "module" erlang-skel-module)
+ ("Author" "author" erlang-skel-author)
+ ()
+ ("Small Header" "small-header"
+ erlang-skel-small-header erlang-skel-header)
+ ("Normal Header" "normal-header"
+ erlang-skel-normal-header erlang-skel-header)
+ ("Large Header" "large-header"
+ erlang-skel-large-header erlang-skel-header)
+ ()
+ ("Small Server" "small-server"
+ erlang-skel-small-server erlang-skel-header)
+ ()
+ ("Application" "application"
+ erlang-skel-application erlang-skel-header)
+ ("Supervisor" "supervisor"
+ erlang-skel-supervisor erlang-skel-header)
+ ("supervisor_bridge" "supervisor-bridge"
+ erlang-skel-supervisor-bridge erlang-skel-header)
+ ("gen_server" "generic-server"
+ erlang-skel-generic-server erlang-skel-header)
+ ("gen_event" "gen-event"
+ erlang-skel-gen-event erlang-skel-header)
+ ("gen_fsm" "gen-fsm"
+ erlang-skel-gen-fsm erlang-skel-header)
+ ("Library module" "gen-lib"
+ erlang-skel-lib erlang-skel-header)
+ ("Corba callback" "gen-corba-cb"
+ erlang-skel-corba-callback erlang-skel-header)
+ ("Small Common Test suite" "ct-test-suite-s"
+ erlang-skel-ct-test-suite-s erlang-skel-header)
+ ("Large Common Test suite" "ct-test-suite-l"
+ erlang-skel-ct-test-suite-l erlang-skel-header)
+ ("Erlang TS test suite" "ts-test-suite"
+ erlang-skel-ts-test-suite erlang-skel-header)
+ )
+ "*Description of all skeleton templates.
+Both functions and menu entries will be created.
+
+Each entry in `erlang-skel' should be a list with three or four
+elements, or the empty list.
+
+The first element is the name which shows up in the menu. The second
+is the `tempo' identifier (The string \"erlang-\" will be added in
+front of it). The third is the skeleton descriptor, a variable
+containing `tempo' attributes as described in the function
+`tempo-define-template'. The optional fourth elements denotes a
+function which should be called when the menu is selected.
+
+Functions corresponding to every template will be created. The name
+of the function will be `tempo-template-erlang-X' where `X' is the
+tempo identifier as specified in the second argument of the elements
+in this list.
+
+A list with zero elements means that the a horizontal line should
+be placed in the menu.")
+
+;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH!
+;; What's wrong with that? RFC 822 says it's legal. [sverkerw]
+;; This needs to use the customized value. If that's not sane, things like
+;; add-log will lose anyhow. Avoid it if there _is_ a paren.
+(defvar erlang-skel-mail-address
+ (if (or (not user-mail-address) (string-match "(" user-mail-address))
+ (concat (user-login-name) "@"
+ (or (and (boundp 'mail-host-address)
+ mail-host-address)
+ (system-name)))
+ user-mail-address)
+ "Mail address of the user.")
+
+;; Expression templates:
+(defvar erlang-skel-case
+ '((erlang-skel-skip-blank) o >
+ "case " p " of" n> p "_ ->" n> p "ok" n> "end" p)
+ "*The skeleton of a `case' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-if
+ '((erlang-skel-skip-blank) o >
+ "if" n> p " ->" n> p "ok" n> "end" p)
+ "The skeleton of an `if' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive
+ '((erlang-skel-skip-blank) o >
+ "receive" n> p "_ ->" n> p "ok" n> "end" p)
+ "*The skeleton of a `receive' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive-after
+ '((erlang-skel-skip-blank) o >
+ "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n>
+ p "ok" n> "end" p)
+ "*The skeleton of a `receive' expression with an `after' clause.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive-loop
+ '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n>
+ "loop(" p ")" n> "end.")
+ "*The skeleton of a simple `receive' loop.
+Please see the function `tempo-define-template'.")
+
+
+;; Attribute templates
+
+(defvar erlang-skel-module
+ '(& "-module("
+ (erlang-add-quotes-if-needed (erlang-get-module-from-file-name))
+ ")." n)
+ "*The skeleton of a `module' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-author
+ '(& "-author('" erlang-skel-mail-address "')." n)
+ "*The skeleton of a `author' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-vc nil
+ "*The skeleton template to generate a version control attribute.
+The default is to insert nothing. Example of usage:
+
+ (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n)
+
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-export
+ '(& "-export([" n> "])." n)
+ "*The skeleton of an `export' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-import
+ '(& "%%-import(Module, [Function/Arity, ...])." n)
+ "*The skeleton of an `import' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-compile nil
+ ;; '(& "%%-compile(export_all)." n)
+ "*The skeleton of a `compile' attribute.
+Please see the function `tempo-define-template'.")
+
+
+;; Comment templates.
+
+(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy
+ "*Function which returns date string.
+Look in the module `time-stamp' for a battery of functions.")
+
+(defvar erlang-skel-copyright-comment '()
+ "*The template for a copyright line in the header, normally empty.
+This variable should be bound to a `tempo' template, for example:
+ '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n)
+
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-created-comment
+ '(& "%%% Created : " (funcall erlang-skel-date-function) " by "
+ (user-full-name) " <" erlang-skel-mail-address ">" n)
+ "*The template for the \"Created:\" comment line.")
+
+(defvar erlang-skel-author-comment
+ '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n)
+ "*The template for creating the \"Author:\" line in the header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-file-comment
+ '(& "%%% File : " (file-name-nondirectory buffer-file-name) n)
+"*The template for creating the \"Module:\" line in the header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-small-header
+ '(o (erlang-skel-include erlang-skel-module)
+ ;; erlang-skel-author)
+ n
+ (erlang-skel-include erlang-skel-compile
+ ;; erlang-skel-export
+ erlang-skel-vc))
+ "*The template of a small header without any comments.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-normal-header
+ '(o (erlang-skel-include erlang-skel-copyright-comment
+ erlang-skel-file-comment
+ erlang-skel-author-comment)
+ "%%% Description : " p n
+ (erlang-skel-include erlang-skel-created-comment) n
+ (erlang-skel-include erlang-skel-small-header) n)
+ "*The template of a normal header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-large-header
+ '(o (erlang-skel-separator)
+ (erlang-skel-include erlang-skel-copyright-comment
+ erlang-skel-file-comment
+ erlang-skel-author-comment)
+ "%%% Description : " p n
+ "%%%" n
+ (erlang-skel-include erlang-skel-created-comment)
+ (erlang-skel-separator)
+ (erlang-skel-include erlang-skel-small-header) )
+ "*The template of a large header.
+Please see the function `tempo-define-template'.")
+
+
+;; Server templates.
+
+(defvar erlang-skel-small-server
+ '((erlang-skel-include erlang-skel-large-header)
+ "-export([start/0,init/1])." n n n
+ "start() ->" n> "spawn(" (erlang-get-module-from-file-name)
+ ", init, [self()])." n n
+ "init(From) ->" n>
+ "loop(From)." n n
+ "loop(From) ->" n>
+ "receive" n>
+ p "_ ->" n>
+ "loop(From)" n>
+ "end."
+ )
+ "*Template of a small server.
+Please see the function `tempo-define-template'.")
+
+;; Behaviour templates.
+
+(defvar erlang-skel-application
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(application)." n n
+ "%% Application callbacks" n
+ "-export([start/2, stop/1])." n n
+ (erlang-skel-double-separator 2)
+ "%% Application callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start(Type, StartArgs) -> {ok, Pid} |" n
+ "%% {ok, Pid, State} |" n
+ "%% {error, Reason}" n
+ "%% Description: This function is called whenever an application " n
+ "%% is started using application:start/1,2, and should start the processes" n
+ "%% of the application. If the application is structured according to the" n
+ "%% OTP design principles as a supervision tree, this means starting the" n
+ "%% top supervisor of the tree." n
+ (erlang-skel-separator 2)
+ "start(_Type, StartArgs) ->" n>
+ "case 'TopSupervisor':start_link(StartArgs) of" n>
+ "{ok, Pid} -> " n>
+ "{ok, Pid};" n>
+ "Error ->" n>
+ "Error" n>
+ "end." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: stop(State) -> void()" n
+ "%% Description: This function is called whenever an application" n
+ "%% has stopped. It is intended to be the opposite of Module:start/2 and" n
+ "%% should do any necessary cleaning up. The return value is ignored. "n
+ (erlang-skel-separator 2)
+ "stop(_State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% Internal functions" n
+ (erlang-skel-double-separator 2)
+ )
+ "*The template of an application behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-supervisor
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(supervisor)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% Supervisor callbacks" n
+ "-export([init/1])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ (erlang-skel-double-separator 2)
+ "%% API functions" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n
+ "%% Description: Starts the supervisor" n
+ (erlang-skel-separator 2)
+ "start_link() ->" n>
+ "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% Supervisor callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} |" n
+ "%% ignore |" n
+ "%% {error, Reason}" n
+ "%% Description: Whenever a supervisor is started using "n
+ "%% supervisor:start_link/[2,3], this function is called by the new process "n
+ "%% to find out about restart strategy, maximum restart frequency and child "n
+ "%% specifications." n
+ (erlang-skel-separator 2)
+ "init([]) ->" n>
+ "AChild = {'AName',{'AModule',start_link,[]}," n>
+ "permanent,2000,worker,['AModule']}," n>
+ "{ok,{{one_for_all,0,1}, [AChild]}}." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% Internal functions" n
+ (erlang-skel-double-separator 2)
+ )
+ "*The template of an supervisor behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-supervisor-bridge
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(supervisor_bridge)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% supervisor_bridge callbacks" n
+ "-export([init/1, terminate/2])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator 2)
+ "%% API" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n
+ "%% Description: Starts the supervisor bridge" n
+ (erlang-skel-separator 2)
+ "start_link() ->" n>
+ "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% supervisor_bridge callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: init(Args) -> {ok, Pid, State} |" n
+ "%% ignore |" n
+ "%% {error, Reason} " n
+ "%% Description:Creates a supervisor_bridge process, linked to the calling" n
+ "%% process, which calls Module:init/1 to start the subsystem. To ensure a" n
+ "%% synchronized start-up procedure, this function does not return until" n
+ "%% Module:init/1 has returned. " n
+ (erlang-skel-separator 2)
+ "init([]) ->" n>
+ "case 'AModule':start_link() of" n>
+ "{ok, Pid} ->" n>
+ "{ok, Pid, #state{}};" n>
+ "Error ->" n>
+ "Error" n>
+ "end." n
+ n
+ (erlang-skel-separator 2)
+ "%% Func: terminate(Reason, State) -> void()" n
+ "%% Description:This function is called by the supervisor_bridge when it is"n
+ "%% about to terminate. It should be the opposite of Module:init/1 and stop"n
+ "%% the subsystem and do any necessary cleaning up.The return value is ignored."
+ (erlang-skel-separator 2)
+ "terminate(Reason, State) ->" n>
+ "'AModule':stop()," n>
+ "ok." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% Internal functions" n
+ (erlang-skel-double-separator 2)
+ )
+ "*The template of an supervisor_bridge behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-generic-server
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_server)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% gen_server callbacks" n
+ "-export([init/1, handle_call/3, handle_cast/2, "
+ "handle_info/2," n>
+ "terminate/2, code_change/3])." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator 2)
+ "%% API" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}" n
+ "%% Description: Starts the server" n
+ (erlang-skel-separator 2)
+ "start_link() ->" n>
+ "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% gen_server callbacks" n
+ (erlang-skel-double-separator 2)
+ n
+ (erlang-skel-separator 2)
+ "%% Function: init(Args) -> {ok, State} |" n
+ "%% {ok, State, Timeout} |" n
+ "%% ignore |" n
+ "%% {stop, Reason}" n
+ "%% Description: Initializes the server" n
+ (erlang-skel-separator 2)
+ "init([]) ->" n>
+ "{ok, #state{}}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: "
+ "%% handle_call(Request, From, State) -> {reply, Reply, State} |" n
+ "%% {reply, Reply, State, Timeout} |" n
+ "%% {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, Reply, State} |" n
+ "%% {stop, Reason, State}" n
+ "%% Description: Handling call messages" n
+ (erlang-skel-separator 2)
+ "handle_call(_Request, _From, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: handle_cast(Msg, State) -> {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, State}" n
+ "%% Description: Handling cast messages" n
+
+ (erlang-skel-separator 2)
+ "handle_cast(_Msg, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: handle_info(Info, State) -> {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, State}" n
+ "%% Description: Handling all non call/cast messages" n
+ (erlang-skel-separator 2)
+ "handle_info(_Info, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: terminate(Reason, State) -> void()" n
+ "%% Description: This function is called by a gen_server when it is about to"n
+ "%% terminate. It should be the opposite of Module:init/1 and do any necessary"n
+ "%% cleaning up. When it returns, the gen_server terminates with Reason." n
+ "%% The return value is ignored." n
+
+ (erlang-skel-separator 2)
+ "terminate(_Reason, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator 2)
+ "%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}" n
+ "%% Description: Convert process state when code is changed" n
+ (erlang-skel-separator 2)
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%%% Internal functions" n
+ (erlang-skel-separator 2)
+ )
+ "*The template of a generic server.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-gen-event
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_event)." n
+
+ "%% API" n
+ "-export([start_link/0, add_handler/0])." n n
+
+ "%% gen_event callbacks" n
+ "-export([init/1, handle_event/2, handle_call/2, " n>
+ "handle_info/2, terminate/2, code_change/3])." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator 2)
+ "%% gen_event callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start_link() -> {ok,Pid} | {error,Error} " n
+ "%% Description: Creates an event manager." n
+ (erlang-skel-separator 2)
+ "start_link() ->" n>
+ "gen_event:start_link({local, ?SERVER}). " n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: add_handler() -> ok | {'EXIT',Reason} | term()" n
+ "%% Description: Adds an event handler" n
+ (erlang-skel-separator 2)
+ "add_handler() ->" n>
+ "gen_event:add_handler(?SERVER, ?MODULE, [])." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% gen_event callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: init(Args) -> {ok, State}" n
+ "%% Description: Whenever a new event handler is added to an event manager,"n
+ "%% this function is called to initialize the event handler." n
+ (erlang-skel-separator 2)
+ "init([]) ->" n>
+ "{ok, #state{}}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: "n
+ "%% handle_event(Event, State) -> {ok, State} |" n
+ "%% {swap_handler, Args1, State1, Mod2, Args2} |"n
+ "%% remove_handler" n
+ "%% Description:Whenever an event manager receives an event sent using"n
+ "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for"n
+ "%% each installed event handler to handle the event. "n
+ (erlang-skel-separator 2)
+ "handle_event(_Event, State) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: " n
+ "%% handle_call(Request, State) -> {ok, Reply, State} |" n
+ "%% {swap_handler, Reply, Args1, State1, "n
+ "%% Mod2, Args2} |" n
+ "%% {remove_handler, Reply}" n
+ "%% Description: Whenever an event manager receives a request sent using"n
+ "%% gen_event:call/3,4, this function is called for the specified event "n
+ "%% handler to handle the request."n
+ (erlang-skel-separator 2)
+ "handle_call(_Request, State) ->" n>
+ "Reply = ok," n>
+ "{ok, Reply, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: " n
+ "%% handle_info(Info, State) -> {ok, State} |" n
+ "%% {swap_handler, Args1, State1, Mod2, Args2} |" n
+ "%% remove_handler" n
+ "%% Description: This function is called for each installed event handler when"n
+ "%% an event manager receives any other message than an event or a synchronous"n
+ "%% request (or a system message)."n
+ (erlang-skel-separator 2)
+ "handle_info(_Info, State) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: terminate(Reason, State) -> void()" n
+ "%% Description:Whenever an event handler is deleted from an event manager,"n
+ "%% this function is called. It should be the opposite of Module:init/1 and "n
+ "%% do any necessary cleaning up. " n
+ (erlang-skel-separator 2)
+ "terminate(_Reason, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n
+ "%% Description: Convert process state when code is changed" n
+ (erlang-skel-separator 2)
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%%% Internal functions" n
+ (erlang-skel-separator 2)
+ )
+ "*The template of a gen_event.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-gen-fsm
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_fsm)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% gen_fsm callbacks" n
+ "-export([init/1, state_name/2, state_name/3, handle_event/3," n>
+ "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator 2)
+ "%% API" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: start_link() -> ok,Pid} | ignore | {error,Error}" n
+ "%% Description:Creates a gen_fsm process which calls Module:init/1 to"n
+ "%% initialize. To ensure a synchronized start-up procedure, this function" n
+ "%% does not return until Module:init/1 has returned. " n
+ (erlang-skel-separator 2)
+ "start_link() ->" n>
+ "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% gen_fsm callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: init(Args) -> {ok, StateName, State} |" n
+ "%% {ok, StateName, State, Timeout} |" n
+ "%% ignore |" n
+ "%% {stop, StopReason} " n
+ "%% Description:Whenever a gen_fsm is started using gen_fsm:start/[3,4] or"n
+ "%% gen_fsm:start_link/3,4, this function is called by the new process to "n
+ "%% initialize. " n
+ (erlang-skel-separator 2)
+ "init([]) ->" n>
+ "{ok, state_name, #state{}}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: "n
+ "%% state_name(Event, State) -> {next_state, NextStateName, NextState}|" n
+ "%% {next_state, NextStateName, " n
+ "%% NextState, Timeout} |" n
+ "%% {stop, Reason, NewState}" n
+ "%% Description:There should be one instance of this function for each possible"n
+ "%% state name. Whenever a gen_fsm receives an event sent using" n
+ "%% gen_fsm:send_event/2, the instance of this function with the same name as"n
+ "%% the current state name StateName is called to handle the event. It is also "n
+ "%% called if a timeout occurs. " n
+ (erlang-skel-separator 2)
+ "state_name(_Event, State) ->" n>
+ "{next_state, state_name, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function:" n
+ "%% state_name(Event, From, State) -> {next_state, NextStateName, NextState} |"n
+ "%% {next_state, NextStateName, " n
+ "%% NextState, Timeout} |" n
+ "%% {reply, Reply, NextStateName, NextState}|"n
+ "%% {reply, Reply, NextStateName, " n
+ "%% NextState, Timeout} |" n
+ "%% {stop, Reason, NewState}|" n
+ "%% {stop, Reason, Reply, NewState}" n
+ "%% Description: There should be one instance of this function for each" n
+ "%% possible state name. Whenever a gen_fsm receives an event sent using" n
+ "%% gen_fsm:sync_send_event/2,3, the instance of this function with the same"n
+ "%% name as the current state name StateName is called to handle the event." n
+ (erlang-skel-separator 2)
+ "state_name(_Event, _From, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, state_name, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: " n
+ "%% handle_event(Event, StateName, State) -> {next_state, NextStateName, "n
+ "%% NextState} |" n
+ "%% {next_state, NextStateName, "n
+ "%% NextState, Timeout} |" n
+ "%% {stop, Reason, NewState}" n
+ "%% Description: Whenever a gen_fsm receives an event sent using"n
+ "%% gen_fsm:send_all_state_event/2, this function is called to handle"n
+ "%% the event." n
+ (erlang-skel-separator 2)
+ "handle_event(_Event, StateName, State) ->" n>
+ "{next_state, StateName, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: " n
+ "%% handle_sync_event(Event, From, StateName, "n
+ "%% State) -> {next_state, NextStateName, NextState} |" n
+ "%% {next_state, NextStateName, NextState, " n
+ "%% Timeout} |" n
+ "%% {reply, Reply, NextStateName, NextState}|" n
+ "%% {reply, Reply, NextStateName, NextState, " n
+ "%% Timeout} |" n
+ "%% {stop, Reason, NewState} |" n
+ "%% {stop, Reason, Reply, NewState}" n
+ "%% Description: Whenever a gen_fsm receives an event sent using"n
+ "%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle"n
+ "%% the event."n
+ (erlang-skel-separator 2)
+ "handle_sync_event(Event, From, StateName, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, StateName, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: " n
+ "%% handle_info(Info,StateName,State)-> {next_state, NextStateName, NextState}|" n
+ "%% {next_state, NextStateName, NextState, "n
+ "%% Timeout} |" n
+ "%% {stop, Reason, NewState}" n
+ "%% Description: This function is called by a gen_fsm when it receives any"n
+ "%% other message than a synchronous or asynchronous event"n
+ "%% (or a system message)." n
+ (erlang-skel-separator 2)
+ "handle_info(_Info, StateName, State) ->" n>
+ "{next_state, StateName, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: terminate(Reason, StateName, State) -> void()" n
+ "%% Description:This function is called by a gen_fsm when it is about"n
+ "%% to terminate. It should be the opposite of Module:init/1 and do any"n
+ "%% necessary cleaning up. When it returns, the gen_fsm terminates with"n
+ "%% Reason. The return value is ignored." n
+ (erlang-skel-separator 2)
+ "terminate(_Reason, _StateName, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function:" n
+ "%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}" n
+ "%% Description: Convert process state when code is changed" n
+ (erlang-skel-separator 2)
+ "code_change(_OldVsn, StateName, State, _Extra) ->" n>
+ "{ok, StateName, State}." n
+ n
+ (erlang-skel-separator 2)
+ "%%% Internal functions" n
+ (erlang-skel-separator 2)
+ )
+ "*The template of a gen_fsm.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-lib
+ '((erlang-skel-include erlang-skel-large-header)
+
+ "%% API" n
+ "-export([])." n n
+
+ (erlang-skel-double-separator 2)
+ "%% API" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: " n
+ "%% Description:" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-double-separator 2)
+ "%% Internal functions" n
+ (erlang-skel-double-separator 2)
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-corba-callback
+ '((erlang-skel-include erlang-skel-large-header)
+ "%% Include files" n n
+
+ "%% API" n
+ "-export([])." n n
+
+ "%% Corba callbacks" n
+ "-export([init/1, terminate/2, code_change/3])." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator 2)
+ "%% Corba callbacks" n
+ (erlang-skel-double-separator 2)
+ (erlang-skel-separator 2)
+ "%% Function: init(Args) -> {ok, State} |" n
+ "%% {ok, State, Timeout} |" n
+ "%% ignore |" n
+ "%% {stop, Reason}" n
+ "%% Description: Initializes the server" n
+ (erlang-skel-separator 2)
+ "init([]) ->" n>
+ "{ok, #state{}}." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: terminate(Reason, State) -> void()" n
+ "%% Description: Shutdown the server" n
+ (erlang-skel-separator 2)
+ "terminate(_Reason, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator 2)
+ "%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} " n
+ "%% Description: Convert process state when code is changed" n
+ (erlang-skel-separator 2)
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-double-separator 2)
+ "%% Internal functions" n
+ (erlang-skel-double-separator 2)
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-ts-test-suite
+ '((erlang-skel-include erlang-skel-large-header)
+ "%% Note: This directive should only be used in test suites." n
+ "-compile(export_all)." n n
+
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
+
+ (erlang-skel-separator 2)
+ "%% TEST SERVER CALLBACK FUNCTIONS" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-separator 2)
+ "%% Function: init_per_suite(Config0) -> Config1 | {skip,Reason}" n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the suite." n
+ "%%" n
+ "%% Description: Initialization before the suite." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ (erlang-skel-separator 2)
+ "init_per_suite(Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_suite(Config) -> term()" n
+ "%%" n
+ "%% Config = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% Description: Cleanup after the suite." n
+ (erlang-skel-separator 2)
+ "end_per_suite(_Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_testcase(TestCase, Config0) -> Config1 |" n
+ "%% {skip,Reason}" n
+ "%% TestCase = atom()" n
+ "%% Name of the test case that is about to run." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%%" n
+ "%% Description: Initialization before each test case." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ (erlang-skel-separator 2)
+ "init_per_testcase(_TestCase, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_testcase(TestCase, Config) -> term()" n
+ "%%" n
+ "%% TestCase = atom()" n
+ "%% Name of the test case that is finished." n
+ "%% Config = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% Description: Cleanup after each test case." n
+ (erlang-skel-separator 2)
+ "end_per_testcase(_TestCase, _Config) ->" n >
+ "ok."n n
+
+ (erlang-skel-separator 2)
+ "%% Function: all(Clause) -> Descr | Spec | {skip,Reason}" n
+ "%%" n
+ "%% Clause = doc | suite" n
+ "%% Indicates expected return value." n
+ "%% Descr = [string()] | []" n
+ "%% String that describes the test suite." n
+ "%% Spec = [TestCase]" n
+ "%% A test specification." n
+ "%% TestCase = ConfCase | atom()" n
+ "%% Configuration case, or the name of a test case function." n
+ "%% ConfCase = {conf,Init,Spec,End} |" n
+ "%% {conf,Properties,Init,Spec,End}" n
+ "%% Init = End = {Mod,Func} | Func" n
+ "%% Initialization and cleanup function." n
+ "%% Mod = Func = atom()" n
+ "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
+ "%% Execution properties of the test cases (may be combined)." n
+ "%% Shuffle = shuffle | {shuffle,Seed}" n
+ "%% To get cases executed in random order." n
+ "%% Seed = {integer(),integer(),integer()}" n
+ "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
+ "%% repeat_until_any_ok | repeat_until_any_fail" n
+ "%% To get execution of cases repeated." n
+ "%% N = integer() | forever" n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test suite." n
+ "%%" n
+ "%% Description: Returns a description of the test suite when" n
+ "%% Clause == doc, and a test specification (list" n
+ "%% of the conf and test cases in the suite) when" n
+ "%% Clause == suite." n
+ (erlang-skel-separator 2)
+ "all(doc) -> " n >
+ "[\"Describe the main purpose of this suite\"];" n n
+ "all(suite) -> " n >
+ "[a_test_case]." n n
+ n
+ (erlang-skel-separator 2)
+ "%% TEST CASES" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-separator 2)
+ "%% Function: TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n
+ "%%" n
+ "%% Arg = doc | suite | Config" n
+ "%% Indicates expected behaviour and return value." n
+ "%% Config = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Descr = [string()] | []" n
+ "%% String that describes the test case." n
+ "%% Spec = [tuple()] | []" n
+ "%% A test specification, see all/1." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%%" n
+ "%% Description: Test case function. Returns a description of the test" n
+ "%% case (doc), then returns a test specification (suite)," n
+ "%% or performs the actual test (Config)." n
+ (erlang-skel-separator 2)
+ "a_test_case(doc) -> " n >
+ "[\"Describe the main purpose of this test case\"];" n n
+ "a_test_case(suite) -> " n >
+ "[];" n n
+ "a_test_case(Config) when is_list(Config) -> " n >
+ "ok." n
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-ct-test-suite-l
+ '((erlang-skel-include erlang-skel-large-header)
+ "%% Note: This directive should only be used in test suites." n
+ "-compile(export_all)." n n
+
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
+
+ (erlang-skel-separator 2)
+ "%% COMMON TEST CALLBACK FUNCTIONS" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-separator 2)
+ "%% Function: suite() -> Info" n
+ "%%" n
+ "%% Info = [tuple()]" n
+ "%% List of key/value pairs." n
+ "%%" n
+ "%% Description: Returns list of tuples to set default properties" n
+ "%% for the suite." n
+ "%%" n
+ "%% Note: The suite/0 function is only meant to be used to return" n
+ "%% default data values, not perform any other operations." n
+ (erlang-skel-separator 2)
+ "suite() ->" n >
+ "[{timetrap,{minutes,10}}]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_suite(Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the suite." n
+ "%%" n
+ "%% Description: Initialization before the suite." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ (erlang-skel-separator 2)
+ "init_per_suite(Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_suite(Config0) -> term() | {save_config,Config1}" n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% Description: Cleanup after the suite." n
+ (erlang-skel-separator 2)
+ "end_per_suite(_Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_group(GroupName, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%%" n
+ "%% GroupName = atom()" n
+ "%% Name of the test case group that is about to run." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding configuration data for the group." n
+ "%% Reason = term()" n
+ "%% The reason for skipping all test cases and subgroups in the group." n
+ "%%" n
+ "%% Description: Initialization before each test case group." n
+ (erlang-skel-separator 2)
+ "init_per_group(_GroupName, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_group(GroupName, Config0) ->" n
+ "%% term() | {save_config,Config1}" n
+ "%%" n
+ "%% GroupName = atom()" n
+ "%% Name of the test case group that is finished." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding configuration data for the group." n
+ "%%" n
+ "%% Description: Cleanup after each test case group." n
+ (erlang-skel-separator 2)
+ "end_per_group(_GroupName, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_testcase(TestCase, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%%" n
+ "%% TestCase = atom()" n
+ "%% Name of the test case that is about to run." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%%" n
+ "%% Description: Initialization before each test case." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ (erlang-skel-separator 2)
+ "init_per_testcase(_TestCase, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_testcase(TestCase, Config0) ->" n
+ "%% term() | {save_config,Config1} | {fail,Reason}" n
+ "%%" n
+ "%% TestCase = atom()" n
+ "%% Name of the test case that is finished." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for failing the test case." n
+ "%%" n
+ "%% Description: Cleanup after each test case." n
+ (erlang-skel-separator 2)
+ "end_per_testcase(_TestCase, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: groups() -> [Group]" n
+ "%%" n
+ "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
+ "%% GroupName = atom()" n
+ "%% The name of the group." n
+ "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
+ "%% Group properties that may be combined." n
+ "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
+ "%% TestCase = atom()" n
+ "%% The name of a test case." n
+ "%% Shuffle = shuffle | {shuffle,Seed}" n
+ "%% To get cases executed in random order." n
+ "%% Seed = {integer(),integer(),integer()}" n
+ "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
+ "%% repeat_until_any_ok | repeat_until_any_fail" n
+ "%% To get execution of cases repeated." n
+ "%% N = integer() | forever" n
+ "%%" n
+ "%% Description: Returns a list of test case group definitions." n
+ (erlang-skel-separator 2)
+ "groups() ->" n >
+ "[]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n
+ "%%" n
+ "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
+ "%% GroupName = atom()" n
+ "%% Name of a test case group." n
+ "%% TestCase = atom()" n
+ "%% Name of a test case." n
+ "%% Reason = term()" n
+ "%% The reason for skipping all groups and test cases." n
+ "%%" n
+ "%% Description: Returns the list of groups and test cases that" n
+ "%% are to be executed." n
+ (erlang-skel-separator 2)
+ "all() -> " n >
+ "[my_test_case]." n n
+
+ n
+ (erlang-skel-separator 2)
+ "%% TEST CASES" n
+ (erlang-skel-separator 2)
+ n
+
+ (erlang-skel-separator 2)
+ "%% Function: TestCase() -> Info" n
+ "%%" n
+ "%% Info = [tuple()]" n
+ "%% List of key/value pairs." n
+ "%%" n
+ "%% Description: Test case info function - returns list of tuples to set" n
+ "%% properties for the test case." n
+ "%%" n
+ "%% Note: This function is only meant to be used to return a list of" n
+ "%% values, not perform any other operations." n
+ (erlang-skel-separator 2)
+ "my_test_case() -> " n >
+ "[]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: TestCase(Config0) ->" n
+ "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
+ "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%% Comment = term()" n
+ "%% A comment about the test case that will be printed in the html log." n
+ "%%" n
+ "%% Description: Test case function. (The name of it must be specified in" n
+ "%% the all/0 list or in a test case group for the test case" n
+ "%% to be executed)." n
+ (erlang-skel-separator 2)
+ "my_test_case(_Config) -> " n >
+ "ok." n
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-ct-test-suite-s
+ '((erlang-skel-include erlang-skel-large-header)
+ "-compile(export_all)." n n
+
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: suite() -> Info" n
+ "%% Info = [tuple()]" n
+ (erlang-skel-separator 2)
+ "suite() ->" n >
+ "[{timetrap,{seconds,30}}]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_suite(Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator 2)
+ "init_per_suite(Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_suite(Config0) -> term() | {save_config,Config1}" n
+ "%% Config0 = Config1 = [tuple()]" n
+ (erlang-skel-separator 2)
+ "end_per_suite(_Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_group(GroupName, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%% GroupName = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator 2)
+ "init_per_group(_GroupName, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_group(GroupName, Config0) ->" n
+ "%% term() | {save_config,Config1}" n
+ "%% GroupName = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ (erlang-skel-separator 2)
+ "end_per_group(_GroupName, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: init_per_testcase(TestCase, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%% TestCase = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator 2)
+ "init_per_testcase(_TestCase, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: end_per_testcase(TestCase, Config0) ->" n
+ "%% term() | {save_config,Config1} | {fail,Reason}" n
+ "%% TestCase = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator 2)
+ "end_per_testcase(_TestCase, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: groups() -> [Group]" n
+ "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
+ "%% GroupName = atom()" n
+ "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
+ "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
+ "%% TestCase = atom()" n
+ "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n
+ "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
+ "%% repeat_until_any_ok | repeat_until_any_fail" n
+ "%% N = integer() | forever" n
+ (erlang-skel-separator 2)
+ "groups() ->" n >
+ "[]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: all() -> GroupsAndTestCases | {skip,Reason}" n
+ "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
+ "%% GroupName = atom()" n
+ "%% TestCase = atom()" n
+ "%% Reason = term()" n
+ (erlang-skel-separator 2)
+ "all() -> " n >
+ "[my_test_case]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: TestCase() -> Info" n
+ "%% Info = [tuple()]" n
+ (erlang-skel-separator 2)
+ "my_test_case() -> " n >
+ "[]." n n
+
+ (erlang-skel-separator 2)
+ "%% Function: TestCase(Config0) ->" n
+ "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
+ "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ "%% Comment = term()" n
+ (erlang-skel-separator 2)
+ "my_test_case(_Config) -> " n >
+ "ok." n
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
--- /dev/null
+;;
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2010-2023. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+;;;
+;;; Purpose: Provide Erlang code skeletons.
+;;; See 'erlang-skel-file' variable.
+
+(defvar erlang-tempo-tags nil
+ "Tempo tags for erlang mode")
+
+(defvar erlang-skel
+ '(("If" "if" erlang-skel-if)
+ ("Case" "case" erlang-skel-case)
+ ("Receive" "receive" erlang-skel-receive)
+ ("Receive After" "after" erlang-skel-receive-after)
+ ("Receive Loop" "loop" erlang-skel-receive-loop)
+ ("Module" "module" erlang-skel-module)
+ ("Author" "author" erlang-skel-author)
+ ("Function" "function" erlang-skel-function)
+ ("Spec" "spec" erlang-skel-spec)
+ ()
+ ("Small Header" "small-header"
+ erlang-skel-small-header erlang-skel-header)
+ ("Normal Header" "normal-header"
+ erlang-skel-normal-header erlang-skel-header)
+ ("Large Header" "large-header"
+ erlang-skel-large-header erlang-skel-header)
+ ()
+ ("Small Server" "small-server"
+ erlang-skel-small-server erlang-skel-header)
+ ()
+ ("Application" "application"
+ erlang-skel-application erlang-skel-header)
+ ("Supervisor" "supervisor"
+ erlang-skel-supervisor erlang-skel-header)
+ ("supervisor_bridge" "supervisor-bridge"
+ erlang-skel-supervisor-bridge erlang-skel-header)
+ ("gen_server" "generic-server"
+ erlang-skel-generic-server erlang-skel-header)
+ ("gen_event" "gen-event"
+ erlang-skel-gen-event erlang-skel-header)
+ ("gen_fsm" "gen-fsm"
+ erlang-skel-gen-fsm erlang-skel-header)
+ ("gen_statem (StateName/3)" "gen-statem-StateName"
+ erlang-skel-gen-statem-StateName erlang-skel-header)
+ ("gen_statem (handle_event/4)" "gen-statem-handle-event"
+ erlang-skel-gen-statem-handle-event erlang-skel-header)
+ ("wx_object" "wx-object"
+ erlang-skel-wx-object erlang-skel-header)
+ ("Library module" "gen-lib"
+ erlang-skel-lib erlang-skel-header)
+ ("Corba callback" "gen-corba-cb"
+ erlang-skel-corba-callback erlang-skel-header)
+ ("Small Common Test suite" "ct-test-suite-s"
+ erlang-skel-ct-test-suite-s erlang-skel-header)
+ ("Large Common Test suite" "ct-test-suite-l"
+ erlang-skel-ct-test-suite-l erlang-skel-header)
+ ("Common Test Hook" "ct-hook"
+ erlang-skel-ct-hook erlang-skel-header)
+ ("Erlang TS test suite" "ts-test-suite"
+ erlang-skel-ts-test-suite erlang-skel-header)
+ )
+ "*Description of all skeleton templates.
+Both functions and menu entries will be created.
+
+Each entry in `erlang-skel' should be a list with three or four
+elements, or the empty list.
+
+The first element is the name which shows up in the menu. The second
+is the `tempo' identifier (The string \"erlang-\" will be added in
+front of it). The third is the skeleton descriptor, a variable
+containing `tempo' attributes as described in the function
+`tempo-define-template'. The optional fourth elements denotes a
+function which should be called when the menu is selected.
+
+Functions corresponding to every template will be created. The name
+of the function will be `tempo-template-erlang-X' where `X' is the
+tempo identifier as specified in the second argument of the elements
+in this list.
+
+A list with zero elements means that the a horizontal line should
+be placed in the menu.")
+
+(defvar erlang-skel-use-separators t
+ "A boolean than determines whether the skeletons include horizontal
+separators.
+
+Should this variable be nil, the documentation for functions will not
+include separators of the form %%--...")
+
+;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH!
+;; What's wrong with that? RFC 822 says it's legal. [sverkerw]
+;; This needs to use the customized value. If that's not sane, things like
+;; add-log will lose anyhow. Avoid it if there _is_ a paren.
+(defvar erlang-skel-mail-address
+ (if (or (not user-mail-address) (string-match "(" user-mail-address))
+ (concat (user-login-name) "@"
+ (or (and (boundp 'mail-host-address)
+ mail-host-address)
+ (system-name)))
+ user-mail-address)
+ "Mail address of the user.")
+
+;; Expression templates:
+(defvar erlang-skel-case
+ '((erlang-skel-skip-blank) o >
+ "case " p " of" n> p "_ ->" n> p "ok" n "end" > p)
+ "*The skeleton of a `case' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-if
+ '((erlang-skel-skip-blank) o >
+ "if" n> p " ->" n> p "ok" n "end" > p)
+ "The skeleton of an `if' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive
+ '((erlang-skel-skip-blank) o >
+ "receive" n> p "_ ->" n> p "ok" n "end" > p)
+ "*The skeleton of a `receive' expression.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive-after
+ '((erlang-skel-skip-blank) o >
+ "receive" n> p "_ ->" n> p "ok" n "after " > p "T ->" n>
+ p "ok" n "end" > p)
+ "*The skeleton of a `receive' expression with an `after' clause.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-receive-loop
+ '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n>
+ "loop(" p ")" n "end." >)
+ "*The skeleton of a simple `receive' loop.
+Please see the function `tempo-define-template'.")
+
+
+(defvar erlang-skel-function
+ '((erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% @spec" n
+ (erlang-skel-separator-end 2))
+ "*The template of a function skeleton.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-spec
+ '("-spec " (erlang-skel-get-function-name) "(" (erlang-skel-get-function-args) ") -> undefined.")
+ "*The template of a -spec for the function following point.
+Please see the function `tempo-define-template'.")
+
+;; Attribute templates
+
+(defvar erlang-skel-module
+ '(& "-module("
+ (erlang-add-quotes-if-needed (erlang-get-module-from-file-name))
+ ")." n)
+ "*The skeleton of a `module' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-author
+ '(& "-author('" erlang-skel-mail-address "')." n)
+ "*The skeleton of a `author' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-vc nil
+ "*The skeleton template to generate a version control attribute.
+The default is to insert nothing. Example of usage:
+
+ (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n)
+
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-export
+ '(& "-export([" n> "])." n)
+ "*The skeleton of an `export' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-import
+ '(& "%%-import(Module, [Function/Arity, ...])." n)
+ "*The skeleton of an `import' attribute.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-compile nil
+ ;; '(& "%%-compile(export_all)." n)
+ "*The skeleton of a `compile' attribute.
+Please see the function `tempo-define-template'.")
+
+
+;; Comment templates.
+
+(defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy
+ "*Function which returns date string.
+Look in the module `time-stamp' for a battery of functions.")
+
+(defvar erlang-skel-copyright-comment
+ (if (boundp '*copyright-organization*)
+ '(& "%%% @copyright (C) " (format-time-string "%Y") ", "
+ *copyright-organization* n)
+ '(& "%%% @copyright (C) " (format-time-string "%Y") ", "
+ (user-full-name) n))
+ "*The template for a copyright line in the header, normally empty.
+This variable should be bound to a `tempo' template, for example:
+ '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n)
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-created-comment
+ '(& "%%% Created : " (funcall erlang-skel-date-function) " by "
+ (user-full-name) " <" erlang-skel-mail-address ">" n)
+ "*The template for the \"Created:\" comment line.")
+
+(defvar erlang-skel-author-comment
+ '(& "%%% @author " (user-full-name) " <" erlang-skel-mail-address ">" n)
+ "*The template for creating the \"Author:\" line in the header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-small-header
+ '(o (erlang-skel-include erlang-skel-module)
+ n
+ (erlang-skel-include erlang-skel-compile erlang-skel-vc))
+ "*The template of a small header without any comments.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-normal-header
+ '(o (erlang-skel-include erlang-skel-author-comment)
+ (erlang-skel-include erlang-skel-copyright-comment)
+ "%%% @doc" n
+ "%%%" p n
+ "%%% @end" n
+ (erlang-skel-include erlang-skel-created-comment) n
+ (erlang-skel-include erlang-skel-small-header) n)
+ "*The template of a normal header.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-large-header
+ '(o (erlang-skel-separator)
+ (erlang-skel-include erlang-skel-author-comment)
+ (erlang-skel-include erlang-skel-copyright-comment)
+ "%%% @doc" n
+ "%%%" p n
+ "%%% @end" n
+ (erlang-skel-include erlang-skel-created-comment)
+ (erlang-skel-separator)
+ (erlang-skel-include erlang-skel-small-header) )
+ "*The template of a large header.
+Please see the function `tempo-define-template'.")
+
+
+ ;; Server templates.
+(defvar erlang-skel-small-server
+ '((erlang-skel-include erlang-skel-large-header)
+ "-export([start/0, init/1])." n n n
+ "start() ->" n> "spawn(" (erlang-get-module-from-file-name)
+ ", init, [self()])." n n
+ "init(From) ->" n>
+ "loop(From)." n n
+ "loop(From) ->" n>
+ "receive" n>
+ p "_ ->" n>
+ "loop(From)" n
+ "end." > n
+ )
+ "*Template of a small server.
+Please see the function `tempo-define-template'.")
+
+;; Behaviour templates.
+(defvar erlang-skel-application
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(application)." n n
+ "%% Application callbacks" n
+ "-export([start/2, start_phase/3, stop/1, prep_stop/1," n>
+ "config_change/3])." n n
+ (erlang-skel-double-separator-start 3)
+ "%%% Application callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called whenever an application is started using" n
+ "%% application:start/[1,2], and should start the processes of the" n
+ "%% application. If the application is structured according to the OTP" n
+ "%% design principles as a supervision tree, this means starting the" n
+ "%% top supervisor of the tree." n
+ (erlang-skel-separator-end 2)
+ "-spec start(StartType :: normal |" n>
+ "{takeover, Node :: node()} |" n>
+ "{failover, Node :: node()}," n>
+ "StartArgs :: term()) ->" n>
+ "{ok, Pid :: pid()} |" n>
+ "{ok, Pid :: pid(), State :: term()} |" n>
+ "{error, Reason :: term()}." n
+ "start(_StartType, _StartArgs) ->" n>
+ "case 'TopSupervisor':start_link() of" n>
+ "{ok, Pid} ->" n>
+ "{ok, Pid};" n>
+ "Error ->" n>
+ "Error" n
+ "end." > n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% top supervisor of the tree." n
+ "%% Starts an application with included applications, when" n
+ "%% synchronization is needed between processes in the different" n
+ "%% applications during startup."
+ (erlang-skel-separator-end 2)
+ "-spec start_phase(Phase :: atom()," n>
+ "StartType :: normal |" n>
+ "{takeover, Node :: node()} |" n>
+ "{failover, Node :: node()}," n>
+ "PhaseArgs :: term()) -> ok | {error, Reason :: term()}." n
+ "start_phase(_Phase, _StartType, _PhaseArgs) ->" n>
+ "ok."n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called whenever an application has stopped. It" n
+ "%% is intended to be the opposite of Module:start/2 and should do" n
+ "%% any necessary cleaning up. The return value is ignored." n
+ (erlang-skel-separator-end 2)
+ "-spec stop(State :: term()) -> any()." n
+ "stop(_State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called when an application is about to be stopped," n
+ "%% before shutting down the processes of the application." n
+ (erlang-skel-separator-end 2)
+ "-spec prep_stop(State :: term()) -> NewState :: term()." n
+ "prep_stop(State) ->" n>
+ "State." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by an application after a code replacement," n
+ "%% if the configuration parameters have changed." n
+ (erlang-skel-separator-end 2)
+ "-spec config_change(Changed :: [{Par :: atom(), Val :: term()}]," n>
+ "New :: [{Par :: atom(), Val :: term()}]," n>
+ "Removed :: [Par :: atom()]) -> ok." n
+ "config_change(_Changed, _New, _Removed) ->" n>
+ "ok." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of an application behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-supervisor
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(supervisor)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% Supervisor callbacks" n
+ "-export([init/1])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API functions" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Starts the supervisor" n
+ (erlang-skel-separator-end 2)
+ "-spec start_link() -> {ok, Pid :: pid()} |" n>
+ "{error, {already_started, Pid :: pid()}} |" n>
+ "{error, {shutdown, term()}} |" n>
+ "{error, term()} |" n>
+ "ignore." n
+ "start_link() ->" n>
+ "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Supervisor callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a supervisor is started using supervisor:start_link/[2,3]," n
+ "%% this function is called by the new process to find out about" n
+ "%% restart strategy, maximum restart intensity, and child" n
+ "%% specifications." n
+ (erlang-skel-separator-end 2)
+ "-spec init(Args :: term()) ->" n>
+ "{ok, {SupFlags :: supervisor:sup_flags()," n>
+ "[ChildSpec :: supervisor:child_spec()]}} |" n>
+ "ignore." n
+ "init([]) ->" n
+ "" n>
+ "SupFlags = #{strategy => one_for_one," n>
+ "intensity => 1," n>
+ "period => 5}," n
+ "" n>
+ "AChild = #{id => 'AName'," n>
+ "start => {'AModule', start_link, []}," n>
+ "restart => permanent," n>
+ "shutdown => 5000," n>
+ "type => worker," n>
+ "modules => ['AModule']}," n
+ "" n>
+ "{ok, {SupFlags, [AChild]}}." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a supervisor behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-supervisor-bridge
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(supervisor_bridge)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% supervisor_bridge callbacks" n
+ "-export([init/1, terminate/2])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Starts the supervisor bridge" n
+ (erlang-skel-separator-end 2)
+ "-spec start_link() -> {ok, Pid :: pid()} |" n>
+ "{error, {already_started, Pid :: pid()}} |" n>
+ "{error, term()} |" n>
+ "ignore." n
+ "start_link() ->" n>
+ "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% supervisor_bridge callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Creates a supervisor_bridge process, linked to the calling process," n
+ "%% which calls Module:init/1 to start the subsystem. To ensure a" n
+ "%% synchronized start-up procedure, this function does not return" n
+ "%% until Module:init/1 has returned." n
+ (erlang-skel-separator-end 2)
+ "-spec init(Args :: term()) -> {ok, Pid :: pid(), State :: term()} |" n>
+ "{error, Error :: term()} |" n>
+ "ignore." n
+ "init([]) ->" n>
+ "case 'AModule':start_link() of" n>
+ "{ok, Pid} ->" n>
+ "{ok, Pid, #state{}};" n>
+ "Error ->" n>
+ "Error" n
+ "end." > n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by the supervisor_bridge when it is about" n
+ "%% to terminate. It should be the opposite of Module:init/1 and stop" n
+ "%% the subsystem and do any necessary cleaning up.The return value is" n
+ "%% ignored." n
+ (erlang-skel-separator-end 2)
+ "-spec terminate(Reason :: shutdown | term(), State :: term()) -> any()." n
+ "terminate(_Reason, _State) ->" n>
+ "'AModule':stop()," n>
+ "ok." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a supervisor_bridge behaviour.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-generic-server
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_server)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% gen_server callbacks" n
+ "-export([init/1, handle_call/3, handle_cast/2, handle_info/2," n>
+ "terminate/2, code_change/3, format_status/2])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Starts the server" n
+ (erlang-skel-separator-end 2)
+ "-spec start_link() -> {ok, Pid :: pid()} |" n>
+ "{error, Error :: {already_started, pid()}} |" n>
+ "{error, Error :: term()} |" n>
+ "ignore." n
+ "start_link() ->" n>
+ "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% gen_server callbacks" n
+ (erlang-skel-double-separator-end 3)
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Initializes the server" n
+ (erlang-skel-separator-end 2)
+ "-spec init(Args :: term()) -> {ok, State :: term()} |" n>
+ "{ok, State :: term(), Timeout :: timeout()} |" n>
+ "{ok, State :: term(), hibernate} |" n>
+ "{stop, Reason :: term()} |" n>
+ "ignore." n
+ "init([]) ->" n>
+ "process_flag(trap_exit, true)," n>
+ "{ok, #state{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling call messages" n
+ (erlang-skel-separator-end 2)
+ "-spec handle_call(Request :: term(), From :: {pid(), term()}, State :: term()) ->" n>
+ "{reply, Reply :: term(), NewState :: term()} |" n>
+ "{reply, Reply :: term(), NewState :: term(), Timeout :: timeout()} |" n>
+ "{reply, Reply :: term(), NewState :: term(), hibernate} |" n>
+ "{noreply, NewState :: term()} |" n>
+ "{noreply, NewState :: term(), Timeout :: timeout()} |" n>
+ "{noreply, NewState :: term(), hibernate} |" n>
+ "{stop, Reason :: term(), Reply :: term(), NewState :: term()} |" n>
+ "{stop, Reason :: term(), NewState :: term()}." n
+ "handle_call(_Request, _From, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling cast messages" n
+ (erlang-skel-separator-end 2)
+ "-spec handle_cast(Request :: term(), State :: term()) ->" n>
+ "{noreply, NewState :: term()} |" n>
+ "{noreply, NewState :: term(), Timeout :: timeout()} |" n>
+ "{noreply, NewState :: term(), hibernate} |" n>
+ "{stop, Reason :: term(), NewState :: term()}." n
+ "handle_cast(_Request, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling all non call/cast messages" n
+ (erlang-skel-separator-end 2)
+ "-spec handle_info(Info :: timeout() | term(), State :: term()) ->" n>
+ "{noreply, NewState :: term()} |" n>
+ "{noreply, NewState :: term(), Timeout :: timeout()} |" n>
+ "{noreply, NewState :: term(), hibernate} |" n>
+ "{stop, Reason :: normal | term(), NewState :: term()}." n
+ "handle_info(_Info, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by a gen_server when it is about to" n
+ "%% terminate. It should be the opposite of Module:init/1 and do any" n
+ "%% necessary cleaning up. When it returns, the gen_server terminates" n
+ "%% with Reason. The return value is ignored." n
+ (erlang-skel-separator-end 2)
+ "-spec terminate(Reason :: normal | shutdown | {shutdown, term()} | term()," n>
+ "State :: term()) -> any()." n
+ "terminate(_Reason, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ (erlang-skel-separator-end 2)
+ "-spec code_change(OldVsn :: term() | {down, term()}," n>
+ "State :: term()," n>
+ "Extra :: term()) -> {ok, NewState :: term()} |" n>
+ "{error, Reason :: term()}." n
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called for changing the form and appearance" n
+ "%% of gen_server status when it is returned from sys:get_status/1,2" n
+ "%% or when it appears in termination error logs." n
+ (erlang-skel-separator-end 2)
+ "-spec format_status(Opt :: normal | terminate," n>
+ "Status :: list()) -> Status :: term()." n
+ "format_status(_Opt, Status) ->" n>
+ "Status." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a generic server.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-gen-event
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_event)." n n
+
+ "%% API" n
+ "-export([start_link/0, add_handler/0])." n n
+
+ "%% gen_event callbacks" n
+ "-export([init/1, handle_event/2, handle_call/2, handle_info/2," n>
+ "terminate/2, code_change/3, format_status/2])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Creates an event manager" n
+ (erlang-skel-separator-end 2)
+ "-spec start_link() -> {ok, Pid :: pid()} |" n>
+ "{error, Error :: {already_started, pid()} | term()}." n
+ "start_link() ->" n>
+ "gen_event:start_link({local, ?SERVER})." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Adds an event handler" n
+ (erlang-skel-separator-end 2)
+ "-spec add_handler() -> ok | {'EXIT', Reason :: term()} | term()." n
+ "add_handler() ->" n>
+ "gen_event:add_handler(?SERVER, ?MODULE, [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% gen_event callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a new event handler is added to an event manager," n
+ "%% this function is called to initialize the event handler." n
+ (erlang-skel-separator-end 2)
+ "-spec init(Args :: term() | {Args :: term(), Term :: term()}) ->" n>
+ "{ok, State :: term()} |" n>
+ "{ok, State :: term(), hibernate} |" n>
+ "{error, Reason :: term()}." n
+ "init([]) ->" n>
+ "{ok, #state{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever an event manager receives an event sent using" n
+ "%% gen_event:notify/2 or gen_event:sync_notify/2, this function is" n
+ "%% called for each installed event handler to handle the event." n
+ (erlang-skel-separator-end 2)
+ "-spec handle_event(Event :: term(), State :: term()) ->" n>
+ "{ok, NewState :: term()} |" n>
+ "{ok, NewState :: term(), hibernate} |" n>
+ "remove_handler |" n>
+ "{swap_handler, Args1 :: term(), NewState :: term()," n>
+ "Handler2 :: atom() | {atom(), term()} , Args2 :: term()}." n>
+ "handle_event(_Event, State) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever an event manager receives a request sent using" n
+ "%% gen_event:call/3,4, this function is called for the specified" n
+ "%% event handler to handle the request." n
+ (erlang-skel-separator-end 2)
+ "-spec handle_call(Request :: term(), State :: term()) ->" n>
+ "{ok, Reply :: term(), NewState :: term()} |" n>
+ "{ok, Reply :: term(), NewState :: term(), hibernate} |" n>
+ "{remove_handler, Reply :: term()} |" n>
+ "{swap_handler, Reply :: term(), Args1 :: term(), NewState :: term()," n>
+ "Handler2 :: atom() | {atom(), term()}, Args2 :: term()}." n
+ "handle_call(_Request, State) ->" n>
+ "Reply = ok," n>
+ "{ok, Reply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called for each installed event handler when" n
+ "%% an event manager receives any other message than an event or a" n
+ "%% synchronous request (or a system message)." n
+ (erlang-skel-separator-end 2)
+ "-spec handle_info(Info :: term(), State :: term()) ->" n>
+ "{ok, NewState :: term()} |" n>
+ "{ok, NewState :: term(), hibernate} |" n>
+ "remove_handler |" n>
+ "{swap_handler, Args1 :: term(), NewState :: term()," n>
+ "Handler2 :: atom() | {atom(), term()}, Args2 :: term()}." n
+ "handle_info(_Info, State) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever an event handler is deleted from an event manager, this" n
+ "%% function is called. It should be the opposite of Module:init/1 and" n
+ "%% do any necessary cleaning up." n
+ (erlang-skel-separator-end 2)
+ "-spec terminate(Arg :: {stop, Reason :: term()} |" n>
+ "stop |" n>
+ "remove_handler |" n>
+ "{error, {'EXIT', Reason :: term()}} |" n>
+ "{error, Term :: term()} |" n>
+ "term()," n>
+ "State :: term()) -> any()." n
+ "terminate(_Arg, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ (erlang-skel-separator-end 2)
+ "-spec code_change(OldVsn :: term() | {down, term()}," n>
+ "State :: term()," n>
+ "Extra :: term()) -> {ok, NewState :: term()}." n
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called for changing the form and appearance" n
+ "%% of gen_event status when it is returned from sys:get_status/1,2" n
+ "%% or when it appears in termination error logs." n
+ (erlang-skel-separator-end 2)
+ "-spec format_status(Opt :: normal | terminate," n>
+ "Status :: list()) -> Status :: term()." n
+ "format_status(_Opt, Status) ->" n>
+ "Status." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a gen_event.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-gen-fsm
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_fsm)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% gen_fsm callbacks" n
+ "-export([init/1, state_name/2, state_name/3, handle_event/3," n>
+ "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n
+
+ "-define(SERVER, ?MODULE)." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Creates a gen_fsm process which calls Module:init/1 to" n
+ "%% initialize. To ensure a synchronized start-up procedure, this" n
+ "%% function does not return until Module:init/1 has returned." n
+ "%%" n
+ "%% @spec start_link() -> {ok, Pid} | ignore | {error, Error}" n
+ (erlang-skel-separator-end 2)
+ "start_link() ->" n>
+ "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% gen_fsm callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a gen_fsm is started using gen_fsm:start/[3,4] or" n
+ "%% gen_fsm:start_link/[3,4], this function is called by the new" n
+ "%% process to initialize." n
+ "%%" n
+ "%% @spec init(Args) -> {ok, StateName, State} |" n
+ "%% {ok, StateName, State, Timeout} |" n
+ "%% ignore |" n
+ "%% {stop, StopReason}" n
+ (erlang-skel-separator-end 2)
+ "init([]) ->" n>
+ "process_flag(trap_exit, true)," n>
+ "{ok, state_name, #state{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% There should be one instance of this function for each possible" n
+ "%% state name. Whenever a gen_fsm receives an event sent using" n
+ "%% gen_fsm:send_event/2, the instance of this function with the same" n
+ "%% name as the current state name StateName is called to handle" n
+ "%% the event. It is also called if a timeout occurs." n
+ "%%" n
+ "%% @spec state_name(Event, State) ->" n
+ "%% {next_state, NextStateName, NextState} |" n
+ "%% {next_state, NextStateName, NextState, Timeout} |" n
+ "%% {stop, Reason, NewState}" n
+ (erlang-skel-separator-end 2)
+ "state_name(_Event, State) ->" n>
+ "{next_state, state_name, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% There should be one instance of this function for each possible" n
+ "%% state name. Whenever a gen_fsm receives an event sent using" n
+ "%% gen_fsm:sync_send_event/[2,3], the instance of this function with" n
+ "%% the same name as the current state name StateName is called to" n
+ "%% handle the event." n
+ "%%" n
+ "%% @spec state_name(Event, From, State) ->" n
+ "%% {next_state, NextStateName, NextState} |"n
+ "%% {next_state, NextStateName, NextState, Timeout} |" n
+ "%% {reply, Reply, NextStateName, NextState} |" n
+ "%% {reply, Reply, NextStateName, NextState, Timeout} |" n
+ "%% {stop, Reason, NewState} |" n
+ "%% {stop, Reason, Reply, NewState}" n
+ (erlang-skel-separator-end 2)
+ "state_name(_Event, _From, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, state_name, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a gen_fsm receives an event sent using" n
+ "%% gen_fsm:send_all_state_event/2, this function is called to handle" n
+ "%% the event." n
+ "%%" n
+ "%% @spec handle_event(Event, StateName, State) ->" n
+ "%% {next_state, NextStateName, NextState} |" n
+ "%% {next_state, NextStateName, NextState, Timeout} |" n
+ "%% {stop, Reason, NewState}" n
+ (erlang-skel-separator-end 2)
+ "handle_event(_Event, StateName, State) ->" n>
+ "{next_state, StateName, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a gen_fsm receives an event sent using" n
+ "%% gen_fsm:sync_send_all_state_event/[2,3], this function is called" n
+ "%% to handle the event." n
+ "%%" n
+ "%% @spec handle_sync_event(Event, From, StateName, State) ->" n
+ "%% {next_state, NextStateName, NextState} |" n
+ "%% {next_state, NextStateName, NextState, Timeout} |" n
+ "%% {reply, Reply, NextStateName, NextState} |" n
+ "%% {reply, Reply, NextStateName, NextState, Timeout} |" n
+ "%% {stop, Reason, NewState} |" n
+ "%% {stop, Reason, Reply, NewState}" n
+ (erlang-skel-separator-end 2)
+ "handle_sync_event(_Event, _From, StateName, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, StateName, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by a gen_fsm when it receives any" n
+ "%% message other than a synchronous or asynchronous event" n
+ "%% (or a system message)." n
+ "%%" n
+ "%% @spec handle_info(Info,StateName,State)->" n
+ "%% {next_state, NextStateName, NextState} |" n
+ "%% {next_state, NextStateName, NextState, Timeout} |" n
+ "%% {stop, Reason, NewState}" n
+ (erlang-skel-separator-end 2)
+ "handle_info(_Info, StateName, State) ->" n>
+ "{next_state, StateName, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by a gen_fsm when it is about to" n
+ "%% terminate. It should be the opposite of Module:init/1 and do any" n
+ "%% necessary cleaning up. When it returns, the gen_fsm terminates with" n
+ "%% Reason. The return value is ignored." n
+ "%%" n
+ "%% @spec terminate(Reason, StateName, State) -> void()" n
+ (erlang-skel-separator-end 2)
+ "terminate(_Reason, _StateName, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ "%%" n
+ "%% @spec code_change(OldVsn, StateName, State, Extra) ->" n
+ "%% {ok, StateName, NewState}" n
+ (erlang-skel-separator-end 2)
+ "code_change(_OldVsn, StateName, State, _Extra) ->" n>
+ "{ok, StateName, State}." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a gen_fsm.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-gen-statem-StateName
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_statem)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n
+ n
+ "%% gen_statem callbacks" n
+ "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n
+ "-export([state_name/3])." n
+ n
+ "-define(SERVER, ?MODULE)." n
+ n
+ "-record(data, {})." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Creates a gen_statem process which calls Module:init/1 to" n
+ "%% initialize. To ensure a synchronized start-up procedure, this" n
+ "%% function does not return until Module:init/1 has returned." n
+ "%%" n
+ (erlang-skel-separator-end 2)
+ "-spec start_link() ->" n>
+ "{ok, Pid :: pid()} |" n>
+ "ignore |" n>
+ "{error, Error :: term()}." n
+ "start_link() ->" n>
+ "gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% gen_statem callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Define the callback_mode() for this callback module." n
+ (erlang-skel-separator-end 2)
+ "-spec callback_mode() -> gen_statem:callback_mode_result()." n
+ "callback_mode() -> state_functions." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n
+ "%% gen_statem:start_link/[3,4], this function is called by the new" n
+ "%% process to initialize." n
+ (erlang-skel-separator-end 2)
+ "-spec init(Args :: term()) ->" n>
+ "gen_statem:init_result(atom())." n
+ "init([]) ->" n>
+ "process_flag(trap_exit, true)," n>
+ "{ok, state_name, #data{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% There should be one function like this for each state name." n
+ "%% Whenever a gen_statem receives an event, the function " n
+ "%% with the name of the current state (StateName) " n
+ "%% is called to handle the event." n
+ (erlang-skel-separator-end 2)
+ "-spec state_name('enter'," n>
+ "OldState :: atom()," n>
+ "Data :: term()) ->" n>
+ "gen_statem:state_enter_result('state_name');" n>
+ "(gen_statem:event_type()," n>
+ "Msg :: term()," n>
+ "Data :: term()) ->" n>
+ "gen_statem:event_handler_result(atom())." n
+ ;;
+ "state_name({call,Caller}, _Msg, Data) ->" n>
+ "{next_state, state_name, Data, [{reply,Caller,ok}]}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by a gen_statem when it is about to" n
+ "%% terminate. It should be the opposite of Module:init/1 and do any" n
+ "%% necessary cleaning up. When it returns, the gen_statem terminates with" n
+ "%% Reason. The return value is ignored." n
+ (erlang-skel-separator-end 2)
+ "-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n>
+ "any()." n
+ "terminate(_Reason, _State, _Data) ->" n>
+ "void." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ (erlang-skel-separator-end 2)
+ "-spec code_change(" n>
+ "OldVsn :: term() | {down,term()}," n>
+ "State :: term(), Data :: term(), Extra :: term()) ->" n>
+ "{ok, NewState :: term(), NewData :: term()} |" n>
+ "(Reason :: term())." n
+ "code_change(_OldVsn, State, Data, _Extra) ->" n>
+ "{ok, State, Data}." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a gen_statem (StateName/3).
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-gen-statem-handle-event
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(gen_statem)." n n
+
+ "%% API" n
+ "-export([start_link/0])." n
+ n
+ "%% gen_statem callbacks" n
+ "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n
+ "-export([handle_event/4])." n
+ n
+ "-define(SERVER, ?MODULE)." n
+ n
+ "-record(data, {})." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Creates a gen_statem process which calls Module:init/1 to" n
+ "%% initialize. To ensure a synchronized start-up procedure, this" n
+ "%% function does not return until Module:init/1 has returned." n
+ "%%" n
+ (erlang-skel-separator-end 2)
+ "-spec start_link() ->" n>
+ "{ok, Pid :: pid()} |" n>
+ "ignore |" n>
+ "{error, Error :: term()}." n
+ "start_link() ->" n>
+ "gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% gen_statem callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Define the callback_mode() for this callback module." n
+ (erlang-skel-separator-end 2)
+ "-spec callback_mode() -> gen_statem:callback_mode_result()." n
+ "callback_mode() -> handle_event_function." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n
+ "%% gen_statem:start_link/[3,4], this function is called by the new" n
+ "%% process to initialize." n
+ (erlang-skel-separator-end 2)
+ "-spec init(Args :: term()) ->" n>
+ "gen_statem:init_result(term())." n
+ "init([]) ->" n>
+ "process_flag(trap_exit, true)," n>
+ "{ok, state_name, #data{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called for every event a gen_statem receives." n
+ (erlang-skel-separator-end 2)
+ "-spec handle_event('enter'," n>
+ "OldState :: term()," n>
+ "State :: term()," n>
+ "Data :: term()) ->" n>
+ "gen_statem:state_enter_result(term());" n>
+ "(gen_statem:event_type()," n>
+ "Msg :: term()," n>
+ "State :: term()," n>
+ "Data :: term()) ->" n>
+ "gen_statem:event_handler_result(term())." n
+ ;;
+ "handle_event({call,From}, _Msg, State, Data) ->" n>
+ "{next_state, State, Data, [{reply,From,ok}]}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by a gen_statem when it is about to" n
+ "%% terminate. It should be the opposite of Module:init/1 and do any" n
+ "%% necessary cleaning up. When it returns, the gen_statem terminates with" n
+ "%% Reason. The return value is ignored." n
+ (erlang-skel-separator-end 2)
+ "-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n>
+ "any()." n
+ "terminate(_Reason, _State, _Data) ->" n>
+ "void." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ (erlang-skel-separator-end 2)
+ "-spec code_change(" n>
+ "OldVsn :: term() | {down,term()}," n>
+ "State :: term(), Data :: term(), Extra :: term()) ->" n>
+ "{ok, NewState :: term(), NewData :: term()} |" n>
+ "(Reason :: term())." n
+ "code_change(_OldVsn, State, Data, _Extra) ->" n>
+ "{ok, State, Data}." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a gen_statem (handle_event/4).
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-wx-object
+ '((erlang-skel-include erlang-skel-large-header)
+ "-behaviour(wx_object)." n n
+
+ "-include_lib(\"wx/include/wx.hrl\")." n n
+
+ "%% API" n
+ "-export([start_link/0])." n n
+
+ "%% wx_object callbacks" n
+ "-export([init/1, handle_call/3, handle_cast/2, "
+ "handle_info/2," n>
+ "handle_event/2, terminate/2, code_change/3])." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Starts the server" n
+ "%%" n
+ "%% @spec start_link() -> wxWindow()" n
+ (erlang-skel-separator-end 2)
+ "start_link() ->" n>
+ "wx_object:start_link(?MODULE, [], [])." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% wx_object callbacks" n
+ (erlang-skel-double-separator-end 3)
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Initializes the server" n
+ "%%" n
+ "%% @spec init(Args) -> {wxWindow(), State} |" n
+ "%% {wxWindow(), State, Timeout} |" n
+ "%% ignore |" n
+ "%% {stop, Reason}" n
+ (erlang-skel-separator-end 2)
+ "init([]) ->" n>
+ "wx:new()," n>
+ "Frame = wxFrame:new()," n>
+ "{Frame, #state{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling events" n
+ "%%" n
+ "%% @spec handle_event(wx{}, State) ->" n
+ "%% {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, State}" n
+ (erlang-skel-separator-end 2)
+ "handle_event(#wx{}, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling call messages" n
+ "%%" n
+ "%% @spec handle_call(Request, From, State) ->" n
+ "%% {reply, Reply, State} |" n
+ "%% {reply, Reply, State, Timeout} |" n
+ "%% {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, Reply, State} |" n
+ "%% {stop, Reason, State}" n
+ (erlang-skel-separator-end 2)
+ "handle_call(_Request, _From, State) ->" n>
+ "Reply = ok," n>
+ "{reply, Reply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling cast messages" n
+ "%%" n
+ "%% @spec handle_cast(Msg, State) -> {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, State}" n
+ (erlang-skel-separator-end 2)
+ "handle_cast(_Msg, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Handling all non call/cast messages" n
+ "%%" n
+ "%% @spec handle_info(Info, State) -> {noreply, State} |" n
+ "%% {noreply, State, Timeout} |" n
+ "%% {stop, Reason, State}" n
+ (erlang-skel-separator-end 2)
+ "handle_info(_Info, State) ->" n>
+ "{noreply, State}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% This function is called by a wx_object when it is about to" n
+ "%% terminate. It should be the opposite of Module:init/1 and do any" n
+ "%% necessary cleaning up. When it returns, the wx_object terminates" n
+ "%% with Reason. The return value is ignored." n
+ "%%" n
+ "%% @spec terminate(Reason, State) -> void()" n
+ (erlang-skel-separator-end 2)
+ "terminate(_Reason, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ "%%" n
+ "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n
+ (erlang-skel-separator-end 2)
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a generic server.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-lib
+ '((erlang-skel-include erlang-skel-large-header)
+
+ "%% API" n
+ "-export([])." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% API" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% @spec" n
+ (erlang-skel-separator-end 2)
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-corba-callback
+ '((erlang-skel-include erlang-skel-large-header)
+ "%% Include files" n n
+
+ "%% API" n
+ "-export([])." n n
+
+ "%% Corba callbacks" n
+ "-export([init/1, terminate/2, code_change/3])." n n
+
+ "-record(state, {})." n n
+
+ (erlang-skel-double-separator-start 3)
+ "%%% Corba callbacks" n
+ (erlang-skel-double-separator-end 3) n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Initializes the server" n
+ "%%" n
+ "%% @spec init(Args) -> {ok, State} |" n
+ "%% {ok, State, Timeout} |" n
+ "%% ignore |" n
+ "%% {stop, Reason}" n
+ (erlang-skel-separator-end 2)
+ "init([]) ->" n>
+ "{ok, #state{}}." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Shutdown the server" n
+ "%%" n
+ "%% @spec terminate(Reason, State) -> void()" n
+ (erlang-skel-separator-end 2)
+ "terminate(_Reason, _State) ->" n>
+ "ok." n
+ n
+ (erlang-skel-separator-start 2)
+ "%% @private" n
+ "%% @doc" n
+ "%% Convert process state when code is changed" n
+ "%%" n
+ "%% @spec code_change(OldVsn, State, Extra) -> {ok, NewState}" n
+ (erlang-skel-separator-end 2)
+ "code_change(_OldVsn, State, _Extra) ->" n>
+ "{ok, State}." n
+ n
+ (erlang-skel-double-separator-start 3)
+ "%%% Internal functions" n
+ (erlang-skel-double-separator-end 3)
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-ts-test-suite
+ '((erlang-skel-include erlang-skel-large-header)
+ "%% Note: This directive should only be used in test suites." n
+ "-compile(export_all)." n n
+
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
+
+ (erlang-skel-separator-start 2)
+ "%% TEST SERVER CALLBACK FUNCTIONS" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-separator-start 2)
+ "%%" n
+ "%% @doc" n
+ "%% Initialization before the suite." n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the suite." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ "%%" n
+ "%% @spec init_per_suite(Config) -> Config" n
+ (erlang-skel-separator-end 2)
+ "init_per_suite(Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Cleanup after the suite." n
+ "%% Config - [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% @spec end_per_suite(Config) -> _" n
+ (erlang-skel-separator-end 2)
+ "end_per_suite(_Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Initialization before each test case" n
+ "%%" n
+ "%% TestCase - atom()" n
+ "%% Name of the test case that is about to be run." n
+ "%% Config - [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ "%%" n
+ "%% @spec init_per_testcase(TestCase, Config) -> Config" n
+ (erlang-skel-separator-end 2)
+ "init_per_testcase(_TestCase, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Cleanup after each test case" n
+ "%%" n
+ "%% TestCase = atom()" n
+ "%% Name of the test case that is finished." n
+ "%% Config = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% @spec end_per_testcase(TestCase, Config) -> _" n
+ (erlang-skel-separator-end 2)
+ "end_per_testcase(_TestCase, _Config) ->" n >
+ "ok."n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Returns a description of the test suite when" n
+ "%% Clause == doc, and a test specification (list" n
+ "%% of the conf and test cases in the suite) when" n
+ "%% Clause == suite." n
+ "%% Returns a list of all test cases in this test suite" n
+ "%%" n
+ "%% Clause = doc | suite" n
+ "%% Indicates expected return value." n
+ "%% Descr = [string()] | []" n
+ "%% String that describes the test suite." n
+ "%% Spec = [TestCase]" n
+ "%% A test specification." n
+ "%% TestCase = ConfCase | atom()" n
+ "%% Configuration case, or the name of a test case function." n
+ "%% ConfCase = {conf,Init,Spec,End} |" n
+ "%% {conf,Properties,Init,Spec,End}" n
+ "%% Init = End = {Mod,Func} | Func" n
+ "%% Initialization and cleanup function." n
+ "%% Mod = Func = atom()" n
+ "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
+ "%% Execution properties of the test cases (may be combined)." n
+ "%% Shuffle = shuffle | {shuffle,Seed}" n
+ "%% To get cases executed in random order." n
+ "%% Seed = {integer(),integer(),integer()}" n
+ "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
+ "%% repeat_until_any_ok | repeat_until_any_fail" n
+ "%% To get execution of cases repeated." n
+ "%% N = integer() | forever" n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test suite." n
+ "%%" n
+ "%% @spec all(Clause) -> TestCases" n
+ (erlang-skel-separator-end 2)
+ "all(doc) ->" n >
+ "[\"Describe the main purpose of this suite\"];" n n
+ "all(suite) -> " n >
+ "[a_test_case]." n n
+ n
+ (erlang-skel-separator-start 2)
+ "%% TEST CASES" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Test case function. Returns a description of the test" n
+ "%% case (doc), then returns a test specification (suite)," n
+ "%% or performs the actual test (Config)." n
+ "%%" n
+ "%% Arg = doc | suite | Config" n
+ "%% Indicates expected behaviour and return value." n
+ "%% Config = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Descr = [string()] | []" n
+ "%% String that describes the test case." n
+ "%% Spec = [tuple()] | []" n
+ "%% A test specification, see all/1." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%%" n
+ "%% @spec TestCase(Arg) -> Descr | Spec | ok | exit() | {skip,Reason}" n
+
+ (erlang-skel-separator-end 2)
+ "a_test_case(doc) -> " n >
+ "[\"Describe the main purpose of this test case\"];" n n
+ "a_test_case(suite) -> " n >
+ "[];" n n
+ "a_test_case(Config) when is_list(Config) -> " n >
+ "ok." n
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-ct-test-suite-s
+ '((erlang-skel-include erlang-skel-large-header)
+ "-compile(export_all)." n n
+
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec suite() -> Info" n
+ "%% Info = [tuple()]" n
+ (erlang-skel-separator-end 2)
+ "suite() ->" n >
+ "[{timetrap,{seconds,30}}]." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec init_per_suite(Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator-end 2)
+ "init_per_suite(Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec end_per_suite(Config0) -> term() | {save_config,Config1}" n
+ "%% Config0 = Config1 = [tuple()]" n
+ (erlang-skel-separator-end 2)
+ "end_per_suite(_Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec init_per_group(GroupName, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%% GroupName = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator-end 2)
+ "init_per_group(_GroupName, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec end_per_group(GroupName, Config0) ->" n
+ "%% term() | {save_config,Config1}" n
+ "%% GroupName = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ (erlang-skel-separator-end 2)
+ "end_per_group(_GroupName, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec init_per_testcase(TestCase, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ "%% TestCase = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator-end 2)
+ "init_per_testcase(_TestCase, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec end_per_testcase(TestCase, Config0) ->" n
+ "%% term() | {save_config,Config1} | {fail,Reason}" n
+ "%% TestCase = atom()" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ (erlang-skel-separator-end 2)
+ "end_per_testcase(_TestCase, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec groups() -> [Group]" n
+ "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
+ "%% GroupName = atom()" n
+ "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
+ "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
+ "%% TestCase = atom()" n
+ "%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}}" n
+ "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
+ "%% repeat_until_any_ok | repeat_until_any_fail" n
+ "%% N = integer() | forever" n
+ (erlang-skel-separator-end 2)
+ "groups() ->" n >
+ "[]." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec all() -> GroupsAndTestCases | {skip,Reason}" n
+ "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
+ "%% GroupName = atom()" n
+ "%% TestCase = atom()" n
+ "%% Reason = term()" n
+ (erlang-skel-separator-end 2)
+ "all() -> " n >
+ "[my_test_case]." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec TestCase() -> Info" n
+ "%% Info = [tuple()]" n
+ (erlang-skel-separator-end 2)
+ "my_test_case() -> " n >
+ "[]." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @spec TestCase(Config0) ->" n
+ "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
+ "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% Reason = term()" n
+ "%% Comment = term()" n
+ (erlang-skel-separator-end 2)
+ "my_test_case(_Config) -> " n >
+ "ok." n
+ )
+ "*The template of a library module.
+Please see the function `tempo-define-template'.")
+
+
+(defvar erlang-skel-ct-test-suite-l
+ '((erlang-skel-include erlang-skel-large-header)
+ "%% Note: This directive should only be used in test suites." n
+ "-compile(export_all)." n n
+
+ "-include_lib(\"common_test/include/ct.hrl\")." n n
+
+ (erlang-skel-separator-start 2)
+ "%% COMMON TEST CALLBACK FUNCTIONS" n
+ (erlang-skel-separator 2)
+ n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Returns list of tuples to set default properties" n
+ "%% for the suite." n
+ "%%" n
+ "%% Function: suite() -> Info" n
+ "%%" n
+ "%% Info = [tuple()]" n
+ "%% List of key/value pairs." n
+ "%%" n
+ "%% Note: The suite/0 function is only meant to be used to return" n
+ "%% default data values, not perform any other operations." n
+ "%%" n
+ "%% @spec suite() -> Info" n
+ (erlang-skel-separator-end 2)
+ "suite() ->" n >
+ "[{timetrap,{minutes,10}}]." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Initialization before the whole suite" n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the suite." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ "%%" n
+ "%% @spec init_per_suite(Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ (erlang-skel-separator-end 2)
+ "init_per_suite(Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Cleanup after the whole suite" n
+ "%%" n
+ "%% Config - [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% @spec end_per_suite(Config) -> _" n
+ (erlang-skel-separator-end 2)
+ "end_per_suite(_Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Initialization before each test case group." n
+ "%%" n
+ "%% GroupName = atom()" n
+ "%% Name of the test case group that is about to run." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding configuration data for the group." n
+ "%% Reason = term()" n
+ "%% The reason for skipping all test cases and subgroups in the group." n
+ "%%" n
+ "%% @spec init_per_group(GroupName, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ (erlang-skel-separator-end 2)
+ "init_per_group(_GroupName, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Cleanup after each test case group." n
+ "%%" n
+ "%% GroupName = atom()" n
+ "%% Name of the test case group that is finished." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding configuration data for the group." n
+ "%%" n
+ "%% @spec end_per_group(GroupName, Config0) ->" n
+ "%% term() | {save_config,Config1}" n
+ (erlang-skel-separator-end 2)
+ "end_per_group(_GroupName, _Config) ->" n >
+ "ok." n n
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Initialization before each test case" n
+ "%%" n
+ "%% TestCase - atom()" n
+ "%% Name of the test case that is about to be run." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%%" n
+ "%% Note: This function is free to add any key/value pairs to the Config" n
+ "%% variable, but should NOT alter/remove any existing entries." n
+ "%%" n
+ "%% @spec init_per_testcase(TestCase, Config0) ->" n
+ "%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}" n
+ (erlang-skel-separator-end 2)
+ "init_per_testcase(_TestCase, Config) ->" n >
+ "Config." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Cleanup after each test case" n
+ "%%" n
+ "%% TestCase - atom()" n
+ "%% Name of the test case that is finished." n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%%" n
+ "%% @spec end_per_testcase(TestCase, Config0) ->" n
+ "%% term() | {save_config,Config1} | {fail,Reason}" n
+ (erlang-skel-separator-end 2)
+ "end_per_testcase(_TestCase, _Config) ->" n >
+ "ok." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Returns a list of test case group definitions." n
+ "%%" n
+ "%% Group = {GroupName,Properties,GroupsAndTestCases}" n
+ "%% GroupName = atom()" n
+ "%% The name of the group." n
+ "%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}]" n
+ "%% Group properties that may be combined." n
+ "%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase]" n
+ "%% TestCase = atom()" n
+ "%% The name of a test case." n
+ "%% Shuffle = shuffle | {shuffle,Seed}" n
+ "%% To get cases executed in random order." n
+ "%% Seed = {integer(),integer(),integer()}" n
+ "%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |" n
+ "%% repeat_until_any_ok | repeat_until_any_fail" n
+ "%% To get execution of cases repeated." n
+ "%% N = integer() | forever" n
+ "%%" n
+ "%% @spec: groups() -> [Group]" n
+ (erlang-skel-separator-end 2)
+ "groups() ->" n >
+ "[]." n n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc" n
+ "%% Returns the list of groups and test cases that" n
+ "%% are to be executed." n
+ "%%" n
+ "%% GroupsAndTestCases = [{group,GroupName} | TestCase]" n
+ "%% GroupName = atom()" n
+ "%% Name of a test case group." n
+ "%% TestCase = atom()" n
+ "%% Name of a test case." n
+ "%% Reason = term()" n
+ "%% The reason for skipping all groups and test cases." n
+ "%%" n
+ "%% @spec all() -> GroupsAndTestCases | {skip,Reason}" n
+ (erlang-skel-separator-end 2)
+ "all() -> " n >
+ "[my_test_case]." n n
+
+ n
+ (erlang-skel-separator-start 2)
+ "%% TEST CASES" n
+ (erlang-skel-separator 2)
+ n
+
+ (erlang-skel-separator-start 2)
+ "%% @doc " n
+ "%% Test case info function - returns list of tuples to set" n
+ "%% properties for the test case." n
+ "%%" n
+ "%% Info = [tuple()]" n
+ "%% List of key/value pairs." n
+ "%%" n
+ "%% Note: This function is only meant to be used to return a list of" n
+ "%% values, not perform any other operations." n
+ "%%" n
+ "%% @spec TestCase() -> Info " n
+ (erlang-skel-separator-end 2)
+ "my_test_case() -> " n >
+ "[]." n n
+
+ (erlang-skel-separator 2)
+ "%% @doc Test case function. (The name of it must be specified in" n
+ "%% the all/0 list or in a test case group for the test case" n
+ "%% to be executed)." n
+ "%%" n
+ "%% Config0 = Config1 = [tuple()]" n
+ "%% A list of key/value pairs, holding the test case configuration." n
+ "%% Reason = term()" n
+ "%% The reason for skipping the test case." n
+ "%% Comment = term()" n
+ "%% A comment about the test case that will be printed in the html log." n
+ "%%" n
+ "%% @spec TestCase(Config0) ->" n
+ "%% ok | exit() | {skip,Reason} | {comment,Comment} |" n
+ "%% {save_config,Config1} | {skip_and_save,Reason,Config1}" n
+ (erlang-skel-separator-end 2)
+ "my_test_case(_Config) -> " n >
+ "ok." n
+
+ )
+ "*The template of a library module.
+ Please see the function `tempo-define-template'.")
+
+(defvar erlang-skel-ct-hook
+ '((erlang-skel-include erlang-skel-normal-header)
+ "%% Mandatory callbacks" n
+ "-export([init/2])." n
+ n
+ "%% Optional callbacks" n
+ "-export([id/1])." n
+ n
+ "-export([pre_init_per_suite/3])." n
+ "-export([post_init_per_suite/4])." n
+ n
+ "-export([pre_end_per_suite/3])." n
+ "-export([post_end_per_suite/4])." n
+ n
+ "-export([pre_init_per_group/4])." n
+ "-export([post_init_per_group/5])." n
+ n
+ "-export([pre_end_per_group/4])." n
+ "-export([post_end_per_group/5])." n
+ n
+ "-export([pre_init_per_testcase/4])." n
+ "-export([post_init_per_testcase/5])." n
+ n
+ "-export([pre_end_per_testcase/4])." n
+ "-export([post_end_per_testcase/5])." n
+ n
+ "-export([on_tc_fail/4])." n
+ "-export([on_tc_skip/4])." n
+ n
+ "-export([terminate/1])." n
+ n
+ "%% The hook state is threaded through all callbacks," n
+ "%% but can be anything the hook needs, replace as desired." n
+ "-record(state, { cases=0, suites=0, groups=0, skips=0, fails=0 })." n
+ n
+ "%% Return a unique id for this CTH." n
+ "id(Opts) ->" n
+ " %% A reference is the default implementation, this can be removed" n
+ " %% or some value can be read from Opts instead." n
+ " erlang:make_ref()." n
+ n
+ "%% Always called before any other callback function, once per installed hook." n
+ "init(Id, Opts) ->" n
+ " {ok, #state{}}." n
+ n
+ "pre_init_per_suite(Suite, Config, State) ->" n
+ " {Config, State}." n
+ n
+ "post_init_per_suite(Suite, Config, Return, State) ->" n
+ " {Return, State}." n
+ n
+ "pre_end_per_suite(Suite, Config, State) ->" n
+ " {Config, State}." n
+ n
+ "post_end_per_suite(Suite, Config, Return, State) ->" n
+ " {Return, State#state{suites = State#state.suites + 1}}." n
+ n
+ "pre_init_per_group(Suite, Group, Config, State) ->" n
+ " {Config, State}." n
+ n
+ "post_init_per_group(Suite, Group, Config, Return, State) ->" n
+ " {Return, State}." n
+ n
+ "pre_end_per_group(Suite, Group, Config, State) ->" n
+ " {Config, State}." n
+ n
+ "post_end_per_group(Suite, Group, Config, Return, State) ->" n
+ " {Return, State#state{groups = State#state.groups + 1}}." n
+ n
+ "pre_init_per_testcase(Suite, TC, Config, State) ->" n
+ " {Config, State}." n
+ n
+ "%% Called after each init_per_testcase (immediately before the test case)." n
+ "post_init_per_testcase(Suite, TC, Config, Return, State) ->" n
+ " {Return, State}." n
+ n
+ "%% Called before each end_per_testcase (immediately after the test case)." n
+ "pre_end_per_testcase(Suite, TC, Config, State) ->" n
+ " {Config, State}." n
+ n
+ "post_end_per_testcase(Suite, TC, Config, Return, State) ->" n
+ " {Return, State#state{cases = State#state.cases + 1}}." n
+ n
+ "%% Called after post_init_per_suite, post_end_per_suite, post_init_per_group," n
+ "%% post_end_per_group and post_end_per_testcase if the suite, group or test case failed." n
+ "on_tc_fail(Suite, TC, Reason, State) ->" n
+ " State#state{fails = State#state.fails + 1}." n
+ n
+ "%% Called when a test case is skipped by either user action" n
+ "%% or due to an init function failing." n
+ "on_tc_skip(Suite, TC, Reason, State) ->" n
+ " State#state{skips = State#state.skips + 1}." n
+ n
+ "%% Called when the scope of the CTH is done" n
+ "terminate(State) ->" n
+ " logger:notice(\"~s is done: ~p~n\", [?MODULE, State])." n
+ n
+ )
+ "*The template of a library module.
+ Please see the function `tempo-define-template'.")
+
+;; Skeleton code:
+
+;; This code is based on the package `tempo' which is part of modern
+;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
+
+(defun erlang-skel-init ()
+ "Generate the skeleton functions and menu items.
+The variable `erlang-skel' contains the name and descriptions of
+all skeletons.
+
+The skeleton routines are based on the `tempo' package. Should this
+package not be present, this function does nothing."
+ (interactive)
+ (condition-case nil
+ (require 'tempo)
+ (error t))
+ (if (featurep 'tempo)
+ (let ((skel erlang-skel)
+ (menu '()))
+ (while skel
+ (cond ((null (car skel))
+ (setq menu (cons nil menu)))
+ (t
+ (funcall (symbol-function 'tempo-define-template)
+ (concat "erlang-" (nth 1 (car skel)))
+ ;; The tempo template used contains an `include'
+ ;; function call only, hence changes to the
+ ;; variables describing the templates take effect
+ ;; immdiately.
+ (list (list 'erlang-skel-include (nth 2 (car skel))))
+ (nth 1 (car skel)))
+ (setq menu (cons (erlang-skel-make-menu-item
+ (car skel)) menu))))
+ (setq skel (cdr skel)))
+ (setq erlang-menu-skel-items
+ (list nil (list "Skeletons" (nreverse menu))))
+ (setq erlang-menu-items
+ (erlang-menu-add-above 'erlang-menu-skel-items
+ 'erlang-menu-version-items
+ erlang-menu-items))
+ (erlang-menu-init))))
+
+(defun erlang-skel-make-menu-item (skel)
+ (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel)))))
+ (cond ((null (nth 3 skel))
+ (list (car skel) func))
+ (t
+ (list (car skel)
+ (list 'lambda '()
+ '(interactive)
+ (list 'funcall
+ (list 'quote (nth 3 skel))
+ (list 'quote func))))))))
+
+;; Functions designed to be added to the skeleton menu.
+;; (Not normally used)
+(defun erlang-skel-insert (func)
+ "Insert skeleton generated by FUNC and goto first tempo mark."
+ (save-excursion (funcall func))
+ (funcall (symbol-function 'tempo-forward-mark)))
+
+(defun erlang-skel-header (func)
+ "Insert the header generated by FUNC at the beginning of the buffer."
+ (goto-char (point-min))
+ (save-excursion (funcall func))
+ (funcall (symbol-function 'tempo-forward-mark)))
+
+
+;; Functions used inside the skeleton descriptions.
+(defun erlang-skel-skip-blank ()
+ (skip-chars-backward " \t")
+ nil)
+
+(defun erlang-skel-include (&rest args)
+ "Include a template inside another template.
+
+Example of use, assuming that `erlang-skel-func' is defined:
+
+ (defvar foo-skeleton '(\"%%% New function:\"
+ (erlang-skel-include erlang-skel-func)))
+
+Technically, this function returns the `tempo' attribute`(l ...)' which
+can contain other `tempo' attributes. Please see the function
+`tempo-define-template' for a description of the `(l ...)' attribute."
+ (let ((res '())
+ entry)
+ (while args
+ (setq entry (car args))
+ (while entry
+ (setq res (cons (car entry) res))
+ (setq entry (cdr entry)))
+ (setq args (cdr args)))
+ (cons 'l (nreverse res))))
+
+(defun erlang-skel-separator (&optional percent)
+ "Return a comment separator."
+ (let ((percent (or percent 3)))
+ (concat (make-string percent ?%)
+ (make-string (- 70 percent) ?-)
+ "\n")))
+
+(defun erlang-skel-separator-start (&optional percent)
+ "Return a comment separator or an empty string if separators
+are configured off."
+ (if erlang-skel-use-separators
+ (erlang-skel-separator percent)
+ ""))
+
+(defun erlang-skel-separator-end (&optional percent)
+ "Return a comment separator to end a function comment block or an
+empty string if separators are configured off."
+ (if erlang-skel-use-separators
+ (concat "%% @end\n" (erlang-skel-separator percent))
+ ""))
+
+(defun erlang-skel-double-separator (&optional percent)
+ "Return a double line (equals sign) comment separator."
+ (let ((percent (or percent 3)))
+ (concat (make-string percent ?%)
+ (make-string (- 70 percent) ?=)
+ "\n")))
+
+(defun erlang-skel-double-separator-start (&optional percent)
+ "Return a double separator or a newline if separators are configured off."
+ (if erlang-skel-use-separators
+ (erlang-skel-double-separator percent)
+ "\n"))
+
+(defun erlang-skel-double-separator-end (&optional percent)
+ "Return a double separator or an empty string if separators are
+configured off."
+ (if erlang-skel-use-separators
+ (erlang-skel-double-separator percent)
+ ""))
+
+(defun erlang-skel-dd-mmm-yyyy ()
+ "Return the current date as a string in \"DD Mon YYYY\" form.
+The first character of DD is space if the value is less than 10."
+ (let ((date (current-time-string)))
+ (format "%2d %s %s"
+ (string-to-number (substring date 8 10))
+ (substring date 4 7)
+ (substring date -4))))
+
+(defun erlang-skel-get-function-name ()
+ (save-excursion
+ (erlang-beginning-of-function -1)
+ (erlang-get-function-name)))
+
+(defun erlang-skel-get-function-args ()
+ (save-excursion
+ (erlang-beginning-of-function -1)
+ (erlang-get-function-arguments)))
+
+;; Local variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; erlang-skels.el ends here
--- /dev/null
+;; erlang-start.el --- Load this file to initialize the Erlang package.
+
+;; Copyright (C) 1998 Ericsson Telecom AB
+
+;; Author: Anders Lindgren
+;; Version: 2.3
+;; Keywords: erlang, languages, processes
+;; Created: 1996-09-18
+;; Date: 1998-03-16
+
+;;; Commentary:
+
+;; Introduction:
+;; ------------
+;;
+;; This package provides support for the programming language Erlang.
+;; The package provides an editing mode with lots of bells and
+;; whistles, compilation support, and it makes it possible for the
+;; user to start Erlang shells that run inside Emacs.
+;;
+;; See the Erlang distribution for full documentation of this package.
+
+;; Installation:
+;; ------------
+;;
+;; Place this file in Emacs load path, byte-compile it, and add the
+;; following line to the appropriate init file:
+;;
+;; (require 'erlang-start)
+;;
+;; The full documentation contains much more extensive description of
+;; the installation procedure.
+
+;; Reporting Bugs:
+;; --------------
+;;
+;; Please send bug reports to the following email address:
+;; supportNOSPAMerlang.ericsson.se
+;;
+;; Please state as exactly as possible:
+;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
+;; and of any other relevant software.
+;; - What the expected result was.
+;; - What you did, preferably in a repeatable step-by-step form.
+;; - A description of the unexpected result.
+;; - Relevant pieces of Erlang code causing the problem.
+;; - Personal Emacs customisations, if any.
+;;
+;; Should the Emacs generate an error, please set the emacs variable
+;; `debug-on-error' to `t'. Repeat the error and enclose the debug
+;; information in your bug-report.
+;;
+;; To set the variable you can use the following command:
+;; M-x set-variable RET debug-on-error RET t RET
+
+;;; Code:
+
+;;
+;; Declare functions in "erlang.el".
+;;
+
+(autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t)
+(autoload 'erlang-version "erlang"
+ "Return the current version of Erlang mode." t)
+(autoload 'erlang-shell "erlang" "Start a new Erlang shell." t)
+(autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
+
+(autoload 'erlang-compile "erlang"
+ "Compile Erlang module in current buffer." t)
+
+(autoload 'erlang-man-module "erlang"
+ "Find manual page for MODULE." t)
+(autoload 'erlang-man-function "erlang"
+ "Find manual page for NAME, where NAME is module:function." t)
+
+(autoload 'erlang-find-tag "erlang"
+ "Like `find-tag'. Capable of retrieving Erlang modules.")
+(autoload 'erlang-find-tag-other-window "erlang"
+ "Like `find-tag-other-window'. Capable of retrieving Erlang modules.")
+
+;;
+;; Declare functions in "erlang-edoc.el".
+;;
+
+(autoload 'erlang-edoc-mode "erlang-edoc" "Toggle Erlang-Edoc mode on or off." t)
+
+;;
+;; Declare functions in "erldoc.el".
+;;
+
+(autoload 'erldoc-browse "erldoc" "\n\n(fn MFA)" t nil)
+(autoload 'erldoc-browse-topic "erldoc" "\n\n(fn TOPIC)" t nil)
+(autoload 'erldoc-apropos "erldoc" "\n\n(fn PATTERN)" t nil)
+(autoload 'erldoc-eldoc-function "erldoc" "\
+A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil)
+
+;;
+;; Associate files extensions ".erl" and ".hrl" with Erlang mode.
+;;
+
+;;;###autoload
+(let ((a '("\\.erl\\'" . erlang-mode))
+ (b '("\\.hrl\\'" . erlang-mode)))
+ (or (assoc (car a) auto-mode-alist)
+ (setq auto-mode-alist (cons a auto-mode-alist)))
+ (or (assoc (car b) auto-mode-alist)
+ (setq auto-mode-alist (cons b auto-mode-alist))))
+
+;;
+;; Associate files using interpreter "escript" with Erlang mode.
+;;
+
+;;;###autoload
+(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
+
+;;
+;; Ignore files ending in ".jam", ".vee", and ".beam" when performing
+;; file completion and in dired omit mode.
+;;
+
+;;;###autoload
+(let ((erl-ext '(".jam" ".vee" ".beam")))
+ (while erl-ext
+ (add-to-list 'completion-ignored-extensions (car erl-ext))
+ (when (boundp 'dired-omit-extensions)
+ (add-to-list 'dired-omit-extensions (car erl-ext)))
+ (setq erl-ext (cdr erl-ext))))
+
+
+;;
+;; The end.
+;;
+
+(provide 'erlang-start)
+
+;; Local variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;; erlang-start.el ends here.
--- /dev/null
+;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
+
+;;; Unit tests for erlang.el.
+
+;; Author: Johan Claesson
+;; Created: 2016-05-07
+;; Keywords: erlang, languages
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2016-2021. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+
+
+;;; Commentary:
+
+;; This library require GNU Emacs 25 or later.
+;;
+;; There are three ways to run the erlang emacs unit tests.
+;;
+;; 1. Within a running emacs process. Load this file. Then to run
+;; all defined test cases:
+;;
+;; M-x ert RET t RET
+;;
+;; To run only the erlang test cases:
+;;
+;; M-x ert RET "^erlang" RET
+;;
+;;
+;; 2. In a new stand-alone emacs process. This process exits
+;; when it executed the tests. For example:
+;;
+;; emacs -Q -batch -L . -l erlang.el -l erlang-test.el \
+;; -f ert-run-tests-batch-and-exit
+;;
+;; The -L option adds a directory to the load-path. It should be the
+;; directory containing erlang.el and erlang-test.el.
+;;
+;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and
+;; tests_compiled/1 in this suite are using the second method. One
+;; way to run this suite is with the ct_run tool, for example like the
+;; following when standing at the OTP repo top directory:
+;;
+;; ct_run -suite lib/tools/test/emacs_SUITE
+;;
+;; Note that this creates a lot of html log files in the current
+;; directory.
+
+;;; Code:
+
+(require 'ert)
+(require 'erlang)
+
+(defvar erlang-test-code
+ '((nil . "-module(erlang_test).")
+ (nil . "-import(lists, [map/2]).")
+ (nil . "-compile(export_all).")
+ ("SYMBOL" . "-define(SYMBOL, value).")
+ ("MACRO" . "-define(MACRO(X), X + X).")
+ ("struct" . "-record(struct, {until,maps,are,everywhere}).")
+ ("function" . "function() -> #struct{}."))
+ "Alist of erlang test code.
+Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME
+is nil there is no definitions in the ERLANG_CODE. The
+ERLANG_CODE is a single line of erlang code. These lines will be
+concatenated to form an erlang file to test on.")
+
+
+(ert-deftest erlang-test-tags ()
+ (let* ((dir (make-temp-file "erlang-test" t))
+ (erlang-file (expand-file-name "erlang_test.erl" dir))
+ (tags-file (expand-file-name "TAGS" dir))
+ (old-tags-file-name (default-value 'tags-file-name))
+ (old-tags-table-list (default-value 'tags-table-list))
+ tags-file-name
+ tags-table-list
+ tags-table-set-list
+ tags-add-tables
+ tags-completion-table
+ erlang-buffer
+ erlang-mode-hook
+ prog-mode-hook
+ erlang-shell-mode-hook)
+ (unwind-protect
+ (progn
+ (setq-default tags-file-name nil)
+ (setq-default tags-table-list nil)
+ (erlang-test-create-erlang-file erlang-file)
+ (erlang-test-compile-tags erlang-file tags-file)
+ (setq erlang-buffer (find-file-noselect erlang-file))
+ (if (< emacs-major-version 26)
+ (progn
+ (with-current-buffer erlang-buffer
+ (setq-local tags-file-name tags-file))
+ ;; Setting global tags-file-name is a workaround for
+ ;; GNU Emacs bug#23164.
+ (setq tags-file-name tags-file))
+ (visit-tags-table tags-file t))
+ (erlang-test-complete-at-point tags-file)
+ (erlang-test-completion-table)
+ (erlang-test-xref-find-definitions erlang-file erlang-buffer))
+ (when (buffer-live-p erlang-buffer)
+ (kill-buffer erlang-buffer))
+ (let ((tags-buffer (find-buffer-visiting tags-file)))
+ (when (buffer-live-p tags-buffer)
+ (kill-buffer tags-buffer)))
+ (when (file-exists-p dir)
+ (delete-directory dir t))
+ (setq-default tags-file-name old-tags-file-name)
+ (setq-default tags-table-list old-tags-table-list))))
+
+(defun erlang-test-create-erlang-file (erlang-file)
+ (with-temp-file erlang-file
+ (cl-loop for (_ . code) in erlang-test-code
+ do (insert code "\n"))))
+
+(defun erlang-test-compile-tags (erlang-file tags-file)
+ (should (zerop (call-process "etags" nil nil nil
+ "-o" tags-file
+ erlang-file))))
+
+(defun erlang-test-completion-table ()
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (setq tags-completion-table nil)
+ (tags-completion-table))
+ (should (equal (sort tags-completion-table #'string-lessp)
+ (sort (erlang-expected-completion-table) #'string-lessp))))
+
+(defun erlang-expected-completion-table ()
+ (append (cl-loop for (symbol . _) in erlang-test-code
+ when (stringp symbol)
+ append (list symbol (concat "erlang_test:" symbol)))
+ (list "erlang_test:" "erlang_test:module_info")))
+
+(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
+ (cl-loop for (tagname . code) in erlang-test-code
+ for line = 1 then (1+ line)
+ do (when tagname
+ (switch-to-buffer erlang-buffer)
+ (erlang-test-xref-jump tagname erlang-file line)
+ (when (string-equal tagname "function")
+ (erlang-test-xref-jump (concat "erlang_test:" tagname)
+ erlang-file line))))
+ (erlang-test-xref-jump "erlang_test:" erlang-file 1))
+
+(defun erlang-test-xref-jump (id expected-file expected-line)
+ (goto-char (point-max))
+ (insert "\n%% " id)
+ (save-buffer)
+ (if (fboundp 'xref-find-definitions)
+ (xref-find-definitions (erlang-id-to-string
+ (erlang-get-identifier-at-point)))
+ (error "xref-find-definitions not defined (too old emacs?)"))
+ (erlang-test-verify-pos expected-file expected-line))
+
+(defun erlang-test-verify-pos (expected-file expected-line)
+ (should (string-equal (file-truename expected-file)
+ (file-truename (buffer-file-name))))
+ (should (eq expected-line (line-number-at-pos)))
+ (should (= (point-at-bol) (point))))
+
+(defun erlang-test-complete-at-point (tags-file)
+ (with-temp-buffer
+ (erlang-mode)
+ (setq-local tags-file-name tags-file)
+ (insert "\nerlang_test:fun")
+ (erlang-complete-tag)
+ (should (looking-back "erlang_test:function" (point-at-bol)))
+ (insert "\nfun")
+ (erlang-complete-tag)
+ (should (looking-back "function" (point-at-bol)))
+ (insert "\nerlang_")
+ (erlang-complete-tag)
+ (should (looking-back "erlang_test:" (point-at-bol)))))
+
+
+(ert-deftest erlang-test-compile-options ()
+ (erlang-test-format-opt t
+ "t")
+ (erlang-test-format-opt nil
+ "nil")
+ (erlang-test-format-opt (cons 1 2)
+ "{1, 2}")
+ (erlang-test-format-opt (list 1)
+ "[1]")
+ (erlang-test-format-opt (list 1 2)
+ "[1, 2]")
+ (erlang-test-format-opt (list 1 2 3)
+ "[1, 2, 3]")
+ (erlang-test-format-opt 'symbol
+ "symbol")
+ (erlang-test-format-opt "string"
+ "\"string\"")
+ (erlang-test-format-opt []
+ "{}")
+ (erlang-test-format-opt [1]
+ "{1}")
+ (erlang-test-format-opt [1 2]
+ "{1, 2}")
+ (erlang-test-format-opt [1 2 (3 [4 5 6] 7)]
+ "{1, 2, [3, {4, 5, 6}, 7]}"))
+
+(defun erlang-test-format-opt (elisp &optional expected-erlang)
+ (let ((erlang (inferior-erlang-format-opt elisp)))
+ (message "%s -> %s" elisp erlang)
+ (when expected-erlang
+ (should (equal erlang expected-erlang)))
+ erlang))
+
+
+(ert-deftest erlang-test-parse-id ()
+ (cl-loop for id-string in '("fun/10"
+ "qualified-function module:fun/10"
+ "record reko"
+ "macro _SYMBOL"
+ "macro MACRO/10"
+ "module modula"
+ "macro"
+ nil)
+ for id-list in '((nil nil "fun" 10)
+ (qualified-function "module" "fun" 10)
+ (record nil "reko" nil)
+ (macro nil "_SYMBOL" nil)
+ (macro nil "MACRO" 10)
+ (module nil "modula" nil)
+ (nil nil "macro" nil)
+ nil)
+ for id-list2 = (erlang-id-to-list id-string)
+ do (should (equal id-list id-list2))
+ for id-string2 = (erlang-id-to-string id-list)
+ do (should (equal id-string id-string2))
+ collect id-list2))
+
+
+(provide 'erlang-test)
+
+;;; erlang-test.el ends here
--- /dev/null
+;;; erlang.el --- Major modes for editing and running Erlang -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+;; Author: Anders Lindgren
+;; Keywords: erlang, languages, processes
+;; Date: 2011-12-11
+;; Version: 2.8.4
+;; Package-Requires: ((emacs "24.3"))
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 1996-2023. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+;;
+
+;; Lars Thorsén's modifications of 2000-06-07 included.
+;; The original version of this package was written by Robert Virding.
+;;
+;;; Commentary:
+
+;; Introduction:
+;; ------------
+;;
+;; This package provides support for the programming language Erlang.
+;; The package provides an editing mode with lots of bells and
+;; whistles, compilation support, and it makes it possible for the
+;; user to start Erlang shells that run inside Emacs.
+;;
+;; See the Erlang distribution for full documentation of this package.
+
+;; Installation:
+;; ------------
+;;
+;; Place this file in Emacs load path, byte-compile it, and add the
+;; following line to the appropriate init file:
+;;
+;; (require 'erlang-start)
+;;
+;; The full documentation contains much more extensive description of
+;; the installation procedure.
+
+;; Reporting Bugs:
+;; --------------
+;;
+;; Please report bugs at:
+;; https://github.com/erlang/otp/issues
+;; Please state as exactly as possible:
+;; - Version number of Erlang Mode (see the menu), Emacs, Erlang,
+;; and of any other relevant software.
+;; - What the expected result was.
+;; - What you did, preferably in a repeatable step-by-step form.
+;; - A description of the unexpected result.
+;; - Relevant pieces of Erlang code causing the problem.
+;; - Personal Emacs customisations, if any.
+;; Patch suggestions are welcome at:
+;; https://github.com/erlang/otp/pulls
+;;
+;; Should the Emacs generate an error, please set the Emacs variable
+;; `debug-on-error' to `t'. Repeat the error and enclose the debug
+;; information in your bug-report.
+;;
+;; To toggle the variable you can use the following command:
+;; M-x toggle-debug-on-error RET
+;;; Code:
+
+(require 'align)
+(require 'comint)
+(require 'tempo)
+
+;;; `caddr' is builtin since Emacs 26.
+(eval-and-compile
+ (or (fboundp 'caddr)
+ (defun caddr (x) (car (cdr (cdr x))))))
+
+;; Variables:
+
+(defgroup erlang nil
+ "The Erlang programming language."
+ :group 'languages)
+
+(defconst erlang-version "2.8.4"
+ "The version number of Erlang mode.")
+
+(defcustom erlang-root-dir nil
+ "The directory where the Erlang man pages are installed. The
+name should not contain a trailing slash.
+
+Should this variable be nil, no manual pages will show up in the
+Erlang mode menu unless man pages have been downloaded by Erlang
+mode (see below).
+
+You can download the Erlang man pages automatically by placing
+the following lines in your Emacs init file or by executing the
+Emacs command `M-x erlang-man-download-ask RET' (the download URL
+can be customized with the Emacs variable
+erlang-man-download-url):
+
+ (require 'erlang)
+ (erlang-man-download)
+
+"
+ :group 'erlang
+ :type '(restricted-sexp :match-alternatives (stringp 'nil))
+ :safe (lambda (val) (or (eq nil val) (stringp val))))
+
+(defvar erlang-menu-items '(erlang-menu-base-items
+ erlang-menu-skel-items
+ erlang-menu-shell-items
+ erlang-menu-compile-items
+ erlang-menu-man-items
+ erlang-menu-personal-items
+ erlang-menu-version-items)
+ "List of menu item list to combine to create Erlang mode menu.
+
+External programs which temporarily add menu items to the Erlang mode
+menu may use this variable. Please use the function `add-hook' to add
+items.
+
+Please call the function `erlang-menu-init' after every change to this
+variable.")
+
+(defvar erlang-menu-base-items
+ '(("Indent"
+ (("Indent Line" erlang-indent-command)
+ ("Indent Region " erlang-indent-region mark-active)
+ ("Indent Clause" erlang-indent-clause)
+ ("Indent Function" erlang-indent-function)
+ ("Indent Buffer" erlang-indent-current-buffer)))
+ ("Edit"
+ (("Fill Comment" erlang-fill-paragraph)
+ ("Comment Region" comment-region mark-active)
+ ("Uncomment Region" uncomment-region mark-active)
+ nil
+ ("Beginning of Function" erlang-beginning-of-function)
+ ("End of Function" erlang-end-of-function)
+ ("Mark Function" erlang-mark-function)
+ nil
+ ("Beginning of Clause" erlang-beginning-of-clause)
+ ("End of Clause" erlang-end-of-clause)
+ ("Mark Clause" erlang-mark-clause)
+ nil
+ ("New Clause" erlang-generate-new-clause)
+ ("Clone Arguments" erlang-clone-arguments)
+ nil
+ ("Align Arrows" erlang-align-arrows)))
+ ("Syntax Highlighting"
+ (("Level 4" erlang-font-lock-level-4)
+ ("Level 3" erlang-font-lock-level-3)
+ ("Level 2" erlang-font-lock-level-2)
+ ("Level 1" erlang-font-lock-level-1)
+ ("Off" erlang-font-lock-level-0)))
+ ("TAGS"
+ (("Find Tag" find-tag)
+ ("Find Next Tag" erlang-find-next-tag)
+ ;("Find Regexp" find-tag-regexp)
+ ("Complete Word" erlang-complete-tag)
+ ("Tags Apropos" tags-apropos)
+ ("Search Files" tags-search))))
+ "Description of menu used in Erlang mode.
+
+This variable must be a list. The elements are either nil representing
+a horizontal line or a list with two or three elements. The first is
+the name of the menu item, the second is the function to call, or a
+submenu, on the same same form as ITEMS. The third optional argument
+is an expression which is evaluated every time the menu is displayed.
+Should the expression evaluate to nil the menu item is ghosted.
+
+Example:
+ '((\"Func1\" function-one)
+ (\"SubItem\"
+ ((\"Yellow\" function-yellow)
+ (\"Blue\" function-blue)))
+ nil
+ (\"Region Function\" spook-function midnight-variable))
+
+Call the function `erlang-menu-init' after modifying this variable.")
+
+(defvar erlang-menu-shell-items
+ '(nil
+ ("Shell"
+ (("Start New Shell" erlang-shell)
+ ("Display Shell" erlang-shell-display))))
+ "Description of the Shell menu used by Erlang mode.
+
+Please see the documentation of `erlang-menu-base-items'.")
+
+(defvar erlang-menu-compile-items
+ '(("Compile"
+ (("Compile Buffer" erlang-compile)
+ ("Display Result" erlang-compile-display)
+ ("Next Error" erlang-next-error))))
+ "Description of the Compile menu used by Erlang mode.
+
+Please see the documentation of `erlang-menu-base-items'.")
+
+(defvar erlang-menu-version-items
+ '(nil
+ ("Version" erlang-version))
+ "Description of the version menu used in Erlang mode.")
+
+(defvar erlang-menu-personal-items nil
+ "Description of personal menu items used in Erlang mode.
+
+Please see the variable `erlang-menu-base-items' for a description
+of the format.")
+
+(defvar erlang-menu-man-items nil
+ "The menu containing man pages.
+
+The format of the menu should be compatible with `erlang-menu-base-items'.
+This variable is added to the list of Erlang menus stored in
+`erlang-menu-items'.")
+
+(defvar erlang-menu-skel-items '()
+ "Description of the menu containing the skeleton entries.
+The menu is in the form described by the variable `erlang-menu-base-items'.")
+
+(defvar erlang-mode-hook nil
+ "Functions to run when Erlang mode is activated.
+
+This hook is used to change the behaviour of Erlang mode. It is
+normally used by the user to personalise the programming environment.
+When used in a site init file, it could be used to customise Erlang
+mode for all users on the system.
+
+The functions added to this hook are run every time Erlang mode is
+started. See also `erlang-load-hook', a hook which is run once,
+when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook'
+which is run every time a new inferior Erlang shell is started.
+
+To use a hook, create an Emacs lisp function to perform your actions
+and add the function to the hook by calling `add-hook'.
+
+The following example binds the key sequence C-c C-c to the command
+`erlang-compile' (normally bound to C-c C-k). The example also
+activates Font Lock mode to fontify the buffer and adds a menu
+containing all functions defined in the current buffer.
+
+To use the example, copy the following lines to your `~/.emacs' file:
+
+ (add-hook 'erlang-mode-hook 'my-erlang-mode-hook)
+
+ (defun my-erlang-mode-hook ()
+ (local-set-key \"\\C-c\\C-c\" 'erlang-compile)
+ (if window-system
+ (progn
+ (setq font-lock-maximum-decoration t)
+ (font-lock-mode 1)))
+ (if (and window-system (fboundp 'imenu-add-to-menubar))
+ (imenu-add-to-menubar \"Imenu\")))")
+
+(defvar erlang-load-hook nil
+ "Functions to run when Erlang mode is loaded.
+
+This hook is used to change the behaviour of Erlang mode. It is
+normally used by the user to personalise the programming environment.
+When used in a site init file, it could be used to customize Erlang
+mode for all users on the system.
+
+The difference between this hook and `erlang-mode-hook' and
+`erlang-shell-mode-hook' is that the functions in this hook
+is only called once, when the Erlang mode is loaded into Emacs
+the first time.
+
+Natural actions for the functions added to this hook are actions which
+only should be performed once, and actions which should be performed
+before starting Erlang mode. For example, a number of variables are
+used by Erlang mode before `erlang-mode-hook' is run.
+
+The following example sets the variable `erlang-root-dir' so that the
+manual pages can be retrieved (note that you must set the value of
+`erlang-root-dir' to match the location of Erlang on your system):
+
+ (add-hook 'erlang-load-hook 'my-erlang-load-hook)
+
+ (defun my-erlang-load-hook ()
+ (setq erlang-root-dir \"/usr/local/erlang\"))")
+
+(defvar erlang-new-file-hook nil
+ "Functions to run when a new Erlang source file is being edited.
+
+A useful function is `tempo-template-erlang-normal-header'.
+\(This function only exists when the `tempo' package is available.)")
+
+(defcustom erlang-check-module-name 'ask
+ "Non-nil means check that module name and file name agrees when saving.
+
+If the value of this variable is the symbol `ask', the user is
+prompted. If the value is t the source is silently changed."
+ :group 'erlang
+ :type '(choice (const :tag "Check on save" 'ask)
+ (const :tag "Don't check on save" t)))
+
+(defvar erlang-electric-commands
+ '(erlang-electric-comma
+ erlang-electric-semicolon
+ erlang-electric-gt)
+ "List of activated electric commands.
+
+The list should contain the electric commands which should be active.
+Currently, the available electric commands are:
+ `erlang-electric-comma'
+ `erlang-electric-semicolon'
+ `erlang-electric-gt'
+ `erlang-electric-newline'
+
+Should the variable be bound to t, all electric commands
+are activated.
+
+To deactivate all electric commands, set this variable to nil.")
+
+(defcustom erlang-electric-newline-inhibit t
+ "Set to non-nil to inhibit newline after electric command.
+
+This is useful since a lot of people press return after executing an
+electric command.
+
+In order to work, the command must also be in the
+list `erlang-electric-newline-inhibit-list'.
+
+Note that commands in this list are required to set the variable
+`erlang-electric-newline-inhibit' to nil when the newline shouldn't be
+inhibited."
+ :group 'erlang
+ :type 'boolean
+ :safe 'booleanp)
+
+(defvar erlang-electric-newline-inhibit-list
+ '(erlang-electric-semicolon
+ erlang-electric-comma
+ erlang-electric-gt)
+ "Commands which can inhibit the next newline.")
+
+(defcustom erlang-electric-semicolon-insert-blank-lines nil
+ "Number of blank lines inserted before header, or nil.
+
+This variable controls the behaviour of `erlang-electric-semicolon'
+when a new function header is generated. When nil, no blank line is
+inserted between the current line and the new header. When bound to a
+number it represents the number of blank lines which should be
+inserted."
+ :type '(restricted-sexp :match-alternatives (integerp 'nil))
+ :group 'erlang)
+
+(defvar erlang-electric-semicolon-criteria
+ '(erlang-next-lines-empty-p
+ erlang-at-keyword-end-p
+ erlang-at-end-of-function-p)
+ "List of functions controlling `erlang-electric-semicolon'.
+The functions in this list are called, in order, whenever a semicolon
+is typed. Each function in the list is called with no arguments,
+and should return one of the following values:
+
+ nil -- no determination made, continue checking
+ 'stop -- do not create prototype for next line
+ (anything else) -- insert prototype, and stop checking
+
+If every function in the list is called with no determination made,
+then no prototype is inserted.
+
+The test is performed by the function `erlang-test-criteria-list'.")
+
+(defvar erlang-electric-comma-criteria
+ '(erlang-stop-when-inside-argument-list
+ erlang-stop-when-at-guard
+ erlang-next-lines-empty-p
+ erlang-at-keyword-end-p
+ erlang-at-end-of-clause-p
+ erlang-at-end-of-function-p)
+ "List of functions controlling `erlang-electric-comma'.
+The functions in this list are called, in order, whenever a comma
+is typed. Each function in the list is called with no arguments,
+and should return one of the following values:
+
+ nil -- no determination made, continue checking
+ 'stop -- do not create prototype for next line
+ (anything else) -- insert prototype, and stop checking
+
+If every function in the list is called with no determination made,
+then no prototype is inserted.
+
+The test is performed by the function `erlang-test-criteria-list'.")
+
+(defvar erlang-electric-arrow-criteria
+ '(erlang-stop-when-in-type-spec
+ erlang-next-lines-empty-p
+ erlang-at-end-of-function-p)
+ "List of functions controlling the arrow aspect of `erlang-electric-gt'.
+The functions in this list are called, in order, whenever a `>'
+is typed. Each function in the list is called with no arguments,
+and should return one of the following values:
+
+ nil -- no determination made, continue checking
+ 'stop -- do not create prototype for next line
+ (anything else) -- insert prototype, and stop checking
+
+If every function in the list is called with no determination made,
+then no prototype is inserted.
+
+The test is performed by the function `erlang-test-criteria-list'.")
+
+(defvar erlang-electric-newline-criteria
+ '(t)
+ "List of functions controlling `erlang-electric-newline'.
+
+The electric newline commands indents the next line. Should the
+current line begin with a comment the comment start is copied to
+the newly created line.
+
+The functions in this list are called, in order, whenever a comma
+is typed. Each function in the list is called with no arguments,
+and should return one of the following values:
+
+ nil -- no determination made, continue checking
+ 'stop -- do not create prototype for next line
+ (anything else) -- trigger the electric command.
+
+If every function in the list is called with no determination made,
+then no prototype is inserted. Should the atom t be a member of the
+list, it is treated as a function triggering the electric command.
+
+The test is performed by the function `erlang-test-criteria-list'.")
+
+(defcustom erlang-next-lines-empty-threshold 2
+ "Number of blank lines required to activate an electric command.
+
+Actually, this value controls the behaviour of the function
+`erlang-next-lines-empty-p' which normally is a member of the
+criteria lists controlling the electric commands. (Please see
+the variables `erlang-electric-semicolon-criteria' and
+`erlang-electric-comma-criteria'.)
+
+The variable is bound to a threshold value, a number, representing the
+number of lines which must be empty.
+
+Setting this variable to zero, electric commands will always be
+triggered by `erlang-next-lines-empty-p', unless inhibited by other
+rules.
+
+Should this variable be nil, `erlang-next-lines-empty-p' will never
+trigger an electric command. The same effect would be reached if the
+function `erlang-next-lines-empty-p' would be removed from the criteria
+lists.
+
+Note that even if `erlang-next-lines-empty-p' should not trigger an
+electric command, other functions in the criteria list could."
+ :group 'erlang
+ :type '(restricted-sexp :match-alternatives (integerp 'nil))
+ :safe (lambda (val) (or (eq val nil) (integerp val))))
+
+(defcustom erlang-new-clause-with-arguments nil
+ "Non-nil means that the arguments are cloned when a clause is generated.
+
+A new function header can be generated by calls to the function
+`erlang-generate-new-clause' and by use of the electric semicolon."
+ :group 'erlang
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom erlang-compile-use-outdir t
+ "When nil, go to the directory containing source file when compiling.
+
+This is a workaround for a bug in the `outdir' option of compile. If the
+outdir is not in the current load path, Erlang doesn't load the object
+module after it has been compiled.
+
+To activate the workaround, place the following in your `~/.emacs' file:
+ (setq erlang-compile-use-outdir nil)"
+ :group 'erlang
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom erlang-indent-level 4
+ "Indentation of Erlang calls/clauses within blocks."
+ :group 'erlang
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom erlang-icr-indent nil
+ "Indentation of Erlang if/case/receive patterns.
+nil means keeping default behavior. When non-nil, indent to the column of
+if/case/receive."
+ :group 'erlang
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom erlang-indent-guard 2
+ "Indentation of Erlang guards."
+ :group 'erlang
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom erlang-argument-indent 2
+ "Indentation of the first argument in a function call.
+When nil, indent to the column after the `(' of the
+function."
+ :group 'erlang
+ :type '(restricted-sexp :match-alternatives (integerp 'nil))
+ :safe (lambda (val) (or (eq val nil) (integerp val))))
+
+(defcustom erlang-tab-always-indent t
+ "Non-nil means TAB in Erlang mode should always re-indent the current line,
+regardless of where in the line point is when the TAB command is used."
+ :group 'erlang
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom erlang-max-files-to-visit-for-refining-xrefs 32
+ "Upper limit how many files to visit for checking arity.
+When `nil' there is no limit."
+ :group 'erlang
+ :type '(restricted-sexp :match-alternatives (integerp 'nil))
+ :safe (lambda (val) (or (eq val nil) (integerp val))))
+
+(defvar erlang-man-inhibit (eq system-type 'windows-nt)
+ "Inhibit the creation of the Erlang Manual Pages menu.
+
+The Windows distribution of Erlang does not include man pages, hence
+there is no attempt to create the menu.")
+
+(defvar erlang-man-dirs
+ '(("Man - Commands" "/man/man1" t)
+ ("Man - Modules" "/man/man3" t)
+ ("Man - Files" "/man/man4" t)
+ ("Man - Applications" "/man/man6" t))
+ "The man directories displayed in the Erlang menu.
+
+Each item in the list should be a list with three elements, the first
+the name of the menu, the second the directory, and the last a flag.
+Should the flag the nil, the directory is absolute, should it be non-nil
+the directory is relative to the variable `erlang-root-dir'.")
+
+(defvar erlang-man-max-menu-size 35
+ "The maximum number of menu items in one menu allowed.")
+
+(defvar erlang-man-display-function 'erlang-man-display
+ "Function used to display man page.
+
+The function is called with one argument, the name of the file
+containing the man page. Use this variable when the default
+function, `erlang-man-display', does not work on your system.")
+
+(defvar erlang-compile-extra-opts '()
+ "Additional options to the compilation command.
+This is an elisp list of options. Each option can be either:
+- an atom
+- a dotted pair
+- a string
+Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))")
+
+(defvar erlang-compile-command-function-alist
+ '((".erl\\'" . inferior-erlang-compute-erl-compile-command)
+ (".xrl\\'" . inferior-erlang-compute-leex-compile-command)
+ (".yrl\\'" . inferior-erlang-compute-yecc-compile-command)
+ ("." . inferior-erlang-compute-erl-compile-command))
+ "Alist of filename patterns vs corresponding compilation functions.
+Each element looks like (REGEXP . FUNCTION). Compiling a file whose name
+matches REGEXP specifies FUNCTION to use to compute the compilation
+command. The FUNCTION will be called with two arguments: module name and
+default compilation options, like output directory. The FUNCTION
+is expected to return a string.")
+
+(defvar erlang-leex-compile-opts '()
+ "Options to pass to leex when compiling xrl files.
+This is an elisp list of options. Each option can be either:
+- an atom
+- a dotted pair
+- a string")
+
+(defvar erlang-yecc-compile-opts '()
+ "Options to pass to yecc when compiling yrl files.
+This is an elisp list of options. Each option can be either:
+- an atom
+- a dotted pair
+- a string")
+
+(eval-and-compile
+ (defvar erlang-regexp-modern-p t
+ "Non-nil when this version of Emacs uses a modern version of regexp.
+Supporting \_< and \_> This is determined by checking the version of Emacs used."))
+
+(eval-and-compile
+ (defconst erlang-atom-quoted-regexp
+ "'\\(?:[^\\']\\|\\(?:\\\\.\\)\\)*'"
+ "Regexp describing a single-quoted atom"))
+
+(eval-and-compile
+ (defconst erlang-atom-regular-regexp
+ (if erlang-regexp-modern-p
+ "\\_<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\_>"
+ "\\<[[:lower:]]\\(?:\\sw\\|\\s_\\)*\\>")
+ "Regexp describing a regular (non-quoted) atom"))
+
+(eval-and-compile
+ (defconst erlang-atom-regexp
+ (concat "\\(" erlang-atom-quoted-regexp "\\|"
+ erlang-atom-regular-regexp "\\)")
+ "Regexp describing an Erlang atom."))
+
+(eval-and-compile
+ (defconst erlang-atom-regexp-matches 1
+ "Number of regexp parenthesis pairs in `erlang-atom-regexp'.
+
+This is used to determine parenthesis matches in complex regexps which
+contains `erlang-atom-regexp'."))
+
+
+(eval-and-compile
+ (defconst erlang-variable-regexp
+ (if erlang-regexp-modern-p
+ "\\_<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\_>"
+ "\\<\\([[:upper:]_]\\(?:\\sw\\|\\s_\\)*\\)\\>")
+ "Regexp which should match an Erlang variable.
+
+The regexp must be surrounded with a pair of regexp parentheses."))
+
+(eval-and-compile
+ (defconst erlang-variable-regexp-matches 1
+ "Number of regexp parenthesis pairs in `erlang-variable-regexp'.
+
+This is used to determine matches in complex regexps which contains
+`erlang-variable-regexp'."))
+
+(defconst erlang-module-function-regexp
+ (eval-when-compile
+ (concat erlang-atom-regexp ":" erlang-atom-regexp))
+ "Regexp matching an erlang module:function.")
+
+(defconst erlang-name-regexp
+ (concat "\\("
+ "\\(?:\\sw\\|\\s_\\)+"
+ "\\|"
+ erlang-atom-quoted-regexp
+ "\\)")
+ "Matches a name of a function, macro or record")
+
+(defconst erlang-id-regexp
+ (concat "\\(?:\\(qualified-function\\|record\\|macro\\|module\\) \\)?"
+ "\\(?:" erlang-atom-regexp ":\\)?"
+ erlang-name-regexp "?"
+ "\\(?:/\\([0-9]+\\)\\)?"))
+
+(eval-and-compile
+ (defun erlang-regexp-opt (strings &optional paren)
+ "Like `regexp-opt', except if PAREN is `symbols', then the
+resulting regexp is surrounded by \\_< and \\_>."
+ (if (eq paren 'symbols)
+ (if erlang-regexp-modern-p
+ (concat "\\_<" (regexp-opt strings t) "\\_>")
+ (concat "\\<" (regexp-opt strings t) "\\>"))
+ (regexp-opt strings paren))))
+
+
+(eval-and-compile
+ (defvar erlang-keywords
+ '("after"
+ "begin"
+ "catch"
+ "case"
+ "cond"
+ "end"
+ "fun"
+ "if"
+ "let"
+ "of"
+ "receive"
+ "try"
+ "maybe"
+ "else"
+ "when")
+ "Erlang reserved keywords"))
+
+(eval-and-compile
+ (defconst erlang-keywords-regexp (erlang-regexp-opt erlang-keywords 'symbols)))
+
+(eval-and-compile
+ (defvar erlang-operators
+ '("and"
+ "andalso"
+ "band"
+ "bnot"
+ "bor"
+ "bsl"
+ "bsr"
+ "bxor"
+ "div"
+ "not"
+ "or"
+ "orelse"
+ "rem"
+ "xor")
+ "Erlang operators"))
+;; What about these?
+;; '+' '-' '*' '/' '>', '>=', '<', '=<', '=:=', '==', '=/=', '/='
+
+(eval-and-compile
+ (defconst erlang-operators-regexp (erlang-regexp-opt erlang-operators 'symbols)))
+
+
+(eval-and-compile
+ (defvar erlang-guards
+ '("is_atom"
+ "is_binary"
+ "is_bitstring"
+ "is_boolean"
+ "is_float"
+ "is_function"
+ "is_integer"
+ "is_list"
+ "is_map"
+ "is_number"
+ "is_pid"
+ "is_port"
+ "is_record"
+ "is_reference"
+ "is_tuple"
+ "atom"
+ "binary"
+ "bitstring"
+ "boolean"
+ ;;"float" ; Not included to avoid clashes with the bif float/1
+ "function"
+ "integer"
+ "list"
+ "number"
+ "pid"
+ "port"
+ "record"
+ "reference"
+ "tuple")
+ "Erlang guards"))
+
+(eval-and-compile
+ (defconst erlang-guards-regexp (erlang-regexp-opt erlang-guards 'symbols)))
+
+(eval-and-compile
+ (defvar erlang-predefined-types
+ '("any"
+ "arity"
+ "boolean"
+ "byte"
+ "char"
+ "cons"
+ "deep_string"
+ "iodata"
+ "iolist"
+ "maybe_improper_list"
+ "module"
+ "mfa"
+ "nil"
+ "neg_integer"
+ "none"
+ "non_neg_integer"
+ "nonempty_list"
+ "nonempty_improper_list"
+ "nonempty_maybe_improper_list"
+ "nonempty_string"
+ "no_return"
+ "pos_integer"
+ "string"
+ "term"
+ "timeout"
+ "map")
+ "Erlang type specs types"))
+
+(eval-and-compile
+ (defconst erlang-predefined-types-regexp
+ (erlang-regexp-opt erlang-predefined-types 'symbols)))
+
+
+(eval-and-compile
+ (defvar erlang-int-bifs
+ '("abs"
+ "alias"
+ "apply"
+ "atom_to_binary"
+ "atom_to_list"
+ "binary_to_atom"
+ "binary_to_existing_atom"
+ "binary_to_float"
+ "binary_to_integer"
+ "binary_to_list"
+ "binary_to_term"
+ "binary_part"
+ "bit_size"
+ "bitstring_to_list"
+ "byte_size"
+ "ceil"
+ "check_old_code"
+ "check_process_code"
+ "date"
+ "delete_module"
+ "demonitor"
+ "disconnect_node"
+ "element"
+ "erase"
+ "error"
+ "exit"
+ "floor"
+ "float"
+ "float_to_binary"
+ "float_to_list"
+ "garbage_collect"
+ "get"
+ "get_keys"
+ "group_leader"
+ "halt"
+ "hd"
+ "integer_to_list"
+ "integer_to_binary"
+ "iolist_size"
+ "iolist_to_binary"
+ "is_alive"
+ "is_atom"
+ "is_binary"
+ "is_bitstring"
+ "is_boolean"
+ "is_float"
+ "is_function"
+ "is_integer"
+ "is_list"
+ "is_map"
+ "is_map_key"
+ "is_number"
+ "is_pid"
+ "is_port"
+ "is_process_alive"
+ "is_record"
+ "is_reference"
+ "is_tuple"
+ "length"
+ "link"
+ "list_to_atom"
+ "list_to_binary"
+ "list_to_bitstring"
+ "list_to_existing_atom"
+ "list_to_float"
+ "list_to_integer"
+ "list_to_pid"
+ "list_to_port"
+ "list_to_ref"
+ "list_to_tuple"
+ "load_module"
+ "make_ref"
+ "map_get"
+ "map_size"
+ "max"
+ "min"
+ "module_loaded"
+ "monitor"
+ "monitor_node"
+ "node"
+ "nodes"
+ "now"
+ "open_port"
+ "pid_to_list"
+ "port_close"
+ "port_command"
+ "port_connect"
+ "port_control"
+ "port_to_list"
+ "pre_loaded"
+ "process_flag"
+ "process_info"
+ "processes"
+ "purge_module"
+ "put"
+ "ref_to_list"
+ "register"
+ "registered"
+ "round"
+ "self"
+ "setelement"
+ "size"
+ "spawn"
+ "spawn_link"
+ "spawn_monitor"
+ "spawn_opt"
+ "spawn_request"
+ "spawn_request_abandon"
+ "split_binary"
+ "statistics"
+ "term_to_binary"
+ "term_to_iovec"
+ "time"
+ "throw"
+ "tl"
+ "trunc"
+ "tuple_size"
+ "tuple_to_list"
+ "unalias"
+ "unlink"
+ "unregister"
+ "whereis")
+ "Erlang built-in functions (BIFs)"))
+
+(eval-and-compile
+ (defconst erlang-int-bif-regexp (erlang-regexp-opt erlang-int-bifs 'symbols)))
+
+
+(eval-and-compile
+ (defvar erlang-ext-bifs
+ '("adler32"
+ "adler32_combine"
+ "alloc_info"
+ "alloc_sizes"
+ "append"
+ "append_element"
+ "bump_reductions"
+ "call_on_load_function"
+ "cancel_timer"
+ "crc32"
+ "crc32_combine"
+ "decode_packet"
+ "delay_trap"
+ "delete_element"
+ "display"
+ "display_string"
+ "dist_get_stat"
+ "dist_ctrl_get_data"
+ "dist_ctrl_get_data_notification"
+ "dist_ctrl_get_opt"
+ "dist_ctrl_input_handler"
+ "dist_ctrl_put_data"
+ "dist_ctrl_set_opt"
+ "dmonitor_node"
+ "dt_append_vm_tag_data"
+ "dt_get_tag"
+ "dt_get_tag_data"
+ "dt_prepend_vm_tag_data"
+ "dt_put_tag"
+ "dt_restore_tag"
+ "dt_spread_tag"
+ "convert_time_unit"
+ "exit_signal"
+ "external_size"
+ "finish_after_on_load"
+ "finish_loading"
+ "format_cpu_topology"
+ "fun_info"
+ "fun_info_mfa"
+ "fun_to_list"
+ "function_exported"
+ "garbage_collect_message_area"
+ "gather_gc_info_result"
+ "get_cookie"
+ "get_module_info"
+ "has_prepared_code_on_load"
+ "hibernate"
+ "insert_element"
+ "iolist_to_iovec"
+ "is_builtin"
+ "load_nif"
+ "loaded"
+ "localtime"
+ "localtime_to_universaltime"
+ "make_fun"
+ "make_tuple"
+ "match_spec_test"
+ "md5"
+ "md5_final"
+ "md5_init"
+ "md5_update"
+ "memory"
+ "module_info"
+ "monitor_node"
+ "monotonic_time"
+ "nif_error"
+ "phash"
+ "phash2"
+ "port_call"
+ "port_get_data"
+ "port_info"
+ "port_set_data"
+ "ports"
+ "posixtime_to_universaltime"
+ "prepare_loading"
+ "process_display"
+ "raise"
+ "read_timer"
+ "resume_process"
+ "send"
+ "send_after"
+ "send_nosuspend"
+ "seq_trace"
+ "seq_trace_info"
+ "seq_trace_print"
+ "set_cookie"
+ "set_cpu_topology"
+ "setnode"
+ "start_timer"
+ "subtract"
+ "suspend_process"
+ "system_flag"
+ "system_info"
+ "system_monitor"
+ "system_profile"
+ "system_time"
+ "trace"
+ "trace_delivered"
+ "trace_info"
+ "trace_pattern"
+ "time_offset"
+ "timestamp"
+ "universaltime"
+ "universaltime_to_localtime"
+ "universaltime_to_posixtime"
+ "unique_integer"
+ "yield")
+ "Erlang built-in functions (BIFs) that needs erlang: prefix"))
+
+(eval-and-compile
+ (defconst erlang-ext-bif-regexp
+ (erlang-regexp-opt (append erlang-int-bifs erlang-ext-bifs) 'symbols)))
+
+
+(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
+ "Regexp which should match beginning of a clause.")
+
+(defvar erlang-file-name-extension-regexp "\\.erl$"
+ "Regexp which should match an Erlang file name.
+
+This regexp is used when an Erlang module name is extracted from the
+name of an Erlang source file.
+
+The regexp should only match the section of the file name which should
+be excluded from the module name.
+
+To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\".
+The matches all except the extension. This is useful if the Erlang
+tags system should interpret tags on the form `module:tag' for
+files written in other languages than Erlang.")
+
+(defvar erlang-inferior-shell-split-window t
+ "If non-nil, when starting an inferior shell, split windows.
+If nil, the inferior shell replaces the window. This is the traditional
+behaviour.")
+
+(defvar erlang-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map ";" 'erlang-electric-semicolon)
+ (define-key map "," 'erlang-electric-comma)
+ (define-key map "<" 'erlang-electric-lt)
+ (define-key map ">" 'erlang-electric-gt)
+ (define-key map "\C-m" 'erlang-electric-newline)
+ (define-key map (kbd "DEL") 'backward-delete-char-untabify)
+ (define-key map "\M-q" 'erlang-fill-paragraph)
+ (define-key map "\M-\t" 'erlang-complete-tag)
+ (define-key map "\C-c\M-\t" 'tempo-complete-tag)
+ (define-key map "\M-+" 'erlang-find-next-tag)
+ (define-key map "\C-c\M-a" 'erlang-beginning-of-clause)
+ (define-key map "\C-c\M-b" 'tempo-backward-mark)
+ (define-key map "\C-c\M-e" 'erlang-end-of-clause)
+ (define-key map "\C-c\M-f" 'tempo-forward-mark)
+ (define-key map "\C-c\M-h" 'erlang-mark-clause)
+ (define-key map "\C-c\C-c" 'comment-region)
+ (define-key map "\C-c\C-j" 'erlang-generate-new-clause)
+ (define-key map "\C-c\C-k" 'erlang-compile)
+ (define-key map "\C-c\C-l" 'erlang-compile-display)
+ (define-key map "\C-c\C-s" 'erlang-show-syntactic-information)
+ (define-key map "\C-c\C-q" 'erlang-indent-function)
+ (define-key map "\C-c\C-u" 'uncomment-region)
+ (define-key map "\C-c\C-y" 'erlang-clone-arguments)
+ (define-key map "\C-c\C-a" 'erlang-align-arrows)
+ (define-key map "\C-c\C-z" 'erlang-shell-display)
+ (define-key map "\C-c\C-d" 'erlang-man-function-no-prompt)
+ map)
+ "Keymap used in Erlang mode.")
+(defvar erlang-mode-abbrev-table nil
+ "Abbrev table in use in Erlang-mode buffers.")
+(defvar erlang-mode-syntax-table nil
+ "Syntax table in use in Erlang-mode buffers.")
+
+
+
+(defvar erlang-skel-file "erlang-skels"
+ "The type of erlang-skeletons that should be used, default
+ uses edoc type, for the old type, standard comments,
+ set \"erlang-skels-old\" in your .emacs and restart.
+
+ Or define your own and set the variable to that file.")
+
+;; Tempo skeleton templates:
+(load erlang-skel-file)
+
+;; Font-lock variables
+
+;; The next few variables define different Erlang font-lock patterns.
+;; They could be appended to form a custom font-lock appearance.
+;;
+;; The function `erlang-font-lock-set-face' could be used to change
+;; the face of a pattern.
+;;
+;; Note that Erlang strings and atoms are highlighted with using
+;; syntactic analysis.
+
+(defvar erlang-font-lock-keywords-function-header
+ (list
+ (list (concat "^" erlang-atom-regexp "\\s-*(")
+ 1 'font-lock-function-name-face t))
+ "Font lock keyword highlighting a function header.")
+
+(defface erlang-font-lock-exported-function-name-face
+ '((default (:inherit font-lock-function-name-face)))
+ "Face used for highlighting exported functions."
+ :group 'erlang)
+
+(defvar erlang-font-lock-exported-function-name-face
+ 'erlang-font-lock-exported-function-name-face)
+
+(defvar erlang-inhibit-exported-function-name-face nil
+ "Inhibit separate face for exported functions")
+
+(defvar erlang-font-lock-keywords-exported-function-header
+ (list
+ (list #'erlang-match-next-exported-function
+ 1 'erlang-font-lock-exported-function-name-face t))
+ "Font lock keyword highlighting an exported function header.")
+
+(defvar erlang-font-lock-keywords-int-bifs
+ (list
+ (list (concat erlang-int-bif-regexp "\\s-*(")
+ 1 'font-lock-builtin-face))
+ "Font lock keyword highlighting built in functions.")
+
+(defvar erlang-font-lock-keywords-ext-bifs
+ (list
+ (list (concat "\\<\\(erlang\\)\\s-*:\\s-*" erlang-ext-bif-regexp "\\s-*(")
+ '(1 'font-lock-builtin-face)
+ '(2 'font-lock-builtin-face)))
+ "Font lock keyword highlighting built in functions.")
+
+(defvar erlang-font-lock-keywords-int-function-calls
+ (list
+ (list (concat erlang-atom-regexp "\\s-*(")
+ 1 'font-lock-type-face))
+ "Font lock keyword highlighting an internal function call.")
+
+(defvar erlang-font-lock-keywords-ext-function-calls
+ (list
+ (list (concat erlang-atom-regexp "\\s-*:\\s-*"
+ erlang-atom-regexp "\\s-*(")
+ '(1 'font-lock-type-face)
+ '(2 'font-lock-type-face)))
+ "Font lock keyword highlighting an external function call.")
+
+(defvar erlang-font-lock-keywords-fun-n
+ (list
+ (list (concat "\\(" erlang-atom-regexp "/[0-9]+\\)")
+ 1 'font-lock-type-face))
+ "Font lock keyword highlighting a fun descriptor in F/N format.")
+
+(defvar erlang-font-lock-keywords-operators
+ (list
+ (list erlang-operators-regexp
+ 1 'font-lock-builtin-face))
+ "Font lock keyword highlighting Erlang operators.")
+
+(defvar erlang-font-lock-keywords-dollar
+ (list
+ (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)"
+ 1 'font-lock-constant-face))
+ "Font lock keyword highlighting numbers in ASCII form (e.g. $A).")
+
+(defvar erlang-font-lock-keywords-arrow
+ (list
+ (list "->\\(\\s \\|$\\)" 1 'font-lock-function-name-face))
+ "Font lock keyword highlighting clause arrow.")
+
+(defvar erlang-font-lock-keywords-lc
+ (list
+ (list "\\(<-\\|<=\\|||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face))
+ "Font lock keyword highlighting list comprehension operators.")
+
+(defvar erlang-font-lock-keywords-keywords
+ (list
+ (list erlang-keywords-regexp 1 'font-lock-keyword-face))
+ "Font lock keyword highlighting Erlang keywords.")
+
+(defvar erlang-font-lock-keywords-attr
+ (list
+ (list (concat "^\\(-" erlang-atom-regexp "\\)\\(\\s-\\|\\.\\|(\\)")
+ 1 (if (boundp 'font-lock-preprocessor-face)
+ 'font-lock-preprocessor-face
+ 'font-lock-constant-face)))
+ "Font lock keyword highlighting attributes.")
+
+(defvar erlang-font-lock-keywords-quotes
+ (list
+ (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'"
+ 1
+ 'font-lock-keyword-face
+ t))
+ "Font lock keyword highlighting words in single quotes in comments.
+
+This is not the highlighting of Erlang strings and atoms, which
+are highlighted by syntactic analysis.")
+
+(defvar erlang-font-lock-keywords-guards
+ (list
+ (list (concat "[^:]" erlang-guards-regexp "\\s-*(")
+ 1 'font-lock-builtin-face))
+ "Font lock keyword highlighting guards.")
+
+(defvar erlang-font-lock-keywords-predefined-types
+ (list
+ (list (concat "[^:]" erlang-predefined-types-regexp "\\s-*(")
+ 1 'font-lock-builtin-face))
+ "Font lock keyword highlighting predefined types.")
+
+
+(defvar erlang-font-lock-keywords-macros
+ (list
+ (list (concat "?\\s-*\\(" erlang-atom-regexp
+ "\\|" erlang-variable-regexp "\\)")
+ 1 'font-lock-constant-face)
+ (list (concat "^\\(-\\(?:define\\|ifn?def\\)\\)\\s-*(\\s-*\\(" erlang-atom-regexp
+ "\\|" erlang-variable-regexp "\\)")
+ (if (boundp 'font-lock-preprocessor-face)
+ (list 1 'font-lock-preprocessor-face t)
+ (list 1 'font-lock-constant-face t))
+ (list 3 'font-lock-type-face t t))
+ (list "^-e\\(lse\\|ndif\\)\\>" 0 'font-lock-preprocessor-face t))
+ "Font lock keyword highlighting macros.
+This must be placed in front of `erlang-font-lock-keywords-vars'.")
+
+(defvar erlang-font-lock-keywords-records
+ (list
+ (list (concat "#\\s *" erlang-atom-regexp)
+ 1 'font-lock-type-face)
+ ;; Don't highlight numerical constants.
+ (list (if erlang-regexp-modern-p
+ "\\_<\\([0-9]+\\(_[0-9]+\\)*#[0-9a-zA-Z]+\\(_[0-9a-zA-Z]+\\)*\\)"
+ "\\<\\([0-9]+\\(_[0-9]+\\)*#[0-9a-zA-Z]+\\(_[0-9a-zA-Z]+\\)*\\)")
+ 1 nil t)
+ (list (concat "^-record\\s-*(\\s-*" erlang-atom-regexp)
+ 1 'font-lock-type-face))
+ "Font lock keyword highlighting Erlang records.
+This must be placed in front of `erlang-font-lock-keywords-vars'.")
+
+(defvar erlang-font-lock-keywords-vars
+ (list
+ (list (concat "[^#]" erlang-variable-regexp) ; no numerical constants
+ 1 'font-lock-variable-name-face))
+ "Font lock keyword highlighting Erlang variables.
+Must be preceded by `erlang-font-lock-keywords-macros' to work properly.")
+
+(defvar erlang-font-lock-descr-string
+ "Font-lock keywords used by Erlang Mode.
+
+There exists three levels of Font Lock keywords for Erlang:
+ `erlang-font-lock-keywords-1' - Function headers and reserved keywords.
+ `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'.
+ `erlang-font-lock-keywords-3' - Variables, macros and records.
+ `erlang-font-lock-keywords-4' - Exported functions, Function names,
+ Funs, LCs (not Atoms).
+
+To use a specific level, please set the variable
+`font-lock-maximum-decoration' to the appropriate level. Note that the
+variable must be set before Erlang mode is activated.
+
+Example:
+ (setq font-lock-maximum-decoration 2)")
+
+(defvar erlang-font-lock-keywords-1
+ (append erlang-font-lock-keywords-function-header
+ erlang-font-lock-keywords-dollar
+ erlang-font-lock-keywords-arrow
+ erlang-font-lock-keywords-keywords
+ )
+ ;; DocStringOrig: erlang-font-lock-keywords
+ erlang-font-lock-descr-string)
+
+(defvar erlang-font-lock-keywords-2
+ (append erlang-font-lock-keywords-1
+ erlang-font-lock-keywords-int-bifs
+ erlang-font-lock-keywords-ext-bifs
+ erlang-font-lock-keywords-attr
+ erlang-font-lock-keywords-quotes
+ erlang-font-lock-keywords-guards
+ )
+ ;; DocStringCopy: erlang-font-lock-keywords
+ erlang-font-lock-descr-string)
+
+(defvar erlang-font-lock-keywords-3
+ (append erlang-font-lock-keywords-2
+ erlang-font-lock-keywords-operators
+ erlang-font-lock-keywords-macros
+ erlang-font-lock-keywords-records
+ erlang-font-lock-keywords-vars
+ erlang-font-lock-keywords-predefined-types
+ )
+ ;; DocStringCopy: erlang-font-lock-keywords
+ erlang-font-lock-descr-string)
+
+(defvar erlang-font-lock-keywords-4
+ (append erlang-font-lock-keywords-3
+ erlang-font-lock-keywords-exported-function-header
+ erlang-font-lock-keywords-int-function-calls
+ erlang-font-lock-keywords-ext-function-calls
+ erlang-font-lock-keywords-fun-n
+ erlang-font-lock-keywords-lc
+ )
+ ;; DocStringCopy: erlang-font-lock-keywords
+ erlang-font-lock-descr-string)
+
+(defvar erlang-font-lock-keywords erlang-font-lock-keywords-4
+ ;; DocStringCopy: erlang-font-lock-keywords
+ erlang-font-lock-descr-string)
+
+(defvar erlang-font-lock-syntax-table nil
+ "Syntax table used by Font Lock mode.
+
+The difference between this and the standard Erlang Mode
+syntax table is that `_' is treated as part of words by
+this syntax table.")
+
+(defvar erlang-replace-etags-tags-completion-table nil
+ "Internal flag used by advice `erlang-replace-tags-table'.
+This is non-nil when `etags-tags-completion-table' should be
+replaced by `erlang-etags-tags-completion-table'.")
+
+
+;;; Avoid errors while compiling this file.
+
+;; defvar some obsolete variables, which we still support for
+;; backwards compatibility reasons.
+(eval-when-compile
+ (defvar comment-indent-hook)
+ (defvar dabbrev-case-fold-search)
+ (defvar tempo-match-finder)
+ (defvar compilation-menu-map)
+ (defvar next-error-last-buffer))
+
+(eval-when-compile
+ (require 'comint)
+ (require 'tempo)
+ (require 'compile))
+
+
+(defun erlang-version ()
+ "Return the current version of Erlang mode."
+ (interactive)
+ (if (called-interactively-p 'interactive)
+ (message "Erlang mode version %s, written by Anders Lindgren"
+ erlang-version))
+ erlang-version)
+
+;;;###autoload
+(define-derived-mode erlang-mode prog-mode "Erlang"
+ "Major mode for editing Erlang source files in Emacs.
+It knows about syntax and comment, it can indent code, it is capable
+of fontifying the source file, the TAGS commands are aware of Erlang
+modules, and the Erlang man pages can be accessed.
+
+Should this module, \"erlang.el\", be installed properly, Erlang mode
+is activated whenever an Erlang source or header file is loaded into
+Emacs. To indicate this, the mode line should contain the word
+\"Erlang\".
+
+The main feature of Erlang mode is indentation, press TAB and the
+current line will be indented correctly.
+
+Comments starting with only one `%' are indented to the column stored
+in the variable `comment-column'. Comments starting with two `%':s
+are indented with the same indentation as code. Comments starting
+with at least three `%':s are indented to the first column.
+
+However, Erlang mode contains much more, this is a list of the most
+useful commands:
+ TAB - Indent the line.
+ C-c C-q - Indent current function.
+ M-; - Create a comment at the end of the line.
+ M-q - Fill a comment, i.e. wrap lines so that they (hopefully)
+ will look better.
+ M-a - Goto the beginning of an Erlang clause.
+ M-C-a - Ditto for function.
+ M-e - Goto the end of an Erlang clause.
+ M-C-e - Ditto for function.
+ M-h - Mark current Erlang clause.
+ M-C-h - Ditto for function.
+ C-c C-z - Start, or switch to, an inferior Erlang shell.
+ C-c C-k - Compile current file.
+ C-x ` - Next error.
+ , - Electric comma.
+ ; - Electric semicolon.
+
+Erlang mode check the name of the file against the module name when
+saving, whenever a mismatch occurs Erlang mode offers to modify the
+source.
+
+The variable `erlang-electric-commands' controls the electric
+commands. To deactivate all of them, set it to nil.
+
+There exists a large number of commands and variables in the Erlang
+module. Please press `M-x apropos RET erlang RET' to see a complete
+list. Press `C-h f name-of-function RET' and `C-h v name-of-variable
+RET'to see the full description of functions and variables,
+respectively.
+
+On entry to this mode the contents of the hook `erlang-mode-hook' is
+executed.
+
+Please see the beginning of the file `erlang.el' for more information
+and examples of hooks.
+
+Other commands:
+\\{erlang-mode-map}"
+ ;; Use our own syntax table function
+ :syntax-table nil
+ (erlang-syntax-table-init)
+ (erlang-electric-init)
+ (erlang-menu-init)
+ (erlang-mode-variables)
+ (add-hook 'before-save-hook 'erlang-check-module-name nil t)
+ (erlang-man-init)
+ (erlang-tags-init)
+ (erlang-font-lock-init)
+ (erlang-skel-init)
+ (tempo-use-tag-list 'erlang-tempo-tags)
+ (when (and (fboundp 'add-function) (fboundp 'erldoc-eldoc-function))
+ (or eldoc-documentation-function
+ (setq-local eldoc-documentation-function #'ignore))
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'erldoc-eldoc-function))
+
+ ;; Align maps.
+ (add-to-list 'align-rules-list
+ '(erlang-maps
+ (regexp . "\\(\\s-*\\)\\(=>\\)\\s-*")
+ (modes . '(erlang-mode))
+ (repeat . t)))
+ ;; Align records and :: specs
+ (add-to-list 'align-rules-list
+ '(erlang-record-specs
+ (regexp . "\\(\\s-*\\)\\(=\\).*\\(::\\)*\\s-*")
+ (modes . '(erlang-mode))
+ (repeat . t)))
+ (if (zerop (buffer-size))
+ (run-hooks 'erlang-new-file-hook)))
+
+;;;###autoload
+(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript"
+ "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app"))
+ (add-to-list 'auto-mode-alist (cons r 'erlang-mode)))
+
+(defun erlang-syntax-table-init ()
+ (erlang-ensure-syntax-table-is-initialized)
+ (set-syntax-table erlang-mode-syntax-table))
+
+(defun erlang-ensure-syntax-table-is-initialized ()
+ (unless erlang-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\n ">" table)
+ (modify-syntax-entry ?\" "\"" table)
+ (modify-syntax-entry ?# "." table)
+ ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indentation afterwards
+ ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indentation problems
+ (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $"
+ ;; we have to live with that for now..it is the best alternative
+ ;; that can be worked around with "string that ends with \$"
+ (modify-syntax-entry ?% "<" table)
+ (modify-syntax-entry ?& "." table)
+ (modify-syntax-entry ?\' "\"" table)
+ (modify-syntax-entry ?* "." table)
+ (modify-syntax-entry ?+ "." table)
+ (modify-syntax-entry ?- "." table)
+ (modify-syntax-entry ?/ "." table)
+ (modify-syntax-entry ?: "." table)
+ (modify-syntax-entry ?< "." table)
+ (modify-syntax-entry ?= "." table)
+ (modify-syntax-entry ?> "." table)
+ (modify-syntax-entry ?\\ "\\" table)
+ (modify-syntax-entry ?_ "_" table)
+ (modify-syntax-entry ?| "." table)
+ (modify-syntax-entry ?^ "'" table)
+
+ ;; Pseudo bit-syntax: Latin1 double angle quotes as parens.
+ ;;(modify-syntax-entry ?\253 "(?\273" table)
+ ;;(modify-syntax-entry ?\273 ")?\253" table)
+
+ (setq erlang-mode-syntax-table table))))
+
+
+
+(defun erlang-electric-init ()
+ ;; Set up electric character functions to work with
+ ;; delsel/pending-del mode. Also, set up text properties for bit
+ ;; syntax handling.
+ (mapc #'(lambda (cmd)
+ (put cmd 'delete-selection t)) ;for delsel (Emacs)
+ '(erlang-electric-semicolon
+ erlang-electric-comma
+ erlang-electric-gt))
+
+ (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>))
+ (put 'bitsyntax-open-outer 'rear-nonsticky '(category))
+ (put 'bitsyntax-open-inner 'rear-nonsticky '(category))
+ (put 'bitsyntax-close-inner 'rear-nonsticky '(category))
+ (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<))
+ (put 'bitsyntax-close-outer 'rear-nonsticky '(category))
+ (make-local-variable 'parse-sexp-lookup-properties)
+ (setq parse-sexp-lookup-properties 't))
+
+
+(defun erlang-mode-variables ()
+ (or erlang-mode-abbrev-table
+ (define-abbrev-table 'erlang-mode-abbrev-table ()))
+ (setq local-abbrev-table erlang-mode-abbrev-table)
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "^$\\|" page-delimiter))
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate paragraph-start)
+ (make-local-variable 'paragraph-ignore-fill-prefix)
+ (setq paragraph-ignore-fill-prefix t)
+ (make-local-variable 'defun-prompt-regexp)
+ (setq defun-prompt-regexp erlang-defun-prompt-regexp)
+ (make-local-variable 'comment-start)
+ (setq comment-start "%")
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "%+\\s *")
+ (make-local-variable 'comment-column)
+ (setq comment-column 48)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'erlang-indent-command)
+ (make-local-variable 'indent-region-function)
+ (setq indent-region-function 'erlang-indent-region)
+ (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'dabbrev-case-fold-search) nil)
+ (set (make-local-variable 'imenu-prev-index-position-function)
+ 'erlang-beginning-of-function)
+ (set (make-local-variable 'imenu-extract-index-name-function)
+ 'erlang-get-function-name-and-arity)
+ (set (make-local-variable 'tempo-match-finder)
+ "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'erlang-beginning-of-function)
+ (set (make-local-variable 'end-of-defun-function) 'erlang-end-of-function)
+ (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
+ (set (make-local-variable 'fill-paragraph-function) 'erlang-fill-paragraph)
+ (set (make-local-variable 'comment-add) 1)
+ (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$")
+ (set (make-local-variable 'outline-level) (lambda () 1))
+ (set (make-local-variable 'add-log-current-defun-function)
+ 'erlang-current-defun))
+
+(defun erlang-font-lock-init ()
+ "Initialize Font Lock for Erlang mode."
+ (or erlang-font-lock-syntax-table
+ (setq erlang-font-lock-syntax-table
+ (let ((table (copy-syntax-table erlang-mode-syntax-table)))
+ (modify-syntax-entry ?_ "w" table)
+ table)))
+ (set (make-local-variable 'font-lock-syntax-table)
+ erlang-font-lock-syntax-table)
+ (set (make-local-variable (if (boundp 'syntax-begin-function)
+ 'syntax-begin-function
+ 'font-lock-beginning-of-syntax-function))
+ 'erlang-beginning-of-clause)
+ (make-local-variable 'font-lock-keywords)
+ (let ((level (cond ((boundp 'font-lock-maximum-decoration)
+ (symbol-value 'font-lock-maximum-decoration))
+ ((boundp 'font-lock-use-maximal-decoration)
+ (symbol-value 'font-lock-use-maximal-decoration))
+ (t nil))))
+ (if (consp level)
+ (setq level (cdr-safe (or (assq 'erlang-mode level)
+ (assq t level)))))
+ ;; `level' can here be:
+ ;; A number - The fontification level
+ ;; nil - Use the default
+ ;; t - Use maximum
+ (cond ((eq level nil)
+ (set 'font-lock-keywords erlang-font-lock-keywords))
+ ((eq level 1)
+ (set 'font-lock-keywords erlang-font-lock-keywords-1))
+ ((eq level 2)
+ (set 'font-lock-keywords erlang-font-lock-keywords-2))
+ ((eq level 3)
+ (set 'font-lock-keywords erlang-font-lock-keywords-3))
+ (t
+ (set 'font-lock-keywords erlang-font-lock-keywords-4))))
+
+ ;; Modern font-locks can handle the above much more elegantly:
+ (set (make-local-variable 'font-lock-defaults)
+ '((erlang-font-lock-keywords erlang-font-lock-keywords-1
+ erlang-font-lock-keywords-2
+ erlang-font-lock-keywords-3
+ erlang-font-lock-keywords-4)
+ nil nil ((?_ . "w")) erlang-beginning-of-clause
+ (font-lock-mark-block-function . erlang-mark-clause)
+ (font-lock-syntactic-keywords
+ ;; A dollar sign right before the double quote that ends a
+ ;; string is not a character escape.
+ ;;
+ ;; And a "string" consists of a double quote not escaped by a
+ ;; dollar sign, any number of non-backslash non-newline
+ ;; characters or escaped backslashes, a dollar sign
+ ;; (otherwise we wouldn't care) and a double quote. This
+ ;; doesn't match multi-line strings, but this is probably
+ ;; the best we can get, since while font-locking we don't
+ ;; know whether matching started inside a string: limiting
+ ;; search to a single line keeps things sane.
+ . (("\\(?:^\\|[^$]\\)\"\\(?:[^\"\n]\\|\\\\\"\\)*\\(\\$\\)\"" 1 "w")
+ ;; Likewise for atoms
+ ("\\(?:^\\|[^$]\\)'\\(?:[^'\n]\\|\\\\'\\)*\\(\\$\\)'" 1 "w")
+ ;; And the dollar sign in $\" or $\' escapes two
+ ;; characters, not just one.
+ ("\\(\\$\\)\\\\[\"']" 1 "'"))))))
+
+
+
+;; Useful when defining your own keywords.
+(defun erlang-font-lock-set-face (ks &rest faces)
+ "Replace the face components in a list of keywords.
+
+The first argument, KS, is a list of keywords. The rest of the
+arguments are expressions to replace the face information with. The
+first expression replaces the face of the first keyword, the second
+expression the second keyword etc.
+
+Should an expression be nil, the face of the corresponding keyword is
+not changed.
+
+Should fewer expressions than keywords be given, the last expression
+is used for all remaining keywords.
+
+Normally, the expressions are just atoms representing the new face.
+They could however be more complex, returning different faces in
+different situations.
+
+This function only handles keywords with elements on the forms:
+ (REGEXP NUMBER FACE)
+ (REGEXP NUMBER FACE OVERWRITE)
+
+This could be used when defining your own special font-lock setup, e.g:
+
+\(setq my-font-lock-keywords
+ (append erlang-font-lock-keywords-function-header
+ erlang-font-lock-keywords-dollar
+ (erlang-font-lock-set-face
+ erlang-font-lock-keywords-macros 'my-neon-green-face)
+ (erlang-font-lock-set-face
+ erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red)
+ erlang-font-lock-keywords-attr))
+
+For a more elaborate example, please see the beginning of the file
+`erlang.el'."
+ (let ((res '()))
+ (while ks
+ (let* ((regexp (car (car ks)))
+ (number (car (cdr (car ks))))
+ (new-face (if (and faces (car faces))
+ (car faces)
+ (car (cdr (cdr (car ks))))))
+ (overwrite (car (cdr (cdr (cdr (car ks))))))
+ (new-keyword (list regexp number new-face)))
+ (if overwrite (nconc new-keyword (list overwrite)))
+ (setq res (cons new-keyword res))
+ (setq ks (cdr ks))
+ (if (and faces (cdr faces))
+ (setq faces (cdr faces)))))
+ (nreverse res)))
+
+
+(defun erlang-font-lock-level-0 ()
+ ;; DocStringOrig: font-cmd
+ "Unfontify current buffer."
+ (interactive)
+ (font-lock-mode 0))
+
+
+(defun erlang-font-lock-level-1 ()
+ ;; DocStringCopy: font-cmd
+ "Fontify current buffer at level 1.
+This highlights function headers, reserved keywords, strings and comments."
+ (interactive)
+ (require 'font-lock)
+ (set 'font-lock-keywords erlang-font-lock-keywords-1)
+ (font-lock-mode 1)
+ (funcall (symbol-function 'font-lock-fontify-buffer)))
+
+
+(defun erlang-font-lock-level-2 ()
+ ;; DocStringCopy: font-cmd
+ "Fontify current buffer at level 2.
+This highlights level 1 features (see `erlang-font-lock-level-1')
+plus bifs, guards and `single quotes'."
+ (interactive)
+ (require 'font-lock)
+ (set 'font-lock-keywords erlang-font-lock-keywords-2)
+ (font-lock-mode 1)
+ (funcall (symbol-function 'font-lock-fontify-buffer)))
+
+
+(defun erlang-font-lock-level-3 ()
+ ;; DocStringCopy: font-cmd
+ "Fontify current buffer at level 3.
+This highlights level 2 features (see `erlang-font-lock-level-2')
+plus variables, macros and records."
+ (interactive)
+ (require 'font-lock)
+ (set 'font-lock-keywords erlang-font-lock-keywords-3)
+ (font-lock-mode 1)
+ (funcall (symbol-function 'font-lock-fontify-buffer)))
+
+(defun erlang-font-lock-level-4 ()
+ ;; DocStringCopy: font-cmd
+ "Fontify current buffer at level 4.
+This highlights level 3 features (see `erlang-font-lock-level-2')
+plus variables, macros and records."
+ (interactive)
+ (require 'font-lock)
+ (set 'font-lock-keywords erlang-font-lock-keywords-4)
+ (font-lock-mode 1)
+ (funcall (symbol-function 'font-lock-fontify-buffer)))
+
+
+(defun erlang-menu-init ()
+ "Init menus for Erlang mode.
+
+The variable `erlang-menu-items' contain a description of the Erlang
+mode menu. Normally, the list contains atoms, representing variables
+bound to pieces of the menu.
+
+Personal extensions could be added to `erlang-menu-personal-items'.
+
+This function should be called if any variable describing the
+menu configuration is changed."
+ (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map))
+
+
+(defun erlang-menu-install (name items keymap)
+ "Install a menu in Emacs based on an abstract description.
+
+NAME is the name of the menu.
+
+ITEMS is a list. The elements are either nil representing a horizontal
+line or a list with two or three elements. The first is the name of
+the menu item, the second the function to call, or a submenu, on the
+same same form as ITEMS. The third optional element is an expression
+which is evaluated every time the menu is displayed. Should the
+expression evaluate to nil the menu item is ghosted.
+
+KEYMAP is the keymap to add to menu to.
+
+Please see the variable `erlang-menu-base-items'."
+ (define-key keymap (vector 'menu-bar (intern name))
+ (erlang-menu-make-keymap name items)))
+
+
+(defun erlang-menu-make-keymap (name items)
+ "Build a menu."
+ (let ((menumap (funcall (symbol-function 'make-sparse-keymap)
+ name))
+ (count 0)
+ id def first second third)
+ (setq items (reverse items))
+ (while items
+ ;; Replace any occurrence of atoms by their value.
+ (while (and items (atom (car items)) (not (null (car items))))
+ (if (and (boundp (car items))
+ (listp (symbol-value (car items))))
+ (setq items (append (reverse (symbol-value (car items)))
+ (cdr items)))
+ (setq items (cdr items))))
+ (setq first (car-safe (car items)))
+ (setq second (car-safe (cdr-safe (car items))))
+ (setq third (car-safe (cdr-safe (cdr-safe (car items)))))
+ (cond ((null first)
+ (setq count (+ count 1))
+ (setq id (intern (format "separator-%d" count)))
+ (setq def '("--" . nil)))
+ ((and (consp second) (eq (car second) 'lambda))
+ (setq count (+ count 1))
+ (setq id (intern (format "lambda-%d" count)))
+ (setq def (cons first second)))
+ ((symbolp second)
+ (setq id second)
+ (setq def (cons first second)))
+ (t
+ (setq count (+ count 1))
+ (setq id (intern (format "submenu-%d" count)))
+ (setq def (erlang-menu-make-keymap first second))))
+ (define-key menumap (vector id) def)
+ (if third
+ (put id 'menu-enable third))
+ (setq items (cdr items)))
+ (cons name menumap)))
+
+(defun erlang-menu-substitute (items alist)
+ "Substitute functions in menu described by ITEMS.
+
+The menu ITEMS is updated destructively.
+
+ALIST is list of pairs where the car is the old function and cdr the new."
+ (let (first second pair)
+ (while items
+ (setq first (car-safe (car items)))
+ (setq second (car-safe (cdr-safe (car items))))
+ (cond ((null first))
+ ((symbolp second)
+ (setq pair (and second (assq second alist)))
+ (if pair
+ (setcar (cdr (car items)) (cdr pair))))
+ ((and (consp second) (eq (car second) 'lambda)))
+ (t
+ (erlang-menu-substitute second alist)))
+ (setq items (cdr items)))))
+
+
+(defun erlang-menu-add-above (entry above items)
+ "Add menu ENTRY above menu entry ABOVE in menu ITEMS.
+Do nothing if the items already should be in the menu.
+Should ABOVE not be in the list, the entry is added at
+the bottom of the menu.
+
+The new menu is returned. No guarantee is given that the original
+menu is left unchanged.
+
+The equality test is performed by `eq'.
+
+Example: (erlang-menu-add-above 'my-erlang-menu-items
+ 'erlang-menu-man-items)"
+ (erlang-menu-add-below entry above items t))
+
+
+(defun erlang-menu-add-below (entry below items &optional above-p)
+ "Add menu ENTRY below menu items BELOW in the Erlang menu.
+Do nothing if the items already should be in the menu.
+Should BELOW not be in the list, items is added at the bottom
+of the menu.
+
+The new menu is returned. No guarantee is given that the original
+menu is left unchanged.
+
+The equality test is performed by `eq'.
+
+Example:
+
+\(setq erlang-menu-items
+ (erlang-menu-add-below 'my-erlang-menu-items
+ 'erlang-menu-base-items
+ erlang-menu-items))"
+ (if (memq entry items)
+ items ; Return the original menu.
+ (let ((head '())
+ (done nil)
+ res)
+ (while (not done)
+ (cond ((null items)
+ (setq res (append head (list entry)))
+ (setq done t))
+ ((eq below (car items))
+ (setq res
+ (if above-p
+ (append head (cons entry items))
+ (append head (cons (car items)
+ (cons entry (cdr items))))))
+ (setq done t))
+ (t
+ (setq head (append head (list (car items))))
+ (setq items (cdr items)))))
+ res)))
+
+(defun erlang-menu-delete (entry items)
+ "Delete ENTRY from menu ITEMS.
+
+The new menu is returned. No guarantee is given that the original
+menu is left unchanged."
+ (delq entry items))
+
+;; Man code:
+
+(defun erlang-man-init ()
+ "Add menus containing the manual pages of the Erlang.
+
+The variable `erlang-man-dirs' contains entries describing
+the location of the manual pages."
+ (interactive)
+ (if (or erlang-man-inhibit
+ (and (boundp 'menu-bar-mode)
+ (not menu-bar-mode)))
+ ()
+ (setq erlang-menu-man-items
+ '(nil
+ ("Man - Function" erlang-man-function)
+ ("Man - Function Under Cursor" erlang-man-function-no-prompt)))
+ (if erlang-man-dirs
+ (setq erlang-menu-man-items
+ (append erlang-menu-man-items
+ (erlang-man-make-top-menu erlang-man-dirs))))
+ (setq erlang-menu-items
+ (erlang-menu-add-above 'erlang-menu-man-items
+ 'erlang-menu-version-items
+ erlang-menu-items))
+ (erlang-menu-init)))
+
+
+(defun erlang-man-uninstall ()
+ "Remove the man pages from the Erlang mode."
+ (interactive)
+ (setq erlang-menu-items
+ (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items))
+ (erlang-menu-init))
+
+
+;; The man menu is a hierarchal structure, with the manual sections
+;; at the top, described by `erlang-man-dirs'. The next level could
+;; either be the manual pages if not to many, otherwise it is an index
+;; menu whose submenus will contain up to `erlang-man-max-menu-size'
+;; manual pages.
+
+(defun erlang-man-make-top-menu (dir-list)
+ "Create one menu entry per element of DIR-LIST.
+The format is described in the documentation of `erlang-man-dirs'."
+ (let ((menu '())
+ dir)
+ (while dir-list
+ (setq dir (cond ((nth 2 (car dir-list))
+ ;; Relative to `erlang-root-dir'.
+ (erlang-man-dir (nth 1 (car dir-list)) t))
+ (t
+ ;; Absolute
+ (nth 1 (car dir-list)))))
+ (if (and dir
+ (file-readable-p dir))
+ (setq menu (cons (list (car (car dir-list))
+ (erlang-man-make-middle-menu
+ (erlang-man-get-files dir)))
+ menu)))
+ (setq dir-list (cdr dir-list)))
+ ;; Should no menus be found, generate a menu item which
+ ;; will display a help text, when selected.
+ (if menu
+ (nreverse menu)
+ '(("Man Pages"
+ (("Error! Why?" erlang-man-describe-error)))))))
+
+(defcustom erlang-man-download-url "http://erlang.org/download/otp_doc_man_22.1.tar.gz"
+ "The URL from which the erlang-man-download function will
+ download Erlang man pages "
+ :type 'string)
+
+(defun erlang-man-user-local-emacs-dir ()
+ "Returns the directory where man pages that are downloaded by
+the functions erlang-man-download and erlang-man-download-ask are
+stored."
+ (concat (file-name-as-directory (locate-user-emacs-file "cache"))
+ (file-name-as-directory "erlang_mode_man_pages"))
+ )
+
+(defun erlang-man-download (&optional download-url-param)
+ "Downloads the Erlang man pages into the
+\"cache/erlang_mode_man_pages\" subdirectory under the user's
+Emacs directory, if the man pages haven't been downloaded
+already. The URL from which the man pages are downloaded can be
+configured with the variable \"erlang-man-download-url\""
+ (interactive)
+ (let* ((download-url (or download-url-param erlang-man-download-url))
+ (downloaded-man-dir (erlang-man-user-local-emacs-dir))
+ (downloaded-man-url-file (concat
+ (file-name-as-directory downloaded-man-dir)
+ "erlang_man_download_url")))
+ (if (and (file-exists-p downloaded-man-url-file)
+ (string= download-url (with-temp-buffer
+ (insert-file-contents downloaded-man-url-file)
+ (buffer-string))))
+ downloaded-man-dir
+ (let ((man-file (concat (file-name-as-directory downloaded-man-dir) "man.tar.gz")))
+ (message "Downloading: %s to %s" download-url man-file)
+ (require 'url)
+ (mkdir downloaded-man-dir t)
+ (url-copy-file download-url man-file t)
+ ;; Write the download URL to a file so that future calls to
+ ;; erlang-man-download can check if the man cache should be
+ ;; updated
+ (write-region download-url nil downloaded-man-url-file)
+ ;; url-copy-file unpacks the zip archive (at least on my
+ ;; system) but this behavior is undocumented so do a tar with
+ ;; the z flag as well
+ (message "Note that %s will only be unpacked automatically if your system has the tar tool in its path" man-file)
+ (shell-command (format "tar -x -z -f %s -C %s" man-file downloaded-man-dir))
+ (message "The error message above can be ignored if everything works fine")
+ (message "Unpacking man pages using the command \"%s\""
+ (format "tar -x -f %s -C %s" man-file downloaded-man-dir))
+ (shell-command (format "tar -x -f %s -C %s" man-file downloaded-man-dir))
+ (message "Restarting erlang-mode")
+ (erlang-mode)
+ downloaded-man-dir
+ )
+ )
+ )
+ )
+
+(defun erlang-man-download-ask (&optional subdir)
+ "Downloads the Erlang man pages into the
+\"cache/erlang_mode_man_pages\" subdirectory under the user's
+Emacs directory, if the man pages haven't been downloaded
+already. This function ask the user to confirm before downloading
+and lets the user edit the download URL. The function
+erlang-man-download downloads the man pages without prompting the
+user."
+ (interactive)
+ (if (y-or-n-p "Could not find Erlang man pages on your system. Do you want to download them?")
+ (let ((download-url (read-string "URL to download man pages from: " erlang-man-download-url)))
+ (concat (directory-file-name (erlang-man-download download-url)) (or subdir "")))))
+
+
+(defun erlang-man-dir (subdir &optional no-download)
+ (let ((default-man-dir (if erlang-root-dir
+ (concat (directory-file-name (concat
+ (file-name-as-directory erlang-root-dir)
+ (file-name-as-directory "lib")
+ (file-name-as-directory "erlang")))
+ subdir)))
+ (alt-man-dir (if erlang-root-dir
+ (concat (directory-file-name erlang-root-dir) subdir)))
+ (downloaded-man-dir (erlang-man-user-local-emacs-dir)))
+ (if (and erlang-root-dir (file-directory-p default-man-dir))
+ default-man-dir
+ (if (and erlang-root-dir (file-directory-p alt-man-dir))
+ alt-man-dir
+ (if (file-directory-p (concat (directory-file-name downloaded-man-dir) subdir))
+ (concat (directory-file-name downloaded-man-dir) subdir)
+ (and (not no-download) (erlang-man-download-ask subdir)))))))
+
+;; Should the menu be to long, let's split it into a number of
+;; smaller menus. Warning, this code contains beautiful
+;; destructive operations!
+(defun erlang-man-make-middle-menu (filelist)
+ "Create the second level menu from FILELIST.
+
+Should the list be longer than `erlang-man-max-menu-size', a tree of
+menus is created."
+ (if (<= (length filelist) erlang-man-max-menu-size)
+ (erlang-man-make-menu filelist)
+ (let ((menu '())
+ (filelist (copy-sequence filelist))
+ segment submenu pair)
+ (while filelist
+ (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist))
+ (setq segment filelist)
+ (if (null pair)
+ (setq filelist nil)
+ (setq filelist (cdr pair))
+ (setcdr pair nil))
+ (setq submenu (erlang-man-make-menu segment))
+ (setq menu (cons (list (concat (car (car submenu))
+ " -- "
+ (car (car (reverse submenu))))
+ submenu)
+ menu)))
+ (nreverse menu))))
+
+
+(defun erlang-man-make-menu (filelist)
+ "Make a leaf menu based on FILELIST."
+ (let ((menu '())
+ item)
+ (while filelist
+ (setq item (erlang-man-make-menu-item (car filelist)))
+ (if item
+ (setq menu (cons item menu)))
+ (setq filelist (cdr filelist)))
+ (nreverse menu)))
+
+
+(defun erlang-man-make-menu-item (file)
+ "Create a menu item containing the name of the man page."
+ (and (string-match ".+/\\([^/]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file)
+ (let ((page (substring file (match-beginning 1) (match-end 1))))
+ (list (capitalize page)
+ (list 'lambda '()
+ '(interactive)
+ (list 'funcall 'erlang-man-display-function
+ file))))))
+
+
+(defun erlang-man-get-files (dir)
+ "Return files in directory DIR."
+ (directory-files dir t ".+\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?\\'"))
+
+
+(defun erlang-man-module (&optional module)
+ "Find manual page for MODULE, defaults to module of function under point.
+This function is aware of imported functions."
+ (interactive
+ (list (let* ((mod (erlang-default-module))
+ (input (read-string
+ (format "Manual entry for module%s: "
+ (if (or (null mod) (string= mod ""))
+ ""
+ (format " (default %s)" mod))))))
+ (if (string= input "")
+ mod
+ input))))
+ (setq module (or module
+ (erlang-default-module)))
+ (when (or (null module) (string= module ""))
+ (error "No Erlang module name given"))
+ (let ((dir-list erlang-man-dirs)
+ (pat (concat "/" (regexp-quote module)
+ "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$"))
+ (file nil)
+ file-list)
+ (while (and dir-list (null file))
+ (let ((dir (if (nth 2 (car dir-list))
+ (erlang-man-dir (nth 1 (car dir-list)))
+ (nth 1 (car dir-list)))))
+ (when (file-directory-p dir)
+ (setq file-list (erlang-man-get-files dir))
+ (while (and file-list (null file))
+ (if (string-match pat (car file-list))
+ (setq file (car file-list)))
+ (setq file-list (cdr file-list))))
+ (setq dir-list (cdr dir-list))))
+ (if file
+ (funcall erlang-man-display-function file)
+ ;; Did not found the manual file. Fallback to manual-entry.
+ (manual-entry module))))
+
+(defun erlang-default-module ()
+ (let ((id (erlang-get-identifier-at-point)))
+ (if (eq (erlang-id-kind id) 'qualified-function)
+ (erlang-id-module id)
+ (erlang-id-name id))))
+
+
+;; Warning, the function `erlang-man-function' is a hack!
+;; It links itself into the man code in a non-clean way. I have
+;; chosen to keep it since it provides a very useful functionality
+;; which is not possible to achieve using a clean approach.
+;; / AndersL
+;;
+;; The previous hack seems to have broken in Emacs 25. This is fixed
+;; by trying to find the function in the man buffer a few times with a
+;; delay in between (see function
+;; erlang-man-repeated-search-for-function). This fix is also a hack
+;; but it should be quite robust and will work even if the function
+;; that erlang-man-function-display-man-page tries to hook into
+;; disappears or changes.
+
+(defvar erlang-man-function-name nil
+ "Name of function for last `erlang-man-function' call.
+Used for communication between `erlang-man-function' and the
+patch to `Man-notify-when-ready'.")
+
+(defun erlang-man-function-display-man-page (name)
+ "Helper function for erlang-man-function. Displays the man page
+ text for the Erlang function named name if it can be found."
+ (let ((modname nil)
+ (funcname nil))
+ (cond ((string-match ":" name)
+ (setq modname (substring name 0 (match-beginning 0)))
+ (setq funcname (substring name (match-end 0) nil)))
+ ((stringp name)
+ (setq modname name)))
+ (when (or (null modname) (string= modname ""))
+ (error "No Erlang module name given"))
+ (cond ((fboundp 'Man-notify-when-ready)
+ ;; From Emacs 19: The man command could possibly start an
+ ;; asynchronous process, i.e. we must hook ourselves into
+ ;; the system to be activated when the man-process
+ ;; terminates.
+ (if (null funcname)
+ ()
+ (erlang-man-patch-notify)
+ (setq erlang-man-function-name funcname))
+ (condition-case err
+ (erlang-man-module modname)
+ (error (setq erlang-man-function-name nil)
+ (signal (car err) (cdr err)))))
+ (t
+ (erlang-man-module modname)
+ (when funcname
+ (erlang-man-repeated-search-for-function nil
+ funcname
+ modname))))))
+
+(defun erlang-man-function (&optional name)
+ "Find manual page for NAME, where NAME is module:function.
+The entry for `function' is displayed.
+
+This function is aware of imported functions."
+ (interactive
+ (list (let* ((default (erlang-default-function-or-module))
+ (input (read-string
+ (format
+ "Manual entry for `module:func' or `module'%s: "
+ (if default
+ (format " (default %s)" default)
+ "")))))
+ (if (string= input "")
+ default
+ input))))
+ (require 'man)
+ (setq name (or name
+ (erlang-default-function-or-module)))
+ (erlang-man-function-display-man-page name))
+
+
+(defun erlang-man-function-no-prompt ()
+ "Find manual page for the function under the cursor.
+The man entry for `function' is displayed. This function
+provides the same functionality as erlang-man-function except for
+that it does not ask the user to confirm the function name before
+opening the man page for the function."
+ (interactive)
+ (let ((name (erlang-default-function-or-module)))
+ (if name
+ (erlang-man-function name)
+ (error "No function name under the cursor"))))
+
+(defun erlang-man-repeated-search-for-function (man-buffer
+ function-name
+ &optional
+ module-name)
+ "This function tries to scroll MAN-BUFFER to the documentation
+of function FUNCTION-NAME. The function will try again a few
+times if the documentation for FUNCTION-NAME can't be found. This
+is necessary as the man page is loaded asynchronously from Emacs
+19 and the correct function to hook into depends on the Emacs
+version. The function will automatically try to find the correct
+buffer from the list of opened buffers if MAN-BUFFER is nil. The
+optional parameter MODULE-NAME will make the search for the
+buffer more accurate."
+ (let* ((time-between-attempts 0.5)
+ (max-wait-time 5.1)
+ (search-for-function
+ (lambda (self
+ time-waited
+ time-between-attempts
+ max-wait-time
+ man-buffer
+ function-name
+ module-name
+ )
+ (when (and (not (erlang-man-find-function man-buffer function-name module-name))
+ (<= (+ time-waited time-between-attempts)
+ max-wait-time))
+ (message "Finding function %s..." function-name)
+ ; Call this function again later
+ (run-at-time time-between-attempts nil
+ self
+ self
+ (+ time-waited time-between-attempts)
+ time-between-attempts
+ max-wait-time
+ man-buffer
+ function-name
+ module-name)
+ ))))
+ (funcall search-for-function
+ search-for-function
+ 0.0
+ time-between-attempts
+ max-wait-time
+ man-buffer
+ function-name
+ module-name)))
+
+;; Should the defadvice be at the top level, the package `advice' would
+;; be required. Now it is only required when this functionality
+;; is used. (Emacs 19 specific.)
+(defun erlang-man-patch-notify ()
+ "Patch the function `Man-notify-when-ready' to search for function.
+The variable `erlang-man-function-name' is assumed to be bound to
+the function name, or to nil.
+
+The reason for patching a function is that under Emacs 19, the man
+command is executed asynchronously."
+ (condition-case nil
+ (require 'advice)
+ ;; This should never happened since this is only called when
+ ;; running under Emacs 19.
+ (error (error (concat "This command needs the package `advice', "
+ "please upgrade your Emacs."))))
+ (require 'man)
+ (defadvice Man-notify-when-ready
+ (after erlang-Man-notify-when-ready activate)
+ "Set point at the documentation of the function name in
+`erlang-man-function-name' when the man page is displayed."
+ (if erlang-man-function-name
+ (erlang-man-repeated-search-for-function (ad-get-arg 0)
+ erlang-man-function-name)
+ (setq erlang-man-function-name nil))))
+
+
+
+
+(defun erlang-man-find-function (buf func &optional module-name)
+ "Find manual page for function `erlang-man-function-name' in buffer BUF.
+The function will automatically try to find the correct buffer among the
+opened buffers if BUF is nil. The optional parameter MODULE-NAME will make
+the search for the buffer more accurate."
+ (let ((buffer (or buf
+ (progn
+ ; find buffer containing man page
+ (require 'cl-lib)
+ (car (cl-remove-if-not (lambda (buf)
+ (string-match
+ (or module-name "")
+ (format "%s" buf)))
+ (cl-remove-if-not
+ (lambda (buf)
+ (string-match
+ "[Mm][Aa][Nn]"
+ (format "%s" buf)))
+ (buffer-list))))))))
+ (if (and func buffer)
+ (let ((win (get-buffer-window buffer)))
+ (if win
+ (progn
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^[ \t]*\\([a-z0-9_]*[ \t]*:\\)?[ \t]*" func "[ \t]*([A-Za-z0-9 \t:,_()]*)[ \t]*->")
+ (point-max) t)
+ (progn
+ (forward-word -1)
+ (set-window-point win (point))
+ (message "Found documentation for function `%s'" func)
+ t)
+ (if (re-search-forward
+ (concat "^[ \t]*\\([a-z0-9_]*[ \t]*:\\)?[ \t]*" func "[ \t]*\(")
+ (point-max) t)
+ (progn
+ (forward-word -1)
+ (set-window-point win (point))
+ (message "Found documentation for function `%s'" func)
+ t)
+ (progn
+ (message "Could not find function `%s'" func)
+ nil)))))))))
+
+(defvar erlang-man-file-regexp
+ "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")
+
+(defun erlang-man-display (file)
+ "Display FILE as a `man' file.
+This is the default manual page display function.
+The variables `erlang-man-display-function' contains the function
+to be used."
+ (require 'man)
+ (if file
+ (let ((process-environment (copy-sequence process-environment)))
+ (if (string-match erlang-man-file-regexp file)
+ (let ((dir (substring file (match-beginning 1) (match-end 1)))
+ (page (substring file (match-beginning 2) (match-end 2))))
+ (setenv "MANPATH" dir)
+ (manual-entry page))
+ (error "Can't find man page for %s\n" file)))))
+
+
+(defun erlang-man-describe-error ()
+ "Describe why the manual pages weren't found."
+ (interactive)
+ (with-output-to-temp-buffer "*Erlang Man Error*"
+ (princ "Normally, this menu should contain Erlang manual pages.
+
+In order to find the manual pages, the variable `erlang-root-dir'
+should be bound to the name of the directory containing the Erlang
+installation. The name should not include the final slash.
+
+Practically, you should add a line on the following form to
+your ~/.emacs, or ask your system administrator to add it to
+the site init file:
+ (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\")
+
+For example:
+ (setq erlang-root-dir \"/usr/local/erlang\")
+
+Alternatively, you can download the Erlang man pages
+automatically by placing the following lines in your Emacs init
+file or by executing the Emacs command `M-x
+erlang-man-download-ask RET' (the download URL can be customized
+with the Emacs variable erlang-man-download-url):
+
+ (require 'erlang)
+ (erlang-man-download)
+
+After installing the line/lines in your Emacs init file or after
+running the command `M-x erlang-man-download-ask RET', kill and
+restart Emacs, or restart Erlang mode with the command `M-x
+erlang-mode RET'.")))
+
+;; Skeleton code:
+
+;; This code is based on the package `tempo' which is part of modern
+;; Emacsen.
+
+(defvar erlang-skel)
+(defun erlang-skel-init ()
+ "Generate the skeleton functions and menu items.
+The variable `erlang-skel' contains the name and descriptions of
+all skeletons.
+
+The skeleton routines are based on the `tempo' package. Should this
+package not be present, this function does nothing."
+ (interactive)
+ (require 'tempo)
+ (let ((skel erlang-skel)
+ (menu '()))
+ (while skel
+ (cond ((null (car skel))
+ (setq menu (cons nil menu)))
+ (t
+ (funcall (symbol-function 'tempo-define-template)
+ (concat "erlang-" (nth 1 (car skel)))
+ ;; The tempo template used contains an `include'
+ ;; function call only, hence changes to the
+ ;; variables describing the templates take effect
+ ;; immediately.
+ (list (list 'erlang-skel-include (nth 2 (car skel))))
+ (nth 1 (car skel))
+ (car (car skel))
+ 'erlang-tempo-tags)
+ (setq menu (cons (erlang-skel-make-menu-item
+ (car skel)) menu))))
+ (setq skel (cdr skel)))
+ (setq erlang-menu-skel-items
+ (list nil (list "Skeletons" (nreverse menu))))
+ (setq erlang-menu-items
+ (erlang-menu-add-above 'erlang-menu-skel-items
+ 'erlang-menu-version-items
+ erlang-menu-items))
+ (erlang-menu-init)))
+
+(defun erlang-skel-make-menu-item (skel)
+ (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel)))))
+ (cond ((null (nth 3 skel))
+ (list (car skel) func))
+ (t
+ (list (car skel)
+ (list 'lambda '()
+ '(interactive)
+ (list 'funcall
+ (list 'quote (nth 3 skel))
+ (list 'quote func))))))))
+
+;; Functions designed to be added to the skeleton menu.
+;; (Not normally used)
+(defun erlang-skel-insert (func)
+ "Insert skeleton generated by FUNC and goto first tempo mark."
+ (save-excursion (funcall func))
+ (funcall (symbol-function 'tempo-forward-mark)))
+
+(defun erlang-skel-header (func)
+ "Insert the header generated by FUNC at the beginning of the buffer."
+ (goto-char (point-min))
+ (save-excursion (funcall func))
+ (funcall (symbol-function 'tempo-forward-mark)))
+
+
+;; Functions used inside the skeleton descriptions.
+(defun erlang-skel-skip-blank ()
+ (skip-chars-backward " \t")
+ nil)
+
+(defun erlang-skel-include (&rest args)
+ "Include a template inside another template.
+
+Example of use, assuming that `erlang-skel-func' is defined:
+
+ (defvar foo-skeleton '(\"%%% New function:\"
+ (erlang-skel-include erlang-skel-func)))
+
+Technically, this function returns the `tempo' attribute`(l ...)' which
+can contain other `tempo' attributes. Please see the function
+`tempo-define-template' for a description of the `(l ...)' attribute."
+ (let ((res '())
+ entry)
+ (while args
+ (setq entry (car args))
+ (while entry
+ (setq res (cons (car entry) res))
+ (setq entry (cdr entry)))
+ (setq args (cdr args)))
+ (cons 'l (nreverse res))))
+
+(defvar erlang-skel-separator-length 70)
+
+(defun erlang-skel-separator (&optional percent)
+ "Return a comment separator."
+ (let ((percent (or percent 3)))
+ (concat (make-string percent ?%)
+ (make-string (- erlang-skel-separator-length percent) ?-)
+ "\n")))
+
+(defun erlang-skel-double-separator (&optional percent)
+ "Return a comment separator."
+ (let ((percent (or percent 3)))
+ (concat (make-string percent ?%)
+ (make-string (- erlang-skel-separator-length percent) ?=)
+ "\n")))
+
+(defun erlang-skel-dd-mmm-yyyy ()
+ "Return the current date as a string in \"DD Mon YYYY\" form.
+The first character of DD is space if the value is less than 10."
+ (let ((date (current-time-string)))
+ (format "%2d %s %s"
+ (string-to-number (substring date 8 10))
+ (substring date 4 7)
+ (substring date -4))))
+
+;; Indentation code:
+
+(defun erlang-indent-command (&optional whole-exp)
+ "Indent current line as Erlang code.
+With argument, indent any additional lines of the same clause
+rigidly along with this one."
+ (interactive "P")
+ (if whole-exp
+ ;; If arg, always indent this line as Erlang
+ ;; and shift remaining lines of clause the same amount.
+ (let ((shift-amt (erlang-indent-line))
+ beg end)
+ (save-excursion
+ (if erlang-tab-always-indent
+ (beginning-of-line))
+ (setq beg (point))
+ (erlang-end-of-clause 1)
+ (setq end (point))
+ (goto-char beg)
+ (forward-line 1)
+ (setq beg (point)))
+ (if (> end beg)
+ (indent-code-rigidly beg end shift-amt "\n")))
+ (if (and (not erlang-tab-always-indent)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp))))
+ (insert-tab)
+ (erlang-indent-line))))
+
+
+(defun erlang-indent-line ()
+ "Indent current line as Erlang code.
+Return the amount the indentation changed by."
+ (let ((pos (- (point-max) (point)))
+ indent beg
+ shift-amt)
+ (beginning-of-line 1)
+ (setq beg (point))
+ (skip-chars-forward " \t")
+ (cond ((looking-at "%")
+ (setq indent (funcall comment-indent-function))
+ (setq shift-amt (- indent (current-column))))
+ (t
+ (setq indent (erlang-calculate-indent))
+ (cond ((null indent)
+ (setq indent (current-indentation)))
+ ((eq indent t)
+ ;; This should never occur here.
+ (error "Erlang mode error"))
+ ;;((= (char-syntax (following-char)) ?\))
+ ;; (setq indent (1- indent)))
+ )
+ (setq shift-amt (- indent (current-column)))))
+ (if (zerop shift-amt)
+ nil
+ (delete-region beg (point))
+ (indent-to indent))
+ ;; If initial point was within line's indentation, position
+ ;; after the indentation. Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))
+ (run-hooks 'erlang-indent-line-hook)
+ shift-amt))
+
+
+(defun erlang-indent-region (beg end)
+ "Indent region of Erlang code.
+
+This is automagically called by the user level function `indent-region'."
+ (interactive "r")
+ (save-excursion
+ (let ((case-fold-search nil)
+ (continue t)
+ (from-end (- (point-max) end))
+ indent-point;; The beginning of the current line
+ indent;; The indent amount
+ state)
+ (goto-char beg)
+ (beginning-of-line)
+ (setq indent-point (point))
+ (erlang-beginning-of-clause)
+ ;; Parse the Erlang code from the beginning of the clause to
+ ;; the beginning of the region.
+ (while (< (point) indent-point)
+ (let ((pt (point)))
+ (setq state (erlang-partial-parse pt indent-point state))
+ (if (= pt (point))
+ (error "Illegal syntax"))))
+ ;; Indent every line in the region
+ (while continue
+ (goto-char indent-point)
+ (skip-chars-forward " \t")
+ (cond ((looking-at "%")
+ ;; Do not use our stack to help the user to customize
+ ;; comment indentation.
+ (setq indent (funcall comment-indent-function)))
+ ((looking-at "$")
+ ;; Don't indent empty lines.
+ (setq indent 0))
+ (t
+ (setq indent
+ (save-excursion
+ (erlang-calculate-stack-indent (point) state)))
+ (cond ((null indent)
+ (setq indent (current-indentation)))
+ ((eq indent t)
+ ;; This should never occur here.
+ (error "Erlang mode error"))
+ ;;((= (char-syntax (following-char)) ?\))
+ ;; (setq indent (1- indent)))
+ )))
+ (if (zerop (- indent (current-column)))
+ nil
+ (delete-region indent-point (point))
+ (indent-to indent))
+ ;; Find the next line in the region
+ (goto-char indent-point)
+ (save-excursion
+ (forward-line 1)
+ (setq indent-point (point)))
+ (if (>= from-end (- (point-max) indent-point))
+ (setq continue nil)
+ (while (< (point) indent-point)
+ (let ((pt (point)))
+ (setq state (erlang-partial-parse
+ pt indent-point state))
+ (if (= pt (point))
+ (error "Illegal syntax")))))))))
+
+
+(defun erlang-indent-current-buffer ()
+ "Indent current buffer as Erlang code."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (erlang-indent-region (point-min) (point-max)))))
+
+
+(defun erlang-indent-function ()
+ "Indent current Erlang function."
+ (interactive)
+ (save-excursion
+ (let ((end (progn (erlang-end-of-function 1) (point)))
+ (beg (progn (erlang-beginning-of-function 1) (point))))
+ (erlang-indent-region beg end))))
+
+
+(defun erlang-indent-clause ()
+ "Indent current Erlang clause."
+ (interactive)
+ (save-excursion
+ (let ((end (progn (erlang-end-of-clause 1) (point)))
+ (beg (progn (erlang-beginning-of-clause 1) (point))))
+ (erlang-indent-region beg end))))
+
+
+(defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack)))
+(defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack)))
+
+
+(defun erlang-calculate-indent (&optional parse-start)
+ "Compute appropriate indentation for current line as Erlang code.
+Return nil if line starts inside string, t if in a comment."
+ (save-excursion
+ (let ((indent-point (point))
+ (case-fold-search nil)
+ (state nil))
+ (if parse-start
+ (goto-char parse-start)
+ (erlang-beginning-of-clause))
+ (while (< (point) indent-point)
+ (let ((pt (point)))
+ (setq state (erlang-partial-parse pt indent-point state))
+ (if (= pt (point))
+ (error "Illegal syntax"))))
+ (erlang-calculate-stack-indent indent-point state))))
+
+(defun erlang-show-syntactic-information ()
+ "Show syntactic information for current line."
+
+ (interactive)
+
+ (save-excursion
+ (let ((starting-point (point))
+ (case-fold-search nil)
+ (state nil))
+ (erlang-beginning-of-clause)
+ (while (< (point) starting-point)
+ (setq state (erlang-partial-parse (point) starting-point state)))
+ (message "%S" state))))
+
+
+(defun erlang-partial-parse (from to &optional state)
+ "Parse Erlang syntax starting at FROM until TO, with an optional STATE.
+Value is list (stack token-start token-type in-what)."
+ (goto-char from) ; Start at the beginning
+ (erlang-skip-blank to)
+ (let ((cs (char-syntax (following-char)))
+ (stack (car state))
+ (token (point))
+ in-what)
+ (cond
+
+ ;; Done: Return previous state.
+ ((>= token to)
+ (setq token (nth 1 state))
+ (setq cs (nth 2 state))
+ (setq in-what (nth 3 state)))
+
+ ;; Word constituent: check and handle keywords.
+ ((= cs ?w)
+ (cond ((looking-at "\\(end\\|after\\|else\\)[^_a-zA-Z0-9]")
+ ;; Must pop top icr layer, `after' will push a new
+ ;; layer next.
+ (progn
+ (while (and stack (eq (car (car stack)) '->))
+ (erlang-pop stack))
+ (if (and stack (memq (car (car stack)) '(icr begin fun try maybe)))
+ (erlang-pop stack))))
+ ((looking-at "catch\\b.*of")
+ t)
+ ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)")
+ ;; Must pop top icr layer, `catch' in try/catch
+ ;;will push a new layer next.
+ (progn
+ (while (and stack (eq (car (car stack)) '->))
+ (erlang-pop stack))
+ (if (and stack (memq (car (car stack)) '(icr begin try maybe)))
+ (erlang-pop stack))))
+ )
+ (cond ((looking-at "\\(if\\|case\\|receive\\)[^_a-zA-Z0-9]")
+ ;; Must push a new icr (if/case/receive) layer.
+ (erlang-push (list 'icr token (current-column)) stack))
+ ((looking-at "\\(try\\|after\\)[^_a-zA-Z0-9]")
+ ;; Must handle separately, try catch or try X of -> catch
+ ;; same for `after', it could be
+ ;; receive after Time -> X end, or
+ ;; try after X end
+ (erlang-push (list 'try token (current-column)) stack))
+ ((looking-at "\\(of\\)[^_a-zA-Z0-9]")
+ ;; Must handle separately, try X of -> catch
+ (if (and stack (eq (car (car stack)) 'try))
+ (let ((try-column (nth 2 (car stack)))
+ (try-pos (nth 1 (car stack))))
+ (erlang-pop stack)
+ (erlang-push (list 'icr try-pos try-column) stack))))
+
+ ((looking-at "\\(fun\\)[^_a-zA-Z0-9]")
+ ;; Push a new layer if we are defining a `fun'
+ ;; expression, not when we are referring an existing
+ ;; function. 'fun's defines are only indented one level now.
+ (if (save-excursion
+ (goto-char (match-end 1))
+ (erlang-skip-blank to)
+ ;; Use erlang-variable-regexp here to look for an
+ ;; optional variable name to match EEP37 named funs.
+ (if (looking-at erlang-variable-regexp)
+ (progn
+ (goto-char (match-end 0))
+ (erlang-skip-blank to)))
+ (eq (following-char) ?\())
+ (erlang-push (list 'fun token (current-column)) stack)))
+ ((looking-at "\\(begin\\)[^_a-zA-Z0-9]")
+ (erlang-push (list 'begin token (current-column)) stack))
+ ((looking-at "\\(maybe\\)[^_a-zA-Z0-9]")
+ (erlang-push (list 'begin token (current-column)) stack))
+ ((looking-at "\\(else\\)[^_a-zA-Z0-9]")
+ (erlang-push (list 'icr token (current-column)) stack))
+
+ ;; Normal when case
+ ;;((looking-at "when\\s ")
+ ;;((looking-at "when\\s *\\($\\|%\\)")
+ ((looking-at "when[^_a-zA-Z0-9]")
+ (erlang-push (list 'when token (current-column)) stack))
+ ((looking-at "catch\\b.*of")
+ t)
+ ((looking-at "catch\\b\\s *\\($\\|%\\|.*->\\)")
+ (erlang-push (list 'icr token (current-column)) stack))
+ ;;(erlang-push (list '-> token (current-column)) stack))
+ ;;((looking-at "^of$")
+ ;; (erlang-push (list 'icr token (current-column)) stack)
+ ;;(erlang-push (list '-> token (current-column)) stack))
+ )
+ (forward-sexp 1))
+ ;; String: Try to skip over it. (Catch error if not complete.)
+ ((= cs ?\")
+ (condition-case nil
+ (progn
+ (forward-sexp 1)
+ (if (> (point) to)
+ (progn
+ (setq in-what 'string)
+ (goto-char to))))
+ (error
+ (setq in-what 'string)
+ (goto-char to))))
+
+ ;; Expression prefix e.i. $ or ^ (Note ^ can be in the character
+ ;; literal $^ or part of string and $ outside of a string denotes
+ ;; a character literal)
+ ((= cs ?')
+ (cond
+ ((= (following-char) ?\") ;; $ or ^ was the last char in a string
+ (forward-char 1))
+ (t
+ ;; Maybe a character literal, quote the next char to avoid
+ ;; situations as $" being seen as the beginning of a string.
+ ;; Note the quoting something in the middle of a string is harmless.
+ (quote (following-char))
+ (forward-char 1))))
+
+ ;; Symbol constituent or punctuation
+
+ ((memq cs '(?. ?_))
+ (cond
+
+ ;; Clause end
+ ((= (following-char) ?\;)
+ (if (eq (car (car (last stack))) 'spec)
+ (while (memq (car (car stack)) '(when ::))
+ (erlang-pop stack)))
+ (if (and stack (eq (car (car stack)) '->))
+ (erlang-pop stack))
+ (forward-char 1))
+
+ ;; Parameter separator
+ ((looking-at ",")
+ (forward-char 1)
+ (if (and stack (eq (car (car stack)) '::))
+ ;; Type or spec
+ (erlang-pop stack)))
+
+ ;; Function end
+ ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")
+ (setq stack nil)
+ (forward-char 1))
+
+ ;; Function head
+ ((looking-at "->")
+ (if (and stack (eq (car (car stack)) 'when))
+ (erlang-pop stack))
+ (erlang-push (list '-> token (current-column)) stack)
+ (forward-char 2))
+
+ ;; List-comprehension divider
+ ((looking-at "||")
+ (erlang-push (list '|| token (current-column)) stack)
+ (forward-char 2))
+
+ ;; Bit-syntax open. Note that map syntax allows "<<" to follow ":="
+ ;; or "=>" without intervening whitespace, so handle that case here
+ ((looking-at "\\(:=\\|=>\\)?<<")
+ (erlang-push (list '<< token (current-column)) stack)
+ (forward-char (- (match-end 0) (match-beginning 0))))
+
+ ;; Bit-syntax close
+ ((looking-at ">>")
+ (while (memq (car (car stack)) '(|| ->))
+ (erlang-pop stack))
+ (cond ((eq (car (car stack)) '<<)
+ (erlang-pop stack))
+ ((memq (car (car stack)) '(icr begin maybe fun))
+ (error "Missing `end'"))
+ (t
+ (error "Unbalanced parentheses")))
+ (forward-char 2))
+
+ ;; Macro
+ ((= (following-char) ??)
+ ;; Skip over the ?
+ (forward-char 1)
+ )
+
+ ;; Type spec's
+ ((looking-at "-type\\s \\|-opaque\\s ")
+ (if stack
+ (forward-char 1)
+ (erlang-push (list 'type token (current-column)) stack)
+ (forward-char 6)))
+ ((looking-at "-spec\\s ")
+ (if stack
+ (forward-char 1)
+ (forward-char 6)
+ (erlang-push (list 'spec (point) (current-column)) stack)
+ (skip-chars-forward "^(\n")
+ (erlang-push (list 'spec_arg (point) (current-column)) stack)
+ ))
+
+ ;; Type spec delimiter
+ ((looking-at "::")
+ (erlang-push (list ':: token (current-column)) stack)
+ (forward-char 2))
+
+ ;; Don't follow through in the clause below
+ ;; '|' don't need spaces around it
+ ((looking-at "|")
+ (forward-char 1))
+
+ ;; Other punctuation: Skip over it and any following punctuation
+ ((= cs ?.)
+ ;; Skip over all characters in the operand.
+ (skip-syntax-forward "."))
+
+ ;; Other char: Skip over it.
+ (t
+ (forward-char 1))))
+
+ ;; Open parenthesis
+ ((= cs ?\()
+ (erlang-push (list '\( token (current-column)) stack)
+ (forward-char 1))
+
+ ;; Close parenthesis
+ ((= cs ?\))
+ (while (memq (car (car stack)) '(|| -> :: when))
+ (erlang-pop stack))
+ (cond ((eq (car (car stack)) '\()
+ (erlang-pop stack)
+ (if (and (eq (car (car stack)) 'fun)
+ (or (eq (car (car (last stack))) 'spec)
+ (eq (car (car (last stack))) 'type))) ;; -type()
+ ;; Inside fun type def ') closes fun definition
+ (erlang-pop stack)))
+ ((eq (car (car stack)) 'icr)
+ (erlang-pop stack)
+ ;; Normal catch not try-catch might have caused icr
+ ;; and then incr should be removed and is not an error.
+ (if (eq (car (car stack)) '\()
+ (erlang-pop stack)
+ (error "Missing `end'")
+ ))
+ ((eq (car (car stack)) 'begin)
+ (error "Missing `end'"))
+ ((eq (car (car stack)) 'maybe)
+ (error "Missing `end'"))
+ (t
+ (error "Unbalanced parenthesis"))
+ )
+ (forward-char 1))
+
+ ;; Character quote: Skip it and the quoted char.
+ ((= cs ?/)
+ (forward-char 2))
+
+ ;; Character escape: Skip it and the escape sequence.
+ ((= cs ?\\)
+ (forward-char 1)
+ (skip-syntax-forward "w"))
+
+ ;; Everything else
+ (t
+ (forward-char 1)))
+ (list stack token cs in-what)))
+
+(defun erlang-calculate-stack-indent (indent-point state)
+ "From the given last position and state (stack) calculate indentation.
+Return nil if inside string, t if in a comment."
+ (let* ((stack (and state (car state)))
+ (token (nth 1 state))
+ (stack-top (and stack (car stack))))
+ (cond ((null state) ;No state
+ 0)
+ ((nth 3 state)
+ ;; Return nil or t.
+ (eq (nth 3 state) 'comment))
+ ((null stack)
+ (if (looking-at "when[^_a-zA-Z0-9]")
+ erlang-indent-guard
+ 0))
+ ((eq (car stack-top) '\()
+ ;; Element of list, tuple or part of an expression,
+ (cond ((null erlang-argument-indent)
+ ;; indent to next column.
+ (1+ (nth 2 stack-top)))
+ ((= (char-syntax (following-char)) ?\))
+ (goto-char (nth 1 stack-top))
+ (cond ((erlang-record-or-function-args-p)
+ ;; Line ends with parenthesis.
+ (let ((previous (erlang-indent-find-preceding-expr))
+ (stack-pos (nth 2 stack-top)))
+ (if (>= previous stack-pos) stack-pos
+ (- (+ previous erlang-argument-indent) 1))))
+ (t
+ (nth 2 stack-top))))
+ ((looking-at "||")
+ (erlang-indent-element stack-top indent-point token))
+ ((memq (following-char) '(?, ?|))
+ ;; a comma at the start of the line: line up with opening parenthesis.
+ (min (nth 2 stack-top)
+ (erlang-indent-element stack-top indent-point token)))
+ (t
+ (erlang-indent-element stack-top indent-point token))))
+ ;;
+ ((eq (car stack-top) '<<)
+ ;; Element of binary (possible comprehension) expression,
+ (cond ((null erlang-argument-indent)
+ ;; indent to next column.
+ (+ 2 (nth 2 stack-top)))
+ ((looking-at "\\(>>\\)[^_a-zA-Z0-9]")
+ (nth 2 stack-top))
+ ((= (following-char) ?,)
+ (min (+ (nth 2 stack-top) 1)
+ (- (erlang-indent-to-first-element stack-top 2) 1)))
+ (t
+ (erlang-indent-to-first-element stack-top 2))))
+
+ ((memq (car stack-top) '(icr fun spec_arg))
+ ;; The default indentation is the column of the option
+ ;; directly following the keyword. (This does not apply to
+ ;; `case'.) Should no option be on the same line, the
+ ;; indentation is the indentation of the keyword +
+ ;; `erlang-indent-level'.
+ ;;
+ ;; `after' should be indented to the same level as the
+ ;; corresponding receive.
+ (cond ((looking-at "\\(after\\|of\\)\\($\\|[^_a-zA-Z0-9]\\)")
+ (nth 2 stack-top))
+ ((looking-at "when[^_a-zA-Z0-9]")
+ ;; Handling one when part
+ (+ (nth 2 stack-top) erlang-indent-level erlang-indent-guard))
+ (t
+ (save-excursion
+ (goto-char (nth 1 stack-top))
+ (if (and erlang-icr-indent
+ (looking-at "\\(if\\|case\\|receive\\|try\\)[^_a-zA-Z0-9]"))
+ (+ (nth 2 stack-top) erlang-icr-indent)
+ (if (looking-at "\\(case\\|receive\\|try\\)[^_a-zA-Z0-9]")
+ (+ (nth 2 stack-top) erlang-indent-level)
+ (skip-chars-forward "a-z")
+ (skip-chars-forward " \t")
+ (if (memq (following-char) '(?% ?\n))
+ (+ (nth 2 stack-top) erlang-indent-level)
+ (current-column))))))))
+ ((and (eq (car stack-top) '||) (looking-at "\\(]\\|>>\\|}\\)[^_a-zA-Z0-9]"))
+ (nth 2 (car (cdr stack))))
+ ;; Real indentation, where operators create extra indentation etc.
+ ((memq (car stack-top) '(-> || try begin maybe))
+ (if (looking-at "\\(of\\)[^_a-zA-Z0-9]")
+ (nth 2 stack-top)
+ (goto-char (nth 1 stack-top))
+ ;; Check if there is more code after the '->' on the
+ ;; same line. If so use this indentation as base, else
+ ;; use parent indentation + 2 * level as base.
+ (let ((off erlang-indent-level)
+ (skip 2))
+ (cond ((null (cdr stack))) ; Top level in function.
+ ((eq (car stack-top) 'begin)
+ (setq skip 5))
+ ((eq (car stack-top) 'maybe)
+ (setq skip 5))
+ ((eq (car stack-top) 'try)
+ (setq skip 5))
+ ((eq (car stack-top) '->)
+ ;; If in fun definition use standard indent level not double
+ ;;(if (not (eq (car (car (cdr stack))) 'fun))
+ ;; Removed it made multi clause Named fun's look too bad
+ (setq off (+ erlang-indent-level
+ (if (not erlang-icr-indent)
+ erlang-indent-level
+ erlang-icr-indent)))))
+ (let ((base (erlang-indent-find-base stack indent-point off skip)))
+ ;; Special cases
+ (goto-char indent-point)
+ (cond ((looking-at "\\(;\\|end\\|after\\|else\\)\\($\\|[^_a-zA-Z0-9]\\)")
+ (if (eq (car stack-top) '->)
+ (erlang-pop stack))
+ (cond ((and stack (looking-at ";"))
+ (+ (caddr (car stack)) (- erlang-indent-level 2)))
+ (stack (caddr (car stack)))
+ (t off)))
+ ((looking-at "catch\\b\\($\\|[^_a-zA-Z0-9]\\)")
+ ;; Are we in a try
+ (let ((start (if (eq (car stack-top) '->)
+ (car (cdr stack))
+ stack-top)))
+ (if (null start) nil
+ (goto-char (nth 1 start)))
+ (cond ((looking-at "try\\($\\|[^_a-zA-Z0-9]\\)")
+ (progn
+ (if (eq (car stack-top) '->)
+ (erlang-pop stack))
+ (if stack
+ (caddr (car stack))
+ 0)))
+ (t (erlang-indent-standard indent-point token base 'nil))))) ;; old catch
+ ;; Indent result types
+ ((eq (car (car (cdr stack))) 'spec_arg)
+ (setq base (+ (caddr (car (last stack))) erlang-indent-level))
+ (erlang-indent-standard indent-point token base 'nil))
+ (t
+ (erlang-indent-standard indent-point token base 'nil)
+ ))))
+ ))
+ ((eq (car stack-top) 'when)
+ (goto-char (nth 1 stack-top))
+ (if (looking-at "when\\s *\\($\\|%\\)")
+ (progn
+ (erlang-pop stack)
+ (if (and stack (memq (nth 0 (car stack)) '(icr fun)))
+ (progn
+ (goto-char (nth 1 (car stack)))
+ (+ (nth 2 (car stack)) erlang-indent-guard
+ ;; receive XYZ or receive
+ ;; XYZ
+ ;; This if thing does not seem to be needed
+ ;;(if (looking-at "[a-z]+\\s *\\($\\|%\\)")
+ ;; erlang-indent-level
+ ;; (* 2 erlang-indent-level))))
+ (* 2 erlang-indent-level)))
+ ;;erlang-indent-level))
+ (+ erlang-indent-level erlang-indent-guard)))
+ ;; "when" is followed by code, let's indent to the same
+ ;; column.
+ (forward-char 4) ; Skip "when"
+ (skip-chars-forward " \t")
+ (current-column)))
+ ;; Type and Spec indentation
+ ((eq (car stack-top) '::)
+ (if (looking-at "[},)]")
+ ;; Closing function spec, record definition with types,
+ ;; or a comma at the start of the line
+ ;; pop stack and recurse
+ (erlang-calculate-stack-indent indent-point
+ (cons (erlang-pop stack) (cdr state)))
+ (cond ((null erlang-argument-indent)
+ ;; indent to next column.
+ (+ 2 (nth 2 stack-top)))
+ ((looking-at "::[^_a-zA-Z0-9]")
+ (nth 2 stack-top))
+ (t
+ (let ((start-alternativ (if (looking-at "|") 2 0)))
+ (goto-char (nth 1 stack-top))
+ (- (cond ((looking-at "::\\s *\\($\\|%\\)")
+ ;; Line ends with ::
+ (if (eq (car (car (last stack))) 'spec)
+ (+ (erlang-indent-find-preceding-expr 1)
+ erlang-argument-indent)
+ (+ (erlang-indent-find-preceding-expr 2)
+ erlang-argument-indent)))
+ (t
+ ;; Indent to the same column as the first
+ ;; argument.
+ (goto-char (+ 2 (nth 1 stack-top)))
+ (skip-chars-forward " \t")
+ (current-column))) start-alternativ))))))
+ )))
+
+(defun erlang-indent-to-first-element (stack-top extra)
+ ;; Indent to the same column as the first
+ ;; argument. extra should be 1 for lists tuples or 2 for binaries
+ (goto-char (+ (nth 1 stack-top) extra))
+ (skip-chars-forward " \t")
+ (current-column))
+
+(defun erlang-indent-element (stack-top indent-point token)
+ (goto-char (nth 1 stack-top))
+ (let ((base (cond ((erlang-record-or-function-args-p)
+ ;; Line ends with parenthesis.
+ (erlang-indent-parenthesis (nth 2 stack-top)))
+ (t
+ (erlang-indent-to-first-element stack-top 1)))))
+ (erlang-indent-standard indent-point token base 't)))
+
+(defun erlang-indent-standard (indent-point token base inside-parenthesis)
+ "Standard indent when in blocks or tuple or arguments.
+ Look at last thing to see in what state we are, move relative to the base."
+ (goto-char token)
+ (cond ((looking-at "||\\|,\\|->\\||")
+ base)
+ ((erlang-at-keyword)
+ (+ (current-column) erlang-indent-level))
+ ((or (= (char-syntax (following-char)) ?.)
+ (erlang-at-operator))
+ (+ base erlang-indent-level))
+ (t
+ (goto-char indent-point)
+ (cond ((memq (following-char) '(?\( ))
+ ;; Function application.
+ (+ (erlang-indent-find-preceding-expr)
+ erlang-argument-indent))
+ ;; Empty line, or end; treat it as the end of
+ ;; the block. (Here we have a choice: should
+ ;; the user be forced to reindent continued
+ ;; lines, or should the "end" be reindented?)
+
+ ;; Avoid treating comments a continued line.
+ ((= (following-char) ?%)
+ base)
+ ((and (= (following-char) ?,) inside-parenthesis)
+ ;; a comma at the start of the line line up with parenthesis
+ (- base 1))
+ ;; Continued line (e.g. line beginning
+ ;; with an operator.)
+ (t
+ (if (or (erlang-at-operator) (not inside-parenthesis))
+ (+ base erlang-indent-level)
+ base))))))
+
+(defun erlang-indent-find-base (stack indent-point &optional offset skip)
+ "Find the base column for current stack."
+ (or skip (setq skip 2))
+ (or offset (setq offset erlang-indent-level))
+ (save-excursion
+ (let* ((stack-top (car stack)))
+ (goto-char (nth 1 stack-top))
+ (if (< skip (- (point-max) (point)))
+ (progn
+ (forward-char skip)
+ (if (looking-at "\\s *\\($\\|%\\)")
+ (progn
+ (if (memq (car stack-top) '(-> ||))
+ (erlang-pop stack))
+ ;; Take parent indentation + offset,
+ ;; else just erlang-indent-level if no parent
+ (if stack
+ (progn
+ (goto-char (- (nth 1 (car stack)) 1))
+ (if (looking-at "#{")
+ (+ (caddr (car stack))
+ (- offset 1))
+ (+ (caddr (car stack))
+ offset)))
+ erlang-indent-level))
+ (erlang-skip-blank indent-point)
+ (current-column)))
+ (+ (current-column) skip)))))
+
+
+;; Does not handle `begin' .. `end'.
+(defun erlang-indent-find-preceding-expr (&optional arg)
+ "Return the first column of the preceding expression.
+This assumes that the preceding expression is either simple
+\(i.e. an atom) or parenthesized."
+ (save-excursion
+ (or arg (setq arg 1))
+ (ignore-errors (forward-sexp (- arg)))
+ (let ((col (current-column)))
+ (skip-chars-backward " \t")
+ ;; Special hack to handle: (note line break)
+ ;; [#myrecord{
+ ;; foo = foo}]
+ ;; where the call (forward-sexp -1) will fail when point is at the `#'.
+ (or
+ (ignore-errors
+ ;; Needed to match the colon in "'foo':'bar'".
+ (cond ((eq (preceding-char) ?:)
+ (backward-char 1)
+ (forward-sexp -1)
+ (current-column))
+ ((eq (preceding-char) ?#)
+ ;; We may now be at:
+ ;; - either a construction of a new record
+ ;; - or update of a record, in which case we want
+ ;; the column of the expression to be updated.
+ ;;
+ ;; To see which of the two cases we are at, we first
+ ;; move an expression backwards, check for keywords,
+ ;; then immediately an expression forwards. Moving
+ ;; backwards skips past tokens like `,' or `->', but
+ ;; when moving forwards again, we won't skip past such
+ ;; tokens. We use this: if, after having moved
+ ;; forwards, we're back where we started, then it was
+ ;; a record update.
+ ;; The check for keywords is to detect cases like:
+ ;; case Something of #record_construction{...}
+ (backward-char 1)
+ (let ((record-start (point))
+ (record-start-col (current-column)))
+ (forward-sexp -1)
+ (let ((preceding-expr-col (current-column))
+ ;; white space definition according to erl_scan
+ (white-space "\000-\040\200-\240"))
+ (if (erlang-at-keyword)
+ ;; The (forward-sexp -1) call moved past a keyword
+ (1+ record-start-col)
+ (forward-sexp 1)
+ (skip-chars-forward white-space record-start)
+ ;; Are we back where we started? If so, it was an update.
+ (if (= (point) record-start)
+ preceding-expr-col
+ (goto-char record-start)
+ (1+ (current-column)))))))
+ (t col)))
+ col))))
+
+(defun erlang-record-or-function-args-p ()
+ (and (looking-at "[({]\\s *\\($\\|%\\)")
+ (or (eq (following-char) ?\( )
+ (save-excursion
+ (ignore-errors (forward-sexp (- 1)))
+ (eq (preceding-char) ?#)))))
+
+(defun erlang-indent-parenthesis (stack-position)
+ (let ((previous (erlang-indent-find-preceding-expr)))
+ (cond ((eq previous stack-position) ;; tuple or map not a record
+ (1+ stack-position))
+ ((> previous stack-position)
+ (+ stack-position erlang-argument-indent))
+ (t
+ (+ previous erlang-argument-indent)))))
+
+(defun erlang-skip-blank (&optional lim)
+ "Skip over whitespace and comments until limit reached."
+ (or lim (setq lim (point-max)))
+ (let (stop)
+ (while (and (not stop) (< (point) lim))
+ (cond ((= (following-char) ?%)
+ (skip-chars-forward "^\n" lim))
+ ((= (following-char) ?\n)
+ (skip-chars-forward "\n" lim))
+ ((looking-at "\\s ")
+ (if (re-search-forward "\\S " lim 'move)
+ (forward-char -1)))
+ (t
+ (setq stop t))))
+ stop))
+
+(defun erlang-at-keyword ()
+ "Are we looking at an Erlang keyword which will increase indentation?"
+ (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|maybe\\|"
+ "of\\|receive\\|after\\|catch\\|try\\|else\\)\\b")))
+
+(defun erlang-at-operator ()
+ "Are we looking at an Erlang operator?"
+ (looking-at
+ "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)\\b"))
+
+(defun erlang-comment-indent ()
+ "Compute Erlang comment indentation.
+
+Used both by `indent-for-comment' and the Erlang specific indentation
+commands."
+ (cond ((looking-at "%%%") 0)
+ ((looking-at "%%")
+ (or (erlang-calculate-indent)
+ (current-indentation)))
+ (t
+ (save-excursion
+ (skip-chars-backward " \t")
+ (max (if (bolp) 0 (1+ (current-column)))
+ comment-column)))))
+
+;;; Erlang movement commands
+
+;; All commands below work as movement commands. I.e. if the point is
+;; at the end of the clause, and the command `erlang-end-of-clause' is
+;; executed, the point is moved to the end of the NEXT clause. (This
+;; mimics the behaviour of `end-of-defun'.)
+;;
+;; Personally I would like to rewrite them to be "pure", and add a set
+;; of movement functions, like `erlang-next-clause',
+;; `erlang-previous-clause', and the same for functions.
+;;
+;; The current implementation makes it hopeless to use the functions as
+;; subroutines in more complex commands. /andersl
+
+(defun erlang-beginning-of-clause (&optional arg)
+ "Move backward to previous start of clause.
+With argument, do this that many times.
+Return t unless search stops due to end of buffer."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (if (< arg 0)
+ ;; Step back to the end of the previous line, unless we are at
+ ;; the beginning of the buffer. The reason for this move is
+ ;; that the regexp below includes the last character of the
+ ;; previous line.
+ (if (bobp)
+ (or (looking-at "\n")
+ (forward-char 1))
+ (forward-char -1)
+ (if (looking-at "\\`\n")
+ (forward-char 1))))
+ ;; The regexp matches a function header that isn't
+ ;; included in a string.
+ (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\(-?[a-z]\\|'\\|-\\)"
+ nil 'move (- arg))
+ (let ((beg (match-beginning 2)))
+ (and beg (goto-char beg))
+ t)))
+
+(defun erlang-end-of-clause (&optional arg)
+ "Move to the end of the current clause.
+With argument, do this that many times."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (while (and (looking-at "[ \t]*[%\n]")
+ (zerop (forward-line 1))))
+ ;; Move to the next clause.
+ (erlang-beginning-of-clause (- arg))
+ (beginning-of-line);; Just to be sure...
+ (let ((continue t))
+ (while (and (not (bobp)) continue)
+ (forward-line -1)
+ (unless (looking-at "[ \t]*[%\n]")
+ (end-of-line)
+ (setq continue nil)))))
+
+(defun erlang-mark-clause ()
+ "Put mark at end of clause, point at beginning."
+ (interactive)
+ (push-mark (point))
+ (erlang-end-of-clause 1)
+ ;; Sets the region.
+ (push-mark (point) nil t)
+ (erlang-beginning-of-clause 1)
+ ;; The above function deactivates the mark.
+ (if (boundp 'deactivate-mark)
+ (funcall (symbol-function 'set) 'deactivate-mark nil)))
+
+(defun erlang-beginning-of-function (&optional arg)
+ "Move backward to previous start of function.
+With positive argument, do this that many times.
+With negative argument, search forward.
+
+Return t unless search stops due to end of buffer."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (cond
+ ;; Search backward
+ ((> arg 0)
+ (while (and (> arg 0)
+ (and (erlang-beginning-of-clause 1)
+ (let ((start (point))
+ (name (erlang-name-of-function))
+ (arity (erlang-get-function-arity)))
+ ;; Note: "arity" is nil for e.g. "-import", hence
+ ;; two "-import" clauses are not considered to
+ ;; be part of the same function.
+ (while (and (erlang-beginning-of-clause 1)
+ (string-equal name
+ (erlang-name-of-function))
+ arity
+ (equal arity
+ (erlang-get-function-arity)))
+ (setq start (point)))
+ (goto-char start)
+ t)))
+ (setq arg (1- arg))))
+ ;; Search forward
+ ((< arg 0)
+ (end-of-line)
+ (erlang-beginning-of-clause 1)
+ ;; Step -arg functions forward.
+ (while (and (< arg 0)
+ ;; Step one function forward, or stop if the end of
+ ;; the buffer was reached. Return t if we found the
+ ;; function.
+ (let ((name (erlang-name-of-function))
+ (arity (erlang-get-function-arity))
+ (found (erlang-beginning-of-clause -1)))
+ (while (and found
+ (string-equal name (erlang-name-of-function))
+ arity
+ (equal arity
+ (erlang-get-function-arity)))
+ (setq found (erlang-beginning-of-clause -1)))
+ found))
+ (setq arg (1+ arg)))))
+ (zerop arg))
+
+
+(defun erlang-end-of-function (&optional arg)
+ "Move forward to next end of function.
+
+With argument, do this that many times.
+With negative argument go towards the beginning of the buffer."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (let ((first t))
+ ;; Forward
+ (while (and (> arg 0) (< (point) (point-max)))
+ (let ((pos (point)))
+ (while (progn
+ (if (and first
+ (progn
+ (forward-char 1)
+ (erlang-beginning-of-clause 1)))
+ nil
+ (or (bobp) (forward-char -1))
+ (erlang-beginning-of-clause -1))
+ (setq first nil)
+ (erlang-pass-over-function)
+ (skip-chars-forward " \t")
+ (if (looking-at "[%\n]")
+ (forward-line 1))
+ (<= (point) pos))))
+ (setq arg (1- arg)))
+ ;; Backward
+ (while (< arg 0)
+ (let ((pos (point)))
+ (erlang-beginning-of-clause 1)
+ (erlang-pass-over-function)
+ (forward-line 1)
+ (if (>= (point) pos)
+ (if (erlang-beginning-of-function 2)
+ (progn
+ (erlang-pass-over-function)
+ (skip-chars-forward " \t")
+ (if (looking-at "[%\n]")
+ (forward-line 1)))
+ (goto-char (point-min)))))
+ (setq arg (1+ arg)))))
+
+(eval-and-compile
+ (if (default-boundp 'beginning-of-defun-function)
+ (defalias 'erlang-mark-function 'mark-defun)
+ (defun erlang-mark-function ()
+ "Put mark at end of function, point at beginning."
+ (interactive)
+ (push-mark (point))
+ (erlang-end-of-function 1)
+ ;; Sets the region.
+ (push-mark (point) nil t)
+ (erlang-beginning-of-function 1)
+ ;; The above function deactivates the mark.
+ (if (boundp 'deactivate-mark)
+ (funcall (symbol-function 'set) 'deactivate-mark nil)))))
+
+(defun erlang-pass-over-function ()
+ (while (progn
+ (erlang-skip-blank)
+ (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)"))
+ (not (eobp))))
+ (forward-sexp 1))
+ (if (not (eobp))
+ (forward-char 1)))
+
+(defun erlang-name-of-function ()
+ (save-excursion
+ ;; Skip over attribute leader.
+ (if (looking-at "-[ \t]*")
+ (re-search-forward "-[ \t]*" nil 'move))
+ (let ((start (point)))
+ (forward-sexp 1)
+ (buffer-substring start (point)))))
+
+
+;;; Miscellaneous
+
+(defun erlang-fill-paragraph (&optional justify)
+ "Like \\[fill-paragraph], but handle Erlang comments.
+If any of the current line is a comment, fill the comment or the
+paragraph of it that point is in, preserving the comment's indentation
+and initial `%':s."
+ (interactive "P")
+ (let ((has-comment nil)
+ ;; If has-comment, the appropriate fill-prefix for the comment.
+ comment-fill-prefix)
+ ;; Figure out what kind of comment we are looking at.
+ (save-excursion
+ (beginning-of-line)
+ (cond
+ ;; Find the command prefix.
+ ((looking-at (concat "\\s *" comment-start-skip))
+ (setq has-comment t)
+ (setq comment-fill-prefix (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ ;; A line with some code, followed by a comment? Remember that the
+ ;; % which starts the comment shouldn't be part of a string or
+ ;; character.
+ ((progn
+ (while (not (looking-at "%\\|$"))
+ (skip-chars-forward "^%\n\"\\\\")
+ (cond
+ ((eq (char-after (point)) ?\\) (forward-char 2))
+ ((eq (char-after (point)) ?\") (forward-sexp 1))))
+ (looking-at comment-start-skip))
+ (setq has-comment t)
+ (setq comment-fill-prefix
+ (concat (make-string (current-column) ? )
+ (buffer-substring (match-beginning 0) (match-end 0)))))))
+ (if (not has-comment)
+ (fill-paragraph justify)
+ ;; Narrow to include only the comment, and then fill the region.
+ (save-restriction
+ (narrow-to-region
+ ;; Find the first line we should include in the region to fill.
+ (save-excursion
+ (while (and (zerop (forward-line -1))
+ (looking-at "^\\s *%")))
+ ;; We may have gone to far. Go forward again.
+ (or (looking-at "^\\s *%")
+ (forward-line 1))
+ (point))
+ ;; Find the beginning of the first line past the region to fill.
+ (save-excursion
+ (while (progn (forward-line 1)
+ (looking-at "^\\s *%")))
+ (point)))
+ ;; Lines with only % on them can be paragraph boundaries.
+ (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$"))
+ (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$"))
+ (fill-prefix comment-fill-prefix))
+ (fill-paragraph justify))))))
+
+(defun erlang-generate-new-clause ()
+ "Create additional Erlang clause header.
+
+Parses the source file for the name of the current Erlang function.
+Create the header containing the name, A pair of parentheses,
+and an arrow. The space between the function name and the
+first parenthesis is preserved. The point is placed between
+the parentheses."
+ (interactive)
+ (let ((name (save-excursion
+ (and (erlang-beginning-of-clause)
+ (erlang-get-function-name t))))
+ (arrow (save-excursion
+ (and (erlang-beginning-of-clause)
+ (erlang-get-function-arrow)))))
+ (if (or (null arrow) (null name))
+ (error "Can't find name of current Erlang function"))
+ (if (and (bolp) (eolp))
+ nil
+ (end-of-line)
+ (newline))
+ (insert name)
+ (save-excursion
+ (insert ") " arrow))
+ (if erlang-new-clause-with-arguments
+ (erlang-clone-arguments))))
+
+
+(defun erlang-clone-arguments ()
+ "Insert, at the point, the argument list of the previous clause.
+
+The mark is set at the beginning of the inserted text, the point
+at the end."
+ (interactive)
+ (let ((args (save-excursion
+ (beginning-of-line)
+ (and (erlang-beginning-of-clause)
+ (erlang-get-function-arguments))))
+ (p (point)))
+ (if (null args)
+ (error "Can't clone argument list"))
+ (insert args)
+ (set-mark p)))
+
+;;; Information retrieval functions.
+
+(defun erlang-get-module ()
+ "Return the name of the module as specified by `-module'.
+
+Return nil if file contains no `-module' attribute."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((md (match-data)))
+ (unwind-protect
+ (if (re-search-forward
+ (eval-when-compile
+ (concat "^-module\\s *(\\s *\\(\\("
+ erlang-atom-regexp
+ "\\)?\\)\\s *)\\s *\\."))
+ (point-max) t)
+ (erlang-remove-quotes
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ nil)
+ (store-match-data md))))))
+
+
+(defun erlang-get-module-from-file-name (&optional file)
+ "Extract the module name from a file name.
+
+First, the directory part is removed. Second, the part of the file name
+matching `erlang-file-name-extension-regexp' is removed.
+
+Should the match fail, nil is returned.
+
+By modifying `erlang-file-name-extension-regexp' to match files other
+than Erlang source files, Erlang specific functions could be applied on
+non-Erlang files. Most notably; the support for Erlang modules in the
+tags system could be used by files written in other languages."
+ (or file (setq file buffer-file-name))
+ (if (null file)
+ nil
+ (setq file (file-name-nondirectory file))
+ (if (string-match erlang-file-name-extension-regexp file)
+ (substring file 0 (match-beginning 0))
+ nil)))
+
+
+;; Used by `erlang-get-export' and `erlang-get-import'.
+
+(defun erlang-get-function-arity-list ()
+ "Parse list of `function/arity' as used by `-import' and `-export'.
+
+Point must be before the opening bracket. When the
+function returns the point will be placed after the closing bracket.
+
+The function does not return an error if the list is incorrectly
+formatted.
+
+Return list of (function . arity). The order of the returned list
+corresponds to the order of the parsed Erlang list."
+ (let ((res '()))
+ (erlang-skip-blank)
+ (forward-char 1)
+ (if (not (eq (preceding-char) ?\[))
+ '() ; Not looking at an Erlang list.
+ (while ; Note: `while' has no body.
+ (progn
+ (erlang-skip-blank)
+ (and (looking-at (eval-when-compile
+ (concat erlang-atom-regexp "/\\([0-9]+\\)\\>")))
+ (progn
+ (setq res (cons
+ (cons
+ (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1)))
+ (string-to-number
+ (buffer-substring-no-properties
+ (match-beginning
+ (+ 1 erlang-atom-regexp-matches))
+ (match-end
+ (+ 1 erlang-atom-regexp-matches)))))
+ res))
+ (goto-char (match-end 0))
+ (erlang-skip-blank)
+ (forward-char 1)
+ ;; Test if there are more exported functions.
+ (eq (preceding-char) ?,))))))
+ (nreverse res)))
+
+
+;;; Note that `-export' and the open parenthesis must be written on
+;;; the same line.
+
+(defun erlang-get-export ()
+ "Return a list of `(function . arity)' as specified by `-export'."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((md (match-data))
+ (res '()))
+ (unwind-protect
+ (progn
+ (while (re-search-forward "^-export\\s *(" (point-max) t)
+ (erlang-skip-blank)
+ (setq res (nconc res (erlang-get-function-arity-list))))
+ res)
+ (store-match-data md)))))
+
+
+(defun erlang-get-import ()
+ "Parse an Erlang source file for imported functions.
+
+Return an alist with module name as car part and list of conses containing
+function and arity as cdr part."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((md (match-data))
+ (res '()))
+ (unwind-protect
+ (progn
+ (while (re-search-forward "^-import\\s *(" (point-max) t)
+ (erlang-skip-blank)
+ (if (looking-at erlang-atom-regexp)
+ (let ((module (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning 0)
+ (match-end 0)))))
+ (goto-char (match-end 0))
+ (erlang-skip-blank)
+ (if (eq (following-char) ?,)
+ (progn
+ (forward-char 1)
+ (erlang-skip-blank)
+ (let ((funcs (erlang-get-function-arity-list))
+ (pair (assoc module res)))
+ (if pair
+ (setcdr pair (nconc (cdr pair) funcs))
+ (setq res (cons (cons module funcs)
+ res)))))))))
+ (nreverse res))
+ (store-match-data md)))))
+
+
+(defun erlang-get-function-name (&optional arg)
+ "Return name of current function, or nil.
+
+If optional argument is non-nil, everything up to and including
+the first `(' is returned.
+
+Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
+ (save-excursion
+ (if (not (eobp)) (forward-char 1))
+ (and (erlang-beginning-of-clause)
+ (erlang-get-function-name t)))"
+ (let ((n (if arg 0 1)))
+ (and (looking-at (eval-when-compile
+ (concat "^" erlang-atom-regexp "\\s *(")))
+ (buffer-substring-no-properties (match-beginning n) (match-end n)))))
+
+
+(defun erlang-get-function-arrow ()
+ "Return arrow of current function, could be \"->\" or nil.
+
+Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
+ (save-excursion
+ (if (not (eobp)) (forward-char 1))
+ (and (erlang-beginning-of-clause)
+ (erlang-get-function-arrow)))"
+ (and
+ (save-excursion
+ (re-search-forward "->" (point-max) t)
+ (buffer-substring-no-properties (- (point) 2) (+ (point) 1)))))
+
+(defun erlang-get-function-arity ()
+ "Return the number of arguments of function at point, or nil."
+ (erlang-get-arity-after-regexp (concat "^" erlang-atom-regexp "\\s *(")))
+
+(defun erlang-get-argument-list-arity ()
+ "Return the number of arguments in argument list at point, or nil.
+The point should be before the opening parenthesis of the
+argument list before calling this function."
+ (erlang-get-arity-after-regexp "\\s *("))
+
+(defun erlang-get-arity-after-regexp (regexp)
+ "Return the number of arguments in argument list after REGEXP, or nil."
+ (when (looking-at regexp)
+ (save-excursion
+ (goto-char (match-end 0))
+ (erlang-get-arity))))
+
+(defun erlang-get-arity ()
+ "Return the number of arguments in argument list at point, or nil.
+The point should be after the opening parenthesis of the argument
+list before calling this function."
+ (condition-case nil
+ (let ((res 0)
+ (cont t))
+ (while cont
+ (cond ((eobp)
+ (setq res nil)
+ (setq cont nil))
+ ((looking-at "\\s *)")
+ (setq cont nil))
+ ((looking-at "\\s *\\($\\|%\\)")
+ (forward-line 1))
+ ((looking-at "\\s *<<[^>]*?>>")
+ (when (zerop res)
+ (setq res (+ 1 res)))
+ (goto-char (match-end 0)))
+ ((looking-at "\\s *,")
+ (setq res (+ 1 res))
+ (goto-char (match-end 0)))
+ (t
+ (when (zerop res)
+ (setq res (+ 1 res)))
+ (forward-sexp 1))))
+ res)
+ (error nil)))
+
+
+(defun erlang-get-function-name-and-arity ()
+ "Return the name and arity of the function at point, or nil.
+The return value is a string of the form \"foo/1\"."
+ (let ((name (erlang-get-function-name))
+ (arity (erlang-get-function-arity)))
+ (and name arity (format "%s/%d" name arity))))
+
+(defun erlang-get-function-arguments ()
+ "Return arguments of current function, or nil."
+ (if (not (looking-at (eval-when-compile
+ (concat "^" erlang-atom-regexp "\\s *("))))
+ nil
+ (save-excursion
+ (condition-case nil
+ (let ((start (match-end 0)))
+ (goto-char (- start 1))
+ (forward-sexp)
+ (buffer-substring-no-properties start (- (point) 1)))
+ (error nil)))))
+
+
+;; erlang-get-function-under-point is replaced by
+;; erlang-get-identifier-at-point as far as internal erlang.el usage
+;; is concerned. But it is kept for backward compatibility. It is
+;; used by erldoc.el and maybe other code out there.
+(defun erlang-get-function-under-point ()
+ "Return the module and function under the point, or nil.
+
+Should no explicit module name be present at the point, the
+list of imported functions is searched.
+
+The following could be returned:
+ (\"module\" \"function\") -- Both module and function name found.
+ (nil \"function\") -- No module name was found.
+ nil -- No function name found.
+
+See also `erlang-get-identifier-at-point'."
+ (let* ((id (erlang-get-identifier-at-point))
+ (kind (erlang-id-kind id))
+ (module (erlang-id-module id))
+ (name (erlang-id-name id)))
+ (cond ((eq kind 'qualified-function)
+ (list module name))
+ (name
+ (list nil name)))))
+
+(defun erlang-get-identifier-at-point ()
+ "Return the erlang identifier at point, or nil.
+
+Should no explicit module name be present at the point, the
+list of imported functions is searched.
+
+When an identifier is found return a list with 4 elements:
+
+1. Kind - One of the symbols qualified-function, record, macro,
+module or nil.
+
+2. Module - Module name string or nil. In case of a
+qualified-function the module is explicitly specified (like
+module:fun()) and the search fails if no entries with correct
+module are found. For other kinds the module is guessed: either
+fetched from import statements or it is assumed to be the local
+module. In these cases the module is just a preference. If no
+matching entries are found the search will be retried without
+regard to module.
+
+3. Name - String name of function, module, record or macro.
+
+4. Arity - Integer in case of functions and macros if the number
+of arguments could be found, otherwise nil."
+ (save-excursion
+ (let (case-fold-search)
+ (save-match-data
+ (if (eq (char-syntax (following-char)) ? )
+ (skip-chars-backward " \t"))
+ (skip-chars-backward "[:word:]_:'")
+ (cond ((and (eq (preceding-char) ??)
+ (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp)))
+ (erlang-get-qualified-function-id-at-point (erlang-get-module)))
+ ((looking-at erlang-module-function-regexp)
+ (erlang-get-qualified-function-id-at-point))
+ ((looking-at (concat erlang-atom-regexp ":"))
+ (erlang-get-module-id-at-point))
+ ((looking-at erlang-name-regexp)
+ (erlang-get-some-other-id-at-point)))))))
+
+(defun erlang-get-qualified-function-id-at-point (&optional module)
+ (let ((kind 'qualified-function)
+ (module (or module
+ (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1)))))
+ (name (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning (1+ erlang-atom-regexp-matches))
+ (match-end (1+ erlang-atom-regexp-matches)))))
+ (arity (progn
+ (goto-char (match-end 0))
+ (erlang-get-argument-list-arity))))
+ (list kind module name arity)))
+
+(defun erlang-get-module-id-at-point ()
+ (let ((kind 'module)
+ (module nil)
+ (name (erlang-remove-quotes
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1))))
+ (arity nil))
+ (list kind module name arity)))
+
+(defun erlang-get-some-other-id-at-point ()
+ (let ((name (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))))
+ (imports (erlang-get-import))
+ kind module arity)
+ (while (and imports (null module))
+ (if (assoc name (cdr (car imports)))
+ (setq module (car (car imports)))
+ (setq imports (cdr imports))))
+ (cond ((eq (preceding-char) ?#)
+ (setq kind 'record))
+ ((eq (preceding-char) ??)
+ (setq kind 'macro))
+ ((and (null module) (not (member name erlang-int-bifs)))
+ (setq module (erlang-get-module))))
+ (setq arity (progn
+ (goto-char (match-end 0))
+ (erlang-get-argument-list-arity)))
+ (list kind module name arity)))
+
+(defmacro erlang-with-id (slots id-string &rest body)
+ (declare (indent 2))
+ (let ((id-var (make-symbol "id")))
+ `(let* ((,id-var (erlang-id-to-list ,id-string))
+ ,@(mapcar (lambda (slot)
+ (list slot
+ (list (intern (format "erlang-id-%s" slot))
+ id-var)))
+ slots))
+ ,@body)))
+
+(defun erlang-id-to-string (id)
+ (when id
+ (erlang-with-id (kind module name arity) id
+ (format "%s%s%s%s"
+ (if kind (format "%s " kind) "")
+ (if module (format "%s:" module) "")
+ name
+ (if arity (format "/%s" arity) "")))))
+
+(defun erlang-id-to-list (id)
+ (if (listp id)
+ id
+ (save-match-data
+ (erlang-ensure-syntax-table-is-initialized)
+ (with-syntax-table erlang-mode-syntax-table
+ (let (case-fold-search)
+ (when (string-match erlang-id-regexp id)
+ (list (when (match-string 1 id)
+ (intern (match-string 1 id)))
+ (match-string 2 id)
+ (match-string 3 id)
+ (when (match-string 4 id)
+ (string-to-number (match-string 4 id))))))))))
+
+(defun erlang-id-kind (id)
+ (car (erlang-id-to-list id)))
+
+(defun erlang-id-module (id)
+ (nth 1 (erlang-id-to-list id)))
+
+(defun erlang-id-name (id)
+ (nth 2 (erlang-id-to-list id)))
+
+(defun erlang-id-arity (id)
+ (nth 3 (erlang-id-to-list id)))
+
+
+(defun erlang-default-function-or-module ()
+ (erlang-with-id (kind module name) (erlang-get-identifier-at-point)
+ (let ((x (cond ((eq kind 'module)
+ (format "%s:" name))
+ ((eq kind 'record)
+ (format "-record(%s" name))
+ ((eq kind 'macro)
+ (format "-define(%s" name))
+ (t
+ name))))
+ (if module
+ (format "%s:%s" module x)
+ x))))
+
+
+;; TODO: Escape single quotes inside the string without
+;; replace-regexp-in-string.
+(defun erlang-add-quotes-if-needed (str)
+ "Return STR, possibly with quotes."
+ (let ((case-fold-search nil)) ; force string matching to be case sensitive
+ (if (and (stringp str)
+ (not (string-match (eval-when-compile
+ (concat "\\`" erlang-atom-regexp "\\'"))
+ str)))
+ (progn
+ (setq str (replace-regexp-in-string "'" "\\'" str t t ))
+ (concat "'" str "'"))
+ str)))
+
+
+(defun erlang-remove-quotes (str)
+ "Return STR without quotes, if present."
+ (let ((md (match-data)))
+ (prog1
+ (if (string-match "\\`'\\(.*\\)'\\'" str)
+ (substring str 1 -1)
+ str)
+ (store-match-data md))))
+
+(defun erlang-match-next-exported-function (max)
+ "Returns non-nil if there is an exported function in the current
+buffer between point and MAX."
+ (catch 'return
+ (while (and (not erlang-inhibit-exported-function-name-face)
+ (erlang-match-next-function max))
+ (when (erlang-last-match-exported-p)
+ (throw 'return (match-data))))))
+
+(defun erlang-match-next-function (max)
+ "Searches forward in current buffer for the next erlang function,
+bounded by position MAX."
+ (re-search-forward erlang-defun-prompt-regexp max 'move-point))
+
+(defun erlang-last-match-exported-p ()
+ "Returns non-nil if match-data describes the name and arity of an
+exported function."
+ (save-excursion
+ (save-match-data
+ (goto-char (match-beginning 1))
+ (erlang-function-exported-p
+ (erlang-remove-quotes (erlang-get-function-name))
+ (erlang-get-function-arity)))))
+
+(defun erlang-function-exported-p (name arity)
+ "Returns non-nil if function of name and arity is exported in current buffer."
+ (save-excursion
+ (let* ((old-match-data (match-data))
+ (exports (erlang-get-export)))
+ (store-match-data old-match-data)
+ (member (cons name arity) exports))))
+
+
+;;; Check module name
+
+(defun erlang-check-module-name ()
+ "If the module name doesn't match file name, ask for permission to change.
+
+The variable `erlang-check-module-name' controls the behaviour of this
+function. It it is nil, this function does nothing. If it is t, the
+source is silently changed. If it is set to the atom `ask', the user
+is prompted.
+
+This function is normally placed in the hook `before-save-hook'."
+ (if erlang-check-module-name
+ (let ((mn (erlang-add-quotes-if-needed
+ (erlang-get-module)))
+ (fn (erlang-add-quotes-if-needed
+ (erlang-get-module-from-file-name (buffer-file-name)))))
+ (if (and (stringp mn) (stringp fn))
+ (or (string-equal mn fn)
+ (if (or (eq erlang-check-module-name t)
+ (y-or-n-p
+ "Module does not match file name. Modify source? "))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (eval-when-compile
+ (concat "^-module\\s *(\\s *\\(\\("
+ erlang-atom-regexp
+ "\\)?\\)\\s *)\\s *\\."))
+ (point-max) t)
+ (progn
+ (goto-char (match-beginning 1))
+ (delete-region (match-beginning 1)
+ (match-end 1))
+ (insert fn))))))))))
+ ;; Must return nil since it is added to `local-write-file-hook'.
+ nil)
+
+
+;;; Electric functions.
+
+(defun erlang-electric-semicolon (&optional arg)
+ "Insert a semicolon character and possibly a prototype for the next line.
+
+The variable `erlang-electric-semicolon-criteria' states a criterion,
+when fulfilled a newline is inserted, the next line is indented and a
+prototype for the next line is inserted. Normally the prototype
+consists of \" ->\". Should the semicolon end the clause a new clause
+header is generated.
+
+The variable `erlang-electric-semicolon-insert-blank-lines' controls
+the number of blank lines inserted between the current line and new
+function header.
+
+Behaves just like the normal semicolon when supplied with a
+numerical arg, point is inside string or comment, or when there are
+non-whitespace characters following the point on the current line."
+ (interactive "P")
+ (self-insert-command (prefix-numeric-value arg))
+ (if (or arg
+ (and (listp erlang-electric-commands)
+ (not (memq 'erlang-electric-semicolon
+ erlang-electric-commands)))
+ (erlang-in-literal)
+ (not (looking-at "\\s *\\(%.*\\)?$"))
+ (null (erlang-test-criteria-list
+ erlang-electric-semicolon-criteria)))
+ (setq erlang-electric-newline-inhibit nil)
+ (setq erlang-electric-newline-inhibit t)
+ (undo-boundary)
+ (erlang-indent-line)
+ (end-of-line)
+ (newline)
+ (if (condition-case nil
+ (progn (erlang-indent-line) t)
+ (error (if (bolp) (delete-char -1))))
+ (if (not (bolp))
+ (save-excursion
+ (insert " ->"))
+ (condition-case nil
+ (progn
+ (erlang-generate-new-clause)
+ (if erlang-electric-semicolon-insert-blank-lines
+ (save-excursion
+ (beginning-of-line)
+ (newline
+ erlang-electric-semicolon-insert-blank-lines))))
+ (error (if (bolp) (delete-char -1))))))))
+
+
+(defun erlang-electric-comma (&optional arg)
+ "Insert a comma character and possibly a new indented line.
+The variable `erlang-electric-comma-criteria' states a criterion,
+when fulfilled a newline is inserted and the next line is indented.
+
+Behaves just like the normal comma when supplied with a
+numerical arg, point is inside string or comment, or when there are
+non-whitespace characters following the point on the current line."
+ (interactive "P")
+
+ (self-insert-command (prefix-numeric-value arg))
+
+ (if (or arg
+ (and (listp erlang-electric-commands)
+ (not (memq 'erlang-electric-comma erlang-electric-commands)))
+ (erlang-in-literal)
+ (not (looking-at "\\s *\\(%.*\\)?$"))
+ (null (erlang-test-criteria-list
+ erlang-electric-comma-criteria)))
+ (setq erlang-electric-newline-inhibit nil)
+ (setq erlang-electric-newline-inhibit t)
+ (undo-boundary)
+ (erlang-indent-line)
+ (end-of-line)
+ (newline)
+ (condition-case nil
+ (erlang-indent-line)
+ (error (if (bolp) (delete-char -1))))))
+
+(defun erlang-electric-lt (&optional arg)
+ "Insert a less-than sign, and optionally mark it as an open paren."
+
+ (interactive "p")
+
+ (self-insert-command arg)
+
+ ;; Was this the second char in bit-syntax open (`<<')?
+ (unless (<= (point) 2)
+ (save-excursion
+ (backward-char 2)
+ (when (and (eq (char-after (point)) ?<)
+ (not (eq (get-text-property (point) 'category)
+ 'bitsyntax-open-inner)))
+ ;; Then mark the two chars...
+ (put-text-property (point) (1+ (point))
+ 'category 'bitsyntax-open-outer)
+ (forward-char 1)
+ (put-text-property (point) (1+ (point))
+ 'category 'bitsyntax-open-inner)
+ ;;...and unmark any subsequent less-than chars.
+ (forward-char 1)
+ (while (eq (char-after (point)) ?<)
+ (remove-text-properties (point) (1+ (point))
+ '(category nil))
+ (forward-char 1))))))
+
+(defun erlang-after-bitsyntax-close ()
+ "Return t if point is immediately after a bit-syntax close parenthesis (`>>')."
+ (and (>= (point) 3)
+ (save-excursion
+ (backward-char 2)
+ (and (eq (char-after (point)) ?>)
+ (not (eq (get-text-property (point) 'category)
+ 'bitsyntax-close-outer))))))
+
+(defun erlang-after-arrow ()
+ "Return true if point is immediately after a function arrow (`->')."
+ (and (>= (point) 2)
+ (and
+ (save-excursion
+ (backward-char)
+ (eq (char-before (point)) ?-))
+ (or (not (listp erlang-electric-commands))
+ (memq 'erlang-electric-gt
+ erlang-electric-commands))
+ (not (erlang-in-literal))
+ (looking-at "\\s *\\(%.*\\)?$")
+ (erlang-test-criteria-list erlang-electric-arrow-criteria))))
+
+
+(defun erlang-electric-gt (&optional arg)
+ "Insert a greater-than sign, and optionally mark it as a close paren."
+
+ (interactive "p")
+
+ (self-insert-command arg)
+
+ (cond
+ ;; Did we just write a bit-syntax close (`>>')?
+ ((erlang-after-bitsyntax-close)
+ (save-excursion
+ ;; Then mark the two chars...
+ (backward-char 2)
+ (put-text-property (point) (1+ (point))
+ 'category 'bitsyntax-close-inner)
+ (forward-char)
+ (put-text-property (point) (1+ (point))
+ 'category 'bitsyntax-close-outer)
+ ;;...and unmark any subsequent greater-than chars.
+ (forward-char)
+ (while (eq (char-after (point)) ?>)
+ (remove-text-properties (point) (1+ (point))
+ '(category nil))
+ (forward-char))))
+
+ ;; Did we just write a function arrow (`->')?
+ ((erlang-after-arrow)
+ (let ((erlang-electric-newline-inhibit t))
+ (undo-boundary)
+ (end-of-line)
+ (newline)
+ (condition-case nil
+ (erlang-indent-line)
+ (error (if (bolp) (delete-char -1))))))
+
+ ;; Then it's just a plain greater-than.
+ (t
+ nil)))
+
+
+(defun erlang-electric-arrow (&optional arg)
+ "Insert a '>'-sign and possibly a new indented line.
+
+This command is only `electric' when the `>' is part of an `->' arrow.
+The variable `erlang-electric-arrow-criteria' states a sequence of
+criteria, which decides when a newline should be inserted and the next
+line indented.
+
+It behaves just like the normal greater than sign when supplied with a
+numerical arg, point is inside string or comment, or when there are
+non-whitespace characters following the point on the current line.
+
+After being split/merged into `erlang-after-arrow' and
+`erlang-electric-gt', it is now unused and disabled."
+ (interactive "P")
+ (let ((prec (preceding-char)))
+ (self-insert-command (prefix-numeric-value arg))
+ (if (or arg
+ (and (listp erlang-electric-commands)
+ (not (memq 'erlang-electric-arrow
+ erlang-electric-commands)))
+ (not (eq prec ?-))
+ (erlang-in-literal)
+ (not (looking-at "\\s *\\(%.*\\)?$"))
+ (null (erlang-test-criteria-list
+ erlang-electric-arrow-criteria)))
+ (setq erlang-electric-newline-inhibit nil)
+ (setq erlang-electric-newline-inhibit t)
+ (undo-boundary)
+ (end-of-line)
+ (newline)
+ (condition-case nil
+ (erlang-indent-line)
+ (error (if (bolp) (delete-char -1)))))))
+
+
+(defun erlang-electric-newline (&optional arg)
+ "Break line at point and indent, continuing comment if within one.
+The variable `erlang-electric-newline-criteria' states a criterion,
+when fulfilled a newline is inserted and the next line is indented.
+
+Should the current line begin with a comment, and the variable
+`comment-multi-line' be non-nil, a new comment start is inserted.
+
+Should the previous command be another electric command we assume that
+the user pressed newline out of old habit, hence we will do nothing."
+ (interactive "P")
+ (cond ((and (not arg)
+ erlang-electric-newline-inhibit
+ (memq last-command erlang-electric-newline-inhibit-list))
+ ()) ; Do nothing!
+ ((or arg
+ (and (listp erlang-electric-commands)
+ (not (memq 'erlang-electric-newline
+ erlang-electric-commands)))
+ (null (erlang-test-criteria-list
+ erlang-electric-newline-criteria)))
+ (newline (prefix-numeric-value arg)))
+ (t
+ (if (and comment-multi-line
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (concat "\\s *" comment-start-skip))))
+ (let ((str (buffer-substring
+ (or (match-end 1) (match-beginning 0))
+ (min (match-end 0) (point)))))
+ (newline)
+ (undo-boundary)
+ (insert str))
+ (newline)
+ (undo-boundary)
+ (indent-according-to-mode)))))
+
+
+(defun erlang-test-criteria-list (criteria)
+ "Given a list of criterion functions, test if criteria are fulfilled.
+
+Each element in the criteria list can a function returning nil, t or
+the atom `stop'. t means that the criterion is fulfilled, `stop' means
+that it isn't fulfilled and that the search should stop,
+and nil means continue searching.
+
+Should the list contain the atom t the criterion is assumed to be
+fulfilled, unless preceded by a function returning `stop', of course.
+
+Should the argument be the atom t instead of a list, the criterion is
+assumed to be trivially true.
+
+Should all functions return nil, the criteria are assumed not to be
+fulfilled.
+
+Return t if criteria fulfilled, nil otherwise."
+ (if (eq criteria t)
+ t
+ (save-excursion
+ (let ((answer nil))
+ (while (and criteria (null answer))
+ (if (eq (car criteria) t)
+ (setq answer t)
+ (setq answer (funcall (car criteria))))
+ (setq criteria (cdr criteria)))
+ (if (and answer (not (eq answer 'stop)))
+ t
+ nil)))))
+
+
+(defun erlang-in-literal ()
+ "Test if point is in string, quoted atom or comment.
+
+Return one of the three atoms `atom', `string', and `comment'.
+Should the point be inside none of the above mentioned types of
+context, nil is returned."
+ (save-excursion
+ (let ((state (funcall (symbol-function 'syntax-ppss))))
+ (cond ((eq (nth 3 state) ?') 'atom)
+ ((nth 3 state) 'string)
+ ((nth 4 state) 'comment)
+ (t nil)))))
+
+
+(defun erlang-at-end-of-function-p ()
+ "Test if point is at end of an Erlang function.
+
+This function is designed to be a member of a criteria list."
+ (eq (save-excursion (erlang-skip-blank) (point))
+ (save-excursion
+ (erlang-beginning-of-function -1) (point))))
+
+
+(defun erlang-at-end-of-clause-p ()
+ "Test if point is at end of an Erlang clause.
+
+This function is designed to be a member of a criteria list."
+ (eq (save-excursion (erlang-skip-blank) (point))
+ (save-excursion
+ (erlang-beginning-of-clause -1) (point))))
+
+
+(defun erlang-stop-when-inside-argument-list ()
+ "Return `stop' if inside parenthesis list, nil otherwise.
+
+Knows about the list comprehension syntax. When the point is
+after `||', `stop' is not returned.
+
+This function is designed to be a member of a criteria list."
+ (save-excursion
+ (condition-case nil
+ (let ((orig-point (point))
+ (state nil))
+ (up-list -1)
+ (if (not (eq (following-char) ?\[))
+ 'stop
+ ;; Do not return `stop' when inside a list comprehension
+ ;; construction. (The point must be after `||').
+ (while (< (point) orig-point)
+ (let ((pt (point)))
+ (setq state (erlang-partial-parse pt orig-point state))
+ (if (= pt (point))
+ (error "Illegal syntax"))))
+ (if (and (car state) (eq (car (car (car state))) '||))
+ nil
+ 'stop)))
+ (error
+ nil))))
+
+
+(defun erlang-stop-when-at-guard ()
+ "Return `stop' when at function guards.
+
+This function is designed to be a member of a criteria list."
+ (save-excursion
+ (beginning-of-line)
+ (if (and (looking-at (eval-when-compile
+ (concat "^" erlang-atom-regexp "\\s *(")))
+ (not (looking-at
+ (eval-when-compile
+ (concat "^" erlang-atom-regexp ".*->")))))
+ 'stop
+ nil)))
+
+
+(defun erlang-stop-when-in-type-spec ()
+ "Return `stop' when in a type spec line.
+
+This function is designed to be a member of a criteria list."
+ (save-excursion
+ (beginning-of-line)
+ (when (save-match-data (looking-at "-\\(spec\\|type\\|callback\\)"))
+ 'stop)))
+
+
+(defun erlang-next-lines-empty-p ()
+ "Return non-nil if next lines are empty.
+
+The variable `erlang-next-lines-empty-threshold' contains the number
+of lines required to be empty.
+
+A line containing only spaces and tabs is considered empty.
+
+This function is designed to be a member of a criteria list."
+ (and erlang-next-lines-empty-threshold
+ (save-excursion
+ (let ((left erlang-next-lines-empty-threshold)
+ (cont t))
+ (while (and cont (> left 0))
+ (forward-line 1)
+ (setq cont (looking-at "\\s *$"))
+ (setq left (- left 1)))
+ cont))))
+
+
+(defun erlang-at-keyword-end-p ()
+ "Test if next readable token is the keyword end.
+
+This function is designed to be a member of a criteria list."
+ (save-excursion
+ (erlang-skip-blank)
+ (looking-at "end[^_a-zA-Z0-9]")))
+
+
+;;; Erlang tags support which is aware of erlang modules.
+
+(eval-when-compile
+ (require 'etags))
+
+
+;; Variables:
+
+(defvar erlang-tags-function-alist
+ '((find-tag . erlang-find-tag)
+ (find-tag-other-window . erlang-find-tag-other-window)
+ (find-tag-regexp . erlang-find-tag-regexp)
+ (find-tag-other-frame . erlang-find-tag-other-frame))
+ "Alist of old tags commands and the replacement functions.")
+
+(defvar erlang-tags-installed nil
+ "Non-nil when the Erlang tags system is installed.")
+(defvar erlang-tags-file-list '()
+ "List of files in tag list. Used when finding tag on form `module:'.")
+(defvar erlang-tags-completion-table nil
+ "Like `tags-completion-table', this table contains `tag' and `module:tag'.")
+(defvar erlang-tags-buffer-installed-p nil
+ "Non-nil when Erlang module recognising functions installed.")
+(defvar erlang-tags-buffer-list '()
+ "Temporary list of buffers.")
+(defvar erlang-tags-orig-completion-table nil
+ "Temporary storage for `tags-completion-table'.")
+(defvar erlang-tags-orig-tag-order nil
+ "Temporary storage for `find-tag-tag-order'.")
+(defvar erlang-tags-orig-regexp-tag-order nil
+ "Temporary storage for `find-tag-regexp-tag-order'.")
+(defvar erlang-tags-orig-search-function nil
+ "Temporary storage for `find-tag-search-function'.")
+(defvar erlang-tags-orig-regexp-search-function nil
+ "Temporary storage for `find-tag-regexp-search-function'.")
+(defvar erlang-tags-orig-format-hooks nil
+ "Temporary storage for `tags-table-format-hooks'.") ;v19
+(defvar erlang-tags-orig-format-functions nil
+ "Temporary storage for `tags-table-format-functions'.") ;v > 19
+
+(defun erlang-tags-init ()
+ "Install an alternate version of tags, aware of Erlang modules.
+
+After calling this function, the tags functions are aware of
+Erlang modules. Tags can be entered on the for `module:tag' as well
+as on the old form `tag'.
+
+In the completion list, `module:tag' and `module:' shows up."
+ (interactive)
+ (require 'etags)
+ (set (make-local-variable 'find-tag-default-function)
+ 'erlang-find-tag-for-completion)
+ (if (>= emacs-major-version 25)
+ (add-hook 'xref-backend-functions
+ #'erlang-etags--xref-backend nil t)
+ (erlang-tags-define-keys (current-local-map))
+ (setq erlang-tags-installed t)))
+
+
+
+;; Set all keys bound to `find-tag' et.al. in the global map and the
+;; menu to `erlang-find-tag' et.al. in `map'.
+;;
+;; The function `substitute-key-definition' does not work properly
+;; in all version of Emacs.
+
+(defun erlang-tags-define-keys (map)
+ "Bind tags commands to keymap MAP aware of Erlang modules."
+ (let ((alist erlang-tags-function-alist))
+ (while alist
+ (let* ((old (car (car alist)))
+ (new (cdr (car alist)))
+ (keys (append (where-is-internal old global-map))))
+ (while keys
+ (define-key map (car keys) new)
+ (setq keys (cdr keys))))
+ (setq alist (cdr alist))))
+ ;; Update the menu.
+ (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist)
+ (erlang-menu-init))
+
+;; Return `t' since it is used inside `tags-loop-form'.
+;;;###autoload
+(defun erlang-find-tag (modtagname &optional next-p regexp-p)
+ "Like `find-tag'. Capable of retrieving Erlang modules.
+
+Tags can be given on the forms `tag', `module:', `module:tag'."
+ (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
+ (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p))
+ t)
+
+
+;; Code mainly from `find-tag-other-window' in `etags.el'.
+;;;###autoload
+(defun erlang-find-tag-other-window (tagname &optional next-p regexp-p)
+ "Like `find-tag-other-window' but aware of Erlang modules."
+ (interactive (erlang-tag-interactive
+ "Find `module:tag' or `tag' other window: "))
+
+ ;; This is to deal with the case where the tag is found in the
+ ;; selected window's buffer; without this, point is moved in both
+ ;; windows. To prevent this, we save the selected window's point
+ ;; before doing find-tag-noselect, and restore it afterwards.
+ (let* ((window-point (window-point (selected-window)))
+ (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p))
+ (tagpoint (progn (set-buffer tagbuf) (point))))
+ (set-window-point (prog1
+ (selected-window)
+ (switch-to-buffer-other-window tagbuf)
+ ;; We have to set this new window's point; it
+ ;; might already have been displaying a
+ ;; different portion of tagbuf, in which case
+ ;; switch-to-buffer-other-window doesn't set
+ ;; the window's point from the buffer.
+ (set-window-point (selected-window) tagpoint))
+ window-point)))
+
+
+(defun erlang-find-tag-other-frame (tagname &optional next-p)
+ "Like `find-tag-other-frame' but aware of Erlang modules."
+ (interactive (erlang-tag-interactive
+ "Find `module:tag' or `tag' other frame: "))
+ (let ((pop-up-frames t))
+ (erlang-find-tag-other-window tagname next-p)))
+
+
+(defun erlang-find-tag-regexp (regexp &optional next-p other-window)
+ "Like `find-tag-regexp' but aware of Erlang modules."
+ (interactive (if (fboundp 'find-tag-regexp)
+ (erlang-tag-interactive
+ "Find `module:regexp' or `regexp': ")
+ (error "This version of Emacs can't find tags by regexps")))
+ (funcall (if other-window
+ 'erlang-find-tag-other-window
+ 'erlang-find-tag)
+ regexp next-p t))
+
+
+;; Just like C-u M-. This could be added to the menu.
+(defun erlang-find-next-tag ()
+ "Find next tag, like \\[find-tag] with prefix arg."
+ (interactive)
+ (let ((current-prefix-arg '(4)))
+ (if erlang-tags-installed
+ (call-interactively 'erlang-find-tag)
+ (call-interactively 'find-tag))))
+
+
+;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to
+;; be compatible with `tags.el'.
+;;
+;; Handles three cases:
+;; * `module:' Loop over all possible file names. Stop if a file-name
+;; without extension and directory matches the module.
+;;
+;; * `module:tag'
+;; Emacs 19: Replace test functions with functions aware of
+;; Erlang modules. Tricky because the etags system wasn't
+;; built for these kind of operations...
+;;
+;; Emacs 18: We loop over `find-tag' until we find a file
+;; whose module matches the requested module. The
+;; drawback is that a lot of files could be loaded into
+;; Emacs.
+;;
+;; * `tag' Just give it to `find-tag'.
+
+(defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p)
+ "Like `find-tag-noselect' but aware of Erlang modules."
+ (interactive (erlang-tag-interactive "Find `module:tag' or `tag': "))
+ (or modtagname
+ (setq modtagname (symbol-value 'last-tag)))
+ (funcall (symbol-function 'set) 'last-tag modtagname)
+ ;; `tags.el' uses this variable to record how M-, would
+ ;; know where to restart a tags command.
+ (if (boundp 'tags-loop-form)
+ (funcall (symbol-function 'set)
+ 'tags-loop-form '(erlang-find-tag nil t)))
+ (save-window-excursion
+ (cond
+ ((string-match ":$" modtagname)
+ ;; Only the module name was given. Read all files whose file name
+ ;; match.
+ (let ((modname (substring modtagname 0 (match-beginning 0)))
+ (file nil))
+ (if (not next-p)
+ (save-excursion
+ (visit-tags-table-buffer)
+ (setq erlang-tags-file-list
+ (funcall (symbol-function 'tags-table-files)))))
+ (while (null file)
+ (or erlang-tags-file-list
+ (save-excursion
+ (if (and (funcall
+ (symbol-function 'visit-tags-table-buffer) 'same)
+ (funcall
+ (symbol-function 'visit-tags-table-buffer) t))
+ (setq erlang-tags-file-list
+ (funcall (symbol-function 'tags-table-files)))
+ (error "No %stags containing %s" (if next-p "more " "")
+ modtagname))))
+ (if erlang-tags-file-list
+ (let ((this-module (erlang-get-module-from-file-name
+ (car erlang-tags-file-list))))
+ (if (and (stringp this-module)
+ (string= modname this-module))
+ (setq file (car erlang-tags-file-list)))
+ (setq erlang-tags-file-list (cdr erlang-tags-file-list)))))
+ (set-buffer (or (get-file-buffer file)
+ (find-file-noselect file)))))
+
+ ((string-match ":" modtagname)
+ (progn
+ (erlang-tags-install-module-check)
+ (unwind-protect
+ (funcall (symbol-function 'find-tag)
+ modtagname next-p regexp-p)
+ (erlang-tags-remove-module-check))))
+ (t
+ (funcall (symbol-function 'find-tag) modtagname next-p regexp-p)))
+ (current-buffer))) ; Return the new buffer.
+
+
+
+
+
+
+
+;; Process interactive arguments for erlang-find-tag-*.
+;;
+;; Negative arguments work only for `etags', not `tags'. This is not
+;; a problem since negative arguments means step back into the
+;; history list, a feature not implemented in `tags'.
+
+(defun erlang-tag-interactive (prompt)
+ (condition-case nil
+ (require 'etags)
+ (error
+ (require 'tags)))
+ (if current-prefix-arg
+ (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
+ '-
+ t))
+ (let* ((default (erlang-default-function-or-module))
+ (prompt (if default
+ (format "%s(default %s) " prompt default)
+ prompt))
+ (spec (completing-read prompt 'erlang-tags-complete-tag)))
+ (list (if (equal spec "")
+ (or default (error "There is no default tag"))
+ spec)))))
+
+
+;; Search tag functions which are aware of Erlang modules. The tactic
+;; is to store new search functions into the local variables of the
+;; TAGS buffers. The variables are restored directly after the
+;; search. The situation is complicated by the fact that new TAGS
+;; files can be loaded during the search.
+;;
+
+(defun erlang-tags-install-module-check ()
+ "Install our own tag search functions."
+ ;; Make sure our functions are installed in TAGS files loaded
+ ;; into Emacs while searching.
+ (setq erlang-tags-orig-format-functions
+ (symbol-value 'tags-table-format-functions))
+ (funcall (symbol-function 'set) 'tags-table-format-functions
+ (cons 'erlang-tags-recognize-tags-table
+ erlang-tags-orig-format-functions))
+ (setq erlang-tags-buffer-list '())
+
+ ;; Install our functions in the TAGS files already resident.
+ (save-excursion
+ (let ((files (symbol-value 'tags-table-computed-list)))
+ (while files
+ (if (stringp (car files))
+ (if (get-file-buffer (car files))
+ (progn
+ (set-buffer (get-file-buffer (car files)))
+ (erlang-tags-install-local))))
+ (setq files (cdr files))))))
+
+
+(defun erlang-tags-install-local ()
+ "Install our tag search functions in current buffer."
+ (if erlang-tags-buffer-installed-p
+ ()
+ ;; Mark this buffer as "installed" and record.
+ (set (make-local-variable 'erlang-tags-buffer-installed-p) t)
+ (setq erlang-tags-buffer-list
+ (cons (current-buffer) erlang-tags-buffer-list))
+
+ ;; Save the original values.
+ (set (make-local-variable 'erlang-tags-orig-tag-order)
+ (symbol-value 'find-tag-tag-order))
+ (set (make-local-variable 'erlang-tags-orig-regexp-tag-order)
+ (symbol-value 'find-tag-regexp-tag-order))
+ (set (make-local-variable 'erlang-tags-orig-search-function)
+ (symbol-value 'find-tag-search-function))
+ (set (make-local-variable 'erlang-tags-orig-regexp-search-function)
+ (symbol-value 'find-tag-regexp-search-function))
+
+ ;; Install our own functions.
+ (set (make-local-variable 'find-tag-search-function)
+ 'erlang-tags-search-forward)
+ (set (make-local-variable 'find-tag-regexp-search-function)
+ 'erlang-tags-regexp-search-forward)
+ (set (make-local-variable 'find-tag-tag-order)
+ (mapcar #'erlang-make-order-function-aware-of-modules
+ erlang-tags-orig-tag-order))
+ (set (make-local-variable 'find-tag-regexp-tag-order)
+ (mapcar #'erlang-make-order-function-aware-of-modules
+ erlang-tags-orig-regexp-tag-order))))
+
+(defun erlang-make-order-function-aware-of-modules (f)
+ `(lambda (tag)
+ (let (mod)
+ (when (string-match ":" tag)
+ (setq mod (substring tag 0 (match-beginning 0)))
+ (setq tag (substring tag (match-end 0) nil)))
+ (and (funcall ',f tag)
+ (or (null mod)
+ (erlang-tag-at-point-match-module-p mod))))))
+
+(defun erlang-tag-at-point-match-module-p (mod)
+ (string-equal mod (erlang-get-module-from-file-name
+ (funcall (symbol-function 'file-of-tag)))))
+
+
+(defun erlang-tags-remove-module-check ()
+ "Remove our own tags search functions."
+ (funcall (symbol-function 'set)
+ 'tags-table-format-functions
+ erlang-tags-orig-format-functions)
+
+ ;; Remove our functions from the TAGS files. (Note that
+ ;; `tags-table-computed-list' need not be the same list as when
+ ;; the search was started.)
+ (save-excursion
+ (let ((buffers erlang-tags-buffer-list))
+ (while buffers
+ (if (buffer-name (car buffers))
+ (progn
+ (set-buffer (car buffers))
+ (erlang-tags-remove-local)))
+ (setq buffers (cdr buffers))))))
+
+
+(defun erlang-tags-remove-local ()
+ "Remove our tag search functions from current buffer."
+ (if (null erlang-tags-buffer-installed-p)
+ ()
+ (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil)
+ (funcall (symbol-function 'set)
+ 'find-tag-tag-order erlang-tags-orig-tag-order)
+ (funcall (symbol-function 'set)
+ 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order)
+ (funcall (symbol-function 'set)
+ 'find-tag-search-function erlang-tags-orig-search-function)
+ (funcall (symbol-function 'set)
+ 'find-tag-regexp-search-function
+ erlang-tags-orig-regexp-search-function)))
+
+
+(defun erlang-tags-recognize-tags-table ()
+ "Install our functions in all loaded TAGS files.
+
+This function is added to `tags-table-format-hooks/functions' when searching
+for a tag on the form `module:tag'."
+ (if (null (funcall (symbol-function 'etags-recognize-tags-table)))
+ nil
+ (erlang-tags-install-local)
+ t))
+
+
+(defun erlang-tags-search-forward (tag &optional bound noerror count)
+ "Forward search function, aware of Erlang module prefix."
+ (if (string-match ":" tag)
+ (setq tag (substring tag (match-end 0) nil)))
+ ;; Avoid unintended recursion.
+ (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward)
+ (search-forward tag bound noerror count)
+ (funcall erlang-tags-orig-search-function tag bound noerror count)))
+
+
+(defun erlang-tags-regexp-search-forward (tag &optional bound noerror count)
+ "Forward regexp search function, aware of Erlang module prefix."
+ (if (string-match ":" tag)
+ (setq tag (substring tag (match-end 0) nil)))
+ (if (eq erlang-tags-orig-regexp-search-function
+ 'erlang-tags-regexp-search-forward)
+ (re-search-forward tag bound noerror count)
+ (funcall erlang-tags-orig-regexp-search-function
+ tag bound noerror count)))
+
+;;; Tags completion, Emacs 19 `etags' specific.
+;;;
+;;; The basic idea is to create a second completion table `erlang-tags-
+;;; completion-table' containing all normal tags plus tags on the form
+;;; `module:tag' and `module:'.
+
+(if (fboundp 'advice-add)
+ ;; Emacs 24.4+
+ (progn
+ (require 'etags)
+ (advice-add 'etags-tags-completion-table :around
+ #'erlang-etags-tags-completion-table-advice))
+ ;; Emacs 23.1-24.3
+ (defadvice etags-tags-completion-table (around
+ erlang-replace-tags-table
+ activate)
+ (if erlang-replace-etags-tags-completion-table
+ (setq ad-return-value (erlang-etags-tags-completion-table))
+ ad-do-it)))
+
+(defun erlang-etags-tags-completion-table-advice (oldfun)
+ (if erlang-replace-etags-tags-completion-table
+ (erlang-etags-tags-completion-table)
+ (funcall oldfun)))
+
+(defun erlang-complete-tag ()
+ "Perform tags completion on the text around point.
+Completes to the set of names listed in the current tags table.
+
+Should the Erlang tags system be installed this command knows
+about Erlang modules."
+ (interactive)
+ (require 'etags)
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (complete-tag)))
+
+
+(defun erlang-find-tag-for-completion ()
+ (let ((start (save-excursion
+ (skip-chars-backward "[:word:][:digit:]_:'")
+ (point))))
+ (unless (eq start (point))
+ (buffer-substring-no-properties start (point)))))
+
+
+;; Based on `tags-complete-tag', but this one uses
+;; `erlang-tags-completion-table' instead of `tags-completion-table'.
+;;
+;; This is the entry-point called by system function `completing-read'.
+;;
+;; Used for minibuffer completion in Emacs 19-24 and completion in
+;; erlang buffers in Emacs 19-22.
+(defun erlang-tags-complete-tag (string predicate what)
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (save-excursion
+ ;; If we need to ask for the tag table, allow that.
+ (let ((enable-recursive-minibuffers t))
+ (visit-tags-table-buffer))
+ (if (eq what t)
+ (all-completions string (erlang-tags-completion-table) predicate)
+ (try-completion string (erlang-tags-completion-table) predicate)))))
+
+
+;; `tags-completion-table' calls itself recursively, make it
+;; call our own wedge instead. Note that the recursive call
+;; is very rare; it only occurs when a tags-file contains
+;; `include'-statements.
+(defun erlang-tags-completion-table ()
+ "Build completion table. Tags on the form `tag' or `module:tag'."
+ (setq erlang-tags-orig-completion-table
+ (symbol-function 'tags-completion-table))
+ (fset 'tags-completion-table
+ (symbol-function 'erlang-tags-completion-table-1))
+ (unwind-protect
+ (erlang-tags-completion-table-1)
+ (fset 'tags-completion-table
+ erlang-tags-orig-completion-table)))
+
+(defun erlang-tags-completion-table-1 ()
+ (make-local-variable 'erlang-tags-completion-table)
+ (or erlang-tags-completion-table
+ (let ((tags-completion-table nil)
+ (tags-completion-table-function
+ 'erlang-etags-tags-completion-table))
+ (funcall erlang-tags-orig-completion-table)
+ (setq erlang-tags-completion-table tags-completion-table))))
+
+
+
+;; Emacs 25 expects this function to return a list (and it is ok for
+;; it to include duplicates). Older emacsen expects an obarray.
+(defun erlang-etags-tags-completion-table ()
+ (if (>= emacs-major-version 25)
+ (erlang-etags-tags-completion-table-list)
+ (let ((obarray (make-vector 511 0)))
+ (dolist (tag (erlang-etags-tags-completion-table-list))
+ (intern tag obarray))
+ obarray)))
+
+;; Based on `etags-tags-completion-table'. The difference is that we
+;; add three strings to the list, the tag, module: and module:tag.
+;; The module is extracted from the file name of a tag. (This one
+;; only works if we are looking at an `etags' file. However, this is
+;; the only format supported by Emacs, so far.)
+(defun erlang-etags-tags-completion-table-list ()
+ (let ((progress-reporter
+ (make-progress-reporter
+ (format "Making tags completion table for %s..." buffer-file-name)
+ (point-min) (point-max)))
+ table module)
+ (save-excursion
+ (goto-char (point-min))
+ (while (progn
+ (while (and (eq (following-char) ?\f)
+ (looking-at "\f\n\\([^,\n]*\\),.*\n"))
+ (let ((file (buffer-substring (match-beginning 1)
+ (match-end 1))))
+ (setq module (erlang-get-module-from-file-name file))
+ (when module
+ (push (concat module ":") table)
+ (push (concat module ":module_info") table))
+ (forward-line 2)))
+ ;; This regexp matches an explicit tag name or the
+ ;; place where it would start.
+ (re-search-forward
+ "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?"
+ nil t))
+ (let ((tag (if (match-beginning 1)
+ ;; There is an explicit tag name.
+ (buffer-substring (match-beginning 1) (match-end 1))
+ ;; No explicit tag name. Backtrack a little,
+ ;; and look for the implicit one.
+ (goto-char (match-beginning 0))
+ (skip-chars-backward "^\f\t\n\r()=,; ")
+ (buffer-substring (point) (match-beginning 0)))))
+ (forward-line 1)
+ (push tag table)
+ (when (stringp module)
+ (push (concat module ":" tag) table))
+ (progress-reporter-update progress-reporter (point)))))
+ table))
+
+
+
+
+;;; Xref backend erlang-etags
+
+;; In GNU Emacs 25 xref was introduced. It is a framework for cross
+;; referencing commands, in particular commands for finding
+;; definitions. It does not replace etags. It rather resides on top
+;; of it and provides user-friendly commands. The idea is that the
+;; user commands should be the same regardless of what backend does
+;; the actual finding of definitions.
+
+;; The backend below is a wrapper around the built-in etags backend.
+;; It adds awareness of the module:tag syntax in a similar way that is
+;; done above for the old etags commands.
+;;
+;; In addition arity is also considered when jumping to definitions.
+;; There is however currently no information about arity in the TAGS
+;; file. Also two functions with the same name but different arity
+;; _sometimes_ get one TAGS entry each and sometimes are joined in one
+;; single entry. If they are directly consecutive they will be
+;; joined. If there are other functions etc in between then they will
+;; get one entry each.
+;;
+;; These limitations are present in both the etags program shipped
+;; with GNU Emacs and the tags.erl program in this repository.
+;;
+;; Therefore erlang.el must complement the information in TAGS by
+;; visiting files and checking arity. When searching for popular
+;; function names (like init, handle_call etc) in a big TAGS file
+;; (like one indexing this repository) this may be quite
+;; time-consuming. There exists therefore an upper limit for the
+;; number of files to visit (called
+;; `erlang-max-files-to-visit-for-refining-xrefs').
+;;
+;; As mentioned this xref implementation is based on the etags xref
+;; implementation. But in the cases where arity is considered the
+;; etags information structures (struct xref-etags-location) will be
+;; translated to our own structures which include arity (struct
+;; erlang-xref-location). This translation is started in the function
+;; `erlang-refine-xrefs'.
+
+;; I mention this as a head up that some of the functions below deal
+;; with xref items with xref-etags-location and some deal with xref
+;; items with erlang-xref-location.
+
+;; NOTE: Around Sept 2021, the xrefs package changed all of its defined types
+;; (i.e. xref-location, xref-file-location) from EIEIO classes to CL-Lib
+;; structures. These are both supported. Older Emacsen with earlier versions of
+;; xref will continue to use defclass. Newer Emacsen will use cl-defstruct.
+
+(defun erlang-etags--xref-backend () 'erlang-etags)
+
+(defun erlang-soft-require (feature)
+ (when (locate-library (symbol-name feature))
+ (require feature)))
+
+(when (and (erlang-soft-require 'xref)
+ (erlang-soft-require 'cl-generic)
+ (erlang-soft-require 'cl-lib)
+ (erlang-soft-require 'eieio)
+ (erlang-soft-require 'etags))
+ ;; The purpose of using eval here is to avoid compilation
+ ;; warnings in emacsen without cl-defmethod etc.
+ (eval
+ '(progn
+ (cl-defmethod xref-backend-identifier-at-point ((_backend
+ (eql erlang-etags)))
+ (if (eq this-command 'xref-find-references)
+ (if (use-region-p)
+ (buffer-substring-no-properties (region-beginning)
+ (region-end))
+ (thing-at-point 'symbol))
+ (erlang-id-to-string (erlang-get-identifier-at-point))))
+
+ (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags))
+ identifier)
+ (erlang-xref-find-definitions identifier))
+
+ (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags))
+ identifier)
+ (erlang-xref-find-definitions identifier t))
+
+ (cl-defmethod xref-backend-identifier-completion-table
+ ((_backend (eql erlang-etags)))
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (tags-completion-table)))
+
+ ;; Xref 1.3.1 bundled with Emacs 28+ switched from using EIEIO classes to
+ ;; using CL-Lib structs.
+ (if (find-class 'xref-file-location)
+ (progn
+ (defclass erlang-xref-location (xref-file-location)
+ ((arity :type fixnum :initarg :arity
+ :reader erlang-xref-location-arity))
+ :documentation "An erlang location is a file location plus arity.")
+ ;; Make a constructor with the same name that a CL structure would have.
+ (defalias 'make-erlang-xref-location 'erlang-xref-location))
+ (cl-defstruct (erlang-xref-location
+ (:include xref-file-location))
+ "An erlang location is a file location plus arity."
+ (arity 0 :type fixnum)))
+
+ ;; This method definition only calls the superclass which is
+ ;; the default behaviour if it was not defined. It is only
+ ;; needed for "upgrade" purposes. In version 2.8.1 of
+ ;; erlang.el this method was defined differently and in case
+ ;; user switch to a new erlang.el without restarting Emacs
+ ;; this method needs to be redefined.
+ (cl-defmethod xref-location-marker ((locus erlang-xref-location))
+ (cl-call-next-method locus)))))
+
+;; If this function returns a single xref the user will jump to that
+;; directly. If two or more xrefs are returned a *xref* window is
+;; displayed and the user can choose where to jump. Hence we want to
+;; return a single xref when we are pretty sure that is where the user
+;; wants to go. Otherwise return all possible xrefs but sort them so
+;; that xrefs in the local file is first and if arity is known sort
+;; the xrefs with matching arity before others.
+
+;; Note that the arity sorting work may partly be undone later when
+;; the hits are presented in the *xref* buffer since they then will be
+;; grouped together by file. Ie when one file have one hit with
+;; correct arity and others with wrong arity these hits will be
+;; grouped together and may end up before hits with correct arity.
+(defun erlang-xref-find-definitions (identifier &optional is-regexp)
+ (erlang-with-id (kind module name arity) identifier
+ (cond ((eq kind 'module)
+ (erlang-xref-find-definitions-module name))
+ ((eq kind 'qualified-function)
+ (erlang-xref-find-definitions-qualified-function module
+ name
+ arity
+ is-regexp))
+ (module
+ (erlang-xref-find-definitions-module-tag kind
+ module
+ name
+ arity
+ is-regexp))
+ (t
+ (erlang-xref-find-definitions-tag kind name arity is-regexp)))))
+
+(defun erlang-xref-find-definitions-module (module)
+ (and (fboundp 'xref-make)
+ (fboundp 'xref-make-file-location)
+ (let* ((first-time t)
+ (cbuf (current-buffer))
+ xrefs matching-files)
+ (save-excursion
+ (while (erlang-visit-tags-table-buffer (not first-time) cbuf)
+ (setq first-time nil)
+ (let ((files (tags-table-files)))
+ (while files
+ (let* ((file (car files))
+ (m (erlang-get-module-from-file-name file)))
+ (when (and m (string-equal m module))
+ (unless (member file matching-files)
+ (push file
+ matching-files)
+ (push (xref-make file
+ (xref-make-file-location file 1 0))
+ xrefs))))
+ (setq files (cdr files))))))
+ (nreverse xrefs))))
+
+(defun erlang-xref-find-definitions-qualified-function (module
+ tag
+ arity
+ is-regexp)
+ "Find definitions of TAG in MODULE preferably with arity ARITY.
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG). If IS-REGEXP is non-nil then
+TAG is a regexp."
+ (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions tag is-regexp)))
+ (xrefs-split (erlang-split-xrefs-on-module xrefs module))
+ (module-xrefs (car xrefs-split))
+ (module-xrefs (erlang-refine-xrefs module-xrefs
+ 'qualified-function
+ tag
+ is-regexp)))
+ (or (erlang-single-arity-match module-xrefs arity)
+ (erlang-sort-by-arity module-xrefs arity))))
+
+
+;; We will end up here when erlang-get-some-other-id-at-point either
+;; found module among the import statements or module is just the
+;; current local file.
+(defun erlang-xref-find-definitions-module-tag (kind
+ module
+ tag
+ arity
+ is-regexp)
+ "Find definitions of TAG preferably in MODULE and with arity ARITY.
+Return definitions outside MODULE if none are found inside. If
+IS-REGEXP is non-nil then TAG is a regexp.
+
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG)."
+ (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions tag is-regexp)))
+ (xrefs-split (erlang-split-xrefs-on-module xrefs module))
+ (module-xrefs (car xrefs-split))
+ (module-xrefs (erlang-refine-xrefs module-xrefs
+ kind
+ tag
+ is-regexp)))
+ (or (erlang-single-arity-match module-xrefs arity)
+ (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs))))
+
+(defun erlang-xref-find-definitions-tag (kind
+ tag
+ arity
+ is-regexp
+ &optional xrefs)
+ "Find definitions of TAG preferably in local file and with arity ARITY.
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG). If no such local match was
+found then look for a matching BIF in the same way. If IS-REGEXP
+is non-nil then TAG is a regexp."
+ (let* ((regexp (erlang-etags-regexp kind tag is-regexp))
+ (xrefs (or xrefs
+ (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions regexp t))))
+ (xrefs-split (erlang-split-xrefs xrefs))
+ (local-xrefs (car xrefs-split))
+ (local-xrefs (erlang-refine-xrefs local-xrefs
+ kind
+ tag
+ is-regexp))
+ (bif-xrefs (cadr xrefs-split))
+ (other-xrefs (caddr xrefs-split)))
+ (or (erlang-single-arity-match local-xrefs arity)
+ ;; No local match, look for a matching BIF.
+ (progn
+ (setq bif-xrefs (erlang-refine-xrefs bif-xrefs
+ kind
+ tag
+ is-regexp))
+ (erlang-single-arity-match bif-xrefs arity))
+ (progn
+ (setq other-xrefs (erlang-refine-xrefs other-xrefs
+ kind
+ tag
+ is-regexp))
+ (and (null local-xrefs)
+ (null bif-xrefs)
+ ;; No local of BIF matches at all. Is there a single
+ ;; arity match among the rest?
+ (erlang-single-arity-match other-xrefs arity)))
+ (append (erlang-sort-by-arity local-xrefs arity)
+ (erlang-sort-by-arity bif-xrefs arity)
+ (erlang-sort-by-arity other-xrefs arity)))))
+
+
+(defun erlang-refine-xrefs (xrefs kind tag is-regexp)
+ (if (or (memq kind '(record module))
+ ;; No support for apropos here.
+ is-regexp
+ (erlang-too-many-files-in-xrefs xrefs))
+ xrefs
+ (when (and xrefs
+ (fboundp 'xref-item-location)
+ (fboundp 'xref-location-group))
+ (let (files)
+ (cl-loop for xref in xrefs
+ for loc = (xref-item-location xref)
+ for file = (xref-location-group loc)
+ do (cl-pushnew file files :test 'string-equal))
+ (or (cl-loop for file in files
+ append (erlang-xrefs-in-file file kind tag is-regexp))
+ ;; Failed for some reason. Pretend like it is raining and
+ ;; return the unrefined xrefs.
+ xrefs)))))
+
+(defun erlang-too-many-files-in-xrefs (xrefs)
+ (and erlang-max-files-to-visit-for-refining-xrefs
+ (let ((files-to-visit (delete-dups
+ (mapcar #'erlang-xref-truename-file
+ xrefs))))
+ (if (< (length files-to-visit)
+ erlang-max-files-to-visit-for-refining-xrefs)
+ nil
+ (message (concat "Too many hits to consider arity (see "
+ "`erlang-max-files-to-visit-for-refining-xrefs')"))
+ t))))
+
+(defun erlang-xrefs-in-file (file kind tag is-regexp)
+ (when (and (fboundp 'make-erlang-xref-location)
+ (fboundp 'xref-make))
+ (with-current-buffer (find-file-noselect file)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((regexp (concat ; "^"
+ (erlang-etags-regexp kind tag is-regexp)
+ "\\s *("))
+ last-arity)
+ (cl-loop while (re-search-forward regexp nil t)
+ for name = (match-string-no-properties 1)
+ for arity = (save-excursion
+ (erlang-get-arity))
+ for loc = (make-erlang-xref-location
+ :file file
+ :line (line-number-at-pos)
+ :column 0
+ :arity arity)
+ for sum = (erlang-xref-summary kind name arity)
+ when (and arity
+ (not (eq arity last-arity)))
+ collect (xref-make sum loc)
+ do (setq last-arity arity)))))))
+
+(defun erlang-xref-summary (kind tag arity)
+ (format "%s%s%s"
+ (if (memq kind '(record macro module))
+ (format "%s " kind)
+ "")
+ tag
+ (if arity (format "/%s" arity) "")))
+
+(defun erlang-single-arity-match (xrefs wanted-arity)
+ "Attempt to find one perfect match.
+
+If we have all information needed to consider arity then return a
+single perfect match or nothing. If there are more than one
+match nothing is returned.
+
+If we don't have all information needed to consider arity just
+return XREFS as is."
+ (if (erlang-should-consider-arity-p xrefs wanted-arity)
+ (let ((nr-matches 0)
+ match)
+ (while (and xrefs
+ (< nr-matches 2))
+ (let* ((xref (car xrefs))
+ (arity (erlang-xref-arity xref)))
+ (when (eq arity wanted-arity)
+ (setq match xref
+ nr-matches (1+ nr-matches)))
+ (setq xrefs (cdr xrefs))))
+ (when (eq nr-matches 1)
+ (list match)))
+ (when (eq (length xrefs) 1)
+ xrefs)))
+
+(defun erlang-sort-by-arity (xrefs wanted-arity)
+ (if (erlang-should-consider-arity-p xrefs wanted-arity)
+ (let (matches non-matches)
+ (while xrefs
+ (let* ((xref (car xrefs))
+ (arity (erlang-xref-arity xref)))
+ (push xref (if (eq arity wanted-arity)
+ matches
+ non-matches))
+ (setq xrefs (cdr xrefs))))
+ (append (reverse matches) (reverse non-matches) xrefs))
+ xrefs))
+
+(defun erlang-should-consider-arity-p (xrefs wanted-arity)
+ (and wanted-arity
+ xrefs
+ (fboundp 'erlang-xref-location-p)
+ (fboundp 'xref-item-location)
+ (erlang-xref-location-p (xref-item-location (car xrefs)))))
+
+(defun erlang-etags-regexp (kind tag is-regexp)
+ (let ((tag-regexp (concat "\\("
+ (if is-regexp
+ tag
+ (regexp-quote tag))
+ "\\)")))
+ (concat (if is-regexp "" "^")
+ (cond ((eq kind 'record)
+ (concat "-record\\s-*(\\s-*" tag-regexp))
+ ((eq kind 'macro)
+ (concat "-define\\s-*(\\s-*" tag-regexp))
+ (t
+ tag-regexp))
+ (if is-regexp "" "\\_>"))))
+
+(defun erlang-xref-arity (xref)
+ (and (fboundp 'erlang-xref-location-arity)
+ (fboundp 'xref-item-location)
+ (erlang-xref-location-arity (xref-item-location xref))))
+
+(defun erlang-split-xrefs-on-module (xrefs module)
+ (let (local-xrefs non-local-xrefs)
+ (dolist (xref xrefs)
+ (if (string-equal (erlang-xref-module xref)
+ module)
+ (push xref local-xrefs)
+ (push xref non-local-xrefs)))
+ (cons (reverse local-xrefs)
+ (reverse non-local-xrefs))))
+
+(defun erlang-split-xrefs (xrefs)
+ (let ((current-file (and (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ local-xrefs bif-xrefs other-xrefs)
+ (dolist (xref xrefs)
+ (cond ((string-equal (erlang-xref-truename-file xref) current-file)
+ (push xref local-xrefs))
+ ((string-equal (erlang-xref-module xref) "erlang")
+ (push xref bif-xrefs))
+ (t
+ (push xref other-xrefs))))
+ (list (reverse local-xrefs)
+ (reverse bif-xrefs)
+ (reverse other-xrefs))))
+
+(defun erlang-xref-module (xref)
+ (erlang-get-module-from-file-name (erlang-xref-file xref)))
+
+(defun erlang-xref-truename-file (xref)
+ (let ((file (erlang-xref-file xref)))
+ (and file
+ (file-truename file))))
+
+(defun erlang-xref-file (xref)
+ (and (fboundp 'xref-location-group)
+ (fboundp 'xref-item-location)
+ (xref-location-group (xref-item-location xref))))
+
+(defun erlang-visit-tags-table-buffer (cont cbuf)
+ (if (< emacs-major-version 26)
+ (visit-tags-table-buffer cont)
+ ;; Remove this with-no-warnings when Emacs 26 is the required
+ ;; version minimum.
+ (with-no-warnings
+ (visit-tags-table-buffer cont cbuf))))
+
+;;;
+;;; Prepare for other methods to run an Erlang slave process.
+;;;
+
+(defvar erlang-shell-function 'inferior-erlang
+ "Command to execute start a new Erlang shell.
+
+Change this variable to use your favorite
+Erlang compilation package.")
+
+(defvar erlang-shell-display-function 'inferior-erlang-run-or-select
+ "Command to execute to display Erlang shell.
+
+Change this variable to use your favorite
+Erlang compilation package.")
+
+(defvar erlang-compile-function 'inferior-erlang-compile
+ "Command to execute to compile current buffer.
+
+Change this variable to use your favorite
+Erlang compilation package.")
+
+(defvar erlang-compile-erlang-function "c"
+ "Erlang function to call to compile an erlang file.")
+
+(defvar erlang-compile-display-function 'inferior-erlang-run-or-select
+ "Command to execute to view last compilation.
+
+Change this variable to use your favorite
+Erlang compilation package.")
+
+(defvar erlang-next-error-function 'inferior-erlang-next-error
+ "Command to execute to go to the next error.
+
+Change this variable to use your favorite Erlang compilation
+package.")
+
+
+;;;###autoload
+(defun erlang-shell ()
+ "Start a new Erlang shell.
+
+The variable `erlang-shell-function' decides which method to use,
+default is to start a new Erlang host. It is possible that, in the
+future, a new shell on an already running host will be started."
+ (interactive)
+ (call-interactively erlang-shell-function))
+
+
+;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t)
+
+;; It is customary for Emacs packages to supply a function on this
+;; form, even though it violates the `erlang-*' name convention.
+(defalias 'run-erlang 'erlang-shell)
+
+
+(defun erlang-shell-display ()
+ "Display an Erlang shell, or start a new."
+ (interactive)
+ (call-interactively erlang-shell-display-function))
+
+
+;;;###autoload
+(defun erlang-compile ()
+ "Compile Erlang module in current buffer."
+ (interactive)
+ (call-interactively erlang-compile-function))
+
+
+(defun erlang-compile-display ()
+ "Display compilation output."
+ (interactive)
+ (call-interactively erlang-compile-display-function))
+
+
+(defun erlang-next-error ()
+ "Display next error message from the latest compilation."
+ (interactive)
+ (call-interactively erlang-next-error-function))
+
+
+
+;;;
+;;; Erlang Shell Mode -- Major mode used for Erlang shells.
+;;;
+
+;; This mode is designed to be implementation independent,
+;; e.g. it does not assume that we are running an inferior
+;; Erlang, there exists a lot of other possibilities.
+
+(defvar erlang-shell-buffer-name "*erlang*"
+ "The name of the Erlang link shell buffer.")
+
+(defcustom erlang-shell-prompt-read-only t
+ "If non-nil, the prompt will be read-only.
+
+Also see the description of `ielm-prompt-read-only'."
+ :type 'boolean
+ :package-version '(erlang . "2.8.0"))
+
+(defvar erlang-shell-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\M-\t" 'erlang-complete-tag)
+
+ ;; Normally the other way around.
+ (define-key map "\C-a" 'comint-bol)
+ (define-key map "\C-c\C-a" 'beginning-of-line)
+
+ (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof'
+ (define-key map "\M-\C-m" 'compile-goto-error)
+ map)
+ "Keymap used by Erlang shells.")
+
+(defvar erlang-input-ring-file-name "~/.erlang_history"
+ "When non-nil, file name used to store Erlang shell history information.")
+
+(define-derived-mode erlang-shell-mode comint-mode "Erlang Shell"
+ "Major mode for interacting with an Erlang shell.
+
+The following special commands are available:
+\\{erlang-shell-mode-map}"
+ (erlang-mode-variables)
+ ;; Needed when compiling directly from the Erlang shell.
+ (setq compilation-last-buffer (current-buffer))
+ (setq comint-prompt-regexp "^[^>=]*> *")
+ (make-local-variable 'comint-prompt-read-only)
+ (setq comint-prompt-read-only erlang-shell-prompt-read-only)
+ (setq comint-eol-on-send t)
+ (setq comint-input-ignoredups t)
+ (setq comint-scroll-show-maximum-output t)
+ (setq comint-scroll-to-bottom-on-output t)
+ (add-hook 'comint-output-filter-functions
+ 'inferior-erlang-strip-delete nil t)
+ (add-hook 'comint-output-filter-functions
+ 'inferior-erlang-strip-ctrl-m nil t)
+ (setq comint-input-ring-file-name erlang-input-ring-file-name)
+ (comint-read-input-ring t)
+ (make-local-variable 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'comint-write-input-ring)
+ (compilation-minor-mode 1)
+ (set (make-local-variable 'minor-mode-overriding-map-alist)
+ `((compilation-minor-mode
+ . ,(let ((map (make-sparse-keymap)))
+ ;; It would be useful to put keymap properties on the
+ ;; error lines so that we could use RET and mouse-2
+ ;; on them directly.
+ (when (boundp 'compilation-skip-threshold) ; new compile.el
+ (define-key map [mouse-2] #'erlang-mouse-2-command)
+ (define-key map "\C-m" #'erlang-RET-command))
+ (if (boundp 'compilation-menu-map)
+ (define-key map [menu-bar compilation]
+ (cons "Errors" compilation-menu-map)))
+ map))))
+ (erlang-tags-init))
+
+
+(defun erlang-mouse-2-command (event)
+ "Command bound to `mouse-2' in inferior Erlang buffer.
+Selects Comint or Compilation mode command as appropriate."
+ (interactive "e")
+ (if (save-window-excursion
+ (save-excursion
+ (mouse-set-point event)
+ (consp (get-text-property (line-beginning-position) 'message))))
+ (call-interactively (lookup-key compilation-mode-map [mouse-2]))
+ (call-interactively (lookup-key comint-mode-map [mouse-2]))))
+
+(defun erlang-RET-command ()
+ "Command bound to `RET' in inferior Erlang buffer.
+Selects Comint or Compilation mode command as appropriate."
+ (interactive)
+ (if (consp (get-text-property (line-beginning-position) 'message))
+ (call-interactively (lookup-key compilation-mode-map "\C-m"))
+ (call-interactively (lookup-key comint-mode-map "\C-m"))))
+
+;;;
+;;; Inferior Erlang -- Run an Erlang shell as a subprocess.
+;;;
+
+(defvar inferior-erlang-display-buffer-any-frame nil
+ "When nil, `inferior-erlang-display-buffer' use only selected frame.
+When t, all frames are searched. When 'raise, the frame is raised.")
+
+(defvar inferior-erlang-shell-type 'newshell
+ "The type of Erlang shell to use.
+
+When this variable is set to the atom `oldshell', the old shell is used.
+When set to `newshell' the new shell is used. Should the variable be
+nil, the default shell is used.
+
+This variable influence the setting of other variables.")
+
+(defvar inferior-erlang-machine "erl"
+ "The name of the Erlang shell.")
+
+(defvar inferior-erlang-machine-options '()
+ "The options used when activating the Erlang shell.
+
+This must be a list of strings.")
+
+(defvar inferior-erlang-process-name "inferior-erlang"
+ "The name of the inferior Erlang process.")
+
+(defvar inferior-erlang-buffer-name erlang-shell-buffer-name
+ "The name of the inferior Erlang buffer.")
+
+(defvar inferior-erlang-prompt-timeout 60
+ "Number of seconds before `inferior-erlang-wait-prompt' timeouts.
+
+The time specified is waited after every output made by the inferior
+Erlang shell. When this variable is t, we assume that we always have
+a prompt. When nil, we will wait forever, or until \\[keyboard-quit].")
+
+(defvar inferior-erlang-process nil
+ "Process of last invoked inferior Erlang, or nil.")
+
+(defvar inferior-erlang-buffer nil
+ "Buffer of last invoked inferior Erlang, or nil.")
+
+;; Enable uniquifying Erlang shell buffers based on directory name.
+(eval-after-load "uniquify"
+ '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode))
+
+;;;###autoload
+(defun inferior-erlang (&optional command)
+ "Run an inferior Erlang.
+With prefix command, prompt for command to start Erlang with.
+
+This is just like running Erlang in a normal shell, except that
+an Emacs buffer is used for input and output.
+\\<comint-mode-map>
+The command line history can be accessed with \\[comint-previous-input] and \\[comint-next-input].
+The history is saved between sessions.
+
+Entry to this mode calls the functions in the variables
+`comint-mode-hook' and `erlang-shell-mode-hook' with no arguments.
+
+The following commands imitate the usual Unix interrupt and
+editing control characters:
+\\{erlang-shell-mode-map}"
+ (interactive
+ (when current-prefix-arg
+ (list (read-shell-command "Erlang command: "))))
+ (require 'comint)
+ (let (cmd opts)
+ (if command
+ (setq cmd "sh"
+ opts (list "-c" command))
+ (setq cmd inferior-erlang-machine
+ opts inferior-erlang-machine-options)
+ (cond ((eq inferior-erlang-shell-type 'oldshell)
+ (setq opts (cons "-oldshell" opts)))
+ ((eq inferior-erlang-shell-type 'newshell)
+ (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))))
+
+ ;; Using create-file-buffer and list-buffers-directory in this way
+ ;; makes uniquify give each buffer a unique name based on the
+ ;; directory.
+ (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory)))
+ (setq inferior-erlang-buffer (create-file-buffer fake-file-name))
+ (apply 'make-comint-in-buffer
+ inferior-erlang-process-name
+ inferior-erlang-buffer
+ cmd
+ nil opts)
+ (with-current-buffer inferior-erlang-buffer
+ (setq list-buffers-directory fake-file-name))))
+
+ (setq inferior-erlang-process
+ (get-buffer-process inferior-erlang-buffer))
+ (funcall (symbol-function 'set-process-query-on-exit-flag)
+ inferior-erlang-process nil)
+ (if erlang-inferior-shell-split-window
+ (switch-to-buffer-other-window inferior-erlang-buffer)
+ (switch-to-buffer inferior-erlang-buffer))
+ (if (and (not (eq system-type 'windows-nt))
+ (eq inferior-erlang-shell-type 'newshell))
+ (setq comint-process-echoes t))
+ (erlang-shell-mode))
+
+
+(defun inferior-erlang-run-or-select ()
+ "Switch to an inferior Erlang buffer, possibly starting new process."
+ (interactive)
+ (if (null (inferior-erlang-running-p))
+ (inferior-erlang)
+ (inferior-erlang-display-buffer t)))
+
+
+(defun inferior-erlang-display-buffer (&optional select)
+ "Make the inferior Erlang process visible.
+The window is returned.
+
+Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is
+displayed in the current frame. Should it be non-nil, and the buffer
+already is visible in any other frame, no new window will be created.
+Should it be the atom 'raise, the frame containing the window will
+be raised.
+
+Should the optional argument SELECT be non-nil, the window is
+selected. Should the window be in another frame, that frame is raised.
+
+Note, should the mouse pointer be places outside the raised frame, that
+frame will become deselected before the next command."
+ (interactive)
+ (or (inferior-erlang-running-p)
+ (error "No inferior Erlang process is running"))
+ (let ((win (inferior-erlang-window
+ inferior-erlang-display-buffer-any-frame))
+ (frames-p (fboundp 'selected-frame)))
+ (if (null win)
+ (let ((old-win (selected-window)))
+ (save-excursion
+ (switch-to-buffer-other-window inferior-erlang-buffer)
+ (setq win (selected-window)))
+ (select-window old-win))
+ (if (and window-system
+ frames-p
+ (or select
+ (eq inferior-erlang-display-buffer-any-frame 'raise))
+ (not (eq (selected-frame) (window-frame win))))
+ (raise-frame (window-frame win))))
+ (if select
+ (select-window win))
+ (sit-for 0)
+ win))
+
+
+(defun inferior-erlang-running-p ()
+ "Non-nil when an inferior Erlang is running."
+ (and inferior-erlang-process
+ (memq (process-status inferior-erlang-process) '(run open))
+ inferior-erlang-buffer
+ (buffer-name inferior-erlang-buffer)))
+
+
+(defun inferior-erlang-window (&optional all-frames)
+ "Return the window containing the inferior Erlang, or nil."
+ (and (inferior-erlang-running-p)
+ (if all-frames
+ (get-buffer-window inferior-erlang-buffer t)
+ (get-buffer-window inferior-erlang-buffer))))
+
+
+(defun inferior-erlang-wait-prompt ()
+ "Wait until the inferior Erlang shell prompt appears."
+ (if (eq inferior-erlang-prompt-timeout t)
+ ()
+ (or (inferior-erlang-running-p)
+ (error "No inferior Erlang shell is running"))
+ (with-current-buffer inferior-erlang-buffer
+ (let ((msg nil))
+ (while (save-excursion
+ (goto-char (process-mark inferior-erlang-process))
+ (forward-line 0)
+ (not (looking-at comint-prompt-regexp)))
+ (if msg
+ ()
+ (setq msg t)
+ (message "Waiting for Erlang shell prompt (press C-g to abort)."))
+ (or (accept-process-output inferior-erlang-process
+ inferior-erlang-prompt-timeout)
+ (error "No Erlang shell prompt before timeout")))
+ (if msg (message ""))))))
+
+(defun inferior-erlang-send-empty-cmd-unless-already-at-prompt ()
+ "If not already at a prompt, try to send an empty cmd to get a prompt.
+The empty command resembles hitting RET. This is useful in some
+situations, for instance if a crash or error report from sasl
+has been printed after the last prompt."
+ (with-current-buffer inferior-erlang-buffer
+ (if (> (point-max) 1)
+ ;; make sure we get a prompt if buffer contains data
+ (if (save-excursion
+ (goto-char (process-mark inferior-erlang-process))
+ (forward-line 0)
+ (not (looking-at comint-prompt-regexp)))
+ (inferior-erlang-send-command "")))))
+
+(autoload 'comint-send-input "comint")
+
+(defun inferior-erlang-send-command (cmd &optional hist)
+ "Send command CMD to the inferior Erlang.
+
+The contents of the current command line (if any) will
+be placed at the next prompt.
+
+If optional second argument is non-nil the command is inserted into
+the history list.
+
+Return the position after the newly inserted command."
+ (or (inferior-erlang-running-p)
+ (error "No inferior Erlang process is running"))
+ (let ((old-buffer (current-buffer))
+ (insert-point (marker-position (process-mark inferior-erlang-process)))
+ (insert-length (if comint-process-echoes
+ 0
+ (1+ (length cmd)))))
+ (set-buffer inferior-erlang-buffer)
+ (goto-char insert-point)
+ (insert cmd)
+ ;; Strange things happened if `comint-eol-on-send' is declared
+ ;; in the `let' expression above, but setq:d here. The
+ ;; `set-buffer' statement obviously makes the buffer local
+ ;; instance of `comint-eol-on-send' shadow this one.
+ ;; I'm considering this a bug in Elisp.
+ ;;
+ ;; This was previously cautioned against in the Lisp manual. It
+ ;; has been sorted out in Emacs 21. -- fx
+ (let ((comint-eol-on-send nil)
+ (comint-input-filter (if hist comint-input-filter 'ignore)))
+ (comint-send-input nil t))
+ ;; Adjust all windows whose points are incorrect.
+ (if (null comint-process-echoes)
+ (walk-windows
+ (function
+ (lambda (window)
+ (if (and (eq (window-buffer window) inferior-erlang-buffer)
+ (= (window-point window) insert-point))
+ (set-window-point window
+ (+ insert-point insert-length)))))
+ nil t))
+ (set-buffer old-buffer)
+ (+ insert-point insert-length)))
+
+
+(defun inferior-erlang-strip-delete (&optional _s)
+ "Remove `^H' (delete) and the characters it was supposed to remove."
+ (interactive)
+ (if (and (boundp 'comint-last-input-end)
+ (boundp 'comint-last-output-start))
+ (save-excursion
+ (goto-char
+ (if (called-interactively-p 'interactive)
+ (symbol-value 'comint-last-input-end)
+ (symbol-value 'comint-last-output-start)))
+ (while (progn (skip-chars-forward "^\C-h")
+ (not (eq (point) (point-max))))
+ (delete-char 1)
+ (or (bolp)
+ (backward-delete-char 1))))))
+
+
+;; Basically `comint-strip-ctrl-m', with a few extra checks.
+(defun inferior-erlang-strip-ctrl-m (&optional _string)
+ "Strip trailing `^M' characters from the current output group."
+ (interactive)
+ (if (and (boundp 'comint-last-input-end)
+ (boundp 'comint-last-output-start))
+ (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
+ (save-excursion
+ (goto-char
+ (if (called-interactively-p 'interactive)
+ (symbol-value 'comint-last-input-end)
+ (symbol-value 'comint-last-output-start)))
+ (while (re-search-forward "\r+$" pmark t)
+ (replace-match "" t t))))))
+
+
+(defun inferior-erlang-compile (arg)
+ "Compile the file in the current buffer.
+
+With prefix arg, compiles for debug.
+
+Should Erlang return `{error, nofile}' it could not load the object
+module after completing the compilation. This is due to a bug in the
+compile command `c' when using the option `outdir'.
+
+There exists two workarounds for this bug:
+
+ 1) Place the directory in the Erlang load path.
+
+ 2) Set the Emacs variable `erlang-compile-use-outdir' to nil.
+ To do so, place the following line in your `~/.emacs'-file:
+ (setq erlang-compile-use-outdir nil)"
+ (interactive "P")
+ (save-some-buffers)
+ (inferior-erlang-prepare-for-input)
+ (let* ((dir (inferior-erlang-compile-outdir))
+ (noext (substring (erlang-local-buffer-file-name) 0 -4))
+ (opts (append (list (cons 'outdir dir))
+ (when arg
+ (list 'debug_info 'export_all))
+ erlang-compile-extra-opts))
+ end)
+ (with-current-buffer inferior-erlang-buffer
+ (when (fboundp 'compilation-forget-errors)
+ (compilation-forget-errors)))
+ (setq end (inferior-erlang-send-command
+ (inferior-erlang-compute-compile-command noext opts)
+ nil))
+ (sit-for 0)
+ (inferior-erlang-wait-prompt)
+ (with-current-buffer inferior-erlang-buffer
+ (setq compilation-error-list nil)
+ (set-marker compilation-parsing-end end))
+ (setq compilation-last-buffer inferior-erlang-buffer)))
+
+(defun inferior-erlang-prepare-for-input (&optional no-display)
+ "Create an inferior erlang buffer if needed and ready it for input.
+The buffer is displayed, according to `inferior-erlang-display-buffer'
+unless the optional NO-DISPLAY is non-nil."
+ (or (inferior-erlang-running-p)
+ (save-excursion
+ (inferior-erlang)))
+ (or (inferior-erlang-running-p)
+ (error "Error starting inferior Erlang shell"))
+ (if (not no-display)
+ (inferior-erlang-display-buffer))
+ (inferior-erlang-send-empty-cmd-unless-already-at-prompt)
+ (sit-for 0)
+ (inferior-erlang-wait-prompt))
+
+(defun inferior-erlang-compile-outdir ()
+ "Return the directory to compile the current buffer into."
+ (let* ((buffer-dir (directory-file-name
+ (file-name-directory (erlang-local-buffer-file-name))))
+ (parent-dir (directory-file-name
+ (file-name-directory buffer-dir)))
+ (ebin-dir (concat (file-name-as-directory parent-dir) "ebin"))
+ (buffer-dir-base-name (file-name-nondirectory
+ (expand-file-name
+ (concat (file-name-as-directory buffer-dir)
+ ".")))))
+ (if (and (string= buffer-dir-base-name "src")
+ (file-directory-p ebin-dir))
+ (file-name-as-directory ebin-dir)
+ (file-name-as-directory buffer-dir))))
+
+(defun inferior-erlang-compute-compile-command (module-name opts)
+ (let ((ccfn erlang-compile-command-function-alist)
+ ccfn-entry
+ done
+ result)
+ (if (not (null (erlang-local-buffer-file-name)))
+ (while (and (not done) (not (null ccfn)))
+ (setq ccfn-entry (car ccfn))
+ (setq ccfn (cdr ccfn))
+ (if (string-match (car ccfn-entry) (erlang-local-buffer-file-name))
+ (let ((c-fn (cdr ccfn-entry)))
+ (setq done t)
+ (if (not (null c-fn))
+ (setq result (funcall c-fn module-name opts)))))))
+ result))
+
+(defun inferior-erlang-compute-erl-compile-command (module-name opts)
+ (let* ((out-dir-opt (assoc 'outdir opts))
+ (out-dir (cdr out-dir-opt)))
+ (if erlang-compile-use-outdir
+ (format "%s(\"%s\"%s)."
+ erlang-compile-erlang-function
+ module-name
+ (inferior-erlang-format-comma-opts opts))
+ (let (;; Hopefully, no one else will ever use these...
+ (tmpvar "Tmp7236")
+ (tmpvar2 "Tmp8742"))
+ (format
+ (concat
+ "f(%s), {ok, %s} = file:get_cwd(), "
+ "file:set_cwd(\"%s\"), "
+ "%s = %s(\"%s\"%s), file:set_cwd(%s), f(%s), %s.")
+ tmpvar2 tmpvar
+ out-dir
+ tmpvar2
+ erlang-compile-erlang-function
+ module-name (inferior-erlang-format-comma-opts
+ (remq out-dir-opt opts))
+ tmpvar tmpvar tmpvar2)))))
+
+(defun inferior-erlang-compute-leex-compile-command (module-name opts)
+ (let ((file-name (erlang-local-buffer-file-name))
+ (erl-compile-expr (inferior-erlang-remove-any-trailing-dot
+ (inferior-erlang-compute-erl-compile-command
+ module-name opts))))
+ (format (concat "f(LErr1__), f(LErr2__), "
+ "case case leex:file(\"%s\", [%s]) of"
+ " ok -> ok;"
+ " {ok,_} -> ok;"
+ " {ok,_,_} -> ok;"
+ " LErr1__ -> LErr1__ "
+ "end of"
+ " ok -> %s;"
+ " LErr2__ -> LErr2__ "
+ "end.")
+ file-name
+ (inferior-erlang-format-comma-opts erlang-leex-compile-opts)
+ erl-compile-expr)))
+
+(defun inferior-erlang-compute-yecc-compile-command (module-name opts)
+ (let ((file-name (erlang-local-buffer-file-name))
+ (erl-compile-expr (inferior-erlang-remove-any-trailing-dot
+ (inferior-erlang-compute-erl-compile-command
+ module-name opts))))
+ (format (concat "f(YErr1__), f(YErr2__), "
+ "case case yecc:file(\"%s\", [%s]) of"
+ " {ok,_} -> ok;"
+ " {ok,_,_} -> ok;"
+ " YErr1__ -> YErr1__ "
+ "end of"
+ " ok -> %s;"
+ " YErr2__ -> YErr2__ "
+ "end.")
+ file-name
+ (inferior-erlang-format-comma-opts erlang-yecc-compile-opts)
+ erl-compile-expr)))
+
+(defun inferior-erlang-remove-any-trailing-dot (str)
+ (if (string= (substring str -1) ".")
+ (substring str 0 (1- (length str)))
+ str))
+
+(defun inferior-erlang-format-comma-opts (opts)
+ (if (null opts)
+ ""
+ (concat ", " (inferior-erlang-format-opt opts))))
+
+(defun inferior-erlang-format-opt (opt)
+ (cond ((stringp opt) (concat "\"" opt "\""))
+ ((vectorp opt) (inferior-erlang-tuple (append opt nil)))
+ ((atom opt) (format "%s" opt))
+ ((consp opt) (if (listp (cdr opt))
+ (inferior-erlang-list opt)
+ (inferior-erlang-tuple (list (car opt) (cdr opt)))))
+ (t (error "Unexpected erlang compile option %s" opt))))
+
+(defun inferior-erlang-tuple (opts)
+ (concat "{" (mapconcat 'inferior-erlang-format-opt
+ opts
+ ", ")
+ "}"))
+
+(defun inferior-erlang-list (opts)
+ (concat "[" (mapconcat 'inferior-erlang-format-opt
+ opts
+ ", ")
+ "]"))
+
+
+(defun erlang-local-buffer-file-name ()
+ ;; When editing a file remotely via tramp,
+ ;; the buffer's file name may be for example
+ ;; "/ssh:host.example.com:/some/path/x.erl"
+ ;;
+ ;; If I try to compile such a file using C-c C-k, an
+ ;; erlang shell on the remote host is automatically
+ ;; started if needed, but for it to successfully compile
+ ;; the file, the c(...) command that is sent must contain
+ ;; the file name "/some/path/x.erl" without the
+ ;; tramp-prefix "/ssh:host.example.com:".
+ (cond ((null (buffer-file-name))
+ nil)
+ ((erlang-tramp-remote-file-p)
+ (erlang-tramp-get-localname))
+ (t
+ (buffer-file-name))))
+
+(defun erlang-tramp-remote-file-p ()
+ (and (fboundp 'tramp-tramp-file-p)
+ (tramp-tramp-file-p (buffer-file-name))))
+
+(defun erlang-tramp-get-localname ()
+ (when (fboundp 'tramp-dissect-file-name)
+ (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
+ (if (fboundp 'tramp-file-name-localname)
+ (tramp-file-name-localname tramp-info)
+ ;; In old versions of tramp, it was `tramp-file-name-path'
+ ;; instead of the newer `tramp-file-name-localname'
+ (when (fboundp 'tramp-file-name-path)
+ (tramp-file-name-path tramp-info))))))
+
+;; `next-error' only accepts buffers with major mode `compilation-mode'
+;; or with the minor mode `compilation-minor-mode' activated.
+;; (To activate the minor mode is out of the question, since it will
+;; ruin the inferior Erlang keymap.)
+;; This is done differently in Emacs 21.
+(defun inferior-erlang-next-error (&optional argp)
+ "Just like `next-error'.
+Capable of finding error messages in an inferior Erlang buffer."
+ (interactive "P")
+ (let ((done nil)
+ (buf (or (and (boundp 'next-error-last-buffer)
+ next-error-last-buffer)
+ (and (boundp 'compilation-last-buffer)
+ compilation-last-buffer))))
+ (if (and (bufferp buf)
+ (with-current-buffer buf
+ (and (eq major-mode 'erlang-shell-mode)
+ (setq major-mode 'compilation-mode))))
+ (unwind-protect
+ (progn
+ (setq done t)
+ (next-error argp))
+ (with-current-buffer buf
+ (setq major-mode 'erlang-shell-mode))))
+ (or done
+ (next-error argp))))
+
+
+(defun inferior-erlang-change-directory (&optional dir)
+ "Make the inferior Erlang change directory.
+The default is to go to the directory of the current buffer."
+ (interactive)
+ (or dir (setq dir (file-name-directory (erlang-local-buffer-file-name))))
+ (or (inferior-erlang-running-p)
+ (error "No inferior Erlang is running"))
+ (inferior-erlang-display-buffer)
+ (inferior-erlang-send-empty-cmd-unless-already-at-prompt)
+ (inferior-erlang-wait-prompt)
+ (inferior-erlang-send-command (format "cd('%s')." dir) nil))
+
+(defun erlang-align-arrows (start end)
+ "Align arrows (\"->\") in function clauses from START to END.
+When called interactively, aligns arrows after function clauses inside
+the region.
+
+With a prefix argument, aligns all arrows, not just those in function
+clauses.
+
+Example:
+
+sum(L) -> sum(L, 0).
+sum([H|T], Sum) -> sum(T, Sum + H);
+sum([], Sum) -> Sum.
+
+becomes:
+
+sum(L) -> sum(L, 0).
+sum([H|T], Sum) -> sum(T, Sum + H);
+sum([], Sum) -> Sum."
+ (interactive "r")
+ (save-excursion
+ (let (;; regexp for matching arrows. without a prefix argument,
+ ;; the regexp matches function heads. With a prefix, it
+ ;; matches any arrow.
+ (re (if current-prefix-arg
+ "^.*\\(\\)->"
+ (eval-when-compile
+ (concat "^" erlang-atom-regexp ".*\\(\\)->"))))
+ ;; part of regexp matching directly before the arrow
+ (arrow-match-pos (if current-prefix-arg
+ 1
+ (1+ erlang-atom-regexp-matches)))
+ ;; accumulator for positions where arrows are found, ordered
+ ;; by buffer position (from greatest to smallest)
+ (arrow-positions '())
+ ;; accumulator for longest distance from start of line to arrow
+ (most-indent 0)
+ ;; marker to track the end of the region we're aligning
+ (end-marker (progn (goto-char end)
+ (point-marker))))
+ ;; Pass 1: Find the arrow positions, adjust the whitespace
+ ;; before each arrow to one space, and find the greatest
+ ;; indentation level.
+ (goto-char start)
+ (while (re-search-forward re end-marker t)
+ (goto-char (match-beginning arrow-match-pos))
+ (just-one-space) ; adjust whitespace
+ (setq arrow-positions (cons (point) arrow-positions))
+ (setq most-indent (max most-indent (erlang-column-number))))
+ (set-marker end-marker nil) ; free the marker
+ ;; Pass 2: Insert extra padding so that all arrow indentation is
+ ;; equal. This is done last-to-first by buffer position, so that
+ ;; inserting spaces before one arrow doesn't change the
+ ;; positions of the next ones.
+ (mapc (lambda (arrow-pos)
+ (goto-char arrow-pos)
+ (let* ((pad (- most-indent (erlang-column-number))))
+ (when (> pad 0)
+ (insert-char ?\ pad))))
+ arrow-positions))))
+
+(defun erlang-column-number ()
+ "Return the column number of the current position in the buffer.
+Tab characters are counted by their visual width."
+ (string-width (buffer-substring (line-beginning-position) (point))))
+
+(defun erlang-current-defun ()
+ "`add-log-current-defun-function' for Erlang."
+ (save-excursion
+ (erlang-beginning-of-function)
+ (if (looking-at "[a-z0-9_]+")
+ (match-string 0))))
+
+(defconst erlang-unload-hook
+ (list (lambda ()
+ (ad-unadvise 'Man-notify-when-ready)
+ (ad-unadvise 'set-visited-file-name))))
+
+;; The end...
+
+(provide 'erlang)
+
+(run-hooks 'erlang-load-hook)
+
+;; Local variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;;; erlang.el ends here
--- /dev/null
+;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*-
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2016-2021. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+
+;;; Commentary:
+
+;; Crawl Erlang/OTP HTML documentation and generate lookup tables.
+;;
+;; This package depends on `cl-lib', `pcase' and
+;; `libxml-parse-html-region'. Emacs 24+ compiled with libxml2 should
+;; work. On Emacs 24.1 and 24.2 do `M-x package-install RET cl-lib
+;; RET' to install `cl-lib'.
+;;
+;; Please customise `erldoc-man-index' to point to your local OTP
+;; documentation.
+;;
+;; To use:
+;;
+;; (define-key help-map "u" 'erldoc-browse)
+;; (define-key help-map "t" 'erldoc-browse-topic)
+;; (define-key help-map "a" 'erldoc-apropos)
+;;
+;; Note: these commands trigger indexing OTP documentation on first
+;; run with cache to disk which may take 1-2 minutes.
+
+
+;;; Examples:
+
+;; 1. `M-x erldoc-browse RET erlang:integer_to_binary/2 RET' opens the
+;; `erlang' manual anchored on the entry for `integer_to_binary/2'.
+;;
+;; 2. `M-x erldoc-apropos RET first RET' list all MFAs matching
+;; substring `first'.
+;;
+;; 3. `M-x erldoc-browse-topic RET efficiency_guide#Introduction RET'
+;; opens chapter `Introduction' of the `Efficiency Guide' in the
+;; browser.
+
+;;; History:
+
+;; Written in December 2013 as a temporary solution to help me browse
+;; the rich Erlang/OTP documentation. Three years on I find myself
+;; still using it every day. - Leo (2016)
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'json)
+(require 'erlang)
+(eval-when-compile (require 'url-parse))
+
+(eval-and-compile ;for emacs < 24.3
+ (or (fboundp 'user-error) (defalias 'user-error 'error)))
+
+(defgroup erldoc nil
+ "Browse Erlang document."
+ :group 'help)
+
+(defcustom erldoc-man-index "http://www.erlang.org/doc/man_index.html"
+ "The URL to the man_index.html page.
+Note it is advisable to customise this to a local URL for example
+`file:///usr/local/19.1/lib/erlang/doc/man_index.html' to speed
+up the indexing."
+ :type 'string
+ :group 'erldoc)
+
+(defcustom erldoc-verify-man-path nil
+ "If non-nil verify man path existence for `file://'."
+ :type 'boolean
+ :group 'erldoc)
+
+(defcustom erldoc-output-file (locate-user-emacs-file "cache/erldoc")
+ "File to store the parsed results."
+ :type 'file
+ :group 'erldoc)
+
+(defcustom erldoc-no-signature-function #'ignore
+ "Notification function called if no function signature was found."
+ :type '(choice (function-item :tag "Ignore" ignore)
+ (function-item :tag "Warn" warn)
+ (function-item :tag "Error" error))
+ :group 'erldoc)
+
+(defun erldoc-strip-string (s)
+ (let* ((re "[ \t\n\r\f\v\u00a0]+")
+ (from (if (string-match (concat "\\`" re) s) (match-end 0) 0))
+ (to (and (string-match (concat re "\\'") s) (match-beginning 0))))
+ (substring s from (and to (max to from)))))
+
+;; Note: don't know how to get the BASE-URL to
+;; `libxml-parse-html-region' to work.
+(defun erldoc-expand-url (url base-url)
+ (if (url-type (url-generic-parse-url url))
+ url
+ (let* ((base (url-generic-parse-url base-url))
+ (dir (directory-file-name (file-name-directory (url-filename base)))))
+ (setf (url-filename base) (expand-file-name url dir))
+ (url-recreate-url base))))
+
+(defun erldoc-parse-html (url)
+ (with-temp-buffer
+ (url-insert-file-contents url)
+ (libxml-parse-html-region (point-min) (point-max))))
+
+(defalias 'erldoc-dom-text-node-p #'stringp)
+
+(defun erldoc-dom-attributes (dom)
+ (and (not (erldoc-dom-text-node-p dom)) (cadr dom)))
+
+(defun erldoc-dom-get-attribute (dom attrib-name)
+ (cdr (assq attrib-name (erldoc-dom-attributes dom))))
+
+(defun erldoc-dom-children (dom)
+ (and (not (erldoc-dom-text-node-p dom)) (cddr dom)))
+
+(defun erldoc-dom-get-text (dom)
+ (let ((text (car (last (erldoc-dom-children dom)))))
+ (and (erldoc-dom-text-node-p text) text)))
+
+(defvar erldoc-dom-walk-parent nil)
+(defvar erldoc-dom-walk-siblings nil)
+
+(defun erldoc-dom-walk (dom k)
+ (funcall k dom)
+ (let ((erldoc-dom-walk-parent dom)
+ (erldoc-dom-walk-siblings (unless (erldoc-dom-text-node-p dom)
+ (cddr dom))))
+ (dolist (child erldoc-dom-walk-siblings)
+ (erldoc-dom-walk child k))))
+
+(defun erldoc-dom-get-element (dom element-name)
+ (catch 'return
+ (erldoc-dom-walk dom (lambda (d)
+ (when (eq (car-safe d) element-name)
+ (throw 'return d))))))
+
+(defun erldoc-dom-get-element-by-id (dom id)
+ (catch 'return
+ (erldoc-dom-walk dom (lambda (d)
+ (when (equal (erldoc-dom-get-attribute d 'id) id)
+ (throw 'return d))))))
+
+(defun erldoc-dom-get-elements-by-id (dom id)
+ (let (result)
+ (erldoc-dom-walk dom (lambda (d)
+ (when (equal (erldoc-dom-get-attribute d 'id) id)
+ (push d result))))
+ (nreverse result)))
+
+(defun erldoc-fix-path (url)
+ (if (and erldoc-verify-man-path
+ ;; Could only verify local files
+ (equal (url-type (url-generic-parse-url url)) "file"))
+ (let* ((obj (url-generic-parse-url url))
+ (new (car (file-expand-wildcards
+ (replace-regexp-in-string
+ "-[0-9]+\\(?:[.][0-9]+\\)*" "*"
+ (url-filename obj))))))
+ (or new (error "File %s does not exist" (url-filename obj)))
+ (setf (url-filename obj) new)
+ (url-recreate-url obj))
+ url))
+
+(defun erldoc-parse-man-index (url)
+ (let ((table (erldoc-dom-get-element (erldoc-parse-html url) 'table))
+ (mans))
+ (erldoc-dom-walk
+ table
+ (lambda (d)
+ (when (eq (car-safe d) 'a)
+ (let ((href (erldoc-dom-get-attribute d 'href)))
+ (when (and href (not (string-match-p "index\\.html\\'" href)))
+ (with-demoted-errors "erldoc-parse-man-index: %S"
+ (push (cons (erldoc-dom-get-text d)
+ (erldoc-fix-path (erldoc-expand-url href url)))
+ mans)))))))
+ (nreverse mans)))
+
+(defun erldoc-parse-man (man)
+ (let ((dom (erldoc-parse-html (cdr man)))
+ (table (make-hash-table :test #'equal)))
+ (erldoc-dom-walk
+ (erldoc-dom-get-element-by-id dom "loadscrollpos")
+ (lambda (d)
+ (let ((href (erldoc-dom-get-attribute d 'href)))
+ (when (and href (string-match "#" href))
+ (puthash (substring href (match-end 0))
+ (list (concat (car man) ":" (erldoc-strip-string
+ (erldoc-dom-get-text d)))
+ (erldoc-expand-url href (cdr man)))
+ table)))))
+ (let ((span-content
+ (lambda (span)
+ (let ((texts))
+ (erldoc-dom-walk span
+ (lambda (d)
+ (and (erldoc-dom-text-node-p d)
+ (push (erldoc-strip-string d) texts))))
+ (and texts (mapconcat 'identity (nreverse texts) " ")))))
+ entries)
+ (erldoc-dom-walk
+ dom
+ (lambda (d)
+ ;; Get the full function signature.
+ (when (and (eq (car-safe d) 'a)
+ (gethash (erldoc-dom-get-attribute d 'name) table))
+ (let* ((name (erldoc-dom-get-attribute d 'name))
+ (mfa-url (gethash name table))
+ (mfa (car mfa-url))
+ (sig (or (funcall span-content d)
+ (funcall span-content
+ (or (erldoc-dom-get-element d 'span)
+ (cadr
+ (memq d erldoc-dom-walk-siblings))))
+ (progn
+ (funcall erldoc-no-signature-function
+ "erldoc-parse-man: no sig for %s"
+ mfa)
+ nil))))
+ (push (append mfa-url (list sig))
+ entries)))
+ ;; Get data types
+ (when (and (eq (car-safe d) 'a)
+ (string-prefix-p "type-"
+ (or (erldoc-dom-get-attribute d 'name) "")))
+ (push (list (concat (car man) ":" (funcall span-content d))
+ (concat (cdr man) "#" (erldoc-dom-get-attribute d 'name))
+ (funcall span-content erldoc-dom-walk-parent))
+ entries))))
+ entries)))
+
+(defun erldoc-parse-all (man-index output &optional json)
+ (let* ((output (expand-file-name output))
+ (table (make-hash-table :size 11503 :test #'equal))
+ (mans (erldoc-parse-man-index man-index))
+ (progress 1)
+ (reporter (make-progress-reporter "Parsing Erlang/OTP documentation"
+ progress (length mans)))
+ fails all)
+ (dolist (man mans)
+ (condition-case err
+ (push (erldoc-parse-man man) all)
+ (error (push (error-message-string err) fails)))
+ (accept-process-output nil 0.01)
+ (progress-reporter-update reporter (cl-incf progress)))
+ (when fails
+ (display-warning 'erldoc-parse-all
+ (format "\n\n%s" (mapconcat #'identity fails "\n"))
+ :error))
+ (progress-reporter-done reporter)
+ (mapc (lambda (x) (puthash (car x) (cdr x) table))
+ (apply #'nconc (nreverse all)))
+ (with-temp-buffer
+ (if (not json)
+ (pp table (current-buffer))
+ (let ((json-encoding-pretty-print t))
+ (insert (json-encode table))))
+ (unless (file-directory-p (file-name-directory output))
+ (make-directory (file-name-directory output) t))
+ (write-region nil nil output nil nil nil 'ask))))
+
+(defun erldoc-otp-release ()
+ "Get the otp release version (as string) or nil if not found."
+ (let ((otp (erldoc-dom-get-text
+ (erldoc-dom-get-element
+ (erldoc-parse-html
+ (erldoc-expand-url "index.html" erldoc-man-index))
+ 'title))))
+ (and (string-match "[0-9.]+\\'" otp) (match-string 0 otp))))
+
+(defvar erldoc-browse-history nil)
+(defvar erldoc-lookup-table nil)
+
+(defun erldoc-lookup-table ()
+ (or erldoc-lookup-table
+ (progn
+ (unless (file-exists-p erldoc-output-file)
+ (let ((of (pcase (erldoc-otp-release)
+ (`nil erldoc-output-file)
+ (ver (concat erldoc-output-file "-" ver)))))
+ (unless (file-exists-p of)
+ (erldoc-parse-all erldoc-man-index of))
+ (unless (string= erldoc-output-file of)
+ (make-symbolic-link (expand-file-name of) erldoc-output-file))))
+ (setq erldoc-lookup-table
+ (with-temp-buffer
+ (insert-file-contents erldoc-output-file)
+ (read (current-buffer)))))))
+
+(defun erldoc-best-matches (mfa)
+ (pcase mfa
+ ((and `(,m ,f) (let a (erlang-get-function-arity)))
+ (let ((mfa (format "%s:%s/%s" m f a)))
+ (cond ((gethash mfa (erldoc-lookup-table)) (list mfa))
+ (m (all-completions (concat m ":" f "/") (erldoc-lookup-table)))
+ (t (let* ((mod (erlang-get-module))
+ (mf1 (and mod (concat mod ":" f "/")))
+ (mf2 (concat "erlang:" f "/"))
+ (re (concat ":" (regexp-quote f) "/")))
+ (or (and mf1 (all-completions mf1 (erldoc-lookup-table)))
+ (all-completions mf2 (erldoc-lookup-table))
+ (cl-loop for k being the hash-keys of (erldoc-lookup-table)
+ when (string-match-p re k)
+ collect k)))))))))
+
+;;;###autoload
+(defun erldoc-browse (mfa)
+ (interactive
+ (let ((default
+ ;; `erlang-mode-syntax-table' is lazily initialised.
+ (with-syntax-table (or erlang-mode-syntax-table (standard-syntax-table))
+ (ignore-errors
+ (erldoc-best-matches
+ (or (erlang-get-function-under-point)
+ (save-excursion
+ (goto-char (or (cadr (syntax-ppss)) (point)))
+ (erlang-get-function-under-point))))))))
+ (list (completing-read (format (if default "Function {%d %s} (default %s): "
+ "Function: ")
+ (length default)
+ (if (= (length default) 1) "guess" "guesses")
+ (car default))
+ (erldoc-lookup-table)
+ nil t nil 'erldoc-browse-history default))))
+ (or (stringp mfa)
+ (signal 'wrong-type-argument (list 'string mfa 'mfa)))
+ (browse-url (or (car (gethash mfa (erldoc-lookup-table)))
+ (user-error "No documentation for %s" mfa))))
+
+;;;###autoload
+(defun erldoc-apropos (pattern)
+ (interactive "sPattern: ")
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (princ (concat "Erldoc apropos pattern: " pattern "\n\n"))
+ (maphash (lambda (k v)
+ (when (string-match-p pattern k)
+ (insert-text-button k :type 'help-url
+ 'help-args (list (car v)))
+ (insert "\n")))
+ (erldoc-lookup-table)))))
+
+(defun erldoc-tokenize-signature (sig)
+ ;; Divide SIG into (MF ARGLIST RETTYPE)
+ (let ((from (if (string-match "\\`.+?(" sig)
+ (1- (match-end 0))
+ 0))
+ (to (and (string-match "\\s-*->\\s-*.*?\\'" sig) (match-beginning 0))))
+ (list (erldoc-strip-string (substring sig 0 from))
+ (erldoc-strip-string (substring sig from (and to (max from to))))
+ (and to (erldoc-strip-string (substring sig to))))))
+
+(defun erldoc-format-signature (mod fn)
+ (when (and mod fn (or erldoc-lookup-table
+ (file-exists-p erldoc-output-file)))
+ (let ((re (concat "\\`" mod ":" fn "/\\([0-9]+\\)\\'"))
+ (sigs))
+ (maphash (lambda (k v)
+ (when (string-match re k)
+ (if (cadr v)
+ (push (cons (string-to-number (match-string 1 k))
+ (cdr (erldoc-tokenize-signature (cadr v))))
+ sigs)
+ (funcall erldoc-no-signature-function
+ "erldoc-format-signature: No sig for %s" k))))
+ (erldoc-lookup-table))
+ (when sigs
+ ;; Mostly single return type but there are exceptions such as
+ ;; `beam_lib:chunks/2,3'.
+ (let ((single-rettype
+ (cl-reduce (lambda (x1 x2) (and x1 x2 (equal x1 x2) x1))
+ sigs :key #'cl-caddr))
+ (sigs (sort sigs #'car-less-than-car)))
+ (if single-rettype
+ (concat mod ":" fn (mapconcat #'cadr sigs " | ") " " single-rettype)
+ (mapconcat (lambda (x) (concat mod ":" fn (nth 1 x) " " (nth 2 x)))
+ sigs "\n")))))))
+
+;;;###autoload
+(defun erldoc-eldoc-function ()
+ "A function suitable for `eldoc-documentation-function'."
+ (save-excursion
+ (pcase (erlang-get-function-under-point)
+ (`(,_ nil) )
+ (`(nil ,fn) (erldoc-format-signature "erlang" fn))
+ (`(,mod ,fn) (erldoc-format-signature mod fn)))))
+
+(defun erldoc-parse-eeps-index ()
+ (let* ((url "http://www.erlang.org/eeps/")
+ (table (catch 'return
+ (erldoc-dom-walk (erldoc-parse-html url)
+ (lambda (d)
+ (and (eq (car-safe d) 'table)
+ (equal (erldoc-dom-get-attribute d 'summary)
+ "Numerical Index of EEPs")
+ (throw 'return d))))))
+ (fix-title (lambda (title)
+ (replace-regexp-in-string
+ "`` *" "" (replace-regexp-in-string " *``, *" " by " title))))
+ (result))
+ (erldoc-dom-walk
+ table (lambda (d)
+ (when (eq (car-safe d) 'a)
+ (push (cons (funcall fix-title (erldoc-dom-get-attribute d 'title))
+ (erldoc-expand-url
+ (erldoc-dom-get-attribute d 'href)
+ url))
+ result))))
+ (nreverse result)))
+
+(defvar erldoc-user-guides nil)
+
+(defvar erldoc-missing-user-guides
+ '("compiler" "kernel" "os_mon" "parsetools")
+ "List of standard Erlang applications with no user guides.")
+
+;; Search in `code:lib_dir/0' using find LIB_DIR -type f -name
+;; '*_app.html'.
+(defvar erldoc-app-manuals '("crypto" "diameter" "erl_docgen"
+ "kernel" "observer" "os_mon"
+ "runtime_tools" "sasl" "snmp"
+ "ssl" "test_server"
+ ("ssh" . "SSH") ("stdlib" . "STDLIB"))
+ "List of applications that come with a manual.")
+
+(defun erldoc-user-guide-chapters (user-guide)
+ (pcase-let ((`(,name . ,url) user-guide))
+ (unless (member name erldoc-missing-user-guides)
+ (let ((chaps (erldoc-dom-get-elements-by-id
+ (erldoc-dom-get-element-by-id (erldoc-parse-html url) "leftnav")
+ "no")))
+ (or chaps (warn "erldoc-user-guide-chapters no chapters found for `%s'"
+ (cdr user-guide)))
+ (mapcar (lambda (li)
+ (cons (concat name "#" (erldoc-dom-get-attribute li 'title))
+ (erldoc-expand-url (erldoc-dom-get-attribute
+ (erldoc-dom-get-element li 'a) 'href)
+ url)))
+ chaps)))))
+
+(defun erldoc-user-guides-1 ()
+ (let ((url (erldoc-expand-url "applications.html" erldoc-man-index))
+ app-guides app-mans)
+ (erldoc-dom-walk
+ (erldoc-parse-html url)
+ (lambda (d)
+ (when (and (eq (car-safe d) 'a)
+ (not (string-match-p "\\`[0-9.]+\\'" (erldoc-dom-get-text d))))
+ (with-demoted-errors "erldoc-user-guides-1: %S"
+ (let ((name (erldoc-strip-string (erldoc-dom-get-text d)))
+ (index-page (erldoc-fix-path (erldoc-expand-url
+ (erldoc-dom-get-attribute d 'href) url))))
+ (push (cons name (if (member name erldoc-missing-user-guides)
+ index-page
+ (erldoc-expand-url "users_guide.html" index-page)))
+ app-guides)
+ ;; Collect application manuals.
+ (pcase (assoc name (mapcar (lambda (x) (if (consp x) x (cons x x)))
+ erldoc-app-manuals))
+ (`(,_ . ,manual)
+ (push (cons name
+ (erldoc-expand-url (format "%s_app.html" manual)
+ index-page))
+ app-mans))))))))
+ (list (nreverse app-guides)
+ (nreverse app-mans))))
+
+(defun erldoc-user-guides ()
+ (or erldoc-user-guides
+ (let ((file (concat erldoc-output-file "-topics")))
+ (unless (file-exists-p file)
+ (unless (file-directory-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (with-temp-buffer
+ (pcase-let ((`(,guides ,mans) (erldoc-user-guides-1)))
+ (pp (append (cl-mapcan #'erldoc-user-guide-chapters
+ (append (mapcar
+ (lambda (dir)
+ (cons dir (erldoc-expand-url
+ (concat dir "/users_guide.html")
+ erldoc-man-index)))
+ '("design_principles"
+ "efficiency_guide"
+ "embedded"
+ "getting_started"
+ "installation_guide"
+ "oam"
+ "programming_examples"
+ "reference_manual"
+ "system_architecture_intro"
+ "system_principles"
+ "tutorial"))
+ guides))
+ (mapcar (lambda (man)
+ (pcase-let ((`(,name . ,url) man))
+ (cons (concat name " (App)") url)))
+ mans)
+ (erldoc-parse-eeps-index))
+ (current-buffer)))
+ (write-region nil nil file nil nil nil 'ask)))
+ (setq erldoc-user-guides (with-temp-buffer (insert-file-contents file)
+ (read (current-buffer)))))))
+
+;;;###autoload
+(defun erldoc-browse-topic (topic)
+ (interactive
+ (list (completing-read "User guide: " (erldoc-user-guides) nil t)))
+ (browse-url (cdr (assoc topic (erldoc-user-guides)))))
+
+(provide 'erldoc)
+
+;; Local variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;;; erldoc.el ends here
projects / emacsconfig.git / commitdiff