lisp/progmodes/elisp-mode.el

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