aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDan Gudmundsson <[email protected]>2016-08-31 16:40:54 +0200
committerDan Gudmundsson <[email protected]>2016-08-31 16:40:54 +0200
commit0d36aebf9384cc7d86d74bb328b1257737722002 (patch)
tree2f5b6835ef3546b1e3a56801b8a2dac626df1990
parent2652d2f9b9f58746b80786fe7e62ae36b09bc890 (diff)
parent248b703336c579db280f0d5dab71a4a9149b3b89 (diff)
downloadotp-0d36aebf9384cc7d86d74bb328b1257737722002.tar.gz
otp-0d36aebf9384cc7d86d74bb328b1257737722002.tar.bz2
otp-0d36aebf9384cc7d86d74bb328b1257737722002.zip
Merge branch 'dgud/tools/emacs-mode-tag-fixes/PR-1106' into maint
* dgud/tools/emacs-mode-tag-fixes/PR-1106: Emacs: make tags unit test more robust Emacs: extend support for compile options Function instead of lambda in advice Enable tag completion in emacs erlang shell
-rw-r--r--lib/tools/emacs/erlang-test.el106
-rw-r--r--lib/tools/emacs/erlang.el112
2 files changed, 131 insertions, 87 deletions
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
index 9a146632c5..ba6190d194 100644
--- a/lib/tools/emacs/erlang-test.el
+++ b/lib/tools/emacs/erlang-test.el
@@ -52,28 +52,42 @@ 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))
- ;; Setting global tags-file-name is a workaround for
- ;; GNU Emacs bug#23164.
- (setq tags-file-name 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)))))
+ (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
@@ -116,6 +130,54 @@ concatenated to form an erlang file to test on.")
(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)
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index a2062180f3..73c6b8d768 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -1436,8 +1436,6 @@ Other commands:
(erlang-skel-init)
(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)))
@@ -1548,9 +1546,7 @@ Other commands:
(set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$")
(set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'add-log-current-defun-function)
- 'erlang-current-defun)
- (set (make-local-variable 'find-tag-default-function)
- 'erlang-find-tag-for-completion))
+ 'erlang-current-defun))
(defun erlang-font-lock-init ()
"Initialize Font Lock for Erlang mode."
@@ -3233,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."
@@ -4352,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.)"
@@ -4367,11 +4356,16 @@ 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.
- (when (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))))))
@@ -4775,8 +4769,6 @@ for a tag on the form `module:tag'."
;;; completion-table' containing all normal tags plus tags on the form
;;; `module:tag' and `module:'.
-;; PENDING - Should probably make use of the
-;; `completion-at-point-functions' hook instead of this advice.
(when (and (locate-library "etags")
(require 'etags)
(fboundp 'etags-tags-completion-table)
@@ -4784,11 +4776,7 @@ for a tag on the form `module:tag'."
(if (fboundp 'advice-add)
;; Emacs 24.4+
(advice-add 'etags-tags-completion-table :around
- (lambda (oldfun)
- (if erlang-replace-etags-tags-completion-table
- (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
@@ -4797,6 +4785,11 @@ for a tag on the form `module:tag'."
(setq ad-return-value (erlang-etags-tags-completion-table))
ad-do-it))))
+(defun erlang-etags-tags-completion-table-advice (oldfun)
+ (if erlang-replace-etags-tags-completion-table
+ (erlang-etags-tags-completion-table)
+ (funcall oldfun)))
+
(defun erlang-complete-tag ()
"Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table.
@@ -4807,8 +4800,7 @@ 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+
(let ((erlang-replace-etags-tags-completion-table t))
(complete-tag)))
@@ -5213,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
@@ -5251,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))
@@ -5730,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,