code.delx.au - gnu-emacs/blob - lisp/progmodes/elisp-mode.el

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