(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.
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."
(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)
\f
;;; 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)
(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
"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))
(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 ()
(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))))
nil))
(eldoc-message (funcall eldoc-documentation-function)))))
-\f
+;; 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
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))
(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."
(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!
((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)))
(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)))
(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)))))))
(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))))))
-
\f
;; Return a list of current function name and argument index.
(defun elisp--fnsym-in-current-sexp ()
(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)
projects / emacs.git / commitdiff