aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorDan Gudmundsson <[email protected]>2016-05-20 09:19:54 +0200
committerDan Gudmundsson <[email protected]>2016-05-20 09:19:54 +0200
commita02721920321d999a79dfd81494186b3ab3d3d81 (patch)
tree3bbc87bceec51a556dfccbedeb13c7d23418afcf /lib
parent0bc0e3e51a4229245c4111667eec9133a1a8984c (diff)
parent39d33793479fd001dd06505575dd3294fe1d8ce4 (diff)
downloadotp-a02721920321d999a79dfd81494186b3ab3d3d81.tar.gz
otp-a02721920321d999a79dfd81494186b3ab3d3d81.tar.bz2
otp-a02721920321d999a79dfd81494186b3ab3d3d81.zip
Merge branch 'dgud/tools/emacs-xref/PR-1051'
* dgud/tools/emacs-xref/PR-1051: Add xref support in erlang.el Conflicts: lib/tools/emacs/erlang.el
Diffstat (limited to 'lib')
-rw-r--r--lib/tools/emacs/erlang-test.el107
-rw-r--r--lib/tools/emacs/erlang.el249
2 files changed, 302 insertions, 54 deletions
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 4f656e3ae4..aff2c4b2c9 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))
@@ -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)
@@ -1338,11 +1344,15 @@ 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
(define-derived-mode erlang-mode prog-mode "Erlang"
@@ -1415,7 +1425,11 @@ 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)))
@@ -1536,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)
@@ -2244,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
@@ -3813,20 +3830,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 ()
@@ -3903,7 +3919,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 " ->"))
@@ -3915,7 +3931,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)
@@ -3945,7 +3961,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."
@@ -4031,7 +4047,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
@@ -4071,7 +4087,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)
@@ -4547,6 +4563,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
@@ -4747,7 +4768,7 @@ for a tag on the form `module:tag'."
(and found
(or (null mod)
(string= mod (erlang-get-module-from-file-name
- (file-of-tag)))))))
+ (funcall (symbol-function 'file-of-tag))))))))
;;; Tags completion, Emacs 19 `etags' specific.
@@ -4787,10 +4808,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
@@ -4912,6 +4933,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.
;;;
@@ -5310,8 +5457,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))
@@ -5331,8 +5477,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
@@ -5398,7 +5543,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")
@@ -5417,7 +5562,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)
@@ -5444,23 +5589,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)))
@@ -5500,7 +5643,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))
@@ -5630,12 +5774,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.
@@ -5652,16 +5798,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))))
@@ -5764,7 +5908,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)
@@ -5782,11 +5926,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)))))