X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d7df36e745a5ba480559b6c8b5ebc93a18fe9bd1..001d88b62ecb8163a148656acb103b354ce7613a:/lisp/progmodes/elisp-mode.el diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 41ca57f668..5f9bdaccd0 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1,6 +1,6 @@ ;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*- -;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1999-2016 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: lisp, languages @@ -228,32 +228,25 @@ Blank lines separate paragraphs. Semicolons start comments. \\{emacs-lisp-mode-map}" :group 'lisp - (defvar xref-find-function) - (defvar xref-identifier-completion-table-function) - (defvar project-search-path-function) + (defvar project-vc-external-roots-function) (lisp-mode-variables nil nil 'elisp) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) (setq-local electric-pair-text-pairs (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs)) (setq-local electric-quote-string t) (setq imenu-case-fold-search nil) - (add-function :before-until (local 'eldoc-documentation-function) - #'elisp-eldoc-documentation-function) - (setq-local xref-find-function #'elisp-xref-find) - (setq-local xref-identifier-completion-table-function - #'elisp--xref-identifier-completion-table) - (setq-local project-search-path-function #'elisp-search-path) + (add-hook 'eldoc-documentation-functions + #'elisp-eldoc-documentation-function nil t) + (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) + (setq-local project-vc-external-roots-function #'elisp-load-path-roots) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local)) ;; Font-locking support. (defun elisp--font-lock-flush-elisp-buffers (&optional file) - ;; FIXME: Aren't we only ever called from after-load-functions? - ;; Don't flush during load unless called from after-load-functions. - ;; In that case, FILE is non-nil. It's somehow strange that - ;; load-in-progress is t when an after-load-function is called since - ;; that should run *after* the load... + ;; We're only ever called from after-load-functions, load-in-progress can + ;; still be t in case of nested loads. (when (or (not load-in-progress) file) ;; FIXME: If the loaded file did not define any macros, there shouldn't ;; be any need to font-lock-flush all the Elisp buffers. @@ -579,8 +572,9 @@ It can be quoted, or be inside a quoted form." " " (cadr table-etc))) (cddr table-etc))))))))) -(define-obsolete-function-alias - 'lisp-completion-at-point 'elisp-completion-at-point "25.1") +(defun lisp-completion-at-point (&optional _predicate) + (declare (obsolete elisp-completion-at-point "25.1")) + (elisp-completion-at-point)) ;;; Xref backend @@ -588,145 +582,219 @@ It can be quoted, or be inside a quoted form." (declare-function xref-make "xref" (summary location)) (declare-function xref-collect-references "xref" (symbol dir)) -(defun elisp-xref-find (action id) - (require 'find-func) - (pcase action - (`definitions - (let ((sym (intern-soft id))) - (when sym - (elisp--xref-find-definitions sym)))) - (`references - (elisp--xref-find-references id)) - (`apropos - (elisp--xref-find-apropos id)))) - -(defconst elisp--xref-format +(defun elisp--xref-backend () 'elisp) + +;; WORKAROUND: This is nominally a constant, but the text properties +;; are not preserved thru dump if use defconst. See bug#21237. +(defvar elisp--xref-format (let ((str "(%s %s)")) (put-text-property 1 3 'face 'font-lock-keyword-face str) (put-text-property 4 6 'face 'font-lock-function-name-face str) str)) -(defconst elisp--xref-format-cl-defmethod +;; WORKAROUND: This is nominally a constant, but the text properties +;; are not preserved thru dump if use defconst. See bug#21237. +(defvar elisp--xref-format-extra (let ((str "(%s %s %s)")) (put-text-property 1 3 'face 'font-lock-keyword-face str) (put-text-property 4 6 'face 'font-lock-function-name-face str) str)) -(defcustom find-feature-regexp - (concat "(provide +'%s)") - "The regexp used by `xref-find-definitions' to search for a feature definition. -Note it must contain a `%s' at the place where `format' -should insert the feature name." - :type 'regexp - :group 'xref - :version "25.0") - -(defcustom find-alias-regexp - "(\\(defalias +'\\|def\\(const\\|face\\) +\\)%s" - "The regexp used by `xref-find-definitions' to search for an alias definition. -Note it must contain a `%s' at the place where `format' -should insert the feature name." - :type 'regexp - :group 'xref - :version "25.0") - -(with-eval-after-load 'find-func - (defvar find-function-regexp-alist) - (add-to-list 'find-function-regexp-alist (cons 'feature 'find-feature-regexp)) - (add-to-list 'find-function-regexp-alist (cons 'defalias 'find-alias-regexp))) +(defvar find-feature-regexp);; in find-func.el (defun elisp--xref-make-xref (type symbol file &optional summary) "Return an xref for TYPE SYMBOL in FILE. -TYPE must be a type in 'find-function-regexp-alist' (use nil for +TYPE must be a type in `find-function-regexp-alist' (use nil for 'defun). If SUMMARY is non-nil, use it for the summary; otherwise build the summary from TYPE and SYMBOL." (xref-make (or summary (format elisp--xref-format (or type 'defun) symbol)) (xref-make-elisp-location symbol type file))) +(defvar elisp-xref-find-def-functions nil + "List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs. +Called with one arg; the symbol whose definition is desired. +Each function should return a list of xrefs, or nil; the first +non-nil result supercedes the xrefs produced by +`elisp--xref-find-definitions'.") + +(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier) + (require 'find-func) + ;; FIXME: use information in source near point to filter results: + ;; (dvc-log-edit ...) - exclude 'feature + ;; (require 'dvc-log-edit) - only 'feature + ;; Semantic may provide additional information + ;; + (let ((sym (intern-soft identifier))) + (when sym + (elisp--xref-find-definitions sym)))) + (defun elisp--xref-find-definitions (symbol) ;; The file name is not known when `symbol' is defined via interactive eval. (let (xrefs) - ;; alphabetical by result type symbol - - ;; FIXME: advised function; list of advice functions - - ;; FIXME: aliased variable - - (when (and (symbolp symbol) - (symbol-function symbol) - (symbolp (symbol-function symbol))) - ;; aliased function - (let* ((alias-symbol symbol) - (alias-file (symbol-file alias-symbol)) - (real-symbol (symbol-function symbol)) - (real-file (find-lisp-object-file-name real-symbol 'defun))) - - (when real-file - (push (elisp--xref-make-xref nil real-symbol real-file) xrefs)) - - (when alias-file - (push (elisp--xref-make-xref 'defalias alias-symbol alias-file) xrefs)))) - - (when (facep symbol) - (let ((file (find-lisp-object-file-name symbol 'defface))) - (when file - (push (elisp--xref-make-xref 'defface symbol file) xrefs)))) - - (when (fboundp symbol) - (let ((file (find-lisp-object-file-name symbol (symbol-function symbol))) - generic) - (when file - (cond - ((eq file 'C-source) - ;; First call to find-lisp-object-file-name (for this - ;; symbol?); C-source has not been cached yet. - ;; Second call will return "src/*.c" in file; handled by 't' case below. - (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs)) - - ((setq generic (cl--generic symbol)) - (dolist (method (cl--generic-method-table generic)) - (let* ((info (cl--generic-method-info method)) - (met-name (cons symbol (cl--generic-method-specializers method))) - (descr (format elisp--xref-format-cl-defmethod 'cl-defmethod symbol (nth 1 info))) - (file (find-lisp-object-file-name met-name 'cl-defmethod))) - (when file - (push (elisp--xref-make-xref 'cl-defmethod met-name file descr) xrefs)) - )) - - (let ((descr (format elisp--xref-format 'cl-defgeneric symbol))) - (push (elisp--xref-make-xref nil symbol file descr) xrefs)) - ) - - (t - (push (elisp--xref-make-xref nil symbol file) xrefs)) - )))) - - (when (boundp symbol) - (let ((file (find-lisp-object-file-name symbol 'defvar))) - (when file - (when (eq file 'C-source) - (setq file (help-C-file-name symbol 'var))) - (push (elisp--xref-make-xref 'defvar symbol file) xrefs)))) - - (when (featurep symbol) - (let ((file (ignore-errors - (find-library-name (symbol-name symbol))))) - (when file - (push (elisp--xref-make-xref 'feature symbol file) xrefs)))) - xrefs)) + (let ((temp elisp-xref-find-def-functions)) + (while (and (null xrefs) + temp) + (setq xrefs (append xrefs (funcall (pop temp) symbol))))) + + (unless xrefs + ;; alphabetical by result type symbol + + ;; FIXME: advised function; list of advice functions + ;; FIXME: aliased variable + + ;; Coding system symbols do not appear in ‘load-history’, + ;; so we can’t get a location for them. + + (when (and (symbolp symbol) + (symbol-function symbol) + (symbolp (symbol-function symbol))) + ;; aliased function + (let* ((alias-symbol symbol) + (alias-file (symbol-file alias-symbol)) + (real-symbol (symbol-function symbol)) + (real-file (find-lisp-object-file-name real-symbol 'defun))) + + (when real-file + (push (elisp--xref-make-xref nil real-symbol real-file) xrefs)) + + (when alias-file + (push (elisp--xref-make-xref 'defalias alias-symbol alias-file) xrefs)))) + + (when (facep symbol) + (let ((file (find-lisp-object-file-name symbol 'defface))) + (when file + (push (elisp--xref-make-xref 'defface symbol file) xrefs)))) + + (when (fboundp symbol) + (let ((file (find-lisp-object-file-name symbol (symbol-function symbol))) + generic doc) + (when file + (cond + ((eq file 'C-source) + ;; First call to find-lisp-object-file-name for an object + ;; defined in C; the doc strings from the C source have + ;; not been loaded yet. Second call will return "src/*.c" + ;; in file; handled by 't' case below. + (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs)) + + ((and (setq doc (documentation symbol t)) + ;; This doc string is defined in cl-macs.el cl-defstruct + (string-match "Constructor for objects of type `\\(.*\\)'" doc)) + ;; `symbol' is a name for the default constructor created by + ;; cl-defstruct, so return the location of the cl-defstruct. + (let* ((type-name (match-string 1 doc)) + (type-symbol (intern type-name)) + (file (find-lisp-object-file-name type-symbol 'define-type)) + (summary (format elisp--xref-format-extra + 'cl-defstruct + (concat "(" type-name) + (concat "(:constructor " (symbol-name symbol) "))")))) + (push (elisp--xref-make-xref 'define-type type-symbol file summary) xrefs) + )) + + ((setq generic (cl--generic symbol)) + ;; FIXME: move this to elisp-xref-find-def-functions, in cl-generic.el + + ;; A generic function. If there is a default method, it + ;; will appear in the method table, with no + ;; specializers. + ;; + ;; If the default method is declared by the cl-defgeneric + ;; declaration, it will have the same location as the + ;; cl-defgeneric, so we want to exclude it from the + ;; result. In this case, it will have a null doc + ;; string. User declarations of default methods may also + ;; have null doc strings, but we hope that is + ;; rare. Perhaps this heuristic will discourage that. + (dolist (method (cl--generic-method-table generic)) + (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly + (specializers (cl--generic-method-specializers method)) + (non-default nil) + (met-name (cons symbol specializers)) + (file (find-lisp-object-file-name met-name 'cl-defmethod))) + (dolist (item specializers) + ;; default method has all 't' in specializers + (setq non-default (or non-default (not (equal t item))))) + + (when (and file + (or non-default + (nth 2 info))) ;; assuming only co-located default has null doc string + (if specializers + (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info)))) + (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)) + + (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()"))) + (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)))) + )) + + (if (and (setq doc (documentation symbol t)) + ;; This doc string is created somewhere in + ;; cl--generic-make-function for an implicit + ;; defgeneric. + (string-match "\n\n(fn ARG &rest ARGS)" doc)) + ;; This symbol is an implicitly defined defgeneric, so + ;; don't return it. + nil + (push (elisp--xref-make-xref 'cl-defgeneric symbol file) xrefs)) + ) + + (t + (push (elisp--xref-make-xref nil symbol file) xrefs)) + )))) + + (when (boundp symbol) + ;; A variable + (let ((file (find-lisp-object-file-name symbol 'defvar))) + (when file + (cond + ((eq file 'C-source) + ;; The doc strings from the C source have not been loaded + ;; yet; help-C-file-name does that. Second call will + ;; return "src/*.c" in file; handled below. + (push (elisp--xref-make-xref 'defvar symbol (help-C-file-name symbol 'var)) xrefs)) + + ((string= "src/" (substring file 0 4)) + ;; The variable is defined in a C source file; don't check + ;; for define-minor-mode. + (push (elisp--xref-make-xref 'defvar symbol file) xrefs)) + + ((memq symbol minor-mode-list) + ;; The symbol is a minor mode. These should be defined by + ;; "define-minor-mode", which means the variable and the + ;; function are declared in the same place. So we return only + ;; the function, arbitrarily. + ;; + ;; There is an exception, when the variable is defined in C + ;; code, as for abbrev-mode. + ;; + ;; IMPROVEME: If the user is searching for the identifier at + ;; point, we can determine whether it is a variable or + ;; function by looking at the source code near point. + ;; + ;; IMPROVEME: The user may actually be asking "do any + ;; variables by this name exist"; we need a way to specify + ;; that. + nil) + + (t + (push (elisp--xref-make-xref 'defvar symbol file) xrefs)) + + )))) + + (when (featurep symbol) + (let ((file (ignore-errors + (find-library-name (symbol-name symbol))))) + (when file + (push (elisp--xref-make-xref 'feature symbol file) xrefs)))) + );; 'unless xrefs' -(declare-function project-search-path "project") -(declare-function project-current "project") + xrefs)) -(defun elisp--xref-find-references (symbol) - (cl-mapcan - (lambda (dir) - (xref-collect-references symbol dir)) - (project-search-path (project-current)))) +(declare-function project-external-roots "project") -(defun elisp--xref-find-apropos (regexp) +(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp) (apply #'nconc (let (lst) (dolist (sym (apropos-internal regexp)) @@ -743,7 +811,7 @@ otherwise build the summary from TYPE and SYMBOL." (facep sym))) 'strict)) -(defun elisp--xref-identifier-completion-table () +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp))) elisp--xref-identifier-completion-table) (cl-defstruct (xref-elisp-location @@ -755,15 +823,17 @@ otherwise build the summary from TYPE and SYMBOL." (pcase-let (((cl-struct xref-elisp-location symbol type file) l)) (let ((buffer-point (find-function-search-for-symbol symbol type file))) (with-current-buffer (car buffer-point) - (goto-char (or (cdr buffer-point) (point-min))) - (point-marker))))) + (save-excursion + (goto-char (or (cdr buffer-point) (point-min))) + (point-marker)))))) (cl-defmethod xref-location-group ((l xref-elisp-location)) (xref-elisp-location-file l)) -(defun elisp-search-path () - (defvar package-user-dir) - (cons package-user-dir load-path)) +(defun elisp-load-path-roots () + (if (boundp 'package-user-dir) + (cons package-user-dir load-path) + load-path)) ;;; Elisp Interaction mode @@ -849,6 +919,7 @@ Semicolons start comments. (goto-char end))))))) (defun elisp-byte-code-syntax-propertize (start end) + (goto-char start) (elisp--byte-code-comment end (point)) (funcall (syntax-propertize-rules @@ -981,6 +1052,17 @@ If CHAR is not a character, return nil." ((or (eq (following-char) ?\') (eq (preceding-char) ?\')) (setq left-quote ?\`))) + + ;; When after a named character literal, skip over the entire + ;; literal, not only its last word. + (when (= (preceding-char) ?}) + (let ((begin (save-excursion + (backward-char) + (skip-syntax-backward "w-") + (backward-char 3) + (when (looking-at-p "\\\\N{") (point))))) + (when begin (goto-char begin)))) + (forward-sexp -1) ;; If we were after `?\e' (or similar case), ;; use the whole thing, not just the `e'. @@ -1034,7 +1116,6 @@ character)." (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding) eval-last-sexp-arg-internal))) - (defun elisp--eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal) (let ((unabbreviated (let ((print-length nil) (print-level nil)) (prin1-to-string value))) @@ -1161,7 +1242,7 @@ If the current defun is actually a call to `defvar', then reset the variable using the initial value expression even if the variable already has some other value. \(Normally `defvar' does not change the variable's value -if it already has a value.\) +if it already has a value.) Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while @@ -1243,7 +1324,7 @@ which see." 0 - contains the last symbol read from the buffer. 1 - contains the string last displayed in the echo area for variables, or argument string for functions. - 2 - 'function if function args, 'variable if variable documentation.") + 2 - `function' if function args, `variable' if variable documentation.") (defun elisp-eldoc-documentation-function () "`eldoc-documentation-function' (which see) for Emacs Lisp." @@ -1485,7 +1566,8 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ARGLIST is either a string, or a list of strings or symbols." (let ((str (cond ((stringp arglist) arglist) ((not (listp arglist)) nil) - (t (help--make-usage-docstring 'toto arglist))))) + (t (substitute-command-keys + (help--make-usage-docstring 'toto arglist)))))) (if (and str (string-match "\\`([^ )]+ ?" str)) (replace-match "(" t t str) str)))