From a7d630eb4895a392bcc0d9986d1ca5382a4f7b96 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 5 May 2015 22:18:19 -0400 Subject: [PATCH] * 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 15ad9872446..fc7e9e61a16 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 d527d676d51..0091cdb8484 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 dac807e4334..7bc7798be03 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) -- 2.39.2