]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/elisp-mode.el
Update copyright year to 2015
[gnu-emacs] / lisp / progmodes / elisp-mode.el
index f3143bd76ee194ba4f6eb6f50893df832c6e4a18..4de40eff538cfcb03cd8158a86e3901c6d86a746 100644 (file)
@@ -1,6 +1,6 @@
 ;;; elisp-mode.el --- Emacs Lisp mode  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1985-1986, 1999-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: lisp, languages
@@ -204,7 +204,7 @@ Comments in the form will be lost."
   (let* ((start (point))
          (exp (read (current-buffer)))
          ;; Compute it before, since it may signal errors.
-         (new (macroexpand exp)))
+         (new (macroexpand-1 exp)))
     (if (equal exp new)
         (message "Not a macro call, nothing to expand")
       (delete-region start (point))
@@ -227,10 +227,15 @@ Blank lines separate paragraphs.  Semicolons start comments.
 
 \\{emacs-lisp-mode-map}"
   :group 'lisp
+  (defvar xref-find-function)
+  (defvar xref-identifier-completion-table-function)
   (lisp-mode-variables nil nil 'elisp)
   (setq imenu-case-fold-search nil)
   (setq-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)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
@@ -255,18 +260,27 @@ Blank lines separate paragraphs.  Semicolons start comments.
                        (dolist (binding bindings)
                          (push (or (car-safe binding) binding) vars))
                        (elisp--local-variables-1 vars (car (last body)))))
-                    (`(lambda ,_) (setq sexp nil))
+                    (`(lambda ,_args)
+                     ;; FIXME: Look for the witness inside `args'.
+                     (setq sexp nil))
                     (`(lambda ,args . ,body)
                      (elisp--local-variables-1
-                      (append args vars) (car (last body))))
+                      (append (remq '&optional (remq '&rest args)) vars)
+                      (car (last body))))
                     (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
                     (`(condition-case ,v ,_ . ,catches)
                      (elisp--local-variables-1
                       (cons v vars) (cdr (car (last catches)))))
+                    (`(quote . ,_)
+                     ;; FIXME: Look for the witness inside sexp.
+                     (setq sexp nil))
+                    ;; FIXME: Handle `cond'.
                     (`(,_ . ,_)
                      (elisp--local-variables-1 vars (car (last sexp))))
                     (`elisp--witness--lisp (or vars '(nil)))
                     (_ nil)))
+          ;; We didn't find the witness in the last element so we try to
+          ;; backtrack to the last-but-one.
           (setq sexp (ignore-errors (butlast sexp)))))
     res))
 
@@ -284,7 +298,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
       (let* ((sexp (condition-case nil
                        (car (read-from-string
                              (concat txt "elisp--witness--lisp" closer)))
-                     (end-of-file nil)))
+                     ((invalid-read-syntax end-of-file) nil)))
              (macroexpand-advice (lambda (expander form &rest args)
                                    (condition-case nil
                                        (apply expander form args)
@@ -404,6 +418,7 @@ It can be quoted, or be inside a quoted form."
          (match-string 0 doc))))
 
 (declare-function find-library-name "find-func" (library))
+(declare-function find-function-library "find-func" (function &optional l-o v))
 
 (defun elisp--company-location (str)
   (let ((sym (intern-soft str)))
@@ -458,11 +473,11 @@ It can be quoted, or be inside a quoted form."
                            :company-location #'elisp--company-location))
                     ((elisp--form-quoted-p beg)
                      (list nil obarray
-                           ;; Don't include all symbols
-                           ;; (bug#16646).
+                           ;; Don't include all symbols (bug#16646).
                            :predicate (lambda (sym)
                                         (or (boundp sym)
                                             (fboundp sym)
+                                            (featurep sym)
                                             (symbol-plist sym)))
                            :annotation-function
                            (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
@@ -539,6 +554,79 @@ It can be quoted, or be inside a quoted form."
 (define-obsolete-function-alias
   'lisp-completion-at-point 'elisp-completion-at-point "25.1")
 
+;;; Xref backend
+
+(declare-function xref-make-elisp-location "xref" (symbol type file))
+(declare-function xref-make-bogus-location "xref" (message))
+(declare-function xref-make "xref" (description location))
+
+(defun elisp-xref-find (action id)
+  (require 'find-func)
+  (pcase action
+    (`definitions
+      (let ((sym (intern-soft id)))
+        (when sym
+          (elisp--xref-find-definitions sym))))
+    (`apropos
+     (elisp--xref-find-apropos id))))
+
+(defun elisp--xref-identifier-location (type sym)
+  (let ((file
+         (pcase type
+           (`defun (when (fboundp sym)
+                     (let ((fun-lib
+                            (find-function-library sym)))
+                       (setq sym (car fun-lib))
+                       (cdr fun-lib))))
+           (`defvar (when (boundp sym)
+                      (or (symbol-file sym 'defvar)
+                          (help-C-file-name sym 'var))))
+           (`feature (when (featurep sym)
+                       (ignore-errors
+                         (find-library-name (symbol-name sym)))))
+           (`defface (when (facep sym)
+                       (symbol-file sym 'defface))))))
+    (when file
+      (when (string-match-p "\\.elc\\'" file)
+        (setq file (substring file 0 -1)))
+      (xref-make-elisp-location sym type file))))
+
+(defun elisp--xref-find-definitions (symbol)
+  (save-excursion
+    (let (lst)
+      (dolist (type '(feature defface defvar defun))
+        (let ((loc
+               (condition-case err
+                   (elisp--xref-identifier-location type symbol)
+                 (error
+                  (xref-make-bogus-location (error-message-string err))))))
+          (when loc
+            (push
+             (xref-make (format "(%s %s)" type symbol)
+                        loc)
+             lst))))
+      lst)))
+
+(defun elisp--xref-find-apropos (regexp)
+  (apply #'nconc
+         (let (lst)
+           (dolist (sym (apropos-internal regexp))
+            (push (elisp--xref-find-definitions sym) lst))
+           (nreverse lst))))
+
+(defvar elisp--xref-identifier-completion-table
+  (apply-partially #'completion-table-with-predicate
+                   obarray
+                   (lambda (sym)
+                     (or (boundp sym)
+                         (fboundp sym)
+                         (featurep sym)
+                         (facep sym)))
+                   'strict))
+
+(defun elisp--xref-identifier-completion-table ()
+  elisp--xref-identifier-completion-table)
+
 ;;; Elisp Interaction mode
 
 (defvar lisp-interaction-mode-map