lisp/progmodes/elisp-mode.el

   1 ;;; elisp-mode.el --- Emacs Lisp mode  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: emacs-devel@gnu.org
   6 ;; Keywords: lisp, languages
   7 ;; Package: emacs
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; The major mode for editing Emacs Lisp code.
  27 ;; This mode is documented in the Emacs manual.
  28
  29 ;;; Code:
  30
  31 (require 'lisp-mode)
  32
  33 (defvar emacs-lisp-mode-abbrev-table nil)
  34 (define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
  35   "Abbrev table for Emacs Lisp mode.
  36 It has `lisp-mode-abbrev-table' as its parent."
  37   :parents (list lisp-mode-abbrev-table))
  38
  39 (defvar emacs-lisp-mode-syntax-table
  40   (let ((table (make-syntax-table lisp--mode-syntax-table)))
  41     (modify-syntax-entry ?\[ "(]  " table)
  42     (modify-syntax-entry ?\] ")[  " table)
  43     table)
  44   "Syntax table used in `emacs-lisp-mode'.")
  45
  46 (defvar emacs-lisp-mode-map
  47   (let ((map (make-sparse-keymap "Emacs-Lisp"))
  48         (menu-map (make-sparse-keymap "Emacs-Lisp"))
  49         (lint-map (make-sparse-keymap))
  50         (prof-map (make-sparse-keymap))
  51         (tracing-map (make-sparse-keymap)))
  52     (set-keymap-parent map lisp-mode-shared-map)
  53     (define-key map "\e\t" 'completion-at-point)
  54     (define-key map "\e\C-x" 'eval-defun)
  55     (define-key map "\e\C-q" 'indent-pp-sexp)
  56     (bindings--define-key map [menu-bar emacs-lisp]
  57       (cons "Emacs-Lisp" menu-map))
  58     (bindings--define-key menu-map [eldoc]
  59       '(menu-item "Auto-Display Documentation Strings" eldoc-mode
  60                   :button (:toggle . (bound-and-true-p eldoc-mode))
  61                   :help "Display the documentation string for the item under cursor"))
  62     (bindings--define-key menu-map [checkdoc]
  63       '(menu-item "Check Documentation Strings" checkdoc
  64                   :help "Check documentation strings for style requirements"))
  65     (bindings--define-key menu-map [re-builder]
  66       '(menu-item "Construct Regexp" re-builder
  67                   :help "Construct a regexp interactively"))
  68     (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
  69     (bindings--define-key tracing-map [tr-a]
  70       '(menu-item "Untrace All" untrace-all
  71                   :help "Untrace all currently traced functions"))
  72     (bindings--define-key tracing-map [tr-uf]
  73       '(menu-item "Untrace Function..." untrace-function
  74                   :help "Untrace function, and possibly activate all remaining advice"))
  75     (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
  76     (bindings--define-key tracing-map [tr-q]
  77       '(menu-item "Trace Function Quietly..." trace-function-background
  78                   :help "Trace the function with trace output going quietly to a buffer"))
  79     (bindings--define-key tracing-map [tr-f]
  80       '(menu-item "Trace Function..." trace-function
  81                   :help "Trace the function given as an argument"))
  82     (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
  83     (bindings--define-key prof-map [prof-restall]
  84       '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
  85                   :help "Restore the original definitions of all functions being profiled"))
  86     (bindings--define-key prof-map [prof-restfunc]
  87       '(menu-item "Remove Instrumentation for Function..." elp-restore-function
  88                   :help "Restore an instrumented function to its original definition"))
  89
  90     (bindings--define-key prof-map [sep-rem] menu-bar-separator)
  91     (bindings--define-key prof-map [prof-resall]
  92       '(menu-item "Reset Counters for All Functions" elp-reset-all
  93                   :help "Reset the profiling information for all functions being profiled"))
  94     (bindings--define-key prof-map [prof-resfunc]
  95       '(menu-item "Reset Counters for Function..." elp-reset-function
  96                   :help "Reset the profiling information for a function"))
  97     (bindings--define-key prof-map [prof-res]
  98       '(menu-item "Show Profiling Results" elp-results
  99                   :help "Display current profiling results"))
 100     (bindings--define-key prof-map [prof-pack]
 101       '(menu-item "Instrument Package..." elp-instrument-package
 102                   :help "Instrument for profiling all function that start with a prefix"))
 103     (bindings--define-key prof-map [prof-func]
 104       '(menu-item "Instrument Function..." elp-instrument-function
 105                   :help "Instrument a function for profiling"))
 106     ;; Maybe this should be in a separate submenu from the ELP stuff?
 107     (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
 108     (bindings--define-key prof-map [prof-natprof-stop]
 109       '(menu-item "Stop Native Profiler" profiler-stop
 110                   :help "Stop recording profiling information"
 111                   :enable (and (featurep 'profiler)
 112                                (profiler-running-p))))
 113     (bindings--define-key prof-map [prof-natprof-report]
 114       '(menu-item "Show Profiler Report" profiler-report
 115                   :help "Show the current profiler report"
 116                   :enable (and (featurep 'profiler)
 117                                (profiler-running-p))))
 118     (bindings--define-key prof-map [prof-natprof-start]
 119       '(menu-item "Start Native Profiler..." profiler-start
 120                   :help "Start recording profiling information"))
 121
 122     (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
 123     (bindings--define-key lint-map [lint-di]
 124       '(menu-item "Lint Directory..." elint-directory
 125                   :help "Lint a directory"))
 126     (bindings--define-key lint-map [lint-f]
 127       '(menu-item "Lint File..." elint-file
 128                   :help "Lint a file"))
 129     (bindings--define-key lint-map [lint-b]
 130       '(menu-item "Lint Buffer" elint-current-buffer
 131                   :help "Lint the current buffer"))
 132     (bindings--define-key lint-map [lint-d]
 133       '(menu-item "Lint Defun" elint-defun
 134                   :help "Lint the function at point"))
 135     (bindings--define-key menu-map [edebug-defun]
 136       '(menu-item "Instrument Function for Debugging" edebug-defun
 137                   :help "Evaluate the top level form point is in, stepping through with Edebug"
 138                   :keys "C-u C-M-x"))
 139     (bindings--define-key menu-map [separator-byte] menu-bar-separator)
 140     (bindings--define-key menu-map [disas]
 141       '(menu-item "Disassemble Byte Compiled Object..." disassemble
 142                   :help "Print disassembled code for OBJECT in a buffer"))
 143     (bindings--define-key menu-map [byte-recompile]
 144       '(menu-item "Byte-recompile Directory..." byte-recompile-directory
 145                   :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
 146     (bindings--define-key menu-map [emacs-byte-compile-and-load]
 147       '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
 148                   :help "Byte-compile the current file (if it has changed), then load compiled code"))
 149     (bindings--define-key menu-map [byte-compile]
 150       '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
 151                   :help "Byte compile the file containing the current buffer"))
 152     (bindings--define-key menu-map [separator-eval] menu-bar-separator)
 153     (bindings--define-key menu-map [ielm]
 154       '(menu-item "Interactive Expression Evaluation" ielm
 155                   :help "Interactively evaluate Emacs Lisp expressions"))
 156     (bindings--define-key menu-map [eval-buffer]
 157       '(menu-item "Evaluate Buffer" eval-buffer
 158                   :help "Execute the current buffer as Lisp code"))
 159     (bindings--define-key menu-map [eval-region]
 160       '(menu-item "Evaluate Region" eval-region
 161                   :help "Execute the region as Lisp code"
 162                   :enable mark-active))
 163     (bindings--define-key menu-map [eval-sexp]
 164       '(menu-item "Evaluate Last S-expression" eval-last-sexp
 165                   :help "Evaluate sexp before point; print value in echo area"))
 166     (bindings--define-key menu-map [separator-format] menu-bar-separator)
 167     (bindings--define-key menu-map [comment-region]
 168       '(menu-item "Comment Out Region" comment-region
 169                   :help "Comment or uncomment each line in the region"
 170                   :enable mark-active))
 171     (bindings--define-key menu-map [indent-region]
 172       '(menu-item "Indent Region" indent-region
 173                   :help "Indent each nonblank line in the region"
 174                   :enable mark-active))
 175     (bindings--define-key menu-map [indent-line]
 176       '(menu-item "Indent Line" lisp-indent-line))
 177     map)
 178   "Keymap for Emacs Lisp mode.
 179 All commands in `lisp-mode-shared-map' are inherited by this map.")
 180
 181 (defun emacs-lisp-byte-compile ()
 182   "Byte compile the file containing the current buffer."
 183   (interactive)
 184   (if buffer-file-name
 185       (byte-compile-file buffer-file-name)
 186     (error "The buffer must be saved in a file first")))
 187
 188 (defun emacs-lisp-byte-compile-and-load ()
 189   "Byte-compile the current file (if it has changed), then load compiled code."
 190   (interactive)
 191   (or buffer-file-name
 192       (error "The buffer must be saved in a file first"))
 193   (require 'bytecomp)
 194   ;; Recompile if file or buffer has changed since last compilation.
 195   (if (and (buffer-modified-p)
 196            (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
 197       (save-buffer))
 198   (byte-recompile-file buffer-file-name nil 0 t))
 199
 200 (defun emacs-lisp-macroexpand ()
 201   "Macroexpand the form after point.
 202 Comments in the form will be lost."
 203   (interactive)
 204   (let* ((start (point))
 205          (exp (read (current-buffer)))
 206          ;; Compute it before, since it may signal errors.
 207          (new (macroexpand-1 exp)))
 208     (if (equal exp new)
 209         (message "Not a macro call, nothing to expand")
 210       (delete-region start (point))
 211       (pp new (current-buffer))
 212       (if (bolp) (delete-char -1))
 213       (indent-region start (point)))))
 214
 215 (defcustom emacs-lisp-mode-hook nil
 216   "Hook run when entering Emacs Lisp mode."
 217   :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
 218   :type 'hook
 219   :group 'lisp)
 220
 221 ;;;###autoload
 222 (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
 223   "Major mode for editing Lisp code to run in Emacs.
 224 Commands:
 225 Delete converts tabs to spaces as it moves back.
 226 Blank lines separate paragraphs.  Semicolons start comments.
 227
 228 \\{emacs-lisp-mode-map}"
 229   :group 'lisp
 230   (defvar xref-find-function)
 231   (defvar xref-identifier-completion-table-function)
 232   (lisp-mode-variables nil nil 'elisp)
 233   (setq imenu-case-fold-search nil)
 234   (setq-local eldoc-documentation-function
 235               #'elisp-eldoc-documentation-function)
 236   (setq-local xref-find-function #'elisp-xref-find)
 237   (setq-local xref-identifier-completion-table-function
 238               #'elisp--xref-identifier-completion-table)
 239   (add-hook 'completion-at-point-functions
 240             #'elisp-completion-at-point nil 'local))
 241
 242 ;;; Completion at point for Elisp
 243
 244 (defun elisp--local-variables-1 (vars sexp)
 245   "Return the vars locally bound around the witness, or nil if not found."
 246   (let (res)
 247     (while
 248         (unless
 249             (setq res
 250                   (pcase sexp
 251                     (`(,(or `let `let*) ,bindings)
 252                      (let ((vars vars))
 253                        (when (eq 'let* (car sexp))
 254                          (dolist (binding (cdr (reverse bindings)))
 255                            (push (or (car-safe binding) binding) vars)))
 256                        (elisp--local-variables-1
 257                         vars (car (cdr-safe (car (last bindings)))))))
 258                     (`(,(or `let `let*) ,bindings . ,body)
 259                      (let ((vars vars))
 260                        (dolist (binding bindings)
 261                          (push (or (car-safe binding) binding) vars))
 262                        (elisp--local-variables-1 vars (car (last body)))))
 263                     (`(lambda ,_args)
 264                      ;; FIXME: Look for the witness inside `args'.
 265                      (setq sexp nil))
 266                     (`(lambda ,args . ,body)
 267                      (elisp--local-variables-1
 268                       (append (remq '&optional (remq '&rest args)) vars)
 269                       (car (last body))))
 270                     (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
 271                     (`(condition-case ,v ,_ . ,catches)
 272                      (elisp--local-variables-1
 273                       (cons v vars) (cdr (car (last catches)))))
 274                     (`(quote . ,_)
 275                      ;; FIXME: Look for the witness inside sexp.
 276                      (setq sexp nil))
 277                     ;; FIXME: Handle `cond'.
 278                     (`(,_ . ,_)
 279                      (elisp--local-variables-1 vars (car (last sexp))))
 280                     (`elisp--witness--lisp (or vars '(nil)))
 281                     (_ nil)))
 282           ;; We didn't find the witness in the last element so we try to
 283           ;; backtrack to the last-but-one.
 284           (setq sexp (ignore-errors (butlast sexp)))))
 285     res))
 286
 287 (defun elisp--local-variables ()
 288   "Return a list of locally let-bound variables at point."
 289   (save-excursion
 290     (skip-syntax-backward "w_")
 291     (let* ((ppss (syntax-ppss))
 292            (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
 293                                                 (or (nth 8 ppss) (point))))
 294            (closer ()))
 295       (dolist (p (nth 9 ppss))
 296         (push (cdr (syntax-after p)) closer))
 297       (setq closer (apply #'string closer))
 298       (let* ((sexp (condition-case nil
 299                        (car (read-from-string
 300                              (concat txt "elisp--witness--lisp" closer)))
 301                      ((invalid-read-syntax end-of-file) nil)))
 302              (macroexpand-advice (lambda (expander form &rest args)
 303                                    (condition-case nil
 304                                        (apply expander form args)
 305                                      (error form))))
 306              (sexp
 307               (unwind-protect
 308                   (progn
 309                     (advice-add 'macroexpand :around macroexpand-advice)
 310                     (macroexpand-all sexp))
 311                 (advice-remove 'macroexpand macroexpand-advice)))
 312              (vars (elisp--local-variables-1 nil sexp)))
 313         (delq nil
 314               (mapcar (lambda (var)
 315                         (and (symbolp var)
 316                              (not (string-match (symbol-name var) "\\`[&_]"))
 317                              ;; Eliminate uninterned vars.
 318                              (intern-soft var)
 319                              var))
 320                       vars))))))
 321
 322 (defvar elisp--local-variables-completion-table
 323   ;; Use `defvar' rather than `defconst' since defconst would purecopy this
 324   ;; value, which would doubly fail: it would fail because purecopy can't
 325   ;; handle the recursive bytecode object, and it would fail because it would
 326   ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
 327   (let ((lastpos nil) (lastvars nil))
 328     (letrec ((hookfun (lambda ()
 329                         (setq lastpos nil)
 330                         (remove-hook 'post-command-hook hookfun))))
 331       (completion-table-dynamic
 332        (lambda (_string)
 333          (save-excursion
 334            (skip-syntax-backward "_w")
 335            (let ((newpos (cons (point) (current-buffer))))
 336              (unless (equal lastpos newpos)
 337                (add-hook 'post-command-hook hookfun)
 338                (setq lastpos newpos)
 339                (setq lastvars
 340                      (mapcar #'symbol-name (elisp--local-variables))))))
 341          lastvars)))))
 342
 343 (defun elisp--expect-function-p (pos)
 344   "Return non-nil if the symbol at point is expected to be a function."
 345   (or
 346    (and (eq (char-before pos) ?')
 347         (eq (char-before (1- pos)) ?#))
 348    (save-excursion
 349      (let ((parent (nth 1 (syntax-ppss pos))))
 350        (when parent
 351          (goto-char parent)
 352          (and
 353           (looking-at (concat "(\\(cl-\\)?"
 354                               (regexp-opt '("declare-function"
 355                                             "function" "defadvice"
 356                                             "callf" "callf2"
 357                                             "defsetf"))
 358                               "[ \t\r\n]+"))
 359           (eq (match-end 0) pos)))))))
 360
 361 (defun elisp--form-quoted-p (pos)
 362   "Return non-nil if the form at POS is not evaluated.
 363 It can be quoted, or be inside a quoted form."
 364   ;; FIXME: Do some macro expansion maybe.
 365   (save-excursion
 366     (let ((state (syntax-ppss pos)))
 367       (or (nth 8 state)   ; Code inside strings usually isn't evaluated.
 368           ;; FIXME: The 9th element is undocumented.
 369           (let ((nesting (cons (point) (reverse (nth 9 state))))
 370                 res)
 371             (while (and nesting (not res))
 372               (goto-char (pop nesting))
 373               (cond
 374                ((or (eq (char-after) ?\[)
 375                     (progn
 376                       (skip-chars-backward " ")
 377                       (memq (char-before) '(?' ?`))))
 378                 (setq res t))
 379                ((eq (char-before) ?,)
 380                 (setq nesting nil))))
 381             res)))))
 382
 383 ;; FIXME: Support for Company brings in features which straddle eldoc.
 384 ;; We should consolidate this, so that major modes can provide all that
 385 ;; data all at once:
 386 ;; - a function to extract "the reference at point" (may be more complex
 387 ;;     than a mere string, to distinguish various namespaces).
 388 ;; - a function to jump to such a reference.
 389 ;; - a function to show the signature/interface of such a reference.
 390 ;; - a function to build a help-buffer about that reference.
 391 ;; FIXME: Those functions should also be used by the normal completion code in
 392 ;; the *Completions* buffer.
 393
 394 (defun elisp--company-doc-buffer (str)
 395   (let ((symbol (intern-soft str)))
 396     ;; FIXME: we really don't want to "display-buffer and then undo it".
 397     (save-window-excursion
 398       ;; Make sure we don't display it in another frame, otherwise
 399       ;; save-window-excursion won't be able to undo it.
 400       (let ((display-buffer-overriding-action
 401              '(nil . ((inhibit-switch-frame . t)))))
 402         (ignore-errors
 403           (cond
 404            ((fboundp symbol) (describe-function symbol))
 405            ((boundp symbol) (describe-variable symbol))
 406            ((featurep symbol) (describe-package symbol))
 407            ((facep symbol) (describe-face symbol))
 408            (t (signal 'user-error nil)))
 409           (help-buffer))))))
 410
 411 (defun elisp--company-doc-string (str)
 412   (let* ((symbol (intern-soft str))
 413          (doc (if (fboundp symbol)
 414                   (documentation symbol t)
 415                 (documentation-property symbol 'variable-documentation t))))
 416     (and (stringp doc)
 417          (string-match ".*$" doc)
 418          (match-string 0 doc))))
 419
 420 (declare-function find-library-name "find-func" (library))
 421 (declare-function find-function-library "find-func" (function &optional l-o v))
 422
 423 (defun elisp--company-location (str)
 424   (let ((sym (intern-soft str)))
 425     (cond
 426      ((fboundp sym) (find-definition-noselect sym nil))
 427      ((boundp sym) (find-definition-noselect sym 'defvar))
 428      ((featurep sym)
 429       (require 'find-func)
 430       (cons (find-file-noselect (find-library-name
 431                                  (symbol-name sym)))
 432             0))
 433      ((facep sym) (find-definition-noselect sym 'defface)))))
 434
 435 (defun elisp-completion-at-point ()
 436   "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
 437   (with-syntax-table emacs-lisp-mode-syntax-table
 438     (let* ((pos (point))
 439            (beg (condition-case nil
 440                     (save-excursion
 441                       (backward-sexp 1)
 442                       (skip-syntax-forward "'")
 443                       (point))
 444                   (scan-error pos)))
 445            (end
 446             (unless (or (eq beg (point-max))
 447                         (member (char-syntax (char-after beg))
 448                                 '(?\s ?\" ?\( ?\))))
 449               (condition-case nil
 450                   (save-excursion
 451                     (goto-char beg)
 452                     (forward-sexp 1)
 453                     (skip-chars-backward "'")
 454                     (when (>= (point) pos)
 455                       (point)))
 456                 (scan-error pos))))
 457            ;; t if in function position.
 458            (funpos (eq (char-before beg) ?\()))
 459       (when (and end (or (not (nth 8 (syntax-ppss)))
 460                          (eq (char-before beg) ?`)))
 461         (let ((table-etc
 462                (if (not funpos)
 463                    ;; FIXME: We could look at the first element of the list and
 464                    ;; use it to provide a more specific completion table in some
 465                    ;; cases.  E.g. filter out keywords that are not understood by
 466                    ;; the macro/function being called.
 467                    (cond
 468                     ((elisp--expect-function-p beg)
 469                      (list nil obarray
 470                            :predicate #'fboundp
 471                            :company-doc-buffer #'elisp--company-doc-buffer
 472                            :company-docsig #'elisp--company-doc-string
 473                            :company-location #'elisp--company-location))
 474                     ((elisp--form-quoted-p beg)
 475                      (list nil obarray
 476                            ;; Don't include all symbols (bug#16646).
 477                            :predicate (lambda (sym)
 478                                         (or (boundp sym)
 479                                             (fboundp sym)
 480                                             (featurep sym)
 481                                             (symbol-plist sym)))
 482                            :annotation-function
 483                            (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
 484                            :company-doc-buffer #'elisp--company-doc-buffer
 485                            :company-docsig #'elisp--company-doc-string
 486                            :company-location #'elisp--company-location))
 487                     (t
 488                      (list nil (completion-table-merge
 489                                 elisp--local-variables-completion-table
 490                                 (apply-partially #'completion-table-with-predicate
 491                                                  obarray
 492                                                  #'boundp
 493                                                  'strict))
 494                            :company-doc-buffer #'elisp--company-doc-buffer
 495                            :company-docsig #'elisp--company-doc-string
 496                            :company-location #'elisp--company-location)))
 497                  ;; Looks like a funcall position.  Let's double check.
 498                  (save-excursion
 499                    (goto-char (1- beg))
 500                    (let ((parent
 501                           (condition-case nil
 502                               (progn (up-list -1) (forward-char 1)
 503                                      (let ((c (char-after)))
 504                                        (if (eq c ?\() ?\(
 505                                          (if (memq (char-syntax c) '(?w ?_))
 506                                              (read (current-buffer))))))
 507                             (error nil))))
 508                      (pcase parent
 509                        ;; FIXME: Rather than hardcode special cases here,
 510                        ;; we should use something like a symbol-property.
 511                        (`declare
 512                         (list t (mapcar (lambda (x) (symbol-name (car x)))
 513                                         (delete-dups
 514                                          ;; FIXME: We should include some
 515                                          ;; docstring with each entry.
 516                                          (append
 517                                           macro-declarations-alist
 518                                           defun-declarations-alist)))))
 519                        ((and (or `condition-case `condition-case-unless-debug)
 520                              (guard (save-excursion
 521                                       (ignore-errors
 522                                         (forward-sexp 2)
 523                                         (< (point) beg)))))
 524                         (list t obarray
 525                               :predicate (lambda (sym) (get sym 'error-conditions))))
 526                        ((and ?\(
 527                              (guard (save-excursion
 528                                       (goto-char (1- beg))
 529                                       (up-list -1)
 530                                       (forward-symbol -1)
 531                                       (looking-at "\\_<let\\*?\\_>"))))
 532                         (list t obarray
 533                               :predicate #'boundp
 534                               :company-doc-buffer #'elisp--company-doc-buffer
 535                               :company-docsig #'elisp--company-doc-string
 536                               :company-location #'elisp--company-location))
 537                        (_ (list nil obarray
 538                                 :predicate #'fboundp
 539                                 :company-doc-buffer #'elisp--company-doc-buffer
 540                                 :company-docsig #'elisp--company-doc-string
 541                                 :company-location #'elisp--company-location
 542                                 ))))))))
 543           (nconc (list beg end)
 544                  (if (null (car table-etc))
 545                      (cdr table-etc)
 546                    (cons
 547                     (if (memq (char-syntax (or (char-after end) ?\s))
 548                               '(?\s ?>))
 549                         (cadr table-etc)
 550                       (apply-partially 'completion-table-with-terminator
 551                                        " " (cadr table-etc)))
 552                     (cddr table-etc)))))))))
 553
 554 (define-obsolete-function-alias
 555   'lisp-completion-at-point 'elisp-completion-at-point "25.1")
 556
 557 ;;; Xref backend
 558
 559 (declare-function xref-make-elisp-location "xref" (symbol type file))
 560 (declare-function xref-make-bogus-location "xref" (message))
 561 (declare-function xref-make "xref" (description location))
 562
 563 (defun elisp-xref-find (action id)
 564   (require 'find-func)
 565   (pcase action
 566     (`definitions
 567       (let ((sym (intern-soft id)))
 568         (when sym
 569           (elisp--xref-find-definitions sym))))
 570     (`apropos
 571      (elisp--xref-find-apropos id))))
 572
 573 (defun elisp--xref-identifier-location (type sym)
 574   (let ((file
 575          (pcase type
 576            (`defun (when (fboundp sym)
 577                      (let ((fun-lib
 578                             (find-function-library sym)))
 579                        (setq sym (car fun-lib))
 580                        (cdr fun-lib))))
 581            (`defvar (when (boundp sym)
 582                       (or (symbol-file sym 'defvar)
 583                           (help-C-file-name sym 'var))))
 584            (`feature (when (featurep sym)
 585                        (ignore-errors
 586                          (find-library-name (symbol-name sym)))))
 587            (`defface (when (facep sym)
 588                        (symbol-file sym 'defface))))))
 589     (when file
 590       (when (string-match-p "\\.elc\\'" file)
 591         (setq file (substring file 0 -1)))
 592       (xref-make-elisp-location sym type file))))
 593
 594 (defun elisp--xref-find-definitions (symbol)
 595   (save-excursion
 596     (let (lst)
 597       (dolist (type '(feature defface defvar defun))
 598         (let ((loc
 599                (condition-case err
 600                    (elisp--xref-identifier-location type symbol)
 601                  (error
 602                   (xref-make-bogus-location (error-message-string err))))))
 603           (when loc
 604             (push
 605              (xref-make (format "(%s %s)" type symbol)
 606                         loc)
 607              lst))))
 608       lst)))
 609
 610 (defun elisp--xref-find-apropos (regexp)
 611   (apply #'nconc
 612          (let (lst)
 613            (dolist (sym (apropos-internal regexp))
 614             (push (elisp--xref-find-definitions sym) lst))
 615            (nreverse lst))))
 616
 617 (defvar elisp--xref-identifier-completion-table
 618   (apply-partially #'completion-table-with-predicate
 619                    obarray
 620                    (lambda (sym)
 621                      (or (boundp sym)
 622                          (fboundp sym)
 623                          (featurep sym)
 624                          (facep sym)))
 625                    'strict))
 626
 627 (defun elisp--xref-identifier-completion-table ()
 628   elisp--xref-identifier-completion-table)
 629
 630 ;;; Elisp Interaction mode
 631
 632 (defvar lisp-interaction-mode-map
 633   (let ((map (make-sparse-keymap))
 634         (menu-map (make-sparse-keymap "Lisp-Interaction")))
 635     (set-keymap-parent map lisp-mode-shared-map)
 636     (define-key map "\e\C-x" 'eval-defun)
 637     (define-key map "\e\C-q" 'indent-pp-sexp)
 638     (define-key map "\e\t" 'completion-at-point)
 639     (define-key map "\n" 'eval-print-last-sexp)
 640     (bindings--define-key map [menu-bar lisp-interaction]
 641       (cons "Lisp-Interaction" menu-map))
 642     (bindings--define-key menu-map [eval-defun]
 643       '(menu-item "Evaluate Defun" eval-defun
 644                   :help "Evaluate the top-level form containing point, or after point"))
 645     (bindings--define-key menu-map [eval-print-last-sexp]
 646       '(menu-item "Evaluate and Print" eval-print-last-sexp
 647                   :help "Evaluate sexp before point; print value into current buffer"))
 648     (bindings--define-key menu-map [edebug-defun-lisp-interaction]
 649       '(menu-item "Instrument Function for Debugging" edebug-defun
 650                   :help "Evaluate the top level form point is in, stepping through with Edebug"
 651                   :keys "C-u C-M-x"))
 652     (bindings--define-key menu-map [indent-pp-sexp]
 653       '(menu-item "Indent or Pretty-Print" indent-pp-sexp
 654                   :help "Indent each line of the list starting just after point, or prettyprint it"))
 655     (bindings--define-key menu-map [complete-symbol]
 656       '(menu-item "Complete Lisp Symbol" completion-at-point
 657                   :help "Perform completion on Lisp symbol preceding point"))
 658     map)
 659   "Keymap for Lisp Interaction mode.
 660 All commands in `lisp-mode-shared-map' are inherited by this map.")
 661
 662 (define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
 663   "Major mode for typing and evaluating Lisp forms.
 664 Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
 665 before point, and prints its value into the buffer, advancing point.
 666 Note that printing is controlled by `eval-expression-print-length'
 667 and `eval-expression-print-level'.
 668
 669 Commands:
 670 Delete converts tabs to spaces as it moves back.
 671 Paragraphs are separated only by blank lines.
 672 Semicolons start comments.
 673
 674 \\{lisp-interaction-mode-map}"
 675   :abbrev-table nil)
 676
 677 ;;; Emacs Lisp Byte-Code mode
 678
 679 (eval-and-compile
 680   (defconst emacs-list-byte-code-comment-re
 681     (concat "\\(#\\)@\\([0-9]+\\) "
 682             ;; Make sure it's a docstring and not a lazy-loaded byte-code.
 683             "\\(?:[^(]\\|([^\"]\\)")))
 684
 685 (defun elisp--byte-code-comment (end &optional _point)
 686   "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
 687   (let ((ppss (syntax-ppss)))
 688     (when (and (nth 4 ppss)
 689                (eq (char-after (nth 8 ppss)) ?#))
 690       (let* ((n (save-excursion
 691                   (goto-char (nth 8 ppss))
 692                   (when (looking-at emacs-list-byte-code-comment-re)
 693                     (string-to-number (match-string 2)))))
 694              ;; `maxdiff' tries to make sure the loop below terminates.
 695              (maxdiff n))
 696         (when n
 697           (let* ((bchar (match-end 2))
 698                  (b (position-bytes bchar)))
 699             (goto-char (+ b n))
 700             (while (let ((diff (- (position-bytes (point)) b n)))
 701                      (unless (zerop diff)
 702                        (when (> diff maxdiff) (setq diff maxdiff))
 703                        (forward-char (- diff))
 704                        (setq maxdiff (if (> diff 0) diff
 705                                        (max (1- maxdiff) 1)))
 706                        t))))
 707           (if (<= (point) end)
 708               (put-text-property (1- (point)) (point)
 709                                  'syntax-table
 710                                  (string-to-syntax "> b"))
 711             (goto-char end)))))))
 712
 713 (defun elisp-byte-code-syntax-propertize (start end)
 714   (elisp--byte-code-comment end (point))
 715   (funcall
 716    (syntax-propertize-rules
 717     (emacs-list-byte-code-comment-re
 718      (1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
 719    start end))
 720
 721 ;;;###autoload
 722 (add-to-list 'auto-mode-alist '("\\.elc\\'" . elisp-byte-code-mode))
 723 ;;;###autoload
 724 (define-derived-mode elisp-byte-code-mode emacs-lisp-mode
 725   "Elisp-Byte-Code"
 726   "Major mode for *.elc files."
 727   ;; TODO: Add way to disassemble byte-code under point.
 728   (setq-local open-paren-in-column-0-is-defun-start nil)
 729   (setq-local syntax-propertize-function
 730               #'elisp-byte-code-syntax-propertize))
 731
 732
 733 ;;; Globally accessible functionality
 734
 735 (defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
 736   "Evaluate sexp before point; print value into current buffer.
 737
 738 Normally, this function truncates long output according to the value
 739 of the variables `eval-expression-print-length' and
 740 `eval-expression-print-level'.  With a prefix argument of zero,
 741 however, there is no such truncation.  Such a prefix argument
 742 also causes integers to be printed in several additional formats
 743 \(octal, hexadecimal, and character).
 744
 745 If `eval-expression-debug-on-error' is non-nil, which is the default,
 746 this command arranges for all errors to enter the debugger."
 747   (interactive "P")
 748   (let ((standard-output (current-buffer)))
 749     (terpri)
 750     (eval-last-sexp (or eval-last-sexp-arg-internal t))
 751     (terpri)))
 752
 753
 754 (defun last-sexp-setup-props (beg end value alt1 alt2)
 755   "Set up text properties for the output of `elisp--eval-last-sexp'.
 756 BEG and END are the start and end of the output in current-buffer.
 757 VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
 758 alternative printed representations that can be displayed."
 759   (let ((map (make-sparse-keymap)))
 760     (define-key map "\C-m" 'elisp-last-sexp-toggle-display)
 761     (define-key map [down-mouse-2] 'mouse-set-point)
 762     (define-key map [mouse-2] 'elisp-last-sexp-toggle-display)
 763     (add-text-properties
 764      beg end
 765      `(printed-value (,value ,alt1 ,alt2)
 766                      mouse-face highlight
 767                      keymap ,map
 768                      help-echo "RET, mouse-2: toggle abbreviated display"
 769                      rear-nonsticky (mouse-face keymap help-echo
 770                                                 printed-value)))))
 771
 772
 773 (defun elisp-last-sexp-toggle-display (&optional _arg)
 774   "Toggle between abbreviated and unabbreviated printed representations."
 775   (interactive "P")
 776   (save-restriction
 777     (widen)
 778     (let ((value (get-text-property (point) 'printed-value)))
 779       (when value
 780         (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
 781                                                         'printed-value)
 782                        (point)))
 783               (end (or (next-single-char-property-change (point) 'printed-value) (point)))
 784               (standard-output (current-buffer))
 785               (point (point)))
 786           (delete-region beg end)
 787           (insert (nth 1 value))
 788           (or (= beg point)
 789               (setq point (1- (point))))
 790           (last-sexp-setup-props beg (point)
 791                                  (nth 0 value)
 792                                  (nth 2 value)
 793                                  (nth 1 value))
 794           (goto-char (min (point-max) point)))))))
 795
 796 (defun prin1-char (char)                ;FIXME: Move it, e.g. to simple.el.
 797   "Return a string representing CHAR as a character rather than as an integer.
 798 If CHAR is not a character, return nil."
 799   (and (integerp char)
 800        (eventp char)
 801        (let ((c (event-basic-type char))
 802              (mods (event-modifiers char))
 803              string)
 804          ;; Prevent ?A from turning into ?\S-a.
 805          (if (and (memq 'shift mods)
 806                   (zerop (logand char ?\S-\^@))
 807                   (not (let ((case-fold-search nil))
 808                          (char-equal c (upcase c)))))
 809              (setq c (upcase c) mods nil))
 810          ;; What string are we considering using?
 811          (condition-case nil
 812              (setq string
 813                    (concat
 814                     "?"
 815                     (mapconcat
 816                      (lambda (modif)
 817                        (cond ((eq modif 'super) "\\s-")
 818                              (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
 819                      mods "")
 820                     (cond
 821                      ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
 822                      ((eq c 127) "\\C-?")
 823                      (t
 824                       (string c)))))
 825            (error nil))
 826          ;; Verify the string reads a CHAR, not to some other character.
 827          ;; If it doesn't, return nil instead.
 828          (and string
 829               (= (car (read-from-string string)) char)
 830               string))))
 831
 832 (defun elisp--preceding-sexp ()
 833   "Return sexp before the point."
 834   (let ((opoint (point))
 835         ignore-quotes
 836         expr)
 837     (save-excursion
 838       (with-syntax-table emacs-lisp-mode-syntax-table
 839         ;; If this sexp appears to be enclosed in `...'
 840         ;; then ignore the surrounding quotes.
 841         (setq ignore-quotes
 842               (or (eq (following-char) ?\')
 843                   (eq (preceding-char) ?\')))
 844         (forward-sexp -1)
 845         ;; If we were after `?\e' (or similar case),
 846         ;; use the whole thing, not just the `e'.
 847         (when (eq (preceding-char) ?\\)
 848           (forward-char -1)
 849           (when (eq (preceding-char) ??)
 850             (forward-char -1)))
 851
 852         ;; Skip over hash table read syntax.
 853         (and (> (point) (1+ (point-min)))
 854              (looking-back "#s" (- (point) 2))
 855              (forward-char -2))
 856
 857         ;; Skip over `#N='s.
 858         (when (eq (preceding-char) ?=)
 859           (let (labeled-p)
 860             (save-excursion
 861               (skip-chars-backward "0-9#=")
 862               (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
 863             (when labeled-p
 864               (forward-sexp -1))))
 865
 866         (save-restriction
 867           (if (and ignore-quotes (eq (following-char) ?`))
 868               ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
 869               ;; that the value is returned, not the name.
 870               (forward-char))
 871           (when (looking-at ",@?") (goto-char (match-end 0)))
 872           (narrow-to-region (point-min) opoint)
 873           (setq expr (read (current-buffer)))
 874           ;; If it's an (interactive ...) form, it's more useful to show how an
 875           ;; interactive call would use it.
 876           ;; FIXME: Is it really the right place for this?
 877           (when (eq (car-safe expr) 'interactive)
 878                (setq expr
 879                   `(call-interactively
 880                     (lambda (&rest args) ,expr args))))
 881           expr)))))
 882 (define-obsolete-function-alias 'preceding-sexp 'elisp--preceding-sexp "25.1")
 883
 884 (defun elisp--eval-last-sexp (eval-last-sexp-arg-internal)
 885   "Evaluate sexp before point; print value in the echo area.
 886 With argument, print output into current buffer.
 887 With a zero prefix arg, print output with no limit on the length
 888 and level of lists, and include additional formats for integers
 889 \(octal, hexadecimal, and character)."
 890   (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
 891     ;; Setup the lexical environment if lexical-binding is enabled.
 892     (elisp--eval-last-sexp-print-value
 893      (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding)
 894      eval-last-sexp-arg-internal)))
 895
 896
 897 (defun elisp--eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
 898   (let ((unabbreviated (let ((print-length nil) (print-level nil))
 899                          (prin1-to-string value)))
 900         (print-length (and (not (zerop (prefix-numeric-value
 901                                         eval-last-sexp-arg-internal)))
 902                            eval-expression-print-length))
 903         (print-level (and (not (zerop (prefix-numeric-value
 904                                        eval-last-sexp-arg-internal)))
 905                           eval-expression-print-level))
 906         (beg (point))
 907         end)
 908     (prog1
 909         (prin1 value)
 910       (let ((str (eval-expression-print-format value)))
 911         (if str (princ str)))
 912       (setq end (point))
 913       (when (and (bufferp standard-output)
 914                  (or (not (null print-length))
 915                      (not (null print-level)))
 916                  (not (string= unabbreviated
 917                                (buffer-substring-no-properties beg end))))
 918         (last-sexp-setup-props beg end value
 919                                unabbreviated
 920                                (buffer-substring-no-properties beg end))
 921         ))))
 922
 923
 924 (defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
 925
 926 (defun eval-sexp-add-defvars (exp &optional pos)
 927   "Prepend EXP with all the `defvar's that precede it in the buffer.
 928 POS specifies the starting position where EXP was found and defaults to point."
 929   (setq exp (macroexpand-all exp))      ;Eager macro-expansion.
 930   (if (not lexical-binding)
 931       exp
 932     (save-excursion
 933       (unless pos (setq pos (point)))
 934       (let ((vars ()))
 935         (goto-char (point-min))
 936         (while (re-search-forward
 937                 "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
 938                 pos t)
 939           (let ((var (intern (match-string 1))))
 940             (and (not (special-variable-p var))
 941                  (save-excursion
 942                    (zerop (car (syntax-ppss (match-beginning 0)))))
 943               (push var vars))))
 944         `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
 945
 946 (defun eval-last-sexp (eval-last-sexp-arg-internal)
 947   "Evaluate sexp before point; print value in the echo area.
 948 Interactively, with prefix argument, print output into current buffer.
 949
 950 Normally, this function truncates long output according to the value
 951 of the variables `eval-expression-print-length' and
 952 `eval-expression-print-level'.  With a prefix argument of zero,
 953 however, there is no such truncation.  Such a prefix argument
 954 also causes integers to be printed in several additional formats
 955 \(octal, hexadecimal, and character).
 956
 957 If `eval-expression-debug-on-error' is non-nil, which is the default,
 958 this command arranges for all errors to enter the debugger."
 959   (interactive "P")
 960   (if (null eval-expression-debug-on-error)
 961       (elisp--eval-last-sexp eval-last-sexp-arg-internal)
 962     (let ((value
 963            (let ((debug-on-error elisp--eval-last-sexp-fake-value))
 964              (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
 965                    debug-on-error))))
 966       (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
 967         (setq debug-on-error (cdr value)))
 968       (car value))))
 969
 970 (defun elisp--eval-defun-1 (form)
 971   "Treat some expressions specially.
 972 Reset the `defvar' and `defcustom' variables to the initial value.
 973 \(For `defcustom', use the :set function if there is one.)
 974 Reinitialize the face according to the `defface' specification."
 975   ;; The code in edebug-defun should be consistent with this, but not
 976   ;; the same, since this gets a macroexpanded form.
 977   (cond ((not (listp form))
 978          form)
 979         ((and (eq (car form) 'defvar)
 980               (cdr-safe (cdr-safe form))
 981               (boundp (cadr form)))
 982          ;; Force variable to be re-set.
 983          `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
 984                  (setq-default ,(nth 1 form) ,(nth 2 form))))
 985         ;; `defcustom' is now macroexpanded to
 986         ;; `custom-declare-variable' with a quoted value arg.
 987         ((and (eq (car form) 'custom-declare-variable)
 988               (default-boundp (eval (nth 1 form) lexical-binding)))
 989          ;; Force variable to be bound, using :set function if specified.
 990          (let ((setfunc (memq :set form)))
 991            (when setfunc
 992              (setq setfunc (car-safe (cdr-safe setfunc)))
 993              (or (functionp setfunc) (setq setfunc nil)))
 994            (funcall (or setfunc 'set-default)
 995                     (eval (nth 1 form) lexical-binding)
 996                     ;; The second arg is an expression that evaluates to
 997                     ;; an expression.  The second evaluation is the one
 998                     ;; normally performed not by normal execution but by
 999                     ;; custom-initialize-set (for example), which does not
1000                     ;; use lexical-binding.
1001                     (eval (eval (nth 2 form) lexical-binding))))
1002          form)
1003         ;; `defface' is macroexpanded to `custom-declare-face'.
1004         ((eq (car form) 'custom-declare-face)
1005          ;; Reset the face.
1006          (let ((face-symbol (eval (nth 1 form) lexical-binding)))
1007            (setq face-new-frame-defaults
1008                  (assq-delete-all face-symbol face-new-frame-defaults))
1009            (put face-symbol 'face-defface-spec nil)
1010            (put face-symbol 'face-override-spec nil))
1011          form)
1012         ((eq (car form) 'progn)
1013          (cons 'progn (mapcar #'elisp--eval-defun-1 (cdr form))))
1014         (t form)))
1015
1016 (defun elisp--eval-defun ()
1017   "Evaluate defun that point is in or before.
1018 The value is displayed in the echo area.
1019 If the current defun is actually a call to `defvar',
1020 then reset the variable using the initial value expression
1021 even if the variable already has some other value.
1022 \(Normally `defvar' does not change the variable's value
1023 if it already has a value.\)
1024
1025 Return the result of evaluation."
1026   ;; FIXME: the print-length/level bindings should only be applied while
1027   ;; printing, not while evaluating.
1028   (let ((debug-on-error eval-expression-debug-on-error)
1029         (print-length eval-expression-print-length)
1030         (print-level eval-expression-print-level))
1031     (save-excursion
1032       ;; Arrange for eval-region to "read" the (possibly) altered form.
1033       ;; eval-region handles recording which file defines a function or
1034       ;; variable.
1035       (let ((standard-output t)
1036             beg end form)
1037         ;; Read the form from the buffer, and record where it ends.
1038         (save-excursion
1039           (end-of-defun)
1040           (beginning-of-defun)
1041           (setq beg (point))
1042           (setq form (read (current-buffer)))
1043           (setq end (point)))
1044         ;; Alter the form if necessary.
1045         (let ((form (eval-sexp-add-defvars
1046                      (elisp--eval-defun-1 (macroexpand form)))))
1047           (eval-region beg end standard-output
1048                        (lambda (_ignore)
1049                          ;; Skipping to the end of the specified region
1050                          ;; will make eval-region return.
1051                          (goto-char end)
1052                          form))))))
1053   (let ((str (eval-expression-print-format (car values))))
1054     (if str (princ str)))
1055   ;; The result of evaluation has been put onto VALUES.  So return it.
1056   (car values))
1057
1058 (defun eval-defun (edebug-it)
1059   "Evaluate the top-level form containing point, or after point.
1060
1061 If the current defun is actually a call to `defvar' or `defcustom',
1062 evaluating it this way resets the variable using its initial value
1063 expression (using the defcustom's :set function if there is one), even
1064 if the variable already has some other value.  \(Normally `defvar' and
1065 `defcustom' do not alter the value if there already is one.)  In an
1066 analogous way, evaluating a `defface' overrides any customizations of
1067 the face, so that it becomes defined exactly as the `defface' expression
1068 says.
1069
1070 If `eval-expression-debug-on-error' is non-nil, which is the default,
1071 this command arranges for all errors to enter the debugger.
1072
1073 With a prefix argument, instrument the code for Edebug.
1074
1075 If acting on a `defun' for FUNCTION, and the function was
1076 instrumented, `Edebug: FUNCTION' is printed in the echo area.  If not
1077 instrumented, just FUNCTION is printed.
1078
1079 If not acting on a `defun', the result of evaluation is displayed in
1080 the echo area.  This display is controlled by the variables
1081 `eval-expression-print-length' and `eval-expression-print-level',
1082 which see."
1083   (interactive "P")
1084   (cond (edebug-it
1085          (require 'edebug)
1086          (eval-defun (not edebug-all-defs)))
1087         (t
1088          (if (null eval-expression-debug-on-error)
1089              (elisp--eval-defun)
1090            (let (new-value value)
1091              (let ((debug-on-error elisp--eval-last-sexp-fake-value))
1092                (setq value (elisp--eval-defun))
1093                (setq new-value debug-on-error))
1094              (unless (eq elisp--eval-last-sexp-fake-value new-value)
1095                (setq debug-on-error new-value))
1096              value)))))
1097
1098 ;;; ElDoc Support
1099
1100 (defvar elisp--eldoc-last-data (make-vector 3 nil)
1101   "Bookkeeping; elements are as follows:
1102   0 - contains the last symbol read from the buffer.
1103   1 - contains the string last displayed in the echo area for variables,
1104       or argument string for functions.
1105   2 - 'function if function args, 'variable if variable documentation.")
1106
1107 (defun elisp-eldoc-documentation-function ()
1108   "`eldoc-documentation-function' (which see) for Emacs Lisp."
1109   (let ((current-symbol (elisp--current-symbol))
1110         (current-fnsym  (elisp--fnsym-in-current-sexp)))
1111     (cond ((null current-fnsym)
1112            nil)
1113           ((eq current-symbol (car current-fnsym))
1114            (or (apply #'elisp--get-fnsym-args-string current-fnsym)
1115                (elisp--get-var-docstring current-symbol)))
1116           (t
1117            (or (elisp--get-var-docstring current-symbol)
1118                (apply #'elisp--get-fnsym-args-string current-fnsym))))))
1119
1120 (defun elisp--get-fnsym-args-string (sym &optional index)
1121   "Return a string containing the parameter list of the function SYM.
1122 If SYM is a subr and no arglist is obtainable from the docstring
1123 or elsewhere, return a 1-line docstring."
1124   (let ((argstring
1125          (cond
1126           ((not (and sym (symbolp sym) (fboundp sym))) nil)
1127           ((and (eq sym (aref elisp--eldoc-last-data 0))
1128                 (eq 'function (aref elisp--eldoc-last-data 2)))
1129            (aref elisp--eldoc-last-data 1))
1130           (t
1131            (let* ((advertised (gethash (indirect-function sym)
1132                                        advertised-signature-table t))
1133                   doc
1134                   (args
1135                    (cond
1136                     ((listp advertised) advertised)
1137                     ((setq doc (help-split-fundoc (documentation sym t) sym))
1138                      (car doc))
1139                     (t (help-function-arglist sym)))))
1140              ;; Stringify, and store before highlighting, downcasing, etc.
1141              ;; FIXME should truncate before storing.
1142              (elisp--last-data-store sym (elisp--function-argstring args)
1143                                     'function))))))
1144     ;; Highlight, truncate.
1145     (if argstring
1146         (elisp--highlight-function-argument sym argstring index))))
1147
1148 (defun elisp--highlight-function-argument (sym args index)
1149   "Highlight argument INDEX in ARGS list for function SYM.
1150 In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1151   ;; FIXME: This should probably work on the list representation of `args'
1152   ;; rather than its string representation.
1153   ;; FIXME: This function is much too long, we need to split it up!
1154   (let ((start          nil)
1155         (end            0)
1156         (argument-face  'eldoc-highlight-function-argument)
1157         (args-lst (mapcar (lambda (x)
1158                             (replace-regexp-in-string
1159                              "\\`[(]\\|[)]\\'" "" x))
1160                           (split-string args))))
1161     ;; Find the current argument in the argument string.  We need to
1162     ;; handle `&rest' and informal `...' properly.
1163     ;;
1164     ;; FIXME: What to do with optional arguments, like in
1165     ;;        (defun NAME ARGLIST [DOCSTRING] BODY...) case?
1166     ;;        The problem is there is no robust way to determine if
1167     ;;        the current argument is indeed a docstring.
1168
1169     ;; When `&key' is used finding position based on `index'
1170     ;; would be wrong, so find the arg at point and determine
1171     ;; position in ARGS based on this current arg.
1172     (when (string-match "&key" args)
1173       (let* (case-fold-search
1174              key-have-value
1175              (sym-name (symbol-name sym))
1176              (cur-w (current-word))
1177              (args-lst-ak (cdr (member "&key" args-lst)))
1178              (limit (save-excursion
1179                       (when (re-search-backward sym-name nil t)
1180                         (match-end 0))))
1181              (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w))
1182                         (substring cur-w 1)
1183                       (save-excursion
1184                         (let (split)
1185                           (when (re-search-backward ":\\([^()\n]*\\)" limit t)
1186                             (setq split (split-string (match-string 1) " " t))
1187                             (prog1 (car split)
1188                               (when (cdr split)
1189                                 (setq key-have-value t))))))))
1190              ;; If `cur-a' is not one of `args-lst-ak'
1191              ;; assume user is entering an unknown key
1192              ;; referenced in last position in signature.
1193              (other-key-arg (and (stringp cur-a)
1194                                  args-lst-ak
1195                                  (not (member (upcase cur-a) args-lst-ak))
1196                                  (upcase (car (last args-lst-ak))))))
1197         (unless (string= cur-w sym-name)
1198           ;; The last keyword have already a value
1199           ;; i.e :foo a b and cursor is at b.
1200           ;; If signature have also `&rest'
1201           ;; (assume it is after the `&key' section)
1202           ;; go to the arg after `&rest'.
1203           (if (and key-have-value
1204                    (save-excursion
1205                      (not (re-search-forward ":.*" (point-at-eol) t)))
1206                    (string-match "&rest \\([^ ()]*\\)" args))
1207               (setq index nil ; Skip next block based on positional args.
1208                     start (match-beginning 1)
1209                     end   (match-end 1))
1210             ;; If `cur-a' is nil probably cursor is on a positional arg
1211             ;; before `&key', in this case, exit this block and determine
1212             ;; position with `index'.
1213             (when (and cur-a     ; A keyword arg (dot removed) or nil.
1214                        (or (string-match
1215                             (concat "\\_<" (upcase cur-a) "\\_>") args)
1216                            (string-match
1217                             (concat "\\_<" other-key-arg "\\_>") args)))
1218               (setq index nil ; Skip next block based on positional args.
1219                     start (match-beginning 0)
1220                     end   (match-end 0)))))))
1221     ;; Handle now positional arguments.
1222     (while (and index (>= index 1))
1223       (if (string-match "[^ ()]+" args end)
1224           (progn
1225             (setq start (match-beginning 0)
1226                   end   (match-end 0))
1227             (let ((argument (match-string 0 args)))
1228               (cond ((string= argument "&rest")
1229                      ;; All the rest arguments are the same.
1230                      (setq index 1))
1231                     ((string= argument "&optional"))         ; Skip.
1232                     ((string= argument "&allow-other-keys")) ; Skip.
1233                     ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
1234                     ;; like in `setq'.
1235                     ((or (and (string-match-p "\\.\\.\\.$" argument)
1236                               (string= argument (car (last args-lst))))
1237                          (and (string-match-p "\\.\\.\\.$"
1238                                               (substring args 1 (1- (length args))))
1239                               (= (length (remove "..." args-lst)) 2)
1240                               (> index 1) (eq (logand index 1) 1)))
1241                      (setq index 0))
1242                     (t
1243                      (setq index (1- index))))))
1244         (setq end           (length args)
1245               start         (1- end)
1246               argument-face 'font-lock-warning-face
1247               index         0)))
1248     (let ((doc args))
1249       (when start
1250         (setq doc (copy-sequence args))
1251         (add-text-properties start end (list 'face argument-face) doc))
1252       (setq doc (elisp--docstring-format-sym-doc
1253                  sym doc (if (functionp sym) 'font-lock-function-name-face
1254                            'font-lock-keyword-face)))
1255       doc)))
1256
1257 ;; Return a string containing a brief (one-line) documentation string for
1258 ;; the variable.
1259 (defun elisp--get-var-docstring (sym)
1260   (cond ((not sym) nil)
1261         ((and (eq sym (aref elisp--eldoc-last-data 0))
1262               (eq 'variable (aref elisp--eldoc-last-data 2)))
1263          (aref elisp--eldoc-last-data 1))
1264         (t
1265          (let ((doc (documentation-property sym 'variable-documentation t)))
1266            (when doc
1267              (let ((doc (elisp--docstring-format-sym-doc
1268                          sym (elisp--docstring-first-line doc)
1269                          'font-lock-variable-name-face)))
1270                (elisp--last-data-store sym doc 'variable)))))))
1271
1272 (defun elisp--last-data-store (symbol doc type)
1273   (aset elisp--eldoc-last-data 0 symbol)
1274   (aset elisp--eldoc-last-data 1 doc)
1275   (aset elisp--eldoc-last-data 2 type)
1276   doc)
1277
1278 ;; Note that any leading `*' in the docstring (which indicates the variable
1279 ;; is a user option) is removed.
1280 (defun elisp--docstring-first-line (doc)
1281   (and (stringp doc)
1282        (substitute-command-keys
1283         (save-match-data
1284           ;; Don't use "^" in the regexp below since it may match
1285           ;; anywhere in the doc-string.
1286           (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
1287             (cond ((string-match "\n" doc)
1288                    (substring doc start (match-beginning 0)))
1289                   ((zerop start) doc)
1290                   (t (substring doc start))))))))
1291
1292 (defvar eldoc-echo-area-use-multiline-p)
1293
1294 ;; If the entire line cannot fit in the echo area, the symbol name may be
1295 ;; truncated or eliminated entirely from the output to make room for the
1296 ;; description.
1297 (defun elisp--docstring-format-sym-doc (sym doc face)
1298   (save-match-data
1299     (let* ((name (symbol-name sym))
1300            (ea-multi eldoc-echo-area-use-multiline-p)
1301            ;; Subtract 1 from window width since emacs will not write
1302            ;; any chars to the last column, or in later versions, will
1303            ;; cause a wraparound and resize of the echo area.
1304            (ea-width (1- (window-width (minibuffer-window))))
1305            (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
1306       (cond ((or (<= strip 0)
1307                  (eq ea-multi t)
1308                  (and ea-multi (> (length doc) ea-width)))
1309              (format "%s: %s" (propertize name 'face face) doc))
1310             ((> (length doc) ea-width)
1311              (substring (format "%s" doc) 0 ea-width))
1312             ((>= strip (length name))
1313              (format "%s" doc))
1314             (t
1315              ;; Show the end of the partial symbol name, rather
1316              ;; than the beginning, since the former is more likely
1317              ;; to be unique given package namespace conventions.
1318              (setq name (substring name strip))
1319              (format "%s: %s" (propertize name 'face face) doc))))))
1320
1321 \f
1322 ;; Return a list of current function name and argument index.
1323 (defun elisp--fnsym-in-current-sexp ()
1324   (save-excursion
1325     (let ((argument-index (1- (elisp--beginning-of-sexp))))
1326       ;; If we are at the beginning of function name, this will be -1.
1327       (when (< argument-index 0)
1328         (setq argument-index 0))
1329       ;; Don't do anything if current word is inside a string.
1330       (if (= (or (char-after (1- (point))) 0) ?\")
1331           nil
1332         (list (elisp--current-symbol) argument-index)))))
1333
1334 ;; Move to the beginning of current sexp.  Return the number of nested
1335 ;; sexp the point was over or after.
1336 (defun elisp--beginning-of-sexp ()
1337   (let ((parse-sexp-ignore-comments t)
1338         (num-skipped-sexps 0))
1339     (condition-case _
1340         (progn
1341           ;; First account for the case the point is directly over a
1342           ;; beginning of a nested sexp.
1343           (condition-case _
1344               (let ((p (point)))
1345                 (forward-sexp -1)
1346                 (forward-sexp 1)
1347                 (when (< (point) p)
1348                   (setq num-skipped-sexps 1)))
1349             (error))
1350           (while
1351               (let ((p (point)))
1352                 (forward-sexp -1)
1353                 (when (< (point) p)
1354                   (setq num-skipped-sexps (1+ num-skipped-sexps))))))
1355       (error))
1356     num-skipped-sexps))
1357
1358 ;; returns nil unless current word is an interned symbol.
1359 (defun elisp--current-symbol ()
1360   (let ((c (char-after (point))))
1361     (and c
1362          (memq (char-syntax c) '(?w ?_))
1363          (intern-soft (current-word)))))
1364
1365 (defun elisp--function-argstring (arglist)
1366   "Return ARGLIST as a string enclosed by ().
1367 ARGLIST is either a string, or a list of strings or symbols."
1368   (let ((str (cond ((stringp arglist) arglist)
1369                    ((not (listp arglist)) nil)
1370                    (t (format "%S" (help-make-usage 'toto arglist))))))
1371     (if (and str (string-match "\\`([^ )]+ ?" str))
1372         (replace-match "(" t t str)
1373       str)))
1374
1375 (provide 'elisp-mode)
1376 ;;; elisp-mode.el ends here