Commit a7d630eb authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 0ed044dc
......@@ -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))))
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment