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