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

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,