aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2015-05-05 22:18:19 -0400
committerStefan Monnier2015-05-05 22:18:19 -0400
commita7d630eb4895a392bcc0d9986d1ca5382a4f7b96 (patch)
treea7dba5dd168029652d5640cac86e5c97444c0563
parent0ed044dc1b524370f02f531b3b6fcc1ef45c395d (diff)
downloademacs-a7d630eb4895a392bcc0d9986d1ca5382a4f7b96.tar.gz
emacs-a7d630eb4895a392bcc0d9986d1ca5382a4f7b96.zip
* 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.
-rw-r--r--lisp/cedet/semantic/grammar.el84
-rw-r--r--lisp/emacs-lisp/eldoc.el27
-rw-r--r--lisp/progmodes/elisp-mode.el75
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
628 t) 628 t)
629 (match-string 0)))) 629 (match-string 0))))
630 630
631(defun semantic-grammar--template-expand (template env)
632 (mapconcat (lambda (S)
633 (if (stringp S) S
634 (let ((x (assq S env)))
635 (cond
636 (x (cdr x))
637 ((symbolp S) (symbol-value S))))))
638 template ""))
639
631(defun semantic-grammar-header () 640(defun semantic-grammar-header ()
632 "Return text of a generated standard header." 641 "Return text of a generated standard header."
633 (let ((file (semantic-grammar-buffer-file 642 (semantic-grammar--template-expand
643 semantic-grammar-header-template
644 `((file . ,(semantic-grammar-buffer-file
634 semantic--grammar-output-buffer)) 645 semantic--grammar-output-buffer))
635 (gram (semantic-grammar-buffer-file)) 646 (gram . ,(semantic-grammar-buffer-file))
636 (date (format-time-string "%Y-%m-%d %T%z")) 647 (date . ,(format-time-string "%Y-%m-%d %T%z"))
637 (vcid (concat "$" "Id" "$")) ;; Avoid expansion 648 (vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
638 ;; Try to get the copyright from the input grammar, or 649 ;; Try to get the copyright from the input grammar, or
639 ;; generate a new one if not found. 650 ;; generate a new one if not found.
640 (copy (or (semantic-grammar-copyright-line) 651 (copy . ,(or (semantic-grammar-copyright-line)
641 (concat (format-time-string ";; Copyright (C) %Y ") 652 (concat (format-time-string ";; Copyright (C) %Y ")
642 user-full-name))) 653 user-full-name))))))
643 (out ""))
644 (dolist (S semantic-grammar-header-template)
645 (cond ((stringp S)
646 (setq out (concat out S)))
647 ((symbolp S)
648 (setq out (concat out (symbol-value S))))))
649 out))
650 654
651(defun semantic-grammar-footer () 655(defun semantic-grammar-footer ()
652 "Return text of a generated standard footer." 656 "Return text of a generated standard footer."
653 (let* ((file (semantic-grammar-buffer-file 657 (semantic-grammar--template-expand
654 semantic--grammar-output-buffer)) 658 semantic-grammar-footer-template
655 (libr (or semantic--grammar-provide 659 `((file . ,(semantic-grammar-buffer-file
656 semantic--grammar-package)) 660 semantic--grammar-output-buffer))
657 (out "")) 661 (libr . ,(or semantic--grammar-provide
658 (dolist (S semantic-grammar-footer-template) 662 semantic--grammar-package)))))
659 (cond ((stringp S)
660 (setq out (concat out S)))
661 ((symbolp S)
662 (setq out (concat out (symbol-value S))))))
663 out))
664 663
665(defun semantic-grammar-token-data () 664(defun semantic-grammar-token-data ()
666 "Return the string value of the table of lexical tokens." 665 "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."
714 (let* ((blocks (cdr (semantic-lex-type-value "block" t))) 713 (let* ((blocks (cdr (semantic-lex-type-value "block" t)))
715 (open-delims (cdr (semantic-lex-type-value "open-paren" t))) 714 (open-delims (cdr (semantic-lex-type-value "open-paren" t)))
716 (close-delims (cdr (semantic-lex-type-value "close-paren" t))) 715 (close-delims (cdr (semantic-lex-type-value "close-paren" t)))
717 olist clist block-spec delim-spec open-spec close-spec) 716 olist clist delim-spec open-spec close-spec)
718 (dolist (block-spec blocks) 717 (dolist (block-spec blocks)
719 (setq delim-spec (semantic-grammar--lex-delim-spec block-spec) 718 (setq delim-spec (semantic-grammar--lex-delim-spec block-spec)
720 open-spec (assq (car delim-spec) open-delims) 719 open-spec (assq (car delim-spec) open-delims)
@@ -818,7 +817,7 @@ Block definitions are read from the current table of lexical types."
818 817
819;;; Generation of the grammar support file. 818;;; Generation of the grammar support file.
820;; 819;;
821(defcustom semantic-grammar-file-regexp "\\.[wb]y$" 820(defcustom semantic-grammar-file-regexp "\\.[wb]y\\'"
822 "Regexp which matches grammar source files." 821 "Regexp which matches grammar source files."
823 :group 'semantic 822 :group 'semantic
824 :type 'regexp) 823 :type 'regexp)
@@ -1073,7 +1072,7 @@ See also the variable `semantic-grammar-file-regexp'."
1073(defvar semantic--grammar-macros-regexp-2 nil) 1072(defvar semantic--grammar-macros-regexp-2 nil)
1074(make-variable-buffer-local 'semantic--grammar-macros-regexp-2) 1073(make-variable-buffer-local 'semantic--grammar-macros-regexp-2)
1075 1074
1076(defun semantic--grammar-clear-macros-regexp-2 (&rest ignore) 1075(defun semantic--grammar-clear-macros-regexp-2 (&rest _)
1077 "Clear the cached regexp that match macros local in this grammar. 1076 "Clear the cached regexp that match macros local in this grammar.
1078IGNORE arguments. 1077IGNORE arguments.
1079Added to `before-change-functions' hooks to be run before each text 1078Added 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."
1665 "Return a one-line docstring for the given grammar MACRO. 1664 "Return a one-line docstring for the given grammar MACRO.
1666EXPANDER is the name of the function that expands MACRO." 1665EXPANDER is the name of the function that expands MACRO."
1667 (require 'eldoc) 1666 (require 'eldoc)
1668 (if (eq expander (car semantic-grammar-eldoc-last-data)) 1667 (cond
1669 (cdr semantic-grammar-eldoc-last-data) 1668 ((eq expander (car semantic-grammar-eldoc-last-data))
1670 (let ((doc (help-split-fundoc (documentation expander t) expander))) 1669 (cdr semantic-grammar-eldoc-last-data))
1670 ((fboundp 'eldoc-function-argstring) ;; Emacs<25
1671 (let* ((doc (help-split-fundoc (documentation expander t) expander)))
1671 (cond 1672 (cond
1672 (doc 1673 (doc
1673 (setq doc (car doc)) 1674 (setq doc (car doc))
@@ -1680,7 +1681,16 @@ EXPANDER is the name of the function that expands MACRO."
1680 (eldoc-docstring-format-sym-doc 1681 (eldoc-docstring-format-sym-doc
1681 macro (format "==> %s %s" expander doc) 'default)) 1682 macro (format "==> %s %s" expander doc) 'default))
1682 (setq semantic-grammar-eldoc-last-data (cons expander doc))) 1683 (setq semantic-grammar-eldoc-last-data (cons expander doc)))
1683 doc))) 1684 doc))
1685 ((fboundp 'elisp-get-fnsym-args-string) ;; Emacs≥25
1686 (elisp-get-fnsym-args-string
1687 expander nil
1688 (concat (propertize (symbol-name macro)
1689 'face 'font-lock-keyword-face)
1690 " ==> "
1691 (propertize (symbol-name macro)
1692 'face 'font-lock-function-name-face)
1693 ": ")))))
1684 1694
1685(define-mode-local-override semantic-idle-summary-current-symbol-info 1695(define-mode-local-override semantic-idle-summary-current-symbol-info
1686 semantic-grammar-mode () 1696 semantic-grammar-mode ()
@@ -1711,10 +1721,14 @@ Otherwise return nil."
1711 (setq val (semantic-grammar-eldoc-get-macro-docstring elt val))) 1721 (setq val (semantic-grammar-eldoc-get-macro-docstring elt val)))
1712 ;; Function 1722 ;; Function
1713 ((and elt (fboundp elt)) 1723 ((and elt (fboundp elt))
1714 (setq val (eldoc-get-fnsym-args-string elt))) 1724 (setq val (if (fboundp 'eldoc-get-fnsym-args-string)
1725 (eldoc-get-fnsym-args-string elt)
1726 (elisp-get-fnsym-args-string elt))))
1715 ;; Variable 1727 ;; Variable
1716 ((and elt (boundp elt)) 1728 ((and elt (boundp elt))
1717 (setq val (eldoc-get-var-docstring elt))) 1729 (setq val (if (fboundp 'eldoc-get-var-docstring)
1730 (eldoc-get-var-docstring elt)
1731 (elisp-get-var-docstring elt))))
1718 (t nil))) 1732 (t nil)))
1719 (or val (semantic-idle-summary-current-symbol-info-default)))) 1733 (or val (semantic-idle-summary-current-symbol-info-default))))
1720 1734
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.")
354 nil)) 354 nil))
355 (eldoc-message (funcall eldoc-documentation-function))))) 355 (eldoc-message (funcall eldoc-documentation-function)))))
356 356
357 357;; If the entire line cannot fit in the echo area, the symbol name may be
358;; truncated or eliminated entirely from the output to make room for the
359;; description.
360(defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
361 (when (symbolp prefix)
362 (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
363 (let* ((ea-multi eldoc-echo-area-use-multiline-p)
364 ;; Subtract 1 from window width since emacs will not write
365 ;; any chars to the last column, or in later versions, will
366 ;; cause a wraparound and resize of the echo area.
367 (ea-width (1- (window-width (minibuffer-window))))
368 (strip (- (+ (length prefix) (length doc)) ea-width)))
369 (cond ((or (<= strip 0)
370 (eq ea-multi t)
371 (and ea-multi (> (length doc) ea-width)))
372 (concat prefix doc))
373 ((> (length doc) ea-width)
374 (substring (format "%s" doc) 0 ea-width))
375 ((>= strip (string-match-p ":? *\\'" prefix))
376 doc)
377 (t
378 ;; Show the end of the partial symbol name, rather
379 ;; than the beginning, since the former is more likely
380 ;; to be unique given package namespace conventions.
381 (concat (substring prefix strip) doc)))))
382
358;; When point is in a sexp, the function args are not reprinted in the echo 383;; When point is in a sexp, the function args are not reprinted in the echo
359;; area after every possible interactive command because some of them print 384;; area after every possible interactive command because some of them print
360;; their own messages in the echo area; the eldoc functions would instantly 385;; 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."
650 lst)))) 650 lst))))
651 lst))) 651 lst)))
652 652
653(defvar package-user-dir)
654
653(defun elisp--xref-find-references (symbol) 655(defun elisp--xref-find-references (symbol)
654 (let* ((dirs (sort 656 (let* ((dirs (sort
655 (mapcar 657 (mapcar
656 (lambda (dir) 658 (lambda (dir)
657 (file-name-as-directory (expand-file-name dir))) 659 (file-name-as-directory (expand-file-name dir)))
660 ;; FIXME: Why add package-user-dir?
658 (cons package-user-dir load-path)) 661 (cons package-user-dir load-path))
659 #'string<)) 662 #'string<))
660 (ref dirs)) 663 (ref dirs))
@@ -1174,13 +1177,13 @@ which see."
1174 (cond ((null current-fnsym) 1177 (cond ((null current-fnsym)
1175 nil) 1178 nil)
1176 ((eq current-symbol (car current-fnsym)) 1179 ((eq current-symbol (car current-fnsym))
1177 (or (apply #'elisp--get-fnsym-args-string current-fnsym) 1180 (or (apply #'elisp-get-fnsym-args-string current-fnsym)
1178 (elisp--get-var-docstring current-symbol))) 1181 (elisp-get-var-docstring current-symbol)))
1179 (t 1182 (t
1180 (or (elisp--get-var-docstring current-symbol) 1183 (or (elisp-get-var-docstring current-symbol)
1181 (apply #'elisp--get-fnsym-args-string current-fnsym)))))) 1184 (apply #'elisp-get-fnsym-args-string current-fnsym))))))
1182 1185
1183(defun elisp--get-fnsym-args-string (sym &optional index) 1186(defun elisp-get-fnsym-args-string (sym &optional index prefix)
1184 "Return a string containing the parameter list of the function SYM. 1187 "Return a string containing the parameter list of the function SYM.
1185If SYM is a subr and no arglist is obtainable from the docstring 1188If SYM is a subr and no arglist is obtainable from the docstring
1186or elsewhere, return a 1-line docstring." 1189or elsewhere, return a 1-line docstring."
@@ -1204,16 +1207,22 @@ or elsewhere, return a 1-line docstring."
1204 (car doc)) 1207 (car doc))
1205 (t (help-function-arglist sym))))) 1208 (t (help-function-arglist sym)))))
1206 ;; Stringify, and store before highlighting, downcasing, etc. 1209 ;; Stringify, and store before highlighting, downcasing, etc.
1207 ;; FIXME should truncate before storing. 1210 (elisp--last-data-store sym (elisp-function-argstring args)
1208 (elisp--last-data-store sym (elisp--function-argstring args)
1209 'function)))))) 1211 'function))))))
1210 ;; Highlight, truncate. 1212 ;; Highlight, truncate.
1211 (if argstring 1213 (if argstring
1212 (elisp--highlight-function-argument sym argstring index)))) 1214 (elisp--highlight-function-argument
1213 1215 sym argstring index
1214(defun elisp--highlight-function-argument (sym args index) 1216 (or prefix
1217 (concat (propertize (symbol-name sym) 'face
1218 (if (functionp sym)
1219 'font-lock-function-name-face
1220 'font-lock-keyword-face))
1221 ": "))))))
1222
1223(defun elisp--highlight-function-argument (sym args index prefix)
1215 "Highlight argument INDEX in ARGS list for function SYM. 1224 "Highlight argument INDEX in ARGS list for function SYM.
1216In the absence of INDEX, just call `elisp--docstring-format-sym-doc'." 1225In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
1217 ;; FIXME: This should probably work on the list representation of `args' 1226 ;; FIXME: This should probably work on the list representation of `args'
1218 ;; rather than its string representation. 1227 ;; rather than its string representation.
1219 ;; FIXME: This function is much too long, we need to split it up! 1228 ;; 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'."
1298 ((string= argument "&allow-other-keys")) ; Skip. 1307 ((string= argument "&allow-other-keys")) ; Skip.
1299 ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc... 1308 ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
1300 ;; like in `setq'. 1309 ;; like in `setq'.
1301 ((or (and (string-match-p "\\.\\.\\.$" argument) 1310 ((or (and (string-match-p "\\.\\.\\.\\'" argument)
1302 (string= argument (car (last args-lst)))) 1311 (string= argument (car (last args-lst))))
1303 (and (string-match-p "\\.\\.\\.$" 1312 (and (string-match-p "\\.\\.\\.\\'"
1304 (substring args 1 (1- (length args)))) 1313 (substring args 1 (1- (length args))))
1305 (= (length (remove "..." args-lst)) 2) 1314 (= (length (remove "..." args-lst)) 2)
1306 (> index 1) (eq (logand index 1) 1))) 1315 (> index 1) (eq (logand index 1) 1)))
@@ -1315,14 +1324,12 @@ In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1315 (when start 1324 (when start
1316 (setq doc (copy-sequence args)) 1325 (setq doc (copy-sequence args))
1317 (add-text-properties start end (list 'face argument-face) doc)) 1326 (add-text-properties start end (list 'face argument-face) doc))
1318 (setq doc (elisp--docstring-format-sym-doc 1327 (setq doc (eldoc-docstring-format-sym-doc prefix doc))
1319 sym doc (if (functionp sym) 'font-lock-function-name-face
1320 'font-lock-keyword-face)))
1321 doc))) 1328 doc)))
1322 1329
1323;; Return a string containing a brief (one-line) documentation string for 1330;; Return a string containing a brief (one-line) documentation string for
1324;; the variable. 1331;; the variable.
1325(defun elisp--get-var-docstring (sym) 1332(defun elisp-get-var-docstring (sym)
1326 (cond ((not sym) nil) 1333 (cond ((not sym) nil)
1327 ((and (eq sym (aref elisp--eldoc-last-data 0)) 1334 ((and (eq sym (aref elisp--eldoc-last-data 0))
1328 (eq 'variable (aref elisp--eldoc-last-data 2))) 1335 (eq 'variable (aref elisp--eldoc-last-data 2)))
@@ -1330,7 +1337,7 @@ In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1330 (t 1337 (t
1331 (let ((doc (documentation-property sym 'variable-documentation t))) 1338 (let ((doc (documentation-property sym 'variable-documentation t)))
1332 (when doc 1339 (when doc
1333 (let ((doc (elisp--docstring-format-sym-doc 1340 (let ((doc (eldoc-docstring-format-sym-doc
1334 sym (elisp--docstring-first-line doc) 1341 sym (elisp--docstring-first-line doc)
1335 'font-lock-variable-name-face))) 1342 'font-lock-variable-name-face)))
1336 (elisp--last-data-store sym doc 'variable))))))) 1343 (elisp--last-data-store sym doc 'variable)))))))
@@ -1354,36 +1361,6 @@ In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1354 (substring doc start (match-beginning 0))) 1361 (substring doc start (match-beginning 0)))
1355 ((zerop start) doc) 1362 ((zerop start) doc)
1356 (t (substring doc start)))))))) 1363 (t (substring doc start))))))))
1357
1358(defvar eldoc-echo-area-use-multiline-p)
1359
1360;; If the entire line cannot fit in the echo area, the symbol name may be
1361;; truncated or eliminated entirely from the output to make room for the
1362;; description.
1363(defun elisp--docstring-format-sym-doc (sym doc face)
1364 (save-match-data
1365 (let* ((name (symbol-name sym))
1366 (ea-multi eldoc-echo-area-use-multiline-p)
1367 ;; Subtract 1 from window width since emacs will not write
1368 ;; any chars to the last column, or in later versions, will
1369 ;; cause a wraparound and resize of the echo area.
1370 (ea-width (1- (window-width (minibuffer-window))))
1371 (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
1372 (cond ((or (<= strip 0)
1373 (eq ea-multi t)
1374 (and ea-multi (> (length doc) ea-width)))
1375 (format "%s: %s" (propertize name 'face face) doc))
1376 ((> (length doc) ea-width)
1377 (substring (format "%s" doc) 0 ea-width))
1378 ((>= strip (length name))
1379 (format "%s" doc))
1380 (t
1381 ;; Show the end of the partial symbol name, rather
1382 ;; than the beginning, since the former is more likely
1383 ;; to be unique given package namespace conventions.
1384 (setq name (substring name strip))
1385 (format "%s: %s" (propertize name 'face face) doc))))))
1386
1387 1364
1388;; Return a list of current function name and argument index. 1365;; Return a list of current function name and argument index.
1389(defun elisp--fnsym-in-current-sexp () 1366(defun elisp--fnsym-in-current-sexp ()
@@ -1428,7 +1405,7 @@ In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1428 (memq (char-syntax c) '(?w ?_)) 1405 (memq (char-syntax c) '(?w ?_))
1429 (intern-soft (current-word))))) 1406 (intern-soft (current-word)))))
1430 1407
1431(defun elisp--function-argstring (arglist) 1408(defun elisp-function-argstring (arglist)
1432 "Return ARGLIST as a string enclosed by (). 1409 "Return ARGLIST as a string enclosed by ().
1433ARGLIST is either a string, or a list of strings or symbols." 1410ARGLIST is either a string, or a list of strings or symbols."
1434 (let ((str (cond ((stringp arglist) arglist) 1411 (let ((str (cond ((stringp arglist) arglist)