aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tools/emacs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/tools/emacs')
-rw-r--r--lib/tools/emacs/erlang-skels.el153
-rw-r--r--lib/tools/emacs/erlang-test.el184
-rw-r--r--lib/tools/emacs/erlang.el547
-rw-r--r--lib/tools/emacs/test.erl.indented13
-rw-r--r--lib/tools/emacs/test.erl.orig13
5 files changed, 678 insertions, 232 deletions
diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el
index ce26c83295..0284c9d686 100644
--- a/lib/tools/emacs/erlang-skels.el
+++ b/lib/tools/emacs/erlang-skels.el
@@ -56,8 +56,10 @@
erlang-skel-gen-event erlang-skel-header)
("gen_fsm" "gen-fsm"
erlang-skel-gen-fsm erlang-skel-header)
- ("gen_statem" "gen-statem"
- erlang-skel-gen-statem 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"
@@ -497,6 +499,7 @@ Please see the function `tempo-define-template'.")
"%% {stop, Reason}" n
(erlang-skel-separator-end 2)
"init([]) ->" n>
+ "process_flag(trap_exit, true)," n>
"{ok, #state{}}." n
n
(erlang-skel-separator-start 2)
@@ -740,6 +743,7 @@ Please see the function `tempo-define-template'.")
"%% {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)
@@ -860,7 +864,7 @@ Please see the function `tempo-define-template'.")
"*The template of a gen_fsm.
Please see the function `tempo-define-template'.")
-(defvar erlang-skel-gen-statem
+(defvar erlang-skel-gen-statem-StateName
'((erlang-skel-include erlang-skel-large-header)
"-behaviour(gen_statem)." n n
@@ -868,9 +872,8 @@ Please see the function `tempo-define-template'.")
"-export([start_link/0])." n
n
"%% gen_statem callbacks" n
- "-export([init/1, terminate/3, code_change/4])." n
+ "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n
"-export([state_name/3])." n
- "-export([handle_event/4])." n
n
"-define(SERVER, ?MODULE)." n
n
@@ -899,48 +902,151 @@ Please see the function `tempo-define-template'.")
(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()." 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:callback_mode()," n>
- "State :: term(), Data :: term()} |" n>
- "{gen_statem:callback_mode()," n>
- "State :: term(), Data :: term()," n>
+ "-spec init(Args :: term()) ->" n>
+ "{ok, State :: term(), Data :: term()} |" n>
+ "{ok, State :: term(), Data :: term()," n>
"[gen_statem:action()] | gen_statem:action()} |" n>
"ignore |" n>
"{stop, Reason :: term()}." n
"init([]) ->" n>
- "{state_functions, state_name, #data{}}." n
+ "process_flag(trap_exit, true)," n>
+ "{ok, state_name, #data{}}." n
n
(erlang-skel-separator-start 2)
"%% @private" n
"%% @doc" n
- "%% If the gen_statem runs with CallbackMode =:= state_functions" n
- "%% there should be one instance of this function for each possible" n
- "%% state name. Whenever a gen_statem receives an event," n
- "%% the instance of this function with the same name" n
- "%% as the current state name StateName is called to" n
- "%% handle the event." 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
+ "%%" n
+ "%% NOTE: If there is an exported function handle_event/4, it is called" n
+ "%% instead of StateName/3 functions like this!" n
(erlang-skel-separator-end 2)
"-spec state_name(" n>
"gen_statem:event_type(), Msg :: term()," n>
"Data :: term()) ->" n>
- "gen_statem:state_function_result(). " n
+ "gen_statem:state_function_result()." 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
- "%% If the gen_statem runs with CallbackMode =:= handle_event_function" n
- "%% this function is called for every event a gen_statem receives." 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()." 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>
+ "{ok, State :: term(), Data :: term()} |" n>
+ "{ok, State :: term(), Data :: term()," n>
+ "[gen_statem:action()] | gen_statem:action()} |" n>
+ "ignore |" n>
+ "{stop, Reason :: 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
+ "%%" n
+ "%% NOTE: If there is no exported function handle_event/4," n
+ "%% StateName/3 functions are called instead!" n
(erlang-skel-separator-end 2)
"-spec handle_event(" n>
"gen_statem:event_type(), Msg :: term()," n>
"State :: term(), Data :: term()) ->" n>
- "gen_statem:handle_event_result(). " n
+ "gen_statem:handle_event_result()." n
"handle_event({call,From}, _Msg, State, Data) ->" n>
"{next_state, State, Data, [{reply,From,ok}]}." n
n
@@ -965,7 +1071,8 @@ Please see the function `tempo-define-template'.")
"-spec code_change(" n>
"OldVsn :: term() | {down,term()}," n>
"State :: term(), Data :: term(), Extra :: term()) ->" n>
- "{ok, NewState :: term(), NewData :: term()}." n
+ "{ok, NewState :: term(), NewData :: term()} |" n>
+ "(Reason :: term())." n
"code_change(_OldVsn, State, Data, _Extra) ->" n>
"{ok, State, Data}." n
n
@@ -973,7 +1080,7 @@ Please see the function `tempo-define-template'.")
"%%% Internal functions" n
(erlang-skel-double-separator-end 3)
)
- "*The template of a gen_statem.
+ "*The template of a gen_statem (handle_event/4).
Please see the function `tempo-define-template'.")
(defvar erlang-skel-wx-object
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
new file mode 100644
index 0000000000..ba6190d194
--- /dev/null
+++ b/lib/tools/emacs/erlang-test.el
@@ -0,0 +1,184 @@
+;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
+
+;;; Unit tests for erlang.el.
+
+;; Author: Johan Claesson
+;; Created: 2016-05-07
+;; Keywords: erlang, languages
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2016. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+
+
+;;; Commentary:
+
+;; This library require GNU Emacs 25 or later.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+(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
+ erlang-buffer
+ erlang-mode-hook
+ prog-mode-hook
+ erlang-shell-mode-hook
+ tags-add-tables)
+ (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))
+ (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)
+ (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)
+ (xref-find-definitions tagname)
+ (erlang-test-verify-pos erlang-file line)
+ (xref-find-definitions (concat "erlang_test:" tagname))
+ (erlang-test-verify-pos erlang-file line)))
+ (xref-find-definitions "erlang_test:")
+ (erlang-test-verify-pos erlang-file 1))
+
+(defun erlang-test-verify-pos (expected-file expected-line)
+ (should (string-equal (file-truename expected-file)
+ (file-truename (buffer-file-name))))
+ (should (eq expected-line (line-number-at-pos)))
+ (should (= (point-at-bol) (point))))
+
+(defun erlang-test-complete-at-point (tags-file)
+ (with-temp-buffer
+ (erlang-mode)
+ (setq-local tags-file-name tags-file)
+ (insert "\nerlang_test:fun")
+ (erlang-complete-tag)
+ (should (looking-back "erlang_test:function"))
+ (insert "\nfun")
+ (erlang-complete-tag)
+ (should (looking-back "function"))
+ (insert "\nerlang_")
+ (erlang-complete-tag)
+ (should (looking-back "erlang_test:"))))
+
+
+(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))
+
+
+(provide 'erlang-test)
+
+;;; erlang-test.el ends here
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 0a3fc0ddff..73c6b8d768 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -70,8 +70,8 @@
;; `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
+;; To toggle the variable you can use the following command:
+;; M-x toggle-debug-on-error RET
;;; Code:
(eval-when-compile (require 'cl))
@@ -971,7 +971,7 @@ resulting regexp is surrounded by \\_< and \\_>."
(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
"Regexp which should match beginning of a clause.")
-(defvar erlang-file-name-extension-regexp "\\.[eh]rl$"
+(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
@@ -1068,8 +1068,14 @@ behaviour.")
"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.")
+ (if (featurep 'xemacs)
+ (progn
+ (require 'font-lock)
+ `((t (:foreground ,(face-foreground 'font-lock-function-name-face))
+ (:background ,(face-background 'font-lock-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)
@@ -1285,6 +1291,11 @@ Unfortunately, XEmacs hasn't got support for a special Font
Lock syntax table. The effect is that `apply' in the atom
`foo_apply' will be highlighted as a bif.")
+(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.
@@ -1338,11 +1349,19 @@ Lock syntax table. The effect is that `apply' in the atom
(defun erlang-version ()
"Return the current version of Erlang mode."
(interactive)
- (if (interactive-p)
+ (if (erlang-interactive-p)
(message "Erlang mode version %s, written by Anders Lindgren"
erlang-version))
erlang-version)
+(defun erlang-interactive-p ()
+ (if (fboundp 'called-interactively-p)
+ (called-interactively-p 'interactive)
+ (funcall (symbol-function 'interactive-p))))
+
+(unless (fboundp 'prog-mode)
+ (defun prog-mode ()
+ (use-local-map (make-keymap))))
;;;###autoload
(define-derived-mode erlang-mode prog-mode "Erlang"
@@ -1415,7 +1434,9 @@ Other commands:
(erlang-tags-init)
(erlang-font-lock-init)
(erlang-skel-init)
- (tempo-use-tag-list 'erlang-tempo-tags)
+ (when (fboundp 'tempo-use-tag-list)
+ (tempo-use-tag-list 'erlang-tempo-tags))
+ (run-hooks 'erlang-mode-hook)
(if (zerop (buffer-size))
(run-hooks 'erlang-new-file-hook)))
@@ -1536,7 +1557,9 @@ Other commands:
table)))
(set (make-local-variable 'font-lock-syntax-table)
erlang-font-lock-syntax-table)
- (set (make-local-variable 'font-lock-beginning-of-syntax-function)
+ (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)
@@ -2244,6 +2267,7 @@ mode with the command `M-x erlang-mode RET'.")))
;; This code is based on the package `tempo' which is part of modern
;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
+(defvar erlang-skel)
(defun erlang-skel-init ()
"Generate the skeleton functions and menu items.
The variable `erlang-skel' contains the name and descriptions of
@@ -2970,8 +2994,9 @@ Return nil if inside string, t if in a comment."
(current-column)))
;; Type and Spec indentation
((eq (car stack-top) '::)
- (if (looking-at "}")
- ;; Closing record definition with types
+ (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)))
@@ -3204,18 +3229,16 @@ With argument, do this that many times."
(interactive "p")
(or arg (setq arg 1))
(while (and (looking-at "[ \t]*[%\n]")
- (zerop (forward-line 1))))
+ (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)
- (skip-chars-forward " \t")
- (if (looking-at "[%\n]")
- nil
- (end-of-line)
- (setq continue nil)))))
+ (unless (looking-at "[ \t]*[%\n]")
+ (end-of-line)
+ (setq continue nil)))))
(defun erlang-mark-clause ()
"Put mark at end of clause, point at beginning."
@@ -3742,6 +3765,12 @@ In the future the list may contain more elements."
(if (assoc fk (cdr (car imports)))
(setq mod (car (car imports)))
(setq imports (cdr imports))))
+ (cond ((eq (preceding-char) ?#)
+ (setq fk (concat "-record(" fk)))
+ ((eq (preceding-char) ??)
+ (setq fk (concat "-define(" fk)))
+ ((and (null mod) (not (member fk erlang-int-bifs)))
+ (setq mod (erlang-get-module))))
(setq res (list mod fk)))))
(store-match-data md)
res)))
@@ -3812,20 +3841,19 @@ exported function."
(defun erlang-check-module-name-init ()
"Initialize the functionality to compare file and module names.
-Unless we have `before-save-hook', we redefine the function
+Unless we have `before-save-hook', we advice the function
`set-visited-file-name' since it clears the variable
-`local-write-file-hooks'. The original function definition is
-stored in `erlang-orig-set-visited-file-name'."
+`local-write-file-hooks'."
(if (boundp 'before-save-hook)
- ;; If we have that, `make-local-hook' is obsolete.
(add-hook 'before-save-hook 'erlang-check-module-name nil t)
(require 'advice)
- (unless (ad-advised-definition-p 'set-visited-file-name)
- (defadvice set-visited-file-name (after erlang-set-visited-file-name
- activate)
- (if (eq major-mode 'erlang-mode)
- (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
- (add-hook 'local-write-file-hooks 'erlang-check-module-name)))
+ (when (fboundp 'ad-advised-definition-p)
+ (unless (ad-advised-definition-p 'set-visited-file-name)
+ (defadvice set-visited-file-name (after erlang-set-visited-file-name
+ activate)
+ (if (eq major-mode 'erlang-mode)
+ (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
+ (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
(defun erlang-check-module-name ()
@@ -3902,7 +3930,7 @@ non-whitespace characters following the point on the current line."
(newline)
(if (condition-case nil
(progn (erlang-indent-line) t)
- (error (if (bolp) (delete-backward-char 1))))
+ (error (if (bolp) (delete-char -1))))
(if (not (bolp))
(save-excursion
(insert " ->"))
@@ -3914,7 +3942,7 @@ non-whitespace characters following the point on the current line."
(beginning-of-line)
(newline
erlang-electric-semicolon-insert-blank-lines))))
- (error (if (bolp) (delete-backward-char 1))))))))
+ (error (if (bolp) (delete-char -1))))))))
(defun erlang-electric-comma (&optional arg)
@@ -3944,7 +3972,7 @@ non-whitespace characters following the point on the current line."
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1))))))
+ (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."
@@ -4030,7 +4058,7 @@ non-whitespace characters following the point on the current line."
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1))))))
+ (error (if (bolp) (delete-char -1))))))
;; Then it's just a plain greater-than.
(t
@@ -4070,7 +4098,7 @@ After being split/merged into `erlang-after-arrow' and
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1)))))))
+ (error (if (bolp) (delete-char -1)))))))
(defun erlang-electric-newline (&optional arg)
@@ -4318,11 +4346,6 @@ as on the old form `tag'.
In the completion list, `module:tag' and `module:' shows up.
-Call this function from an appropriate init file, or add it to
-Erlang mode hook with the commands:
- (add-hook 'erlang-mode-hook 'erlang-tags-init)
- (add-hook 'erlang-shell-mode-hook 'erlang-tags-init)
-
This function only works under Emacs 18 and Emacs 19. Currently, It
is not implemented under XEmacs. (Hint: The Emacs 19 etags module
works under XEmacs.)"
@@ -4333,12 +4356,17 @@ works under XEmacs.)"
(setq erlang-tags-installed t))
(t
(require 'etags)
- ;; Test on a function available in the Emacs 19 version
- ;; of tags but not in the XEmacs version.
- (if (not (fboundp 'find-tag-noselect))
- ()
- (erlang-tags-define-keys (current-local-map))
- (setq erlang-tags-installed t)))))
+ (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)
+ ;; Test on a function available in the Emacs 19 version
+ ;; of tags but not in the XEmacs version.
+ (when (fboundp 'find-tag-noselect)
+ (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
@@ -4363,10 +4391,6 @@ works under XEmacs.)"
(erlang-menu-init))
-;; There exists a variable `find-tag-default-function'. It is not used
-;; since `complete-tag' uses it to get current word under point. In that
-;; situation we don't want the module to be prepended.
-
(defun erlang-find-tag-default ()
"Return the default tag.
Search `-import' list of imported functions.
@@ -4546,6 +4570,11 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(current-buffer))) ; Return the new buffer.
+
+
+
+
+
;; Process interactive arguments for erlang-find-tag-*.
;;
;; Negative arguments work only for `etags', not `tags'. This is not
@@ -4639,9 +4668,25 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(set (make-local-variable 'find-tag-regexp-search-function)
'erlang-tags-regexp-search-forward)
(set (make-local-variable 'find-tag-tag-order)
- '(erlang-tag-match-module-p))
+ (mapcar #'erlang-make-order-function-aware-of-modules
+ erlang-tags-orig-tag-order))
(set (make-local-variable 'find-tag-regexp-tag-order)
- '(erlang-tag-match-module-regexp-p))))
+ (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 ()
@@ -4718,60 +4763,32 @@ for a tag on the form `module:tag'."
(funcall erlang-tags-orig-regexp-search-function
tag bound noerror count)))
-
-;; t if point is at a tag line that matches TAG, containing
-;; module information. Assumes that all other order functions
-;; are stored in `erlang-tags-orig-[regex]-tag-order'.
-
-(defun erlang-tag-match-module-p (tag)
- (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order))
-
-(defun erlang-tag-match-module-regexp-p (tag)
- (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order))
-
-(defun erlang-tag-match-module-common-p (tag order)
- (let ((mod nil)
- (found nil))
- (if (string-match ":" tag)
- (progn
- (setq mod (substring tag 0 (match-beginning 0)))
- (setq tag (substring tag (match-end 0) nil))))
- (while (and order (not found))
- (setq found
- (and (not (memq (car order)
- '(erlang-tag-match-module-p
- erlang-tag-match-module-regexp-p)))
- (funcall (car order) tag)))
- (setq order (cdr order)))
- (and found
- (or (null mod)
- (string= mod (erlang-get-module-from-file-name
- (file-of-tag)))))))
-
-
;;; 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'.
+;;; `module:tag' and `module:'.
-
-(when (and (fboundp 'etags-tags-completion-table)
+(when (and (locate-library "etags")
+ (require 'etags)
+ (fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
(if (fboundp 'advice-add)
;; Emacs 24.4+
(advice-add 'etags-tags-completion-table :around
- (lambda (oldfun)
- (if (eq find-tag-default-function 'erlang-find-tag-for-completion)
- (erlang-etags-tags-completion-table)
- (funcall oldfun)))
- (list :name 'erlang-replace-tags-table))
+ #'erlang-etags-tags-completion-table-advice)
;; Emacs 23.1-24.3
- (defadvice etags-tags-completion-table (around erlang-replace-tags-table activate)
- (if (eq find-tag-default-function 'erlang-find-tag-for-completion)
+ (defadvice etags-tags-completion-table (around
+ erlang-replace-tags-table
+ activate)
+ (if erlang-replace-etags-tags-completion-table
(setq ad-return-value (erlang-etags-tags-completion-table))
ad-do-it))))
+(defun erlang-etags-tags-completion-table-advice (oldfun)
+ (if erlang-replace-etags-tags-completion-table
+ (erlang-etags-tags-completion-table)
+ (funcall oldfun)))
(defun erlang-complete-tag ()
"Perform tags completion on the text around point.
@@ -4783,26 +4800,21 @@ about Erlang modules."
(condition-case nil
(require 'etags)
(error nil))
- (cond ((and erlang-tags-installed
- (fboundp 'etags-tags-completion-table)
+ (cond ((and (fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
- ;; This depends on the advice called erlang-replace-tags-table
- ;; above. It is not enough to let-bind
- ;; tags-completion-table-function since that will not override
- ;; the buffer-local value in the TAGS buffer.
- (let ((find-tag-default-function 'erlang-find-tag-for-completion))
+ (let ((erlang-replace-etags-tags-completion-table t))
(complete-tag)))
((and erlang-tags-installed
- (fboundp 'complete-tag)
- (fboundp 'tags-complete-tag)) ; Emacs 19
+ (fboundp 'complete-tag)
+ (fboundp 'tags-complete-tag)) ; Emacs 19-22
(let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag)))
(fset 'tags-complete-tag
(symbol-function 'erlang-tags-complete-tag))
(unwind-protect
- (funcall (symbol-function 'complete-tag))
+ (complete-tag)
(fset 'tags-complete-tag orig-tags-complete-tag))))
((fboundp 'complete-tag) ; Emacs 19
- (funcall (symbol-function 'complete-tag)))
+ (complete-tag))
((fboundp 'tag-complete-symbol) ; XEmacs
(funcall (symbol-function 'tag-complete-symbol)))
(t
@@ -4817,19 +4829,22 @@ about Erlang modules."
(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)
- (save-excursion
- ;; If we need to ask for the tag table, allow that.
- (let ((enable-recursive-minibuffers t))
- (visit-tags-table-buffer))
+ (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))))
+ (try-completion string (erlang-tags-completion-table) predicate)))))
;; `tags-completion-table' calls itself recursively, make it
@@ -4847,7 +4862,6 @@ about Erlang modules."
(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
@@ -4858,59 +4872,190 @@ about Erlang modules."
(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 symbols to the vector, the tag, module: and module:tag.
+;; 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 ()
- (let ((table (make-vector 511 0))
- (file nil)
- (progress-reporter
- (when (fboundp 'make-progress-reporter)
- (make-progress-reporter
- (format "Making erlang tags completion table for %s..." buffer-file-name)
- (point-min) (point-max)))))
+(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))
- ;; This monster regexp matches an etags tag line.
- ;; \1 is the string to match;
- ;; \2 is not interesting;
- ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
- ;; \4 is not interesting;
- ;; \5 is the explicitly-specified tag name.
- ;; \6 is the line to start searching at;
- ;; \7 is the char to start searching at.
(while (progn
- (while (and
- (eq (following-char) ?\f)
- (looking-at "\f\n\\([^,\n]*\\),.*\n"))
- (setq file (buffer-substring
- (match-beginning 1) (match-end 1)))
- (goto-char (match-end 0)))
+ (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
- "\
-^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
-\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
-\\([0-9]+\\)?,\\([0-9]+\\)?\n"
+ "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?"
nil t))
- (let ((tag (if (match-beginning 5)
+ (let ((tag (if (match-beginning 1)
;; There is an explicit tag name.
- (buffer-substring (match-beginning 5) (match-end 5))
- ;; No explicit tag name. Best guess.
- (buffer-substring (match-beginning 3) (match-end 3))))
- (module (and file
- (erlang-get-module-from-file-name file))))
- (intern tag table)
+ (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)
- (intern (concat module ":" tag) table)
- ;; Only the first ones will be stored in the table.
- (intern (concat module ":") table)
- (intern (concat module ":module_info") table))
- (when progress-reporter
- (progress-reporter-update progress-reporter (point))))))
+ (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.
+
+
+(defun erlang-etags--xref-backend () 'erlang-etags)
+
+(defun erlang-soft-require (feature)
+ (when (locate-library (symbol-name feature))
+ (require feature)))
+
+(and (erlang-soft-require 'xref)
+ (erlang-soft-require 'cl-generic)
+ ;; The purpose of using eval here is to avoid compilation
+ ;; warnings in emacsen without cl-defmethod.
+ (eval
+ '(progn
+ (cl-defmethod xref-backend-identifier-at-point
+ ((_backend (eql erlang-etags)))
+ (erlang-find-tag-default))
+
+ (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))))))
+
+
+
+
+(defun erlang-xref-find-definitions (identifier &optional is-regexp)
+ (let ((id-list (split-string identifier ":")))
+ (cond
+ ;; Handle "tag"
+ ((null (cdr id-list))
+ (erlang-xref-find-definitions-tag identifier is-regexp))
+ ;; Handle "module:"
+ ((string-equal (cadr id-list) "")
+ (erlang-xref-find-definitions-module (car id-list)))
+ ;; Handle "module:tag"
+ (t
+ (erlang-xref-find-definitions-module-tag (car id-list)
+ (cadr id-list)
+ is-regexp)))))
+
+(defun erlang-xref-find-definitions-tag (tag is-regexp)
+ "Find all definitions of TAG and reorder them so that
+definitions in the currently visited file comes first."
+ (when (fboundp 'etags--xref-find-definitions)
+ (let* ((current-file (and (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ (xrefs (etags--xref-find-definitions tag is-regexp))
+ local-xrefs non-local-xrefs)
+ (while xrefs
+ (if (string-equal (erlang-xref-truename-file (car xrefs))
+ current-file)
+ (push (car xrefs) local-xrefs)
+ (push (car xrefs) non-local-xrefs))
+ (setq xrefs (cdr xrefs)))
+ (append (reverse local-xrefs)
+ (reverse non-local-xrefs)))))
+
+(defun erlang-xref-find-definitions-module (module)
+ (and (fboundp 'xref-make)
+ (fboundp 'xref-make-file-location)
+ (let* ((first-time t)
+ xrefs matching-files)
+ (save-excursion
+ (while (visit-tags-table-buffer (not first-time))
+ (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-module-tag (module tag is-regexp)
+ "Find all definitions of TAG and filter away definitions
+outside of MODULE."
+ (when (fboundp 'etags--xref-find-definitions)
+ (let ((xrefs (etags--xref-find-definitions tag is-regexp))
+ xrefs-in-module)
+ (while xrefs
+ (when (string-equal module (erlang-xref-module (car xrefs)))
+ (push (car xrefs) xrefs-in-module))
+ (setq xrefs (cdr xrefs)))
+ xrefs-in-module)))
+
+(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))))
+
+
+
;;;
;;; Prepare for other methods to run an Erlang slave process.
;;;
@@ -5060,19 +5205,10 @@ The following special commands are available:
(setq comint-input-ignoredups t)
(setq comint-scroll-show-maximum-output t)
(setq comint-scroll-to-bottom-on-output t)
- ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If
- ;; the call fails, just call the normal `add-hook'.
- (condition-case nil
- (progn
- (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))
- (error
- (funcall (symbol-function 'make-local-hook)
- 'comint-output-filter-functions) ; obsolete as of Emacs 21.1
- (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete)
- (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m)))
+ (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)
;; Some older versions of comint don't have an input ring.
(if (fboundp 'comint-read-input-ring)
(progn
@@ -5098,6 +5234,7 @@ The following special commands are available:
(define-key map [menu-bar compilation]
(cons "Errors" compilation-menu-map)))
map)))))
+ (erlang-tags-init)
(run-hooks 'erlang-shell-mode-hook))
@@ -5309,8 +5446,7 @@ frame will become deselected before the next command."
()
(or (inferior-erlang-running-p)
(error "No inferior Erlang shell is running"))
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(let ((msg nil))
(while (save-excursion
(goto-char (process-mark inferior-erlang-process))
@@ -5330,8 +5466,7 @@ frame will become deselected before the next command."
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."
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(if (> (point-max) 1)
;; make sure we get a prompt if buffer contains data
(if (save-excursion
@@ -5397,7 +5532,7 @@ Return the position after the newly inserted command."
(boundp 'comint-last-output-start))
(save-excursion
(goto-char
- (if (interactive-p)
+ (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start)))
(while (progn (skip-chars-forward "^\C-h")
@@ -5416,7 +5551,7 @@ Return the position after the newly inserted command."
(let ((pmark (process-mark (get-buffer-process (current-buffer)))))
(save-excursion
(goto-char
- (if (interactive-p)
+ (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start)))
(while (re-search-forward "\r+$" pmark t)
@@ -5443,23 +5578,21 @@ There exists two workarounds for this bug:
(save-some-buffers)
(inferior-erlang-prepare-for-input)
(let* ((dir (inferior-erlang-compile-outdir))
-;;; (file (file-name-nondirectory (buffer-file-name)))
(noext (substring (erlang-local-buffer-file-name) 0 -4))
(opts (append (list (cons 'outdir dir))
(if current-prefix-arg
(list 'debug_info 'export_all))
erlang-compile-extra-opts))
end)
- (save-excursion
- (set-buffer inferior-erlang-buffer)
- (compilation-forget-errors))
+ (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)
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(setq compilation-error-list nil)
(set-marker compilation-parsing-end end))
(setq compilation-last-buffer inferior-erlang-buffer)))
@@ -5499,7 +5632,8 @@ unless the optional NO-DISPLAY is non-nil."
(let ((ccfn erlang-compile-command-function-alist)
(res (inferior-erlang-compute-erl-compile-command module-name opts))
ccfn-entry
- done)
+ done
+ result)
(if (not (null (erlang-local-buffer-file-name)))
(while (and (not done) (not (null ccfn)))
(setq ccfn-entry (car ccfn))
@@ -5580,31 +5714,29 @@ unless the optional NO-DISPLAY is non-nil."
(defun inferior-erlang-format-comma-opts (opts)
(if (null opts)
""
- (concat ", " (inferior-erlang-format-opts opts))))
-
-(defun inferior-erlang-format-opts (opts)
- (concat "[" (inferior-erlang-string-join (mapcar 'inferior-erlang-format-opt
- opts)
- ", ")
- "]"))
+ (concat ", " (inferior-erlang-format-opt opts))))
(defun inferior-erlang-format-opt (opt)
(cond ((stringp opt) (concat "\"" opt "\""))
- ((atom opt) (format "%s" opt))
- ((consp opt) (concat "{" (inferior-erlang-string-join
- (mapcar 'inferior-erlang-format-opt
- (list (car opt) (cdr opt)))
- ", ")
- "}"))
- (t (error (format "Unexpected opt %s" opt)))))
-
-(defun inferior-erlang-string-join (strs sep)
- (let ((result (or (car strs) "")))
- (setq strs (cdr strs))
- (while strs
- (setq result (concat result sep (car strs)))
- (setq strs (cdr strs)))
- result))
+ ((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,
@@ -5629,12 +5761,14 @@ unless the optional NO-DISPLAY is non-nil."
(tramp-tramp-file-p (buffer-file-name))))
(defun erlang-tramp-get-localname ()
- (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'
- (tramp-file-name-path tramp-info))))
+ (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.
@@ -5651,16 +5785,14 @@ Capable of finding error messages in an inferior Erlang buffer."
(and (boundp 'compilation-last-buffer)
compilation-last-buffer))))
(if (and (bufferp buf)
- (save-excursion
- (set-buffer 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))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(setq major-mode 'erlang-shell-mode))))
(or done
(next-error argp))))
@@ -5763,7 +5895,7 @@ Simplified version of a combination `defalias' and `make-obsolete',
it assumes that NEWDEF is loaded."
(defalias sym (symbol-function newdef))
(if (fboundp 'make-obsolete)
- (make-obsolete sym newdef)))
+ (make-obsolete sym newdef "long ago")))
(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent)
@@ -5781,11 +5913,8 @@ it assumes that NEWDEF is loaded."
(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function)
-;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above.
(defconst erlang-unload-hook
(list (lambda ()
- (defalias 'set-visited-file-name
- 'erlang-orig-set-visited-file-name)
(when (featurep 'advice)
(ad-unadvise 'Man-notify-when-ready)
(ad-unadvise 'set-visited-file-name)))))
diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented
index 6913068133..7a1ff6a954 100644
--- a/lib/tools/emacs/test.erl.indented
+++ b/lib/tools/emacs/test.erl.indented
@@ -70,6 +70,9 @@ foo() ->
234,
d}).
+-record(record5, { a = 1 :: integer()
+ , b = foobar :: atom()
+ }).
-define(MACRO_1, macro).
-define(MACRO_2(_), macro).
@@ -144,6 +147,12 @@ foo() ->
-type t25() :: #rec3{f123 :: [t24() |
1|2|3|4|a|b|c|d|
nonempty_maybe_improper_list(integer, any())]}.
+-type t26() :: #rec4{ a :: integer()
+ , b :: any()
+ }.
+-type t27() :: { integer()
+ , atom()
+ }.
-type t99() ::
{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14(),
t15(),t20(),t21(), t22(),t25()}.
@@ -179,6 +188,10 @@ foo() ->
| {'error', {'no_process', term()}
| {'no_such_group', term()}}.
+-spec add( X :: integer()
+ , Y :: integer()
+ ) -> integer().
+
-opaque attributes_data() ::
[{'column', column()} | {'line', info_line()} |
{'text', string()}] | {line(),column()}.
diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig
index 621948cbe1..2552c71baf 100644
--- a/lib/tools/emacs/test.erl.orig
+++ b/lib/tools/emacs/test.erl.orig
@@ -70,6 +70,9 @@ foo() ->
234,
d}).
+-record(record5, { a = 1 :: integer()
+, b = foobar :: atom()
+}).
-define(MACRO_1, macro).
-define(MACRO_2(_), macro).
@@ -144,6 +147,12 @@ nonempty_maybe_improper_list('integer', any())|
-type t25() :: #rec3{f123 :: [t24() |
1|2|3|4|a|b|c|d|
nonempty_maybe_improper_list(integer, any())]}.
+-type t26() :: #rec4{ a :: integer()
+, b :: any()
+}.
+-type t27() :: { integer()
+, atom()
+}.
-type t99() ::
{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14(),
t15(),t20(),t21(), t22(),t25()}.
@@ -179,6 +188,10 @@ t15(),t20(),t21(), t22(),t25()}.
| {'error', {'no_process', term()}
| {'no_such_group', term()}}.
+-spec add( X :: integer()
+, Y :: integer()
+) -> integer().
+
-opaque attributes_data() ::
[{'column', column()} | {'line', info_line()} |
{'text', string()}] | {line(),column()}.
generated by cgit v1.2.3 (git 2.25.1) at 2025-06-04 17:35:52 +0000