diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-09-26 23:57:41 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-09-26 23:57:41 -0400 |
commit | e6cfa098ae23e34c5415642e2f848a92982924ef (patch) | |
tree | 99f569a54971a64e06420953928fb3bfcb803125 /lisp/emacs-lisp | |
parent | 6a19cde634d233f44c8db61ae4f6d54c07e277fb (diff) |
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.
Diffstat (limited to 'lisp/emacs-lisp')
-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 |
3 files changed, 69 insertions, 1250 deletions
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 50c7816286..c190e2745e 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." (defface eldoc-highlight-function-argument '((t (:inherit bold))) "Face used for the argument at point in a function's argument list. -Note that if `eldoc-documentation-function' is non-nil, this face -has no effect, unless the function handles it explicitly." +Note that this face has no effect unless the `eldoc-documentation-function' +handles it explicitly." :group 'eldoc) ;;; No user options below here. @@ -185,15 +185,34 @@ it displays the argument list of the function called in the expression point is on." :group 'eldoc :lighter eldoc-minor-mode-string (setq eldoc-last-message nil) - (if eldoc-mode + (cond + (eldoc-documentation-function + (message "There is no ElDoc support in this buffer") + (setq eldoc-mode nil)) + (eldoc-mode + (when eldoc-print-after-edit + (setq-local eldoc-message-commands (eldoc-edit-message-commands))) + (add-hook 'post-command-hook 'eldoc-schedule-timer nil t) + (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t)) + (t + (kill-local-variable 'eldoc-message-commands) + (remove-hook 'post-command-hook 'eldoc-schedule-timer t) + (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)))) + +;;;###autoload +(define-minor-mode global-eldoc-mode + "Enable `eldoc-mode' in all buffers where it's applicable." + :group 'eldoc :global t + (setq eldoc-last-message nil) + (if global-eldoc-mode (progn (when eldoc-print-after-edit (setq-local eldoc-message-commands (eldoc-edit-message-commands))) - (add-hook 'post-command-hook 'eldoc-schedule-timer nil t) - (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t)) + (add-hook 'post-command-hook #'eldoc-schedule-timer) + (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area)) (kill-local-variable 'eldoc-message-commands) - (remove-hook 'post-command-hook 'eldoc-schedule-timer t) - (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))) + (remove-hook 'post-command-hook #'eldoc-schedule-timer) + (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area))) ;;;###autoload (define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4") @@ -201,11 +220,14 @@ expression point is on." (defun eldoc-schedule-timer () (or (and eldoc-timer - (memq eldoc-timer timer-idle-list)) + (memq eldoc-timer timer-idle-list)) ;FIXME: Why? (setq eldoc-timer (run-with-idle-timer eldoc-idle-delay t - (lambda () (and eldoc-mode (eldoc-print-current-symbol-info)))))) + (lambda () + (when (or eldoc-mode + (and global-eldoc-mode eldoc-documentation-function)) + (eldoc-print-current-symbol-info)))))) ;; If user has changed the idle delay, update the timer. (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay)) @@ -300,7 +322,7 @@ Otherwise work like `message'." ;;;###autoload -(defvar eldoc-documentation-function #'eldoc-documentation-function-default +(defvar eldoc-documentation-function nil "Function to call to return doc string. The function of no args should return a one-line string for displaying 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', and the face `eldoc-highlight-function-argument', if they are to have any effect. -This variable is expected to be made buffer-local by modes (other than -Emacs Lisp mode) that support ElDoc.") +This variable is expected to be set buffer-locally by modes that support ElDoc.") (defun eldoc-print-current-symbol-info () ;; This is run from post-command-hook or some idle timer thing, @@ -327,281 +348,6 @@ Emacs Lisp mode) that support ElDoc.") nil)) (eldoc-message (funcall eldoc-documentation-function))))) -(defun eldoc-documentation-function-default () - "Default value for `eldoc-documentation-function' (which see)." - (let ((current-symbol (eldoc-current-symbol)) - (current-fnsym (eldoc-fnsym-in-current-sexp))) - (cond ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply #'eldoc-get-fnsym-args-string current-fnsym) - (eldoc-get-var-docstring current-symbol))) - (t - (or (eldoc-get-var-docstring current-symbol) - (apply #'eldoc-get-fnsym-args-string current-fnsym)))))) - -(defun eldoc-get-fnsym-args-string (sym &optional index) - "Return a string containing the parameter list of the function SYM. -If SYM is a subr and no arglist is obtainable from the docstring -or elsewhere, return a 1-line docstring." - (let ((argstring - (cond - ((not (and sym (symbolp sym) (fboundp sym))) nil) - ((and (eq sym (aref eldoc-last-data 0)) - (eq 'function (aref eldoc-last-data 2))) - (aref eldoc-last-data 1)) - (t - (let* ((advertised (gethash (indirect-function sym) - advertised-signature-table t)) - doc - (args - (cond - ((listp advertised) advertised) - ((setq doc (help-split-fundoc (documentation sym t) sym)) - (car doc)) - (t (help-function-arglist sym))))) - ;; Stringify, and store before highlighting, downcasing, etc. - ;; FIXME should truncate before storing. - (eldoc-last-data-store sym (eldoc-function-argstring args) - 'function)))))) - ;; Highlight, truncate. - (if argstring - (eldoc-highlight-function-argument sym argstring index)))) - -(defun eldoc-highlight-function-argument (sym args index) - "Highlight argument INDEX in ARGS list for function SYM. -In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." - ;; FIXME: This should probably work on the list representation of `args' - ;; rather than its string representation. - ;; FIXME: This function is much too long, we need to split it up! - (let ((start nil) - (end 0) - (argument-face 'eldoc-highlight-function-argument) - (args-lst (mapcar (lambda (x) - (replace-regexp-in-string - "\\`[(]\\|[)]\\'" "" x)) - (split-string args)))) - ;; Find the current argument in the argument string. We need to - ;; handle `&rest' and informal `...' properly. - ;; - ;; FIXME: What to do with optional arguments, like in - ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? - ;; The problem is there is no robust way to determine if - ;; the current argument is indeed a docstring. - - ;; When `&key' is used finding position based on `index' - ;; would be wrong, so find the arg at point and determine - ;; position in ARGS based on this current arg. - (when (string-match "&key" args) - (let* (case-fold-search - key-have-value - (sym-name (symbol-name sym)) - (cur-w (current-word)) - (args-lst-ak (cdr (member "&key" args-lst))) - (limit (save-excursion - (when (re-search-backward sym-name nil t) - (match-end 0)))) - (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w)) - (substring cur-w 1) - (save-excursion - (let (split) - (when (re-search-backward ":\\([^()\n]*\\)" limit t) - (setq split (split-string (match-string 1) " " t)) - (prog1 (car split) - (when (cdr split) - (setq key-have-value t)))))))) - ;; If `cur-a' is not one of `args-lst-ak' - ;; assume user is entering an unknown key - ;; referenced in last position in signature. - (other-key-arg (and (stringp cur-a) - args-lst-ak - (not (member (upcase cur-a) args-lst-ak)) - (upcase (car (last args-lst-ak)))))) - (unless (string= cur-w sym-name) - ;; The last keyword have already a value - ;; i.e :foo a b and cursor is at b. - ;; If signature have also `&rest' - ;; (assume it is after the `&key' section) - ;; go to the arg after `&rest'. - (if (and key-have-value - (save-excursion - (not (re-search-forward ":.*" (point-at-eol) t))) - (string-match "&rest \\([^ ()]*\\)" args)) - (setq index nil ; Skip next block based on positional args. - start (match-beginning 1) - end (match-end 1)) - ;; If `cur-a' is nil probably cursor is on a positional arg - ;; before `&key', in this case, exit this block and determine - ;; position with `index'. - (when (and cur-a ; A keyword arg (dot removed) or nil. - (or (string-match - (concat "\\_<" (upcase cur-a) "\\_>") args) - (string-match - (concat "\\_<" other-key-arg "\\_>") args))) - (setq index nil ; Skip next block based on positional args. - start (match-beginning 0) - end (match-end 0))))))) - ;; Handle now positional arguments. - (while (and index (>= index 1)) - (if (string-match "[^ ()]+" args end) - (progn - (setq start (match-beginning 0) - end (match-end 0)) - (let ((argument (match-string 0 args))) - (cond ((string= argument "&rest") - ;; All the rest arguments are the same. - (setq index 1)) - ((string= argument "&optional")) ; Skip. - ((string= argument "&allow-other-keys")) ; Skip. - ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc... - ;; like in `setq'. - ((or (and (string-match-p "\\.\\.\\.$" argument) - (string= argument (car (last args-lst)))) - (and (string-match-p "\\.\\.\\.$" - (substring args 1 (1- (length args)))) - (= (length (remove "..." args-lst)) 2) - (> index 1) (cl-oddp index))) - (setq index 0)) - (t - (setq index (1- index)))))) - (setq end (length args) - start (1- end) - argument-face 'font-lock-warning-face - index 0))) - (let ((doc args)) - (when start - (setq doc (copy-sequence args)) - (add-text-properties start end (list 'face argument-face) doc)) - (setq doc (eldoc-docstring-format-sym-doc - sym doc (if (functionp sym) 'font-lock-function-name-face - 'font-lock-keyword-face))) - doc))) - -;; Return a string containing a brief (one-line) documentation string for -;; the variable. -(defun eldoc-get-var-docstring (sym) - (cond ((not sym) nil) - ((and (eq sym (aref eldoc-last-data 0)) - (eq 'variable (aref eldoc-last-data 2))) - (aref eldoc-last-data 1)) - (t - (let ((doc (documentation-property sym 'variable-documentation t))) - (when doc - (let ((doc (eldoc-docstring-format-sym-doc - sym (eldoc-docstring-first-line doc) - 'font-lock-variable-name-face))) - (eldoc-last-data-store sym doc 'variable))))))) - -(defun eldoc-last-data-store (symbol doc type) - (aset eldoc-last-data 0 symbol) - (aset eldoc-last-data 1 doc) - (aset eldoc-last-data 2 type) - doc) - -;; Note that any leading `*' in the docstring (which indicates the variable -;; is a user option) is removed. -(defun eldoc-docstring-first-line (doc) - (and (stringp doc) - (substitute-command-keys - (save-match-data - ;; Don't use "^" in the regexp below since it may match - ;; anywhere in the doc-string. - (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0))) - (cond ((string-match "\n" doc) - (substring doc start (match-beginning 0))) - ((zerop start) doc) - (t (substring doc start)))))))) - -;; If the entire line cannot fit in the echo area, the symbol name may be -;; truncated or eliminated entirely from the output to make room for the -;; description. -(defun eldoc-docstring-format-sym-doc (sym doc face) - (save-match-data - (let* ((name (symbol-name sym)) - (ea-multi eldoc-echo-area-use-multiline-p) - ;; Subtract 1 from window width since emacs will not write - ;; any chars to the last column, or in later versions, will - ;; cause a wraparound and resize of the echo area. - (ea-width (1- (window-width (minibuffer-window)))) - (strip (- (+ (length name) (length ": ") (length doc)) ea-width))) - (cond ((or (<= strip 0) - (eq ea-multi t) - (and ea-multi (> (length doc) ea-width))) - (format "%s: %s" (propertize name 'face face) doc)) - ((> (length doc) ea-width) - (substring (format "%s" doc) 0 ea-width)) - ((>= strip (length name)) - (format "%s" doc)) - (t - ;; Show the end of the partial symbol name, rather - ;; than the beginning, since the former is more likely - ;; to be unique given package namespace conventions. - (setq name (substring name strip)) - (format "%s: %s" (propertize name 'face face) doc)))))) - - -;; Return a list of current function name and argument index. -(defun eldoc-fnsym-in-current-sexp () - (save-excursion - (let ((argument-index (1- (eldoc-beginning-of-sexp)))) - ;; If we are at the beginning of function name, this will be -1. - (when (< argument-index 0) - (setq argument-index 0)) - ;; Don't do anything if current word is inside a string. - (if (= (or (char-after (1- (point))) 0) ?\") - nil - (list (eldoc-current-symbol) argument-index))))) - -;; Move to the beginning of current sexp. Return the number of nested -;; sexp the point was over or after. -(defun eldoc-beginning-of-sexp () - (let ((parse-sexp-ignore-comments t) - (num-skipped-sexps 0)) - (condition-case _ - (progn - ;; First account for the case the point is directly over a - ;; beginning of a nested sexp. - (condition-case _ - (let ((p (point))) - (forward-sexp -1) - (forward-sexp 1) - (when (< (point) p) - (setq num-skipped-sexps 1))) - (error)) - (while - (let ((p (point))) - (forward-sexp -1) - (when (< (point) p) - (setq num-skipped-sexps (1+ num-skipped-sexps)))))) - (error)) - num-skipped-sexps)) - -;; returns nil unless current word is an interned symbol. -(defun eldoc-current-symbol () - (let ((c (char-after (point)))) - (and c - (memq (char-syntax c) '(?w ?_)) - (intern-soft (current-word))))) - -;; Do indirect function resolution if possible. -(defun eldoc-symbol-function (fsym) - (let ((defn (symbol-function fsym))) - (and (symbolp defn) - (condition-case _ - (setq defn (indirect-function fsym)) - (error (setq defn nil)))) - defn)) - -(defun eldoc-function-argstring (arglist) - "Return ARGLIST as a string enclosed by (). -ARGLIST is either a string, or a list of strings or symbols." - (let ((str (cond ((stringp arglist) arglist) - ((not (listp arglist)) nil) - (t (format "%S" (help-make-usage 'toto arglist)))))) - (if (and str (string-match "\\`([^ )]+ ?" str)) - (replace-match "(" t t str) - str))) - ;; When point is in a sexp, the function args are not reprinted in the echo ;; 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." (defun eldoc-add-command-completions (&rest names) (dolist (name names) - (apply 'eldoc-add-command (all-completions name obarray 'commandp)))) + (apply #'eldoc-add-command (all-completions name obarray 'commandp)))) (defun eldoc-remove-command (&rest cmds) (dolist (name cmds) @@ -627,7 +373,7 @@ ARGLIST is either a string, or a list of strings or symbols." (defun eldoc-remove-command-completions (&rest names) (dolist (name names) - (apply 'eldoc-remove-command + (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 435730ae09..57900e39be 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -33,17 +33,10 @@ (defvar font-lock-keywords-case-fold-search) (defvar font-lock-string-face) -(defvar lisp-mode-abbrev-table nil) (define-abbrev-table 'lisp-mode-abbrev-table () "Abbrev table for Lisp mode.") -(defvar emacs-lisp-mode-abbrev-table nil) -(define-abbrev-table 'emacs-lisp-mode-abbrev-table () - "Abbrev table for Emacs Lisp mode. -It has `lisp-mode-abbrev-table' as its parent." - :parents (list lisp-mode-abbrev-table)) - -(defvar emacs-lisp-mode-syntax-table +(defvar lisp--mode-syntax-table (let ((table (make-syntax-table)) (i 0)) (while (< i ?0) @@ -82,13 +75,11 @@ It has `lisp-mode-abbrev-table' as its parent." (modify-syntax-entry ?\\ "\\ " table) (modify-syntax-entry ?\( "() " table) (modify-syntax-entry ?\) ")( " table) - (modify-syntax-entry ?\[ "(] " table) - (modify-syntax-entry ?\] ")[ " table) table) - "Syntax table used in `emacs-lisp-mode'.") + "Parent syntax table used in Lisp modes.") (defvar lisp-mode-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) + (let ((table (make-syntax-table lisp--mode-syntax-table))) (modify-syntax-entry ?\[ "_ " table) (modify-syntax-entry ?\] "_ " table) (modify-syntax-entry ?# "' 14" table) @@ -102,26 +93,35 @@ It has `lisp-mode-abbrev-table' as its parent." (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defun" "defun*" "defsubst" "defmacro" + '("defun" "defmacro" + ;; Elisp. + "defun*" "defsubst" "defadvice" "define-skeleton" "define-compilation-mode" "define-minor-mode" "define-global-minor-mode" "define-globalized-minor-mode" "define-derived-mode" "define-generic-mode" + "cl-defun" "cl-defsubst" "cl-defmacro" + "cl-define-compiler-macro" + ;; CL. "define-compiler-macro" "define-modify-macro" "defsetf" "define-setf-expander" "define-method-combination" - "defgeneric" "defmethod" - "cl-defun" "cl-defsubst" "cl-defmacro" - "cl-define-compiler-macro") t)) + ;; CLOS and EIEIO + "defgeneric" "defmethod") + t)) "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 2) (list (purecopy "Variables") (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defconst" "defconstant" "defcustom" - "defparameter" "define-symbol-macro") t)) + '(;; Elisp + "defconst" "defcustom" + ;; CL + "defconstant" + "defparameter" "define-symbol-macro") + t)) "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 2) ;; For `defvar', we ignore (defvar FOO) constructs. @@ -133,10 +133,16 @@ It has `lisp-mode-abbrev-table' as its parent." (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defgroup" "deftheme" "deftype" "defstruct" - "defclass" "define-condition" "define-widget" - "defface" "defpackage" "cl-deftype" - "cl-defstruct") t)) + '(;; Elisp + "defgroup" "deftheme" + "define-widget" "define-error" + "defface" "cl-deftype" "cl-defstruct" + ;; CL + "deftype" "defstruct" + "define-condition" "defpackage" + ;; CLOS and EIEIO + "defclass") + t)) "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)")) 2)) @@ -558,166 +564,6 @@ font-lock keywords will not be case sensitive." map) "Keymap for commands shared by all sorts of Lisp modes.") -(defvar emacs-lisp-mode-map - (let ((map (make-sparse-keymap "Emacs-Lisp")) - (menu-map (make-sparse-keymap "Emacs-Lisp")) - (lint-map (make-sparse-keymap)) - (prof-map (make-sparse-keymap)) - (tracing-map (make-sparse-keymap))) - (set-keymap-parent map lisp-mode-shared-map) - (define-key map "\e\t" 'completion-at-point) - (define-key map "\e\C-x" 'eval-defun) - (define-key map "\e\C-q" 'indent-pp-sexp) - (bindings--define-key map [menu-bar emacs-lisp] - (cons "Emacs-Lisp" menu-map)) - (bindings--define-key menu-map [eldoc] - '(menu-item "Auto-Display Documentation Strings" eldoc-mode - :button (:toggle . (bound-and-true-p eldoc-mode)) - :help "Display the documentation string for the item under cursor")) - (bindings--define-key menu-map [checkdoc] - '(menu-item "Check Documentation Strings" checkdoc - :help "Check documentation strings for style requirements")) - (bindings--define-key menu-map [re-builder] - '(menu-item "Construct Regexp" re-builder - :help "Construct a regexp interactively")) - (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map)) - (bindings--define-key tracing-map [tr-a] - '(menu-item "Untrace All" untrace-all - :help "Untrace all currently traced functions")) - (bindings--define-key tracing-map [tr-uf] - '(menu-item "Untrace Function..." untrace-function - :help "Untrace function, and possibly activate all remaining advice")) - (bindings--define-key tracing-map [tr-sep] menu-bar-separator) - (bindings--define-key tracing-map [tr-q] - '(menu-item "Trace Function Quietly..." trace-function-background - :help "Trace the function with trace output going quietly to a buffer")) - (bindings--define-key tracing-map [tr-f] - '(menu-item "Trace Function..." trace-function - :help "Trace the function given as an argument")) - (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map)) - (bindings--define-key prof-map [prof-restall] - '(menu-item "Remove Instrumentation for All Functions" elp-restore-all - :help "Restore the original definitions of all functions being profiled")) - (bindings--define-key prof-map [prof-restfunc] - '(menu-item "Remove Instrumentation for Function..." elp-restore-function - :help "Restore an instrumented function to its original definition")) - - (bindings--define-key prof-map [sep-rem] menu-bar-separator) - (bindings--define-key prof-map [prof-resall] - '(menu-item "Reset Counters for All Functions" elp-reset-all - :help "Reset the profiling information for all functions being profiled")) - (bindings--define-key prof-map [prof-resfunc] - '(menu-item "Reset Counters for Function..." elp-reset-function - :help "Reset the profiling information for a function")) - (bindings--define-key prof-map [prof-res] - '(menu-item "Show Profiling Results" elp-results - :help "Display current profiling results")) - (bindings--define-key prof-map [prof-pack] - '(menu-item "Instrument Package..." elp-instrument-package - :help "Instrument for profiling all function that start with a prefix")) - (bindings--define-key prof-map [prof-func] - '(menu-item "Instrument Function..." elp-instrument-function - :help "Instrument a function for profiling")) - ;; Maybe this should be in a separate submenu from the ELP stuff? - (bindings--define-key prof-map [sep-natprof] menu-bar-separator) - (bindings--define-key prof-map [prof-natprof-stop] - '(menu-item "Stop Native Profiler" profiler-stop - :help "Stop recording profiling information" - :enable (and (featurep 'profiler) - (profiler-running-p)))) - (bindings--define-key prof-map [prof-natprof-report] - '(menu-item "Show Profiler Report" profiler-report - :help "Show the current profiler report" - :enable (and (featurep 'profiler) - (profiler-running-p)))) - (bindings--define-key prof-map [prof-natprof-start] - '(menu-item "Start Native Profiler..." profiler-start - :help "Start recording profiling information")) - - (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) - (bindings--define-key lint-map [lint-di] - '(menu-item "Lint Directory..." elint-directory - :help "Lint a directory")) - (bindings--define-key lint-map [lint-f] - '(menu-item "Lint File..." elint-file - :help "Lint a file")) - (bindings--define-key lint-map [lint-b] - '(menu-item "Lint Buffer" elint-current-buffer - :help "Lint the current buffer")) - (bindings--define-key lint-map [lint-d] - '(menu-item "Lint Defun" elint-defun - :help "Lint the function at point")) - (bindings--define-key menu-map [edebug-defun] - '(menu-item "Instrument Function for Debugging" edebug-defun - :help "Evaluate the top level form point is in, stepping through with Edebug" - :keys "C-u C-M-x")) - (bindings--define-key menu-map [separator-byte] menu-bar-separator) - (bindings--define-key menu-map [disas] - '(menu-item "Disassemble Byte Compiled Object..." disassemble - :help "Print disassembled code for OBJECT in a buffer")) - (bindings--define-key menu-map [byte-recompile] - '(menu-item "Byte-recompile Directory..." byte-recompile-directory - :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) - (bindings--define-key menu-map [emacs-byte-compile-and-load] - '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load - :help "Byte-compile the current file (if it has changed), then load compiled code")) - (bindings--define-key menu-map [byte-compile] - '(menu-item "Byte-compile This File" emacs-lisp-byte-compile - :help "Byte compile the file containing the current buffer")) - (bindings--define-key menu-map [separator-eval] menu-bar-separator) - (bindings--define-key menu-map [ielm] - '(menu-item "Interactive Expression Evaluation" ielm - :help "Interactively evaluate Emacs Lisp expressions")) - (bindings--define-key menu-map [eval-buffer] - '(menu-item "Evaluate Buffer" eval-buffer - :help "Execute the current buffer as Lisp code")) - (bindings--define-key menu-map [eval-region] - '(menu-item "Evaluate Region" eval-region - :help "Execute the region as Lisp code" - :enable mark-active)) - (bindings--define-key menu-map [eval-sexp] - '(menu-item "Evaluate Last S-expression" eval-last-sexp - :help "Evaluate sexp before point; print value in echo area")) - (bindings--define-key menu-map [separator-format] menu-bar-separator) - (bindings--define-key menu-map [comment-region] - '(menu-item "Comment Out Region" comment-region - :help "Comment or uncomment each line in the region" - :enable mark-active)) - (bindings--define-key menu-map [indent-region] - '(menu-item "Indent Region" indent-region - :help "Indent each nonblank line in the region" - :enable mark-active)) - (bindings--define-key menu-map [indent-line] - '(menu-item "Indent Line" lisp-indent-line)) - map) - "Keymap for Emacs Lisp mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") - -(defun emacs-lisp-byte-compile () - "Byte compile the file containing the current buffer." - (interactive) - (if buffer-file-name - (byte-compile-file buffer-file-name) - (error "The buffer must be saved in a file first"))) - -(defun emacs-lisp-byte-compile-and-load () - "Byte-compile the current file (if it has changed), then load compiled code." - (interactive) - (or buffer-file-name - (error "The buffer must be saved in a file first")) - (require 'bytecomp) - ;; Recompile if file or buffer has changed since last compilation. - (if (and (buffer-modified-p) - (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) - (save-buffer)) - (byte-recompile-file buffer-file-name nil 0 t)) - -(defcustom emacs-lisp-mode-hook nil - "Hook run when entering Emacs Lisp mode." - :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode) - :type 'hook - :group 'lisp) - (defcustom lisp-mode-hook nil "Hook run when entering Lisp mode." :options '(imenu-add-menubar-index) @@ -733,72 +579,6 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (defconst lisp--prettify-symbols-alist '(("lambda" . ?λ))) -(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" - "Major mode for editing Lisp code to run in Emacs. -Commands: -Delete converts tabs to spaces as it moves back. -Blank lines separate paragraphs. Semicolons start comments. - -\\{emacs-lisp-mode-map}" - :group 'lisp - (lisp-mode-variables nil nil 'elisp) - (setq imenu-case-fold-search nil) - (add-hook 'completion-at-point-functions - 'lisp-completion-at-point nil 'local)) - -;;; Emacs Lisp Byte-Code mode - -(eval-and-compile - (defconst emacs-list-byte-code-comment-re - (concat "\\(#\\)@\\([0-9]+\\) " - ;; Make sure it's a docstring and not a lazy-loaded byte-code. - "\\(?:[^(]\\|([^\"]\\)"))) - -(defun emacs-lisp-byte-code-comment (end &optional _point) - "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files." - (let ((ppss (syntax-ppss))) - (when (and (nth 4 ppss) - (eq (char-after (nth 8 ppss)) ?#)) - (let* ((n (save-excursion - (goto-char (nth 8 ppss)) - (when (looking-at emacs-list-byte-code-comment-re) - (string-to-number (match-string 2))))) - ;; `maxdiff' tries to make sure the loop below terminates. - (maxdiff n)) - (when n - (let* ((bchar (match-end 2)) - (b (position-bytes bchar))) - (goto-char (+ b n)) - (while (let ((diff (- (position-bytes (point)) b n))) - (unless (zerop diff) - (when (> diff maxdiff) (setq diff maxdiff)) - (forward-char (- diff)) - (setq maxdiff (if (> diff 0) diff - (max (1- maxdiff) 1))) - t)))) - (if (<= (point) end) - (put-text-property (1- (point)) (point) - 'syntax-table - (string-to-syntax "> b")) - (goto-char end))))))) - -(defun emacs-lisp-byte-code-syntax-propertize (start end) - (emacs-lisp-byte-code-comment end (point)) - (funcall - (syntax-propertize-rules - (emacs-list-byte-code-comment-re - (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point)))))) - start end)) - -(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode)) -(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode - "Elisp-Byte-Code" - "Major mode for *.elc files." - ;; TODO: Add way to disassemble byte-code under point. - (setq-local open-paren-in-column-0-is-defun-start nil) - (setq-local syntax-propertize-function - #'emacs-lisp-byte-code-syntax-propertize)) - ;;; Generic Lisp mode. (defvar lisp-mode-map @@ -852,415 +632,6 @@ or to switch back to an existing one." (interactive) (error "Process lisp does not exist")) -(defvar lisp-interaction-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Lisp-Interaction"))) - (set-keymap-parent map lisp-mode-shared-map) - (define-key map "\e\C-x" 'eval-defun) - (define-key map "\e\C-q" 'indent-pp-sexp) - (define-key map "\e\t" 'completion-at-point) - (define-key map "\n" 'eval-print-last-sexp) - (bindings--define-key map [menu-bar lisp-interaction] - (cons "Lisp-Interaction" menu-map)) - (bindings--define-key menu-map [eval-defun] - '(menu-item "Evaluate Defun" eval-defun - :help "Evaluate the top-level form containing point, or after point")) - (bindings--define-key menu-map [eval-print-last-sexp] - '(menu-item "Evaluate and Print" eval-print-last-sexp - :help "Evaluate sexp before point; print value into current buffer")) - (bindings--define-key menu-map [edebug-defun-lisp-interaction] - '(menu-item "Instrument Function for Debugging" edebug-defun - :help "Evaluate the top level form point is in, stepping through with Edebug" - :keys "C-u C-M-x")) - (bindings--define-key menu-map [indent-pp-sexp] - '(menu-item "Indent or Pretty-Print" indent-pp-sexp - :help "Indent each line of the list starting just after point, or prettyprint it")) - (bindings--define-key menu-map [complete-symbol] - '(menu-item "Complete Lisp Symbol" completion-at-point - :help "Perform completion on Lisp symbol preceding point")) - map) - "Keymap for Lisp Interaction mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") - -(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction" - "Major mode for typing and evaluating Lisp forms. -Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression -before point, and prints its value into the buffer, advancing point. -Note that printing is controlled by `eval-expression-print-length' -and `eval-expression-print-level'. - -Commands: -Delete converts tabs to spaces as it moves back. -Paragraphs are separated only by blank lines. -Semicolons start comments. - -\\{lisp-interaction-mode-map}" - :abbrev-table nil) - -(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value into current buffer. - -Normally, this function truncates long output according to the value -of the variables `eval-expression-print-length' and -`eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character). - -If `eval-expression-debug-on-error' is non-nil, which is the default, -this command arranges for all errors to enter the debugger." - (interactive "P") - (let ((standard-output (current-buffer))) - (terpri) - (eval-last-sexp (or eval-last-sexp-arg-internal t)) - (terpri))) - - -(defun last-sexp-setup-props (beg end value alt1 alt2) - "Set up text properties for the output of `eval-last-sexp-1'. -BEG and END are the start and end of the output in current-buffer. -VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the -alternative printed representations that can be displayed." - (let ((map (make-sparse-keymap))) - (define-key map "\C-m" 'last-sexp-toggle-display) - (define-key map [down-mouse-2] 'mouse-set-point) - (define-key map [mouse-2] 'last-sexp-toggle-display) - (add-text-properties - beg end - `(printed-value (,value ,alt1 ,alt2) - mouse-face highlight - keymap ,map - help-echo "RET, mouse-2: toggle abbreviated display" - rear-nonsticky (mouse-face keymap help-echo - printed-value))))) - - -(defun last-sexp-toggle-display (&optional _arg) - "Toggle between abbreviated and unabbreviated printed representations." - (interactive "P") - (save-restriction - (widen) - (let ((value (get-text-property (point) 'printed-value))) - (when value - (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point))) - 'printed-value) - (point))) - (end (or (next-single-char-property-change (point) 'printed-value) (point))) - (standard-output (current-buffer)) - (point (point))) - (delete-region beg end) - (insert (nth 1 value)) - (or (= beg point) - (setq point (1- (point)))) - (last-sexp-setup-props beg (point) - (nth 0 value) - (nth 2 value) - (nth 1 value)) - (goto-char (min (point-max) point))))))) - -(defun prin1-char (char) - "Return a string representing CHAR as a character rather than as an integer. -If CHAR is not a character, return nil." - (and (integerp char) - (eventp char) - (let ((c (event-basic-type char)) - (mods (event-modifiers char)) - string) - ;; Prevent ?A from turning into ?\S-a. - (if (and (memq 'shift mods) - (zerop (logand char ?\S-\^@)) - (not (let ((case-fold-search nil)) - (char-equal c (upcase c))))) - (setq c (upcase c) mods nil)) - ;; What string are we considering using? - (condition-case nil - (setq string - (concat - "?" - (mapconcat - (lambda (modif) - (cond ((eq modif 'super) "\\s-") - (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) - mods "") - (cond - ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) - ((eq c 127) "\\C-?") - (t - (string c))))) - (error nil)) - ;; Verify the string reads a CHAR, not to some other character. - ;; If it doesn't, return nil instead. - (and string - (= (car (read-from-string string)) char) - string)))) - - -(defun preceding-sexp () - "Return sexp before the point." - (let ((opoint (point)) - ignore-quotes - expr) - (save-excursion - (with-syntax-table emacs-lisp-mode-syntax-table - ;; If this sexp appears to be enclosed in `...' - ;; then ignore the surrounding quotes. - (setq ignore-quotes - (or (eq (following-char) ?\') - (eq (preceding-char) ?\'))) - (forward-sexp -1) - ;; If we were after `?\e' (or similar case), - ;; use the whole thing, not just the `e'. - (when (eq (preceding-char) ?\\) - (forward-char -1) - (when (eq (preceding-char) ??) - (forward-char -1))) - - ;; Skip over hash table read syntax. - (and (> (point) (1+ (point-min))) - (looking-back "#s" (- (point) 2)) - (forward-char -2)) - - ;; Skip over `#N='s. - (when (eq (preceding-char) ?=) - (let (labeled-p) - (save-excursion - (skip-chars-backward "0-9#=") - (setq labeled-p (looking-at "\\(#[0-9]+=\\)+"))) - (when labeled-p - (forward-sexp -1)))) - - (save-restriction - (if (and ignore-quotes (eq (following-char) ?`)) - ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so - ;; that the value is returned, not the name. - (forward-char)) - (when (looking-at ",@?") (goto-char (match-end 0))) - (narrow-to-region (point-min) opoint) - (setq expr (read (current-buffer))) - ;; If it's an (interactive ...) form, it's more useful to show how an - ;; interactive call would use it. - ;; FIXME: Is it really the right place for this? - (when (eq (car-safe expr) 'interactive) - (setq expr - `(call-interactively - (lambda (&rest args) ,expr args)))) - expr))))) - - -(defun eval-last-sexp-1 (eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value in the echo area. -With argument, print output into current buffer. -With a zero prefix arg, print output with no limit on the length -and level of lists, and include additional formats for integers -\(octal, hexadecimal, and character)." - (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) - ;; Setup the lexical environment if lexical-binding is enabled. - (eval-last-sexp-print-value - (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding) - eval-last-sexp-arg-internal))) - - -(defun eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal) - (let ((unabbreviated (let ((print-length nil) (print-level nil)) - (prin1-to-string value))) - (print-length (and (not (zerop (prefix-numeric-value - eval-last-sexp-arg-internal))) - eval-expression-print-length)) - (print-level (and (not (zerop (prefix-numeric-value - eval-last-sexp-arg-internal))) - eval-expression-print-level)) - (beg (point)) - end) - (prog1 - (prin1 value) - (let ((str (eval-expression-print-format value))) - (if str (princ str))) - (setq end (point)) - (when (and (bufferp standard-output) - (or (not (null print-length)) - (not (null print-level))) - (not (string= unabbreviated - (buffer-substring-no-properties beg end)))) - (last-sexp-setup-props beg end value - unabbreviated - (buffer-substring-no-properties beg end)) - )))) - - -(defvar eval-last-sexp-fake-value (make-symbol "t")) - -(defun eval-sexp-add-defvars (exp &optional pos) - "Prepend EXP with all the `defvar's that precede it in the buffer. -POS specifies the starting position where EXP was found and defaults to point." - (setq exp (macroexpand-all exp)) ;Eager macro-expansion. - (if (not lexical-binding) - exp - (save-excursion - (unless pos (setq pos (point))) - (let ((vars ())) - (goto-char (point-min)) - (while (re-search-forward - "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" - pos t) - (let ((var (intern (match-string 1)))) - (and (not (special-variable-p var)) - (save-excursion - (zerop (car (syntax-ppss (match-beginning 0))))) - (push var vars)))) - `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) - -(defun eval-last-sexp (eval-last-sexp-arg-internal) - "Evaluate sexp before point; print value in the echo area. -Interactively, with prefix argument, print output into current buffer. - -Normally, this function truncates long output according to the value -of the variables `eval-expression-print-length' and -`eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character). - -If `eval-expression-debug-on-error' is non-nil, which is the default, -this command arranges for all errors to enter the debugger." - (interactive "P") - (if (null eval-expression-debug-on-error) - (eval-last-sexp-1 eval-last-sexp-arg-internal) - (let ((value - (let ((debug-on-error eval-last-sexp-fake-value)) - (cons (eval-last-sexp-1 eval-last-sexp-arg-internal) - debug-on-error)))) - (unless (eq (cdr value) eval-last-sexp-fake-value) - (setq debug-on-error (cdr value))) - (car value)))) - -(defun eval-defun-1 (form) - "Treat some expressions specially. -Reset the `defvar' and `defcustom' variables to the initial value. -\(For `defcustom', use the :set function if there is one.) -Reinitialize the face according to the `defface' specification." - ;; The code in edebug-defun should be consistent with this, but not - ;; the same, since this gets a macroexpanded form. - (cond ((not (listp form)) - form) - ((and (eq (car form) 'defvar) - (cdr-safe (cdr-safe form)) - (boundp (cadr form))) - ;; Force variable to be re-set. - `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form)) - (setq-default ,(nth 1 form) ,(nth 2 form)))) - ;; `defcustom' is now macroexpanded to - ;; `custom-declare-variable' with a quoted value arg. - ((and (eq (car form) 'custom-declare-variable) - (default-boundp (eval (nth 1 form) lexical-binding))) - ;; Force variable to be bound, using :set function if specified. - (let ((setfunc (memq :set form))) - (when setfunc - (setq setfunc (car-safe (cdr-safe setfunc))) - (or (functionp setfunc) (setq setfunc nil))) - (funcall (or setfunc 'set-default) - (eval (nth 1 form) lexical-binding) - ;; The second arg is an expression that evaluates to - ;; an expression. The second evaluation is the one - ;; normally performed not by normal execution but by - ;; custom-initialize-set (for example), which does not - ;; use lexical-binding. - (eval (eval (nth 2 form) lexical-binding)))) - form) - ;; `defface' is macroexpanded to `custom-declare-face'. - ((eq (car form) 'custom-declare-face) - ;; Reset the face. - (let ((face-symbol (eval (nth 1 form) lexical-binding))) - (setq face-new-frame-defaults - (assq-delete-all face-symbol face-new-frame-defaults)) - (put face-symbol 'face-defface-spec nil) - (put face-symbol 'face-override-spec nil)) - form) - ((eq (car form) 'progn) - (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) - (t form))) - -(defun eval-defun-2 () - "Evaluate defun that point is in or before. -The value is displayed in the echo area. -If the current defun is actually a call to `defvar', -then reset the variable using the initial value expression -even if the variable already has some other value. -\(Normally `defvar' does not change the variable's value -if it already has a value.\) - -Return the result of evaluation." - ;; FIXME: the print-length/level bindings should only be applied while - ;; printing, not while evaluating. - (let ((debug-on-error eval-expression-debug-on-error) - (print-length eval-expression-print-length) - (print-level eval-expression-print-level)) - (save-excursion - ;; Arrange for eval-region to "read" the (possibly) altered form. - ;; eval-region handles recording which file defines a function or - ;; variable. - (let ((standard-output t) - beg end form) - ;; Read the form from the buffer, and record where it ends. - (save-excursion - (end-of-defun) - (beginning-of-defun) - (setq beg (point)) - (setq form (read (current-buffer))) - (setq end (point))) - ;; Alter the form if necessary. - (let ((form (eval-sexp-add-defvars - (eval-defun-1 (macroexpand form))))) - (eval-region beg end standard-output - (lambda (_ignore) - ;; Skipping to the end of the specified region - ;; will make eval-region return. - (goto-char end) - form)))))) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str))) - ;; The result of evaluation has been put onto VALUES. So return it. - (car values)) - -(defun eval-defun (edebug-it) - "Evaluate the top-level form containing point, or after point. - -If the current defun is actually a call to `defvar' or `defcustom', -evaluating it this way resets the variable using its initial value -expression (using the defcustom's :set function if there is one), even -if the variable already has some other value. \(Normally `defvar' and -`defcustom' do not alter the value if there already is one.) In an -analogous way, evaluating a `defface' overrides any customizations of -the face, so that it becomes defined exactly as the `defface' expression -says. - -If `eval-expression-debug-on-error' is non-nil, which is the default, -this command arranges for all errors to enter the debugger. - -With a prefix argument, instrument the code for Edebug. - -If acting on a `defun' for FUNCTION, and the function was -instrumented, `Edebug: FUNCTION' is printed in the echo area. If not -instrumented, just FUNCTION is printed. - -If not acting on a `defun', the result of evaluation is displayed in -the echo area. This display is controlled by the variables -`eval-expression-print-length' and `eval-expression-print-level', -which see." - (interactive "P") - (cond (edebug-it - (require 'edebug) - (eval-defun (not edebug-all-defs))) - (t - (if (null eval-expression-debug-on-error) - (eval-defun-2) - (let ((old-value (make-symbol "t")) new-value value) - (let ((debug-on-error old-value)) - (setq value (eval-defun-2)) - (setq new-value debug-on-error)) - (unless (eq old-value new-value) - (setq debug-on-error new-value)) - value))))) - ;; May still be used by some external Lisp-mode variant. (define-obsolete-function-alias 'lisp-comment-indent 'comment-indent-default "22.1") @@ -1583,19 +954,21 @@ Lisp function does not specify a special indentation." ;; like defun if the first form is placed on the next line, otherwise ;; it is indented like any other form (i.e. forms line up under first). -(put 'autoload 'lisp-indent-function 'defun) +(put 'autoload 'lisp-indent-function 'defun) ;Elisp (put 'progn 'lisp-indent-function 0) (put 'prog1 'lisp-indent-function 1) (put 'prog2 'lisp-indent-function 2) -(put 'save-excursion 'lisp-indent-function 0) -(put 'save-restriction 'lisp-indent-function 0) -(put 'save-current-buffer 'lisp-indent-function 0) +(put 'save-excursion 'lisp-indent-function 0) ;Elisp +(put 'save-restriction 'lisp-indent-function 0) ;Elisp +(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) (put 'while 'lisp-indent-function 1) (put 'if 'lisp-indent-function 2) (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) +(put 'handler-case 'lisp-indent-function 1) ;CL +(put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 7e5f47b80b..31682d036b 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -758,304 +758,4 @@ considered." (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) (plist-get plist :predicate)))))) -(defun lisp--local-variables-1 (vars sexp) - "Return the vars locally bound around the witness, or nil if not found." - (let (res) - (while - (unless - (setq res - (pcase sexp - (`(,(or `let `let*) ,bindings) - (let ((vars vars)) - (when (eq 'let* (car sexp)) - (dolist (binding (cdr (reverse bindings))) - (push (or (car-safe binding) binding) vars))) - (lisp--local-variables-1 - vars (car (cdr-safe (car (last bindings))))))) - (`(,(or `let `let*) ,bindings . ,body) - (let ((vars vars)) - (dolist (binding bindings) - (push (or (car-safe binding) binding) vars)) - (lisp--local-variables-1 vars (car (last body))))) - (`(lambda ,_) (setq sexp nil)) - (`(lambda ,args . ,body) - (lisp--local-variables-1 - (append args vars) (car (last body)))) - (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e)) - (`(condition-case ,v ,_ . ,catches) - (lisp--local-variables-1 - (cons v vars) (cdr (car (last catches))))) - (`(,_ . ,_) - (lisp--local-variables-1 vars (car (last sexp)))) - (`lisp--witness--lisp (or vars '(nil))) - (_ nil))) - (setq sexp (ignore-errors (butlast sexp))))) - res)) - -(defun lisp--local-variables () - "Return a list of locally let-bound variables at point." - (save-excursion - (skip-syntax-backward "w_") - (let* ((ppss (syntax-ppss)) - (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point)) - (or (nth 8 ppss) (point)))) - (closer ())) - (dolist (p (nth 9 ppss)) - (push (cdr (syntax-after p)) closer)) - (setq closer (apply #'string closer)) - (let* ((sexp (condition-case nil - (car (read-from-string - (concat txt "lisp--witness--lisp" closer))) - (end-of-file nil))) - (macroexpand-advice (lambda (expander form &rest args) - (condition-case nil - (apply expander form args) - (error form)))) - (sexp - (unwind-protect - (progn - (advice-add 'macroexpand :around macroexpand-advice) - (macroexpand-all sexp)) - (advice-remove 'macroexpand macroexpand-advice))) - (vars (lisp--local-variables-1 nil sexp))) - (delq nil - (mapcar (lambda (var) - (and (symbolp var) - (not (string-match (symbol-name var) "\\`[&_]")) - ;; Eliminate uninterned vars. - (intern-soft var) - var)) - vars)))))) - -(defvar lisp--local-variables-completion-table - ;; Use `defvar' rather than `defconst' since defconst would purecopy this - ;; value, which would doubly fail: it would fail because purecopy can't - ;; handle the recursive bytecode object, and it would fail because it would - ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! - (let ((lastpos nil) (lastvars nil)) - (letrec ((hookfun (lambda () - (setq lastpos nil) - (remove-hook 'post-command-hook hookfun)))) - (completion-table-dynamic - (lambda (_string) - (save-excursion - (skip-syntax-backward "_w") - (let ((newpos (cons (point) (current-buffer)))) - (unless (equal lastpos newpos) - (add-hook 'post-command-hook hookfun) - (setq lastpos newpos) - (setq lastvars - (mapcar #'symbol-name (lisp--local-variables)))))) - lastvars))))) - -(defun lisp--expect-function-p (pos) - "Return non-nil if the symbol at point is expected to be a function." - (or - (and (eq (char-before pos) ?') - (eq (char-before (1- pos)) ?#)) - (save-excursion - (let ((parent (nth 1 (syntax-ppss pos)))) - (when parent - (goto-char parent) - (and - (looking-at (concat "(\\(cl-\\)?" - (regexp-opt '("declare-function" - "function" "defadvice" - "callf" "callf2" - "defsetf")) - "[ \t\r\n]+")) - (eq (match-end 0) pos))))))) - -(defun lisp--form-quoted-p (pos) - "Return non-nil if the form at POS is not evaluated. -It can be quoted, or be inside a quoted form." - ;; FIXME: Do some macro expansion maybe. - (save-excursion - (let ((state (syntax-ppss pos))) - (or (nth 8 state) ; Code inside strings usually isn't evaluated. - ;; FIXME: The 9th element is undocumented. - (let ((nesting (cons (point) (reverse (nth 9 state)))) - res) - (while (and nesting (not res)) - (goto-char (pop nesting)) - (cond - ((or (eq (char-after) ?\[) - (progn - (skip-chars-backward " ") - (memq (char-before) '(?' ?`)))) - (setq res t)) - ((eq (char-before) ?,) - (setq nesting nil)))) - res))))) - -;; FIXME: Support for Company brings in features which straddle eldoc. -;; We should consolidate this, so that major modes can provide all that -;; data all at once: -;; - a function to extract "the reference at point" (may be more complex -;; than a mere string, to distinguish various namespaces). -;; - a function to jump to such a reference. -;; - a function to show the signature/interface of such a reference. -;; - a function to build a help-buffer about that reference. -;; FIXME: Those functions should also be used by the normal completion code in -;; the *Completions* buffer. - -(defun lisp--company-doc-buffer (str) - (let ((symbol (intern-soft str))) - ;; FIXME: we really don't want to "display-buffer and then undo it". - (save-window-excursion - ;; Make sure we don't display it in another frame, otherwise - ;; save-window-excursion won't be able to undo it. - (let ((display-buffer-overriding-action - '(nil . ((inhibit-switch-frame . t))))) - (ignore-errors - (cond - ((fboundp symbol) (describe-function symbol)) - ((boundp symbol) (describe-variable symbol)) - ((featurep symbol) (describe-package symbol)) - ((facep symbol) (describe-face symbol)) - (t (signal 'user-error nil))) - (help-buffer)))))) - -(defun lisp--company-doc-string (str) - (let* ((symbol (intern-soft str)) - (doc (if (fboundp symbol) - (documentation symbol t) - (documentation-property symbol 'variable-documentation t)))) - (and (stringp doc) - (string-match ".*$" doc) - (match-string 0 doc)))) - -(declare-function find-library-name "find-func" (library)) - -(defun lisp--company-location (str) - (let ((sym (intern-soft str))) - (cond - ((fboundp sym) (find-definition-noselect sym nil)) - ((boundp sym) (find-definition-noselect sym 'defvar)) - ((featurep sym) - (require 'find-func) - (cons (find-file-noselect (find-library-name - (symbol-name sym))) - 0)) - ((facep sym) (find-definition-noselect sym 'defface))))) - -(defun lisp-completion-at-point (&optional _predicate) - "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." - (with-syntax-table emacs-lisp-mode-syntax-table - (let* ((pos (point)) - (beg (condition-case nil - (save-excursion - (backward-sexp 1) - (skip-syntax-forward "'") - (point)) - (scan-error pos))) - (end - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - '(?\s ?\" ?\( ?\)))) - (condition-case nil - (save-excursion - (goto-char beg) - (forward-sexp 1) - (skip-chars-backward "'") - (when (>= (point) pos) - (point))) - (scan-error pos)))) - ;; t if in function position. - (funpos (eq (char-before beg) ?\())) - (when (and end (or (not (nth 8 (syntax-ppss))) - (eq (char-before beg) ?`))) - (let ((table-etc - (if (not funpos) - ;; FIXME: We could look at the first element of the list and - ;; use it to provide a more specific completion table in some - ;; cases. E.g. filter out keywords that are not understood by - ;; the macro/function being called. - (cond - ((lisp--expect-function-p beg) - (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - ((lisp--form-quoted-p beg) - (list nil obarray - ;; Don't include all symbols - ;; (bug#16646). - :predicate (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))) - :annotation-function - (lambda (str) (if (fboundp (intern-soft str)) " <f>")) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (t - (list nil (completion-table-merge - lisp--local-variables-completion-table - (apply-partially #'completion-table-with-predicate - obarray - #'boundp - 'strict)) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location))) - ;; Looks like a funcall position. Let's double check. - (save-excursion - (goto-char (1- beg)) - (let ((parent - (condition-case nil - (progn (up-list -1) (forward-char 1) - (let ((c (char-after))) - (if (eq c ?\() ?\( - (if (memq (char-syntax c) '(?w ?_)) - (read (current-buffer)))))) - (error nil)))) - (pcase parent - ;; FIXME: Rather than hardcode special cases here, - ;; we should use something like a symbol-property. - (`declare - (list t (mapcar (lambda (x) (symbol-name (car x))) - (delete-dups - ;; FIXME: We should include some - ;; docstring with each entry. - (append - macro-declarations-alist - defun-declarations-alist))))) - ((and (or `condition-case `condition-case-unless-debug) - (guard (save-excursion - (ignore-errors - (forward-sexp 2) - (< (point) beg))))) - (list t obarray - :predicate (lambda (sym) (get sym 'error-conditions)))) - ((and ?\( - (guard (save-excursion - (goto-char (1- beg)) - (up-list -1) - (forward-symbol -1) - (looking-at "\\_<let\\*?\\_>")))) - (list t obarray - :predicate #'boundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (_ (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location - )))))))) - (nconc (list beg end) - (if (null (car table-etc)) - (cdr table-etc) - (cons - (if (memq (char-syntax (or (char-after end) ?\s)) - '(?\s ?>)) - (cadr table-etc) - (apply-partially 'completion-table-with-terminator - " " (cadr table-etc))) - (cddr table-etc))))))))) - ;;; lisp.el ends here |