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