lisp/progmodes/elisp-mode.el

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