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