From: Andreas Gerler Date: Sun, 26 Apr 2026 17:48:18 +0000 (+0200) Subject: update erlang X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=311cb41a39198ea791a0d603d008765bb935def3;p=emacsconfig.git update erlang --- diff --git a/elpa/erlang-20250827.800/erlang-autoloads.el b/elpa/erlang-20250827.800/erlang-autoloads.el deleted file mode 100644 index f925f0b6..00000000 --- a/elpa/erlang-20250827.800/erlang-autoloads.el +++ /dev/null @@ -1,201 +0,0 @@ -;;; erlang-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; 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) -(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) -(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) -(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) - (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) -(autoload 'erlang-compile "erlang" "\ -Compile Erlang module in current buffer." t) -(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. -\\ -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) -(register-definition-prefixes "erlang" '("erlang-" "inferior-erlang-" "run-erlang")) - - -;;; 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 the variable `erlang-edoc-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(register-definition-prefixes "erlang-edoc" '("erlang-edoc-")) - - -;;; Generated autoloads from erlang-eunit.el - -(register-definition-prefixes "erlang-eunit" '("erlang-e" "filename-join")) - - -;;; Generated autoloads from erlang-flymake.el - -(register-definition-prefixes "erlang-flymake" '("erlang-flymake-")) - - -;;; Generated autoloads from erlang-skels.el - -(register-definition-prefixes "erlang-skels" '("erlang-")) - - -;;; Generated autoloads from erlang-skels-old.el - -(register-definition-prefixes "erlang-skels-old" '("erlang-")) - - -;;; 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)))) - - -;;; Generated autoloads from erlang-test.el - -(register-definition-prefixes "erlang-test" '("erlang-")) - - -;;; Generated autoloads from erldoc.el - -(autoload 'erldoc-browse "erldoc" "\ - - -(fn MFA)" t) -(autoload 'erldoc-apropos "erldoc" "\ - - -(fn PATTERN)" t) -(autoload 'erldoc-eldoc-function "erldoc" "\ -A function suitable for `eldoc-documentation-function'.") -(autoload 'erldoc-browse-topic "erldoc" "\ - - -(fn TOPIC)" t) -(register-definition-prefixes "erldoc" '("erldoc-")) - -;;; End of scraped data - -(provide 'erlang-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; erlang-autoloads.el ends here diff --git a/elpa/erlang-20250827.800/erlang-edoc.el b/elpa/erlang-20250827.800/erlang-edoc.el deleted file mode 100644 index ead7f1b0..00000000 --- a/elpa/erlang-20250827.800/erlang-edoc.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; erlang-edoc.el --- EDoc support for Erlang mode -*- lexical-binding: t; -*- - -;; -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 1996-2025. 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 diff --git a/elpa/erlang-20250827.800/erlang-eunit.el b/elpa/erlang-20250827.800/erlang-eunit.el deleted file mode 100644 index 25e5e595..00000000 --- a/elpa/erlang-20250827.800/erlang-eunit.el +++ /dev/null @@ -1,459 +0,0 @@ -;;; erlang-eunit.el -*- lexical-binding: t; -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 2009-2025. 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 * 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))) - (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 -* 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 erlang-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 diff --git a/elpa/erlang-20250827.800/erlang-flymake.el b/elpa/erlang-20250827.800/erlang-flymake.el deleted file mode 100644 index e49367ae..00000000 --- a/elpa/erlang-20250827.800/erlang-flymake.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; erlang-flymake.el -*- lexical-binding: t; -*- -;;; -;;; %CopyrightBegin% -;;; -;;; SPDX-License-Identifier: Apache-2.0 -;;; -;;; Copyright Ericsson AB 2010-2025. 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% -;;; -;; 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) -(require 'flymake-proc nil 'noerror) - -(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)) - - -(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-proc-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 diff --git a/elpa/erlang-20250827.800/erlang-pkg.el b/elpa/erlang-20250827.800/erlang-pkg.el deleted file mode 100644 index a9395f6d..00000000 --- a/elpa/erlang-20250827.800/erlang-pkg.el +++ /dev/null @@ -1,8 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "erlang" "20250827.800" - "Major modes for editing and running Erlang." - '((emacs "24.3")) - :url "https://github.com/erlang/otp" - :commit "ed8445a63861f510d21e27c9122e4fafa8039d9d" - :revdesc "ed8445a63861" - :keywords '("erlang" "languages" "processes")) diff --git a/elpa/erlang-20250827.800/erlang-skels-old.el b/elpa/erlang-20250827.800/erlang-skels-old.el deleted file mode 100644 index ade95de7..00000000 --- a/elpa/erlang-20250827.800/erlang-skels-old.el +++ /dev/null @@ -1,1272 +0,0 @@ -;;; erlang-skels-old.el -*- lexical-binding: t; -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 2010-2025. 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'.") diff --git a/elpa/erlang-20250827.800/erlang-skels.el b/elpa/erlang-20250827.800/erlang-skels.el deleted file mode 100644 index e118b00b..00000000 --- a/elpa/erlang-20250827.800/erlang-skels.el +++ /dev/null @@ -1,2127 +0,0 @@ -;;; erlang-skels.el -*- lexical-binding: t; -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 2010-2025. 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. - -;; (eval-when-compile -;; (let ((erlang-skels-loading-for-compilation t)) -;; (load "erlang"))) - -(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.) - -(declare-function erlang-menu-init "erlang") -(declare-function erlang-menu-add-above "erlang") -(declare-function erlang-beginning-of-function "erlang") -(declare-function erlang-get-function-name "erlang") -(declare-function erlang-get-function-arguments "erlang") - -;; Forward declarations -(defvar erlang-menu-items) -(defvar erlang-menu-skel-items) - -(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 diff --git a/elpa/erlang-20250827.800/erlang-start.el b/elpa/erlang-20250827.800/erlang-start.el deleted file mode 100644 index 6232af0c..00000000 --- a/elpa/erlang-20250827.800/erlang-start.el +++ /dev/null @@ -1,159 +0,0 @@ -;;; erlang-start.el --- Load this file to initialize the Erlang package. -*- lexical-binding: t; -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 1996-2025. 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% - - -;; Author: Anders Lindgren -;; 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: -;; support@erlang.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. diff --git a/elpa/erlang-20250827.800/erlang-test.el b/elpa/erlang-20250827.800/erlang-test.el deleted file mode 100644 index 0d44e5b4..00000000 --- a/elpa/erlang-20250827.800/erlang-test.el +++ /dev/null @@ -1,258 +0,0 @@ -;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 2016-2025. 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% - -;;; Unit tests for erlang.el. - -;; Author: Johan Claesson -;; Created: 2016-05-07 -;; Keywords: erlang, languages - -;;; 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 (= (line-beginning-position) (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" (line-beginning-position))) - (insert "\nfun") - (erlang-complete-tag) - (should (looking-back "function" (line-beginning-position))) - (insert "\nerlang_") - (erlang-complete-tag) - (should (looking-back "erlang_test:" (line-beginning-position))))) - - -(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 () - ;; Put it in a lambda to make it work on new (and old) versions - ;; (with-suppressed-warnings ((ignored-return-value nreverse)) - ;; don't exist on emacs 26. - (let ((dotest (lambda () - (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)))) - (funcall dotest))) - - -(provide 'erlang-test) - -;;; erlang-test.el ends here diff --git a/elpa/erlang-20250827.800/erlang.el b/elpa/erlang-20250827.800/erlang.el deleted file mode 100644 index 45fbaae9..00000000 --- a/elpa/erlang-20250827.800/erlang.el +++ /dev/null @@ -1,6419 +0,0 @@ -;;; erlang.el --- Major modes for editing and running Erlang -*- lexical-binding: t; -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 1996-2025. 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% - -;; Copyright (C) 2004 Free Software Foundation, Inc. -;; Author: Anders Lindgren -;; Keywords: erlang, languages, processes -;; Date: 2011-12-11 -;; Package-Version: 20250827.800 -;; Package-Revision: ed8445a63861 -;; Package-Requires: ((emacs "24.3")) - -;; 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) -(require 'cl-lib) -(require 'advice) - -;;; `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.6" - "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 Region" align) - ("Align Current" align-current))) - ("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 "Prompt" ask) - (const :tag "Silently change" t) - (const :tag "Don't check on save" nil))) - -(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 '(restricted-sexp :match-alternatives (integerp 'nil)) - :safe (lambda (val) (or (eq val nil) (integerp val)))) - -(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-compilation-parsing-end nil - "The position after last compilation command") - - -(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" - "processes_iterator" - "processes_next" - "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 (kbd ";") 'erlang-electric-semicolon) - (define-key map (kbd ",") 'erlang-electric-comma) - (define-key map (kbd "<") 'erlang-electric-lt) - (define-key map (kbd ">") 'erlang-electric-gt) - (define-key map (kbd "C-m") 'erlang-electric-newline) - (define-key map (kbd "DEL") 'backward-delete-char-untabify) - (define-key map (kbd "M-q") 'erlang-fill-paragraph) - (define-key map (kbd "M-") 'erlang-complete-tag) - (define-key map (kbd "M-+") 'erlang-find-next-tag) - (define-key map (kbd "C-c M-") 'tempo-complete-tag) - (define-key map (kbd "C-c M-a") 'erlang-beginning-of-clause) - (define-key map (kbd "C-c M-b") 'tempo-backward-mark) - (define-key map (kbd "C-c M-e") 'erlang-end-of-clause) - (define-key map (kbd "C-c M-f") 'tempo-forward-mark) - (define-key map (kbd "C-c M-h") 'erlang-mark-clause) - (define-key map (kbd "C-c C-c") 'comment-region) - (define-key map (kbd "C-c C-j") 'erlang-generate-new-clause) - (define-key map (kbd "C-c C-k") 'erlang-compile) - (define-key map (kbd "C-c C-l") 'erlang-compile-display) - (define-key map (kbd "C-c C-s") 'erlang-show-syntactic-information) - (define-key map (kbd "C-c C-q") 'erlang-indent-function) - (define-key map (kbd "C-c C-u") 'uncomment-region) - (define-key map (kbd "C-c C-y") 'erlang-clone-arguments) - (define-key map (kbd "C-c C-a") 'align-current) - (define-key map (kbd "C-c C-z") 'erlang-shell-display) - (define-key map (kbd "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.") - -(defmacro 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)) - - ;; Some definitions (wrapped in "shy groups" which do not get a number) - (let* ((space-group "\\([[:space:]]*\\)") - (erl-keywords "\\(?:end\\|begin\\|case\\|of\\|if\\|receive\\|after\\|try\\|catch\\|fun\\)") - (erl-sep-symbols (concat "\\(?:\\_<" erl-keywords "\\_>\\)")) - (erl-sep-forms "\\(?:[.][[:space:]]\\|[.]$\\)") - (erl-just-eq ; sets whitespace groups 1 and 2 - ;; NOTE: '...> = <...' may occur in Erlang, so no easy way here - (concat - "\\(?:" ; outer wrapper - "\\(?:" ; shy group for whitespace-before (subgroups get index 1) - "\\(?1:[[:space:]]+\\|^\\)\\|" ; some whitespace, or... - "[^=<>/:?[:space:]]\\(?1:\\)" ; no whitespace but not == <= >= /= := ?= - "\\)" ; end first shy group - "=" - "\\(?:" ; shy group for whitespace-after (subgroups get index 2) - "\\(?2:[[:space:]]+\\|$\\)\\|" ; some whitespace, or... - "\\(?2:\\)[^=<>/:[:space:]]" ; no whitespace but not == =< => =/ =: - "\\)" ; end second shy group - "\\)" ; end outer wrapper - )) ) - - ;; The default Erlang separator is whole forms (dot-terminated) - (setq align-region-separate erl-sep-forms) - - ;; Exclusion rules - ;; (the exc-open-comment rule in align.el seems broken) - (add-to-list 'align-exclude-rules-list - '(erlang-exc-open-comment - (regexp . "^[^%\n]*\\(%.*\\)$") - (modes . '(erlang-mode)))) - ;; (the exc-dq-string and exc-sq-string rules in align.el have a bug) - (add-to-list 'align-exclude-rules-list - '(erlang-exc-dq-string - (regexp . "\\(\"[^\"\n]+\"\\)") - (repeat . t) - (modes . '(erlang-mode)) - )) - (add-to-list 'align-exclude-rules-list - '(erlang-exc-sq-string - (regexp . "\\('[^'\n]+'\\)") - (repeat . t) - (modes . '(erlang-mode)) - )) - - ;; Alignment rules - ;; (Do not try to align things that are the first nonspace character on - ;; its line, such as comments, |, etc. - this is handled by indentation.) - ;; NOTE: Rules that get added later end up earlier in the list. Things - ;; that tend to occur further to the left on a line should be listed - ;; before things that occur further to the right, so a single invokation - ;; of align will clean up most things in one go. - - ;; The align.el 'open-comment' rule doesn't seem to work, so we use our - ;; own rule instead of enabling open-comment for erlang-mode. - ;; (This rule should be added first since comments are rightmost.) - (add-to-list 'align-rules-list - `(erlang-open-comment - (regexp . ,(concat "[^%\n[:space:]]" space-group "%.*$")) - (separate . group) - (modes . '(erlang-mode)) - )) - (add-to-list 'align-rules-list - `(erlang-maps - ;; must not match =:= here - (regexp . ,(concat "[^=]" space-group "\\(=>\\|:=\\)" space-group)) - (group . (1 3)) - (separate . ,(concat "\\(#{\\|" erl-sep-forms "\\|" erl-sep-symbols "\\)")) - (repeat . t) - (modes . '(erlang-mode)) - )) - (add-to-list 'align-rules-list - `(erlang-generator-arrows - (regexp . ,(concat space-group "\\(<-\\|<:-\\|<=\\|<:=\\|&&\\)" space-group)) - (group . (1 3)) - (separate . ,(concat "\\(||\\|" erl-sep-forms "\\|" erl-sep-symbols "\\)")) - (repeat . t) - (modes . '(erlang-mode)) - )) - (add-to-list 'align-rules-list - `(erlang-type-annotation - (regexp . ,(concat space-group "::" space-group)) - (group . (1 2)) - (repeat . t) - (modes . '(erlang-mode)) - )) - ;; erlang-assignment should precede erlang-type-annotation in the rules list - (add-to-list 'align-rules-list - `(erlang-assignment - (regexp . ,erl-just-eq) - (group . (1 2)) - (separate . ,(concat "\\(" erl-sep-forms "\\|" erl-sep-symbols "\\)")) - (repeat . t) - (modes . '(erlang-mode)) - )) - ;; erlang-case-arrow should come first in the rules list - (add-to-list 'align-rules-list - `(erlang-case-arrow - (regexp . ,(concat space-group "->")) - (separate . ,(concat "\\(" erl-sep-forms "\\|" erl-sep-symbols "\\)")) - (modes . '(erlang-mode)) - )) - ) - - (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) - (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) - (add-hook 'post-self-insert-hook - #'erlang-electric-pair-string-delimiter 'append 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 "'") - ;; To highlight triple-or-more quoted strings decently: - ;; mark the second to last character in a sequence - ;; containing an even number of " characters - ;; as an expression prefix character. - ;; This makes an opening even number of (4 or above) - ;; " characters one or more empty strings - ;; followed by one prefixed single opening ", - ;; so effectively just a single ". - ;; A closing even number of " becomes a single closing " - ;; followed by zero or more empty strings, - ;; and then one string containing just a prefix ". - ;; An odd number of opening or closing " works without - ;; any tricks since they become empty strings and - ;; an opening or closing single " last or first. - ;; " chars within a triple-or-more quoted string really - ;; does not work, but a single "-quoted string on one line - ;; only looses the string highlighting. - ("\\(?:\"\"\\)+\\(\"?\\)\"" 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))) - -(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." - (require 'man) - (if (fboundp 'advice-add) - (advice-add 'Man-notify-when-ready :after - #'erlang-man-function-name-advice))) - -(defun erlang-man-function-name-advice (arg) - "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 arg 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 - (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-string-start) - (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-string-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-string-start) - (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 - ((and stack (eq (car (car stack)) 'string)) - (goto-char (car (cdr (car stack)))) ;; String start - (condition-case nil - (progn - (forward-sexp 1) - (if (<= (point) to) - (erlang-pop stack) - (setq in-what 'string) - )) - (error - (setq in-what 'string) - (goto-char to)))) - - ;; 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 - (erlang-push (list 'string token (current-column)) stack) - (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-string-start () - "If inside a string (or comment), move to the beginning of the string" - - ;; This is not perfect because of erlang.el handling of multiline strings but better than before - (beginning-of-line) - (let ((string-start-pos (nth 8 (syntax-ppss)))) - (while string-start-pos - (goto-char string-start-pos) - (beginning-of-line) ;; Hack to handle "" inside """ """ - (setq string-start-pos (nth 8 (syntax-ppss))) - ))) - -(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-electric-pair-string-delimiter () - "Check if a third double-quote was just inserted, and if so, insert three more." - (when (and electric-pair-mode - (eq last-command-event ?\") - (let ((count 0)) - (while (eq (char-before (- (point) count)) last-command-event) - (cl-incf count)) - (= count 3)) - (eq (char-after) last-command-event)) - (insert ?\n) - (save-excursion (insert "\n\"\"")))) - -(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:'. - -(progn - (require 'etags) - (if (fboundp 'advice-add) - (advice-add 'etags-tags-completion-table :around - #'erlang-etags-tags-completion-table-advice))) - -(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 next-error-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. -\\ -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) - (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 - (set-marker erlang-compilation-parsing-end end) - (when (boundp 'compilation-error-list) - (setq compilation-error-list nil))) - (setq next-error-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-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 - (if (fboundp 'advice-remove) - (list (lambda () - (advice-remove 'Man-notify-when-ready - #'erlang-man-function-name-advice) - (advice-remove 'etags-tags-completion-table - #'erlang-etags-tags-completion-table-advice))))) - -;; The end... - -(provide 'erlang) - -(run-hooks 'erlang-load-hook) - -;; Local variables: -;; coding: utf-8 -;; lisp-indent-offset: 2 -;; indent-tabs-mode: nil -;; End: - -;;; erlang.el ends here diff --git a/elpa/erlang-20250827.800/erldoc.el b/elpa/erlang-20250827.800/erldoc.el deleted file mode 100644 index 2988ae5a..00000000 --- a/elpa/erlang-20250827.800/erldoc.el +++ /dev/null @@ -1,535 +0,0 @@ -;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*- - -;; %CopyrightBegin% -;; -;; SPDX-License-Identifier: Apache-2.0 -;; -;; Copyright Ericsson AB 2016-2025. 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 diff --git a/elpa/erlang-20260420.1445/README-elpa b/elpa/erlang-20260420.1445/README-elpa new file mode 100644 index 00000000..73817e69 --- /dev/null +++ b/elpa/erlang-20260420.1445/README-elpa @@ -0,0 +1,43 @@ +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 diff --git a/elpa/erlang-20260420.1445/erlang-autoloads.el b/elpa/erlang-20260420.1445/erlang-autoloads.el new file mode 100644 index 00000000..e06aced4 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-autoloads.el @@ -0,0 +1,185 @@ +;;; erlang-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; 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}" t) +(dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" "\\.hrl$" "\\.xrl$" "\\.yrl" "/ebin/.+\\.app")) (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) +(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) + (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) +(autoload 'erlang-compile "erlang" +"Compile Erlang module in current buffer." t) +(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. +\\ +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) +(register-definition-prefixes "erlang" '("erlang-" "inferior-erlang-" "run-erlang")) + + +;;; 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 the variable `erlang-edoc-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "erlang-edoc" '("erlang-edoc-")) + + +;;; Generated autoloads from erlang-eunit.el + +(register-definition-prefixes "erlang-eunit" '("erlang-e")) + + +;;; Generated autoloads from erlang-flymake.el + +(register-definition-prefixes "erlang-flymake" '("erlang-flymake-")) + + +;;; Generated autoloads from erlang-skels.el + +(register-definition-prefixes "erlang-skels" '("erlang-")) + + +;;; Generated autoloads from erlang-start.el + +(add-to-list 'auto-mode-alist '("\\.erl\\'" . erlang-mode)) +(add-to-list 'auto-mode-alist '("\\.hrl\\'" . erlang-mode)) +(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) +(add-to-list 'completion-ignored-extensions ".beam") + + +;;; Generated autoloads from erlang-test.el + +(register-definition-prefixes "erlang-test" '("erlang-")) + + +;;; Generated autoloads from erldoc.el + +(autoload 'erldoc-browse "erldoc" +" + +(fn MFA)" t) +(autoload 'erldoc-apropos "erldoc" +" + +(fn PATTERN)" t) +(autoload 'erldoc-eldoc-function "erldoc" +"A function suitable for `eldoc-documentation-function'.") +(autoload 'erldoc-browse-topic "erldoc" +" + +(fn TOPIC)" t) +(register-definition-prefixes "erldoc" '("erldoc-")) + +;;; End of scraped data + +(provide 'erlang-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; erlang-autoloads.el ends here diff --git a/elpa/erlang-20260420.1445/erlang-edoc.el b/elpa/erlang-20260420.1445/erlang-edoc.el new file mode 100644 index 00000000..ead7f1b0 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-edoc.el @@ -0,0 +1,183 @@ +;;; erlang-edoc.el --- EDoc support for Erlang mode -*- lexical-binding: t; -*- + +;; +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 1996-2025. 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 diff --git a/elpa/erlang-20260420.1445/erlang-eunit.el b/elpa/erlang-20260420.1445/erlang-eunit.el new file mode 100644 index 00000000..9d26b028 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-eunit.el @@ -0,0 +1,437 @@ +;;; erlang-eunit.el -*- lexical-binding: t; -*- + +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 2009-2025. 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 + +(require 'cl-lib) +(require 'erlang) + +(defcustom erlang-eunit-src-candidate-dirs '("../src" ".") + "Directories to search for source files matching an EUnit test file. +The first directory in the list will be used if there is no match." + :type '(repeat string) + :group 'erlang) + +(defcustom erlang-eunit-test-candidate-dirs '("../test" ".") + "Directories to search for EUnit test files matching a source file. +The first directory in the list will be used if there is no match." + :type '(repeat string) + :group 'erlang) + +(defcustom erlang-eunit-autosave nil + "Non-nil means automatically save unsaved buffers before running tests." + :type 'boolean + :group 'erlang) + +(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil)) + "Info about the most recent running of an EUnit test representation.") + +(defcustom erlang-error-regexp-alist + '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) + "Patterns for matching Erlang errors." + :type '(alist :key-type regexp :value-type sexp) + :group 'erlang) + +;;; +;;; 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 + (expand-file-name buddy-dir-name orig-dir-name))) + (buddy-base-name (erlang-eunit-buddy-basename orig-file-path))) + (expand-file-name buddy-base-name buddy-dir-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) + (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) + (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) + (file-name-sans-extension (file-name-nondirectory file-path))) + + +;;; 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 (string-match-p "^\\(.+\\)_test$" test-name) t nil)) + +(defun erlang-eunit-test-generator-p (test-name) + (if (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 * 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))) + (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. + (let ((buf (get-buffer-create (format "*%s coverage*" module-name)))) + (with-current-buffer buf + (setq buffer-read-only nil) + (insert-file-contents tmp-filename nil nil nil t) + (if (= (buffer-size) 0) + (kill-buffer buf) + (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 +* 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 erlang-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 () + (string-match-p + "[0-9]+: Warning:" + (buffer-substring (line-beginning-position) (line-end-position)))) + +(defalias 'erlang-eunit-all-list-elems-fulfill-p #'cl-every) + +;;; 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 diff --git a/elpa/erlang-20260420.1445/erlang-flymake.el b/elpa/erlang-20260420.1445/erlang-flymake.el new file mode 100644 index 00000000..f9cbf026 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-flymake.el @@ -0,0 +1,161 @@ +;;; erlang-flymake.el -*- lexical-binding: t; -*- +;;; +;;; %CopyrightBegin% +;;; +;;; SPDX-License-Identifier: Apache-2.0 +;;; +;;; Copyright Ericsson AB 2010-2025. 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% +;;; +;; 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) +;; +;; 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) + +(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-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)))) + +(defvar-local erlang-flymake--proc nil + "Internal variable for the Erlang flymake backend process.") + +(defun erlang-flymake-backend (report-fn &rest _args) + "Flymake backend for Erlang using erlc. +REPORT-FN is the flymake callback." + (when (process-live-p erlang-flymake--proc) + (kill-process erlang-flymake--proc)) + (let* ((source (current-buffer)) + (filename (buffer-file-name source)) + (code-dir-opts + (apply #'append + (mapcar (lambda (dir) (list "-pa" dir)) + (funcall erlang-flymake-get-code-path-dirs-function)))) + (inc-dir-opts + (apply #'append + (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 filename)))) + (save-restriction + (widen) + (setq erlang-flymake--proc + (make-process + :name "erlang-flymake" + :noquery t + :connection-type 'pipe + :buffer (generate-new-buffer " *erlang-flymake*") + :command (cons erlang-flymake-command compile-opts) + :sentinel + (lambda (proc _event) + (when (memq (process-status proc) '(exit signal)) + (unwind-protect + (when (with-current-buffer source + (eq proc erlang-flymake--proc)) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (let (diagnostics) + (while (search-forward-regexp + "^\\(.*\\):\\([0-9]+\\):\\([0-9]+\\):\\s-*\\(warning\\|error\\):\\s-*\\(.*\\)$" + nil t) + (let* ((file (match-string 1)) + (line (string-to-number (match-string 2))) + (col (string-to-number (match-string 3))) + (type (if (string= (match-string 4) "warning") + :warning + :error)) + (msg (match-string 5)) + (region (flymake-diag-region source line col))) + (when (and region + (string= (file-truename file) + (file-truename filename))) + (push (flymake-make-diagnostic + source (car region) (cdr region) + type msg) + diagnostics)))) + ;; Also match old-style output without column: + ;; file.erl:LINE: warning/error: message + (goto-char (point-min)) + (while (search-forward-regexp + "^\\(.*\\):\\([0-9]+\\):\\s-*\\(warning\\|error\\):\\s-*\\(.*\\)$" + nil t) + (let* ((file (match-string 1)) + (line (string-to-number (match-string 2))) + (type (if (string= (match-string 3) "warning") + :warning + :error)) + (msg (match-string 4)) + (region (flymake-diag-region source line))) + (when (and region + (string= (file-truename file) + (file-truename filename))) + (push (flymake-make-diagnostic + source (car region) (cdr region) + type msg) + diagnostics)))) + (funcall report-fn (nreverse diagnostics))))) + (kill-buffer (process-buffer proc)))))))))) + +(defun erlang-flymake-setup () + "Set up the Erlang flymake backend for the current buffer." + (add-hook 'flymake-diagnostic-functions #'erlang-flymake-backend nil t)) + +(add-hook 'erlang-mode-hook #'erlang-flymake-setup) +(add-hook 'erlang-mode-hook #'flymake-mode) + +(provide 'erlang-flymake) +;; erlang-flymake ends here diff --git a/elpa/erlang-20260420.1445/erlang-pkg.el b/elpa/erlang-20260420.1445/erlang-pkg.el new file mode 100644 index 00000000..2b042bc6 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-pkg.el @@ -0,0 +1,8 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "erlang" "20260420.1445" + "Major modes for editing and running Erlang." + '((emacs "27.1")) + :url "https://github.com/erlang/otp" + :commit "a42e46bab47432b988ee60e4c9d915c858bcf32d" + :revdesc "a42e46bab474" + :keywords '("erlang" "languages" "processes")) diff --git a/elpa/erlang-20260420.1445/erlang-skels.el b/elpa/erlang-20260420.1445/erlang-skels.el new file mode 100644 index 00000000..ddd0a714 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-skels.el @@ -0,0 +1,1681 @@ +;;; erlang-skels.el -*- lexical-binding: t; -*- + +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 2010-2025. 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. + +;; (eval-when-compile +;; (let ((erlang-skels-loading-for-compilation t)) +;; (load "erlang"))) + +(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) + ("gen_server" "generic-server" + erlang-skel-generic-server erlang-skel-header) + ("gen_event" "gen-event" + erlang-skel-gen-event 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) + ("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) + ) + "*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-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-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-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.) + +(declare-function erlang-menu-init "erlang") +(declare-function erlang-menu-add-above "erlang") +(declare-function erlang-beginning-of-function "erlang") +(declare-function erlang-get-function-name "erlang") +(declare-function erlang-get-function-arguments "erlang") + +;; Forward declarations +(defvar erlang-menu-items) +(defvar erlang-menu-skel-items) + +(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 diff --git a/elpa/erlang-20260420.1445/erlang-start.el b/elpa/erlang-20260420.1445/erlang-start.el new file mode 100644 index 00000000..271121ca --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-start.el @@ -0,0 +1,146 @@ +;;; erlang-start.el --- Load this file to initialize the Erlang package. -*- lexical-binding: t; -*- + +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 1996-2025. 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% + + +;; Author: Anders Lindgren +;; 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: +;; support@erlang.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) + +;; +;; 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 +(add-to-list 'auto-mode-alist '("\\.erl\\'" . erlang-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.hrl\\'" . erlang-mode)) + +;; +;; Associate files using interpreter "escript" with Erlang mode. +;; + +;;;###autoload +(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) + +;; +;; Ignore files ending in ".beam" when performing +;; file completion and in dired omit mode. +;; + +;;;###autoload +(add-to-list 'completion-ignored-extensions ".beam") + + +;; +;; The end. +;; + +(provide 'erlang-start) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;; erlang-start.el ends here. diff --git a/elpa/erlang-20260420.1445/erlang-test.el b/elpa/erlang-20260420.1445/erlang-test.el new file mode 100644 index 00000000..015d2d8e --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang-test.el @@ -0,0 +1,251 @@ +;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*- + +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 2016-2025. 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% + +;;; Unit tests for erlang.el. + +;; Author: Johan Claesson +;; Created: 2016-05-07 +;; Keywords: erlang, languages + +;;; 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)) + (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 (= (line-beginning-position) (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" (line-beginning-position))) + (insert "\nfun") + (erlang-complete-tag) + (should (looking-back "function" (line-beginning-position))) + (insert "\nerlang_") + (erlang-complete-tag) + (should (looking-back "erlang_test:" (line-beginning-position))))) + + +(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 () + ;; Put it in a lambda to make it work on new (and old) versions + ;; (with-suppressed-warnings ((ignored-return-value nreverse)) + ;; don't exist on emacs 26. + (let ((dotest (lambda () + (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)))) + (funcall dotest))) + + +(provide 'erlang-test) + +;;; erlang-test.el ends here diff --git a/elpa/erlang-20260420.1445/erlang.el b/elpa/erlang-20260420.1445/erlang.el new file mode 100644 index 00000000..91313134 --- /dev/null +++ b/elpa/erlang-20260420.1445/erlang.el @@ -0,0 +1,5871 @@ +;;; erlang.el --- Major modes for editing and running Erlang -*- lexical-binding: t; -*- + +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 1996-2025. 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% + +;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Author: Anders Lindgren +;; Keywords: erlang, languages, processes +;; Date: 2011-12-11 +;; Package-Version: 20260420.1445 +;; Package-Revision: a42e46bab474 +;; Package-Requires: ((emacs "27.1")) + +;; 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) +(require 'cl-lib) + +;; Variables: + +(defgroup erlang nil + "The Erlang programming language." + :group 'languages) + +(defconst erlang-version "29.0" + "The version number of Erlang mode. +This tracks the Erlang/OTP release version.") + +(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 Region" align) + ("Align Current" align-current))) + ("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 Definition" xref-find-definitions) + ("Find References" xref-find-references) + ("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 "Prompt" ask) + (const :tag "Silently change" t) + (const :tag "Don't check on save" nil))) + +(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 '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + +(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-compilation-parsing-end nil + "The position after last compilation command") + + +(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" + "exit_signal" + "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" + "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" + "processes_iterator" + "processes_next" + "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 (kbd ";") 'erlang-electric-semicolon) + (define-key map (kbd ",") 'erlang-electric-comma) + (define-key map (kbd "<") 'erlang-electric-lt) + (define-key map (kbd ">") 'erlang-electric-gt) + (define-key map (kbd "C-m") 'erlang-electric-newline) + (define-key map (kbd "DEL") 'backward-delete-char-untabify) + (define-key map (kbd "M-q") 'erlang-fill-paragraph) + (define-key map (kbd "M-?") 'xref-find-references) + (define-key map (kbd "C-c M-") 'tempo-complete-tag) + (define-key map (kbd "C-c M-a") 'erlang-beginning-of-clause) + (define-key map (kbd "C-c M-b") 'tempo-backward-mark) + (define-key map (kbd "C-c M-e") 'erlang-end-of-clause) + (define-key map (kbd "C-c M-f") 'tempo-forward-mark) + (define-key map (kbd "C-c M-h") 'erlang-mark-clause) + (define-key map (kbd "C-c C-c") 'comment-region) + (define-key map (kbd "C-c C-j") 'erlang-generate-new-clause) + (define-key map (kbd "C-c C-k") 'erlang-compile) + (define-key map (kbd "C-c C-l") 'erlang-compile-display) + (define-key map (kbd "C-c C-s") 'erlang-show-syntactic-information) + (define-key map (kbd "C-c C-q") 'erlang-indent-function) + (define-key map (kbd "C-c C-u") 'uncomment-region) + (define-key map (kbd "C-c C-y") 'erlang-clone-arguments) + (define-key map (kbd "C-c C-a") 'align-current) + (define-key map (kbd "C-c C-z") 'erlang-shell-display) + (define-key map (kbd "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 skeleton file to load. +The default uses EDoc-style skeletons. Set to a different file +name to use custom skeletons.") + +;; 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 'font-lock-preprocessor-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 "\\)") + (list 1 'font-lock-preprocessor-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.") + +(defmacro 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 (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)) + + ;; Some definitions (wrapped in "shy groups" which do not get a number) + (let* ((space-group "\\([[:space:]]*\\)") + (erl-keywords "\\(?:end\\|begin\\|case\\|of\\|if\\|receive\\|after\\|try\\|catch\\|fun\\)") + (erl-sep-symbols (concat "\\(?:\\_<" erl-keywords "\\_>\\)")) + (erl-sep-forms "\\(?:[.][[:space:]]\\|[.]$\\)") + (erl-just-eq ; sets whitespace groups 1 and 2 + ;; NOTE: '...> = <...' may occur in Erlang, so no easy way here + (concat + "\\(?:" ; outer wrapper + "\\(?:" ; shy group for whitespace-before (subgroups get index 1) + "\\(?1:[[:space:]]+\\|^\\)\\|" ; some whitespace, or... + "[^=<>/:?[:space:]]\\(?1:\\)" ; no whitespace but not == <= >= /= := ?= + "\\)" ; end first shy group + "=" + "\\(?:" ; shy group for whitespace-after (subgroups get index 2) + "\\(?2:[[:space:]]+\\|$\\)\\|" ; some whitespace, or... + "\\(?2:\\)[^=<>/:[:space:]]" ; no whitespace but not == =< => =/ =: + "\\)" ; end second shy group + "\\)" ; end outer wrapper + )) ) + + ;; The default Erlang separator is whole forms (dot-terminated) + (setq align-region-separate erl-sep-forms) + + ;; Exclusion rules + ;; (the exc-open-comment rule in align.el seems broken) + (add-to-list 'align-exclude-rules-list + '(erlang-exc-open-comment + (regexp . "^[^%\n]*\\(%.*\\)$") + (modes . '(erlang-mode)))) + ;; (the exc-dq-string and exc-sq-string rules in align.el have a bug) + (add-to-list 'align-exclude-rules-list + '(erlang-exc-dq-string + (regexp . "\\(\"[^\"\n]+\"\\)") + (repeat . t) + (modes . '(erlang-mode)) + )) + (add-to-list 'align-exclude-rules-list + '(erlang-exc-sq-string + (regexp . "\\('[^'\n]+'\\)") + (repeat . t) + (modes . '(erlang-mode)) + )) + + ;; Alignment rules + ;; (Do not try to align things that are the first nonspace character on + ;; its line, such as comments, |, etc. - this is handled by indentation.) + ;; NOTE: Rules that get added later end up earlier in the list. Things + ;; that tend to occur further to the left on a line should be listed + ;; before things that occur further to the right, so a single invokation + ;; of align will clean up most things in one go. + + ;; The align.el 'open-comment' rule doesn't seem to work, so we use our + ;; own rule instead of enabling open-comment for erlang-mode. + ;; (This rule should be added first since comments are rightmost.) + (add-to-list 'align-rules-list + `(erlang-open-comment + (regexp . ,(concat "[^%\n[:space:]]" space-group "%.*$")) + (separate . group) + (modes . '(erlang-mode)) + )) + (add-to-list 'align-rules-list + `(erlang-maps + ;; must not match =:= here + (regexp . ,(concat "[^=]" space-group "\\(=>\\|:=\\)" space-group)) + (group . (1 3)) + (separate . ,(concat "\\(#{\\|" erl-sep-forms "\\|" erl-sep-symbols "\\)")) + (repeat . t) + (modes . '(erlang-mode)) + )) + (add-to-list 'align-rules-list + `(erlang-generator-arrows + (regexp . ,(concat space-group "\\(<-\\|<:-\\|<=\\|<:=\\|&&\\)" space-group)) + (group . (1 3)) + (separate . ,(concat "\\(||\\|" erl-sep-forms "\\|" erl-sep-symbols "\\)")) + (repeat . t) + (modes . '(erlang-mode)) + )) + (add-to-list 'align-rules-list + `(erlang-type-annotation + (regexp . ,(concat space-group "::" space-group)) + (group . (1 2)) + (repeat . t) + (modes . '(erlang-mode)) + )) + ;; erlang-assignment should precede erlang-type-annotation in the rules list + (add-to-list 'align-rules-list + `(erlang-assignment + (regexp . ,erl-just-eq) + (group . (1 2)) + (separate . ,(concat "\\(" erl-sep-forms "\\|" erl-sep-symbols "\\)")) + (repeat . t) + (modes . '(erlang-mode)) + )) + ;; erlang-case-arrow should come first in the rules list + (add-to-list 'align-rules-list + `(erlang-case-arrow + (regexp . ,(concat space-group "->")) + (separate . ,(concat "\\(" erl-sep-forms "\\|" erl-sep-symbols "\\)")) + (modes . '(erlang-mode)) + )) + ) + + (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) + (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)) + (setq-local parse-sexp-lookup-properties t) + (add-hook 'post-self-insert-hook + #'erlang-electric-pair-string-delimiter 'append 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) + (setq-local paragraph-start (concat "^$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local defun-prompt-regexp erlang-defun-prompt-regexp) + (setq-local comment-start "%") + (setq-local comment-start-skip "%+\\s *") + (setq-local comment-column 48) + (setq-local indent-line-function 'erlang-indent-command) + (setq-local indent-region-function 'erlang-indent-region) + (setq-local comment-indent-function 'erlang-comment-indent) + (setq-local parse-sexp-ignore-comments t) + (setq-local dabbrev-case-fold-search nil) + (setq-local imenu-prev-index-position-function + 'erlang-beginning-of-function) + (setq-local imenu-extract-index-name-function + 'erlang-get-function-name-and-arity) + (setq-local tempo-match-finder + "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=") + (setq-local beginning-of-defun-function 'erlang-beginning-of-function) + (setq-local end-of-defun-function 'erlang-end-of-function) + (setq-local open-paren-in-column-0-is-defun-start nil) + (setq-local fill-paragraph-function 'erlang-fill-paragraph) + (setq-local comment-add 1) + (setq-local outline-regexp "[[:lower:]0-9_]+ *(.*) *-> *$") + (setq-local outline-level (lambda () 1)) + (setq-local 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))) + (setq-local 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 "'") + ;; To highlight triple-or-more quoted strings decently: + ;; mark the second to last character in a sequence + ;; containing an even number of " characters + ;; as an expression prefix character. + ;; This makes an opening even number of (4 or above) + ;; " characters one or more empty strings + ;; followed by one prefixed single opening ", + ;; so effectively just a single ". + ;; A closing even number of " becomes a single closing " + ;; followed by zero or more empty strings, + ;; and then one string containing just a prefix ". + ;; An odd number of opening or closing " works without + ;; any tricks since they become empty strings and + ;; an opening or closing single " last or first. + ;; " chars within a triple-or-more quoted string really + ;; does not work, but a single "-quoted string on one line + ;; only looses the string highlighting. + ("\\(?:\"\"\\)+\\(\"?\\)\"" 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) + (font-lock-ensure)) + + +(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) + (font-lock-ensure)) + + +(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) + (font-lock-ensure)) + +(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) + (font-lock-ensure)) + + +(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 (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-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 + (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")) + (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)))))) + +(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))) + +(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." + (require 'man) + (advice-add 'Man-notify-when-ready :after + #'erlang-man-function-name-advice)) + +(defun erlang-man-function-name-advice (arg) + "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 arg 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 + (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 + (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)) + (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)) + (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-string-start) + (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-string-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-string-start) + (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 + ((and stack (eq (car (car stack)) 'string)) + (goto-char (car (cdr (car stack)))) ;; String start + (condition-case nil + (progn + (forward-sexp 1) + (if (<= (point) to) + (erlang-pop stack) + (setq in-what 'string) + )) + (error + (setq in-what 'string) + (goto-char to)))) + + ;; 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 + (erlang-push (list 'string token (current-column)) stack) + (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-string-start () + "If inside a string (or comment), move to the beginning of the string" + + ;; This is not perfect because of erlang.el handling of multiline strings but better than before + (beginning-of-line) + (let ((string-start-pos (nth 8 (syntax-ppss)))) + (while string-start-pos + (goto-char string-start-pos) + (beginning-of-line) ;; Hack to handle "" inside """ """ + (setq string-start-pos (nth 8 (syntax-ppss))) + ))) + +(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. + (setq 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))))) + +(defalias 'erlang-mark-function 'mark-defun) + +(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-electric-pair-string-delimiter () + "Check if a third double-quote was just inserted, and if so, insert three more." + (when (and electric-pair-mode + (eq last-command-event ?\") + (let ((count 0)) + (while (eq (char-before (- (point) count)) last-command-event) + (cl-incf count)) + (= count 3)) + (eq (char-after) last-command-event)) + (insert ?\n) + (save-excursion (insert "\n\"\"")))) + +(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 (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)) + +(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) + (setq-local find-tag-default-function 'erlang-find-tag-for-completion) + (add-hook 'xref-backend-functions + #'erlang-etags--xref-backend nil t)) + + + + + + + +;;; Tags completion. +;;; +;;; The basic idea is to create a completion table containing all normal +;;; tags plus tags on the form `module:tag' and `module:'. + +(progn + (require 'etags) + (advice-add 'etags-tags-completion-table :around + #'erlang-etags-tags-completion-table-advice)) + +(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, +including module-qualified names." + (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))))) + + + +(defun erlang-etags-tags-completion-table () + (erlang-etags-tags-completion-table-list)) + +;; 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)))) + +(declare-function xref-item-location "xref" (item)) +(declare-function xref-location-group "xref" (location)) +(declare-function xref-location-origin "xref" (location)) + +(defun erlang-xref-file (xref) + (let ((location (xref-item-location xref))) + (cond ((fboundp 'xref-location-origin) ; Emacs 30+ + (xref-location-origin location)) + ((fboundp 'xref-location-group) + (xref-location-group location))))) + +(defun erlang-visit-tags-table-buffer (cont cbuf) + (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))) + ;; 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) + (setq-local erlang-compilation-parsing-end (make-marker)) + (kill-local-variable 'indent-line-function) + ;; Needed when compiling directly from the Erlang shell. + (setq next-error-last-buffer (current-buffer)) + (setq comint-prompt-regexp "^[^>=]*> *") + (setq-local 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) + (add-hook 'kill-buffer-hook 'comint-write-input-ring nil t) + (compilation-minor-mode 1) + (setq-local minor-mode-overriding-map-alist + `((compilation-minor-mode + . ,(let ((map (make-sparse-keymap))) + (define-key map [mouse-2] #'erlang-mouse-2-command) + (define-key map "\C-m" #'erlang-RET-command) + (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. +;;; + +(defcustom inferior-erlang-display-buffer-any-frame nil + "How to find the inferior Erlang buffer when displaying it. +When nil, use only the selected frame. When t, search all frames. +When `raise', search all frames and raise the frame containing the buffer." + :type '(choice (const :tag "Selected frame only" nil) + (const :tag "Search all frames" t) + (const :tag "Search and raise" raise)) + :group 'erlang) + +(defcustom inferior-erlang-machine "erl" + "The command to start the Erlang shell." + :type 'string + :group 'erlang) + +(defcustom inferior-erlang-machine-options '() + "Additional options for the Erlang shell command. +This must be a list of strings." + :type '(repeat string) + :group 'erlang) + +(defcustom inferior-erlang-process-name "inferior-erlang" + "The name of the inferior Erlang process." + :type 'string + :group 'erlang) + +(defcustom inferior-erlang-buffer-name erlang-shell-buffer-name + "The name of the inferior Erlang buffer." + :type 'string + :group 'erlang) + +(defcustom 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]." + :type '(choice integer + (const :tag "Always assume prompt" t) + (const :tag "Wait forever" nil)) + :group 'erlang) + +(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. +\\ +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)) + + ;; 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)) + (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)) + (unless (eq system-type 'windows-nt) + (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))) + (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 (display-graphic-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 + (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) + (save-excursion + (goto-char + (if (called-interactively-p 'interactive) + comint-last-input-end + comint-last-output-start)) + (while (progn (skip-chars-forward "^\C-h") + (not (eq (point) (point-max)))) + (delete-char 1) + (or (bolp) + (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) + (let ((pmark (process-mark (get-buffer-process (current-buffer))))) + (save-excursion + (goto-char + (if (called-interactively-p 'interactive) + comint-last-input-end + 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 + (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 + (set-marker erlang-compilation-parsing-end end) + (when (boundp 'compilation-error-list) + (setq compilation-error-list nil))) + (setq next-error-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)))) + +(declare-function compilation-forget-errors "compile" ()) +(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) +(declare-function tramp-file-name-localname "tramp" (vec)) + +(defun erlang-tramp-get-localname () + (when (fboundp 'tramp-dissect-file-name) + (tramp-file-name-localname + (tramp-dissect-file-name (buffer-file-name))))) + +;; `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 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-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 () + (advice-remove 'Man-notify-when-ready + #'erlang-man-function-name-advice) + (advice-remove 'etags-tags-completion-table + #'erlang-etags-tags-completion-table-advice)))) + +;; The end... + +(provide 'erlang) + +(run-hooks 'erlang-load-hook) + +;; Local variables: +;; coding: utf-8 +;; lisp-indent-offset: 2 +;; indent-tabs-mode: nil +;; End: + +;;; erlang.el ends here diff --git a/elpa/erlang-20260420.1445/erldoc.el b/elpa/erlang-20260420.1445/erldoc.el new file mode 100644 index 00000000..84c83650 --- /dev/null +++ b/elpa/erlang-20260420.1445/erldoc.el @@ -0,0 +1,511 @@ +;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*- + +;; %CopyrightBegin% +;; +;; SPDX-License-Identifier: Apache-2.0 +;; +;; Copyright Ericsson AB 2016-2025. 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. +;; +;; 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 'dom) +(require 'json) +(require 'erlang) +(eval-when-compile (require 'url-parse)) + +(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)))) + +(defun erldoc-dom-last-text (dom) + "Return the last text child of DOM, or nil." + (let ((text (car (last (dom-children dom))))) + (and (stringp text) text))) + +(defvar erldoc-dom-walk-parent nil + "Parent node during `erldoc-dom-walk' traversal.") +(defvar erldoc-dom-walk-siblings nil + "Sibling nodes during `erldoc-dom-walk' traversal.") + +(defun erldoc-dom-walk (dom k) + "Recursively walk DOM, calling K on each node. +During the walk, `erldoc-dom-walk-parent' and +`erldoc-dom-walk-siblings' are dynamically bound." + (funcall k dom) + (let ((erldoc-dom-walk-parent dom) + (erldoc-dom-walk-siblings (dom-children dom))) + (dolist (child erldoc-dom-walk-siblings) + (erldoc-dom-walk child k)))) + +(defun erldoc-dom-get-elements-by-id (dom id) + "Return all elements in DOM with the given ID." + (let (result) + (erldoc-dom-walk dom (lambda (d) + (when (equal (dom-attr 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 (car (dom-by-tag (erldoc-parse-html url) 'table))) + (mans)) + (erldoc-dom-walk + table + (lambda (d) + (when (eq (car-safe d) 'a) + (let ((href (dom-attr d 'href))) + (when (and href (not (string-match-p "index\\.html\\'" href))) + (with-demoted-errors "erldoc-parse-man-index: %S" + (push (cons (erldoc-dom-last-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 + (dom-by-id dom "loadscrollpos") + (lambda (d) + (let ((href (dom-attr d 'href))) + (when (and href (string-match "#" href)) + (puthash (substring href (match-end 0)) + (list (concat (car man) ":" (erldoc-strip-string + (erldoc-dom-last-text d))) + (erldoc-expand-url href (cdr man))) + table))))) + (let ((span-content + (lambda (span) + (let ((texts)) + (erldoc-dom-walk span + (lambda (d) + (and (stringp 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 (dom-attr d 'name) table)) + (let* ((name (dom-attr d 'name)) + (mfa-url (gethash name table)) + (mfa (car mfa-url)) + (sig (or (funcall span-content d) + (funcall span-content + (or (car (dom-by-tag 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 (dom-attr d 'name) ""))) + (push (list (concat (car man) ":" (funcall span-content d)) + (concat (cdr man) "#" (dom-attr 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-last-text + (car (dom-by-tag + (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 (dom-attr 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 (dom-attr d 'title)) + (erldoc-expand-url + (dom-attr 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" + ("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 + (dom-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 "#" (dom-attr li 'title)) + (erldoc-expand-url (dom-attr + (car (dom-by-tag 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-last-text d)))) + (with-demoted-errors "erldoc-user-guides-1: %S" + (let ((name (erldoc-strip-string (erldoc-dom-last-text d))) + (index-page (erldoc-fix-path (erldoc-expand-url + (dom-attr 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