]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/elisp-mode.el
Use eldoc-documentation-functions
[gnu-emacs] / lisp / progmodes / elisp-mode.el
index 7ac5a5cb77869c0d187b5693323d91603a95f766..5f9bdaccd0f98e544538e798b1ecf249e152b6d4 100644 (file)
@@ -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,164 +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)
-  ;; 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
-  (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-extra
+;; 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 doc)
-       (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))
-
-           ((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))
-           (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-extra '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))
@@ -762,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
@@ -774,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
 
@@ -868,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
@@ -1000,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'.
@@ -1053,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)))
@@ -1180,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
@@ -1262,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."
@@ -1504,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)))