;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
-;; Copyright (C) 1985-1986, 1999-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages
(purecopy (concat "^\\s-*("
(eval-when-compile
(regexp-opt
- '("defvar" "defconst" "defconstant" "defcustom"
+ '("defconst" "defconstant" "defcustom"
"defparameter" "define-symbol-macro") t))
"\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
2)
+ ;; For `defvar', we ignore (defvar FOO) constructs.
+ (list (purecopy "Variables")
+ (purecopy (concat "^\\s-*(defvar\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+ "[[:space:]\n]+[^)]"))
+ 1)
(list (purecopy "Types")
(purecopy (concat "^\\s-*("
(eval-when-compile
(goto-char listbeg)
(and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
(match-string 1)))))
- (docelt (and firstsym (get (intern-soft firstsym)
+ (docelt (and firstsym
+ (function-get (intern-soft firstsym)
lisp-doc-string-elt-property))))
(if (and docelt
;; It's a string in a form that can have a docstring.
font-lock-string-face))))
font-lock-comment-face))
-(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive)
+(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive
+ bar-not-symbol)
"Common initialization routine for lisp modes.
The LISP-SYNTAX argument is used by code in inf-lisp.el and is
\(uselessly) passed from pp.el, chistory.el, gnus-kill.el and
score-mode.el. KEYWORDS-CASE-INSENSITIVE non-nil means that for
-font-lock keywords will not be case sensitive."
+font-lock keywords will not be case sensitive. BAR-NOT-SYMBOL
+non-nil means that | is not a symbol character."
(when lisp-syntax
(set-syntax-table lisp-mode-syntax-table))
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'lisp-fill-paragraph)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local fill-paragraph-function 'lisp-fill-paragraph)
;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of
;; a single docstring. Let's fix it here.
- (set (make-local-variable 'adaptive-fill-function)
- (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")))
+ (setq-local adaptive-fill-function
+ (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")))
;; Adaptive fill mode gets in the way of auto-fill,
;; and should make no difference for explicit fill
;; because lisp-fill-paragraph should do the job.
;; I believe that newcomment's auto-fill code properly deals with it -stef
;;(set (make-local-variable 'adaptive-fill-mode) nil)
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'lisp-indent-line)
- (make-local-variable 'outline-regexp)
- (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
- (make-local-variable 'outline-level)
- (setq outline-level 'lisp-outline-level)
- (make-local-variable 'comment-start)
- (setq comment-start ";")
- (make-local-variable 'comment-start-skip)
+ (setq-local indent-line-function 'lisp-indent-line)
+ (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
+ (setq-local outline-level 'lisp-outline-level)
+ (setq-local add-log-current-defun-function #'lisp-current-defun-name)
+ (setq-local comment-start ";")
;; Look within the line for a ; following an even number of backslashes
;; after either a non-backslash or the line beginning.
- (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- (make-local-variable 'font-lock-comment-start-skip)
+ (setq-local comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
;; Font lock mode uses this only when it KNOWS a comment is starting.
- (setq font-lock-comment-start-skip ";+ *")
- (make-local-variable 'comment-add)
- (setq comment-add 1) ;default to `;;' in comment-region
- (make-local-variable 'comment-column)
- (setq comment-column 40)
+ (setq-local font-lock-comment-start-skip ";+ *")
+ (setq-local comment-add 1) ;default to `;;' in comment-region
+ (setq-local comment-column 40)
;; Don't get confused by `;' in doc strings when paragraph-filling.
- (set (make-local-variable 'comment-use-global-state) t)
- (make-local-variable 'imenu-generic-expression)
- (setq imenu-generic-expression lisp-imenu-generic-expression)
- (make-local-variable 'multibyte-syntax-as-symbol)
- (setq multibyte-syntax-as-symbol t)
- (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun)
+ (setq-local comment-use-global-state t)
+ (setq-local imenu-generic-expression lisp-imenu-generic-expression)
+ (setq-local multibyte-syntax-as-symbol t)
+ (setq-local syntax-begin-function 'beginning-of-defun)
(setq font-lock-defaults
`((lisp-font-lock-keywords
lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
- nil ,keywords-case-insensitive (("+-*/.<>=!?$%_&~^:@" . "w")) nil
+ nil ,keywords-case-insensitive
+ ((,(concat "+-*/.<>=!?$%_&~^:@" (if bar-not-symbol "" "|")) . "w"))
+ nil
(font-lock-mark-block-function . mark-defun)
(font-lock-syntactic-face-function
. lisp-font-lock-syntactic-face-function))))
1000
len)))
+(defun lisp-current-defun-name ()
+ "Return the name of the defun at point, or nil."
+ (save-excursion
+ (let ((location (point)))
+ ;; If we are now precisely at the beginning of a defun, make sure
+ ;; beginning-of-defun finds that one rather than the previous one.
+ (or (eobp) (forward-char 1))
+ (beginning-of-defun)
+ ;; Make sure we are really inside the defun found, not after it.
+ (when (and (looking-at "\\s(")
+ (progn (end-of-defun)
+ (< location (point)))
+ (progn (forward-sexp -1)
+ (>= location (point))))
+ (if (looking-at "\\s(")
+ (forward-char 1))
+ ;; Skip the defining construct name, typically "defun" or
+ ;; "defvar".
+ (forward-sexp 1)
+ ;; The second element is usually a symbol being defined. If it
+ ;; is not, use the first symbol in it.
+ (skip-chars-forward " \t\n'(")
+ (buffer-substring-no-properties (point)
+ (progn (forward-sexp 1)
+ (point)))))))
+
(defvar lisp-mode-shared-map
(let ((map (make-sparse-keymap)))
(define-key map "\e\C-q" 'indent-sexp)
(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
(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
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Lisp")))
Entry to this mode calls the value of `lisp-mode-hook'
if that value is non-nil."
- (lisp-mode-variables nil t)
- (set (make-local-variable 'find-tag-default-function) 'lisp-find-tag-default)
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ (lisp-mode-variables nil t t)
+ (setq-local find-tag-default-function 'lisp-find-tag-default)
+ (setq-local comment-start-skip
+ "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
(setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()
(let ((vars ()))
(goto-char (point-min))
(while (re-search-forward
- "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
+ "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
pos t)
(let ((var (intern (match-string 1))))
- (unless (special-variable-p var)
+ (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-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.
;; `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.
- (set-default (eval (nth 1 form) lexical-binding)
- (eval (nth 1 (nth 2 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)
(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-documentation (nth 3 form))
- ;; Setting `customized-face' to the new spec after calling
- ;; the form, but preserving the old saved spec in `saved-face',
- ;; imitates the situation when the new face spec is set
- ;; temporarily for the current session in the customize
- ;; buffer, thus allowing `face-user-default-spec' to use the
- ;; new customized spec instead of the saved spec.
- ;; Resetting `saved-face' temporarily to nil is needed to let
- ;; `defface' change the spec, regardless of a saved spec.
- (prog1 `(prog1 ,form
- (put ,(nth 1 form) 'saved-face
- ',(get face-symbol 'saved-face))
- (put ,(nth 1 form) 'customized-face
- ,(nth 2 form)))
- (put face-symbol 'saved-face nil))))
+ (put face-symbol 'face-override-spec nil))
+ form)
((eq (car form) 'progn)
(cons 'progn (mapcar 'eval-defun-1 (cdr form))))
(t form)))
With argument, insert value in current buffer after the defun.
Return the result of evaluation."
- (interactive "P")
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
(let ((debug-on-error eval-expression-debug-on-error)
If the current defun is actually a call to `defvar' or `defcustom',
evaluating it this way resets the variable using its initial value
-expression 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.
+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.
(if (or (null indent) (looking-at "\\s<\\s<\\s<"))
;; Don't alter indentation of a ;;; comment line
;; or a line that starts in a string.
+ ;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
(goto-char (- (point-max) pos))
(if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
;; Single-semicolon comment lines should be indented
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
- ;; If desired, shift remaining lines of expression the same amount.
- (and whole-exp (not (zerop shift-amt))
- (save-excursion
- (goto-char beg)
- (forward-sexp 1)
- (setq end (point))
- (goto-char beg)
- (forward-line 1)
- (setq beg (point))
- (> end beg))
- (indent-code-rigidly beg end shift-amt)))))
+ (goto-char (- (point-max) pos))))))
(defvar calculate-lisp-indent-last-sexp)
The function `calculate-lisp-indent' calls this to determine
if the arguments of a Lisp function call should be indented specially.
-INDENT-POINT is the position where the user typed TAB, or equivalent.
+INDENT-POINT is the position at which the line being indented begins.
Point is located at the point to indent under (for default indentation);
STATE is the `parse-partial-sexp' state for that position.
(let ((function (buffer-substring (point)
(progn (forward-sexp 1) (point))))
method)
- (setq method (or (get (intern-soft function) 'lisp-indent-function)
+ (setq method (or (function-get (intern-soft function)
+ 'lisp-indent-function)
(get (intern-soft function) 'lisp-indent-hook)))
(cond ((or (eq method 'defun)
(and (null method)
(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
(put 'save-current-buffer 'lisp-indent-function 0)
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)