[Emacs-diffs] master a7d630e: * lisp/cedet/semantic/grammar.el: Fix compiler warnings (bug#20505)

[Stefan Monnier]

branch: master
commit a7d630eb4895a392bcc0d9986d1ca5382a4f7b96
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/cedet/semantic/grammar.el: Fix compiler warnings (bug#20505)
    
    (semantic-grammar--template-expand): New function.
    (semantic-grammar-header, semantic-grammar-footer): Use it.
    (semantic-grammar--lex-block-specs): Remove unused var `block-spec'.
    (semantic-grammar-file-regexp): Refine regexp.
    (semantic-grammar-eldoc-get-macro-docstring):
    Use elisp-get-fnsym-args-string when available.
    (semantic-idle-summary-current-symbol-info): Use new elisp-* names
    instead of the old eldoc-* names.
    
    * lisp/emacs-lisp/eldoc.el (eldoc-docstring-format-sym-doc): Move back
    from elisp-mode.el.  Tweak calling convention.
    
    * lisp/progmodes/elisp-mode.el (package-user-dir): Declare.
    (elisp-get-fnsym-args-string): Add `prefix' argument.  Rename from
    elisp--get-fnsym-args-string.
    (elisp--highlight-function-argument): Add `prefix' arg.
    (elisp-get-var-docstring): Rename from elisp--get-var-docstring.
    (elisp--docstring-format-sym-doc): Move back to eldoc.el.
---
 lisp/cedet/semantic/grammar.el |   84 +++++++++++++++++++++++----------------
 lisp/emacs-lisp/eldoc.el       |   27 ++++++++++++-
 lisp/progmodes/elisp-mode.el   |   75 ++++++++++++-----------------------
 3 files changed, 101 insertions(+), 85 deletions(-)

diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 15ad987..fc7e9e6 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -628,39 +628,38 @@ The symbols in the list are local variables in
                              t)
       (match-string 0))))
 
+(defun semantic-grammar--template-expand (template env)
+  (mapconcat (lambda (S)
+               (if (stringp S) S
+                 (let ((x (assq S env)))
+                   (cond
+                    (x (cdr x))
+                    ((symbolp S) (symbol-value S))))))
+             template ""))
+
 (defun semantic-grammar-header ()
   "Return text of a generated standard header."
-  (let ((file (semantic-grammar-buffer-file
+  (semantic-grammar--template-expand
+   semantic-grammar-header-template
+   `((file . ,(semantic-grammar-buffer-file
                semantic--grammar-output-buffer))
-        (gram (semantic-grammar-buffer-file))
-        (date (format-time-string "%Y-%m-%d %T%z"))
-        (vcid (concat "$" "Id" "$")) ;; Avoid expansion
-        ;; Try to get the copyright from the input grammar, or
-        ;; generate a new one if not found.
-        (copy (or (semantic-grammar-copyright-line)
+     (gram . ,(semantic-grammar-buffer-file))
+     (date . ,(format-time-string "%Y-%m-%d %T%z"))
+     (vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
+     ;; Try to get the copyright from the input grammar, or
+     ;; generate a new one if not found.
+     (copy . ,(or (semantic-grammar-copyright-line)
                   (concat (format-time-string ";; Copyright (C) %Y ")
-                          user-full-name)))
-       (out ""))
-    (dolist (S semantic-grammar-header-template)
-      (cond ((stringp S)
-            (setq out (concat out S)))
-           ((symbolp S)
-            (setq out (concat out (symbol-value S))))))
-    out))
+                          user-full-name))))))
 
 (defun semantic-grammar-footer ()
   "Return text of a generated standard footer."
-  (let* ((file (semantic-grammar-buffer-file
-                semantic--grammar-output-buffer))
-         (libr (or semantic--grammar-provide
-                  semantic--grammar-package))
-        (out ""))
-    (dolist (S semantic-grammar-footer-template)
-      (cond ((stringp S)
-            (setq out (concat out S)))
-           ((symbolp S)
-            (setq out (concat out (symbol-value S))))))
-    out))
+  (semantic-grammar--template-expand
+   semantic-grammar-footer-template
+   `((file . ,(semantic-grammar-buffer-file
+               semantic--grammar-output-buffer))
+     (libr . ,(or semantic--grammar-provide
+                  semantic--grammar-package)))))
 
 (defun semantic-grammar-token-data ()
   "Return the string value of the table of lexical tokens."
@@ -714,7 +713,7 @@ Block definitions are read from the current table of 
lexical types."
         (let* ((blocks       (cdr (semantic-lex-type-value "block" t)))
                (open-delims  (cdr (semantic-lex-type-value "open-paren" t)))
                (close-delims (cdr (semantic-lex-type-value "close-paren" t)))
-               olist clist block-spec delim-spec open-spec close-spec)
+               olist clist delim-spec open-spec close-spec)
           (dolist (block-spec blocks)
             (setq delim-spec (semantic-grammar--lex-delim-spec block-spec)
                   open-spec  (assq (car  delim-spec) open-delims)
@@ -818,7 +817,7 @@ Block definitions are read from the current table of 
lexical types."
 
 ;;; Generation of the grammar support file.
 ;;
-(defcustom semantic-grammar-file-regexp "\\.[wb]y$"
+(defcustom semantic-grammar-file-regexp "\\.[wb]y\\'"
   "Regexp which matches grammar source files."
   :group 'semantic
   :type 'regexp)
@@ -1073,7 +1072,7 @@ See also the variable `semantic-grammar-file-regexp'."
 (defvar semantic--grammar-macros-regexp-2 nil)
 (make-variable-buffer-local 'semantic--grammar-macros-regexp-2)
 
-(defun semantic--grammar-clear-macros-regexp-2 (&rest ignore)
+(defun semantic--grammar-clear-macros-regexp-2 (&rest _)
   "Clear the cached regexp that match macros local in this grammar.
 IGNORE arguments.
 Added to `before-change-functions' hooks to be run before each text
@@ -1665,9 +1664,11 @@ Select the buffer containing the tag's definition, and 
move point there."
   "Return a one-line docstring for the given grammar MACRO.
 EXPANDER is the name of the function that expands MACRO."
   (require 'eldoc)
-  (if (eq expander (car semantic-grammar-eldoc-last-data))
-      (cdr semantic-grammar-eldoc-last-data)
-    (let ((doc (help-split-fundoc (documentation expander t) expander)))
+  (cond
+   ((eq expander (car semantic-grammar-eldoc-last-data))
+    (cdr semantic-grammar-eldoc-last-data))
+   ((fboundp 'eldoc-function-argstring) ;; Emacs<25
+    (let* ((doc (help-split-fundoc (documentation expander t) expander)))
       (cond
        (doc
         (setq doc (car doc))
@@ -1680,7 +1681,16 @@ EXPANDER is the name of the function that expands MACRO."
              (eldoc-docstring-format-sym-doc
               macro (format "==> %s %s" expander doc) 'default))
         (setq semantic-grammar-eldoc-last-data (cons expander doc)))
-      doc)))
+      doc))
+   ((fboundp 'elisp-get-fnsym-args-string) ;; Emacs≥25
+    (elisp-get-fnsym-args-string
+     expander nil
+     (concat (propertize (symbol-name macro)
+                         'face 'font-lock-keyword-face)
+             " ==> "
+             (propertize (symbol-name macro)
+                         'face 'font-lock-function-name-face)
+             ": ")))))
 
 (define-mode-local-override semantic-idle-summary-current-symbol-info
   semantic-grammar-mode ()
@@ -1711,10 +1721,14 @@ Otherwise return nil."
         (setq val (semantic-grammar-eldoc-get-macro-docstring elt val)))
        ;; Function
        ((and elt (fboundp elt))
-        (setq val (eldoc-get-fnsym-args-string elt)))
+        (setq val (if (fboundp 'eldoc-get-fnsym-args-string)
+                      (eldoc-get-fnsym-args-string elt)
+                    (elisp-get-fnsym-args-string elt))))
        ;; Variable
        ((and elt (boundp elt))
-        (setq val (eldoc-get-var-docstring elt)))
+        (setq val (if (fboundp 'eldoc-get-var-docstring)
+                      (eldoc-get-var-docstring elt)
+                    (elisp-get-var-docstring elt))))
        (t nil)))
     (or val (semantic-idle-summary-current-symbol-info-default))))
 
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index d527d67..0091cdb 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -354,7 +354,32 @@ return any documentation.")
                nil))
         (eldoc-message (funcall eldoc-documentation-function)))))
 
-
+;; If the entire line cannot fit in the echo area, the symbol name may be
+;; truncated or eliminated entirely from the output to make room for the
+;; description.
+(defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
+  (when (symbolp prefix)
+    (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
+  (let* ((ea-multi eldoc-echo-area-use-multiline-p)
+         ;; Subtract 1 from window width since emacs will not write
+         ;; any chars to the last column, or in later versions, will
+         ;; cause a wraparound and resize of the echo area.
+         (ea-width (1- (window-width (minibuffer-window))))
+         (strip (- (+ (length prefix) (length doc)) ea-width)))
+    (cond ((or (<= strip 0)
+               (eq ea-multi t)
+               (and ea-multi (> (length doc) ea-width)))
+           (concat prefix doc))
+          ((> (length doc) ea-width)
+           (substring (format "%s" doc) 0 ea-width))
+          ((>= strip (string-match-p ":? *\\'" prefix))
+           doc)
+          (t
+           ;; Show the end of the partial symbol name, rather
+           ;; than the beginning, since the former is more likely
+           ;; to be unique given package namespace conventions.
+           (concat (substring prefix strip) doc)))))
+
 ;; When point is in a sexp, the function args are not reprinted in the echo
 ;; area after every possible interactive command because some of them print
 ;; their own messages in the echo area; the eldoc functions would instantly
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index dac807e..7bc7798 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -650,11 +650,14 @@ It can be quoted, or be inside a quoted form."
              lst))))
       lst)))
 
+(defvar package-user-dir)
+
 (defun elisp--xref-find-references (symbol)
   (let* ((dirs (sort
                 (mapcar
                  (lambda (dir)
                    (file-name-as-directory (expand-file-name dir)))
+                 ;; FIXME: Why add package-user-dir?
                  (cons package-user-dir load-path))
                 #'string<))
          (ref dirs))
@@ -1174,13 +1177,13 @@ which see."
     (cond ((null current-fnsym)
           nil)
          ((eq current-symbol (car current-fnsym))
-          (or (apply #'elisp--get-fnsym-args-string current-fnsym)
-              (elisp--get-var-docstring current-symbol)))
+          (or (apply #'elisp-get-fnsym-args-string current-fnsym)
+              (elisp-get-var-docstring current-symbol)))
          (t
-          (or (elisp--get-var-docstring current-symbol)
-              (apply #'elisp--get-fnsym-args-string current-fnsym))))))
+          (or (elisp-get-var-docstring current-symbol)
+              (apply #'elisp-get-fnsym-args-string current-fnsym))))))
 
-(defun elisp--get-fnsym-args-string (sym &optional index)
+(defun elisp-get-fnsym-args-string (sym &optional index prefix)
   "Return a string containing the parameter list of the function SYM.
 If SYM is a subr and no arglist is obtainable from the docstring
 or elsewhere, return a 1-line docstring."
@@ -1204,16 +1207,22 @@ or elsewhere, return a 1-line docstring."
                     (car doc))
                    (t (help-function-arglist sym)))))
              ;; Stringify, and store before highlighting, downcasing, etc.
-             ;; FIXME should truncate before storing.
-            (elisp--last-data-store sym (elisp--function-argstring args)
+            (elisp--last-data-store sym (elisp-function-argstring args)
                                     'function))))))
     ;; Highlight, truncate.
     (if argstring
-       (elisp--highlight-function-argument sym argstring index))))
-
-(defun elisp--highlight-function-argument (sym args index)
+       (elisp--highlight-function-argument
+         sym argstring index
+         (or prefix
+             (concat (propertize (symbol-name sym) 'face
+                                 (if (functionp sym)
+                                     'font-lock-function-name-face
+                                   'font-lock-keyword-face))
+                     ": "))))))
+
+(defun elisp--highlight-function-argument (sym args index prefix)
   "Highlight argument INDEX in ARGS list for function SYM.
-In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
+In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
   ;; FIXME: This should probably work on the list representation of `args'
   ;; rather than its string representation.
   ;; FIXME: This function is much too long, we need to split it up!
@@ -1298,9 +1307,9 @@ In the absence of INDEX, just call 
`elisp--docstring-format-sym-doc'."
                     ((string= argument "&allow-other-keys")) ; Skip.
                     ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
                     ;; like in `setq'.
-                   ((or (and (string-match-p "\\.\\.\\.$" argument)
+                   ((or (and (string-match-p "\\.\\.\\.\\'" argument)
                               (string= argument (car (last args-lst))))
-                         (and (string-match-p "\\.\\.\\.$"
+                         (and (string-match-p "\\.\\.\\.\\'"
                                               (substring args 1 (1- (length 
args))))
                               (= (length (remove "..." args-lst)) 2)
                               (> index 1) (eq (logand index 1) 1)))
@@ -1315,14 +1324,12 @@ In the absence of INDEX, just call 
`elisp--docstring-format-sym-doc'."
       (when start
        (setq doc (copy-sequence args))
        (add-text-properties start end (list 'face argument-face) doc))
-      (setq doc (elisp--docstring-format-sym-doc
-                sym doc (if (functionp sym) 'font-lock-function-name-face
-                           'font-lock-keyword-face)))
+      (setq doc (eldoc-docstring-format-sym-doc prefix doc))
       doc)))
 
 ;; Return a string containing a brief (one-line) documentation string for
 ;; the variable.
-(defun elisp--get-var-docstring (sym)
+(defun elisp-get-var-docstring (sym)
   (cond ((not sym) nil)
         ((and (eq sym (aref elisp--eldoc-last-data 0))
               (eq 'variable (aref elisp--eldoc-last-data 2)))
@@ -1330,7 +1337,7 @@ In the absence of INDEX, just call 
`elisp--docstring-format-sym-doc'."
         (t
          (let ((doc (documentation-property sym 'variable-documentation t)))
            (when doc
-             (let ((doc (elisp--docstring-format-sym-doc
+             (let ((doc (eldoc-docstring-format-sym-doc
                          sym (elisp--docstring-first-line doc)
                          'font-lock-variable-name-face)))
                (elisp--last-data-store sym doc 'variable)))))))
@@ -1354,36 +1361,6 @@ In the absence of INDEX, just call 
`elisp--docstring-format-sym-doc'."
                    (substring doc start (match-beginning 0)))
                   ((zerop start) doc)
                   (t (substring doc start))))))))
-
-(defvar eldoc-echo-area-use-multiline-p)
-
-;; If the entire line cannot fit in the echo area, the symbol name may be
-;; truncated or eliminated entirely from the output to make room for the
-;; description.
-(defun elisp--docstring-format-sym-doc (sym doc face)
-  (save-match-data
-    (let* ((name (symbol-name sym))
-           (ea-multi eldoc-echo-area-use-multiline-p)
-           ;; Subtract 1 from window width since emacs will not write
-           ;; any chars to the last column, or in later versions, will
-           ;; cause a wraparound and resize of the echo area.
-           (ea-width (1- (window-width (minibuffer-window))))
-           (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
-      (cond ((or (<= strip 0)
-                 (eq ea-multi t)
-                 (and ea-multi (> (length doc) ea-width)))
-             (format "%s: %s" (propertize name 'face face) doc))
-            ((> (length doc) ea-width)
-             (substring (format "%s" doc) 0 ea-width))
-            ((>= strip (length name))
-             (format "%s" doc))
-            (t
-             ;; Show the end of the partial symbol name, rather
-             ;; than the beginning, since the former is more likely
-             ;; to be unique given package namespace conventions.
-             (setq name (substring name strip))
-             (format "%s: %s" (propertize name 'face face) doc))))))
-
 
 ;; Return a list of current function name and argument index.
 (defun elisp--fnsym-in-current-sexp ()
@@ -1428,7 +1405,7 @@ In the absence of INDEX, just call 
`elisp--docstring-format-sym-doc'."
          (memq (char-syntax c) '(?w ?_))
          (intern-soft (current-word)))))
 
-(defun elisp--function-argstring (arglist)
+(defun elisp-function-argstring (arglist)
   "Return ARGLIST as a string enclosed by ().
 ARGLIST is either a string, or a list of strings or symbols."
   (let ((str (cond ((stringp arglist) arglist)