diff options
Diffstat (limited to 'lib/tools/emacs')
| -rw-r--r-- | lib/tools/emacs/erlang-eunit.el | 2 | ||||
| -rw-r--r-- | lib/tools/emacs/erlang-skels-old.el | 4 | ||||
| -rw-r--r-- | lib/tools/emacs/erlang-skels.el | 122 | ||||
| -rw-r--r-- | lib/tools/emacs/erlang-test.el | 107 | ||||
| -rw-r--r-- | lib/tools/emacs/erlang.el | 325 | ||||
| -rw-r--r-- | lib/tools/emacs/test.erl.indented | 15 | ||||
| -rw-r--r-- | lib/tools/emacs/test.erl.orig | 15 |
7 files changed, 484 insertions, 106 deletions
diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index a3c29c520c..3b85e6680a 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2009-2010. All Rights Reserved. +;; Copyright Ericsson AB 2009-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. diff --git a/lib/tools/emacs/erlang-skels-old.el b/lib/tools/emacs/erlang-skels-old.el index c271cce3cb..4087bc3013 100644 --- a/lib/tools/emacs/erlang-skels-old.el +++ b/lib/tools/emacs/erlang-skels-old.el @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2010. All Rights Reserved. +;; Copyright Ericsson AB 2010-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. @@ -816,7 +816,7 @@ Please see the function `tempo-define-template'.") "%% Note: This directive should only be used in test suites." n "-compile(export_all)." n n - "-include_lib(\"test_server/include/test_server.hrl\")." n n + "-include_lib(\"common_test/include/ct.hrl\")." n n (erlang-skel-separator 2) "%% TEST SERVER CALLBACK FUNCTIONS" n diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 6880ec733c..ce26c83295 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2010-2014. All Rights Reserved. +;; Copyright Ericsson AB 2010-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. @@ -56,6 +56,8 @@ 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) ("wx_object" "wx-object" erlang-skel-wx-object erlang-skel-header) ("Library module" "gen-lib" @@ -858,6 +860,122 @@ 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 + '((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([init/1, terminate/3, code_change/4])." n + "-export([state_name/3])." 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 + "%% 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> + "[gen_statem:action()] | gen_statem:action()} |" n> + "ignore |" n> + "{stop, Reason :: term()}." n + "init([]) ->" n> + "{state_functions, 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 + (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 + "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 + (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 + "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 + "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. +Please see the function `tempo-define-template'.") + (defvar erlang-skel-wx-object '((erlang-skel-include erlang-skel-large-header) "-behaviour(wx_object)." n n @@ -1070,7 +1188,7 @@ Please see the function `tempo-define-template'.") "%% Note: This directive should only be used in test suites." n "-compile(export_all)." n n - "-include_lib(\"test_server/include/test_server.hrl\")." n n + "-include_lib(\"common_test/include/ct.hrl\")." n n (erlang-skel-separator-start 2) "%% TEST SERVER CALLBACK FUNCTIONS" n diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el new file mode 100644 index 0000000000..a5aab04953 --- /dev/null +++ b/lib/tools/emacs/erlang-test.el @@ -0,0 +1,107 @@ +;;; 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) + +(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)) + tags-file-name tags-table-list erlang-buffer) + (unwind-protect + (progn + (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)) + ;; PENDING - setting global tags-file-name is a workaround + ;; for GNU Emacs bug23164. + (setq tags-file-name tags-file) + (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))))) + +(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-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)))) + + +(provide 'erlang-test) + +;;; erlang-test.el ends here diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 466bf139b9..3d20d86f43 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -7,7 +7,7 @@ ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 1996-2014. All Rights Reserved. +;; Copyright Ericsson AB 1996-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. @@ -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)) @@ -897,6 +897,7 @@ resulting regexp is surrounded by \\_< and \\_>." "get_module_info" "get_stacktrace" "hash" + "has_prepared_code_on_load" "hibernate" "insert_element" "is_builtin" @@ -1067,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) @@ -1337,14 +1344,18 @@ 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)))) ;;;###autoload -(defun erlang-mode () +(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 @@ -1403,12 +1414,9 @@ and examples of hooks. Other commands: \\{erlang-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'erlang-mode) - (setq mode-name "Erlang") + ;; Use our own syntax table function + :syntax-table nil (erlang-syntax-table-init) - (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) @@ -1417,13 +1425,13 @@ 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)) + (when (boundp 'xref-backend-functions) + (add-hook 'xref-backend-functions #'erlang-etags--xref-backend nil t)) (run-hooks 'erlang-mode-hook) (if (zerop (buffer-size)) - (run-hooks 'erlang-new-file-hook)) - ;; Doesn't exist in Emacs v21.4; required by Emacs v23. - (if (boundp 'after-change-major-mode-hook) - (run-hooks 'after-change-major-mode-hook))) + (run-hooks 'erlang-new-file-hook))) ;;;###autoload (dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" @@ -1542,7 +1550,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) @@ -2250,6 +2260,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 @@ -2976,8 +2987,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))) @@ -3748,6 +3760,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))) @@ -3818,20 +3836,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 () @@ -3908,7 +3925,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 " ->")) @@ -3920,7 +3937,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) @@ -3950,7 +3967,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." @@ -4036,7 +4053,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 @@ -4076,7 +4093,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) @@ -4552,6 +4569,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 @@ -4645,9 +4667,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 () @@ -4724,37 +4762,6 @@ 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- @@ -4792,10 +4799,10 @@ about Erlang modules." (cond ((and erlang-tags-installed (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. + ;; This depends on the advice called + ;; erlang-replace-tags-table above. It is not enough to + ;; let-bind tags-completion-table-function since that may be + ;; overwritten in etags-recognize-tags-table. (let ((find-tag-default-function 'erlang-find-tag-for-completion)) (complete-tag))) ((and erlang-tags-installed @@ -4917,6 +4924,132 @@ about Erlang modules." (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)) + + ;; PENDING - This remains to be properly implemented. + (cl-defmethod xref-backend-identifier-completion-table + ((_backend (eql erlang-etags))) + (tags-lazy-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. ;;; @@ -5315,8 +5448,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)) @@ -5336,8 +5468,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 @@ -5403,7 +5534,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") @@ -5422,7 +5553,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) @@ -5449,23 +5580,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))) @@ -5505,7 +5634,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)) @@ -5635,12 +5765,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. @@ -5657,16 +5789,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)))) @@ -5769,7 +5899,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) @@ -5787,11 +5917,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 1986acadf1..7a1ff6a954 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-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. @@ -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 7e8ad23412..2552c71baf 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-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. @@ -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()}. |