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