1;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -*- lexical-binding:t -*- 2 3;; Copyright (C) 1985-1986, 1999-2021 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 <https://www.gnu.org/licenses/>. 23 24;;; Commentary: 25 26;; The base major mode for editing Lisp code (used also for Emacs Lisp). 27;; This mode is documented in the Emacs manual. 28 29;;; Code: 30 31(eval-when-compile (require 'cl-lib)) 32(eval-when-compile (require 'subr-x)) 33 34(defvar font-lock-comment-face) 35(defvar font-lock-doc-face) 36(defvar font-lock-keywords-case-fold-search) 37(defvar font-lock-string-face) 38 39(define-abbrev-table 'lisp-mode-abbrev-table () 40 "Abbrev table for Lisp mode.") 41 42(defvar lisp-data-mode-syntax-table 43 (let ((table (make-syntax-table)) 44 (i 0)) 45 (while (< i ?0) 46 (modify-syntax-entry i "_ " table) 47 (setq i (1+ i))) 48 (setq i (1+ ?9)) 49 (while (< i ?A) 50 (modify-syntax-entry i "_ " table) 51 (setq i (1+ i))) 52 (setq i (1+ ?Z)) 53 (while (< i ?a) 54 (modify-syntax-entry i "_ " table) 55 (setq i (1+ i))) 56 (setq i (1+ ?z)) 57 (while (< i 128) 58 (modify-syntax-entry i "_ " table) 59 (setq i (1+ i))) 60 (modify-syntax-entry ?\s " " table) 61 ;; Non-break space acts as whitespace. 62 (modify-syntax-entry ?\xa0 " " table) 63 (modify-syntax-entry ?\t " " table) 64 (modify-syntax-entry ?\f " " table) 65 (modify-syntax-entry ?\n "> " table) 66 (modify-syntax-entry ?\; "< " table) 67 (modify-syntax-entry ?` "' " table) 68 (modify-syntax-entry ?' "' " table) 69 (modify-syntax-entry ?, "' " table) 70 (modify-syntax-entry ?@ "_ p" table) 71 ;; Used to be singlequote; changed for flonums. 72 (modify-syntax-entry ?. "_ " table) 73 (modify-syntax-entry ?# "' " table) 74 (modify-syntax-entry ?\" "\" " table) 75 (modify-syntax-entry ?\\ "\\ " table) 76 (modify-syntax-entry ?\( "() " table) 77 (modify-syntax-entry ?\) ")( " table) 78 (modify-syntax-entry ?\[ "(]" table) 79 (modify-syntax-entry ?\] ")[" table) 80 table) 81 "Parent syntax table used in Lisp modes.") 82 83(defvar lisp-mode-syntax-table 84 (let ((table (make-syntax-table lisp-data-mode-syntax-table))) 85 (modify-syntax-entry ?\[ "_ " table) 86 (modify-syntax-entry ?\] "_ " table) 87 (modify-syntax-entry ?# "' 14" table) 88 (modify-syntax-entry ?| "\" 23bn" table) 89 table) 90 "Syntax table used in `lisp-mode'.") 91 92(eval-and-compile 93 (defconst lisp-mode-symbol-regexp "\\(?:\\sw\\|\\s_\\|\\\\.\\)+")) 94 95(defvar lisp-imenu-generic-expression 96 (list 97 (list nil 98 (purecopy (concat "^\\s-*(" 99 (eval-when-compile 100 (regexp-opt 101 '("defun" "defmacro" 102 ;; Elisp. 103 "defun*" "defsubst" "define-inline" 104 "define-advice" "defadvice" "define-skeleton" 105 "define-compilation-mode" "define-minor-mode" 106 "define-global-minor-mode" 107 "define-globalized-minor-mode" 108 "define-derived-mode" "define-generic-mode" 109 "ert-deftest" 110 "cl-defun" "cl-defsubst" "cl-defmacro" 111 "cl-define-compiler-macro" "cl-defgeneric" 112 "cl-defmethod" 113 ;; CL. 114 "define-compiler-macro" "define-modify-macro" 115 "defsetf" "define-setf-expander" 116 "define-method-combination" 117 ;; CLOS and EIEIO 118 "defgeneric" "defmethod") 119 t)) 120 "\\s-+\\(" lisp-mode-symbol-regexp "\\)")) 121 2) 122 (list (purecopy "Variables") 123 (purecopy (concat "^\\s-*(" 124 (eval-when-compile 125 (regexp-opt 126 '(;; Elisp 127 "defconst" "defcustom" 128 ;; CL 129 "defconstant" 130 "defparameter" "define-symbol-macro") 131 t)) 132 "\\s-+\\(" lisp-mode-symbol-regexp "\\)")) 133 2) 134 ;; For `defvar'/`defvar-local', we ignore (defvar FOO) constructs. 135 (list (purecopy "Variables") 136 (purecopy (concat "^\\s-*(defvar\\(?:-local\\)?\\s-+\\(" 137 lisp-mode-symbol-regexp "\\)" 138 "[[:space:]\n]+[^)]")) 139 1) 140 (list (purecopy "Types") 141 (purecopy (concat "^\\s-*(" 142 (eval-when-compile 143 (regexp-opt 144 '(;; Elisp 145 "defgroup" "deftheme" 146 "define-widget" "define-error" 147 "defface" "cl-deftype" "cl-defstruct" 148 ;; CL 149 "deftype" "defstruct" 150 "define-condition" "defpackage" 151 ;; CLOS and EIEIO 152 "defclass") 153 t)) 154 "\\s-+'?\\(" lisp-mode-symbol-regexp "\\)")) 155 2)) 156 157 "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") 158 159;; This was originally in autoload.el and is still used there. 160(put 'autoload 'doc-string-elt 3) 161(put 'defmethod 'doc-string-elt 3) 162(put 'defvar 'doc-string-elt 3) 163(put 'defconst 'doc-string-elt 3) 164(put 'defalias 'doc-string-elt 3) 165(put 'defvaralias 'doc-string-elt 3) 166(put 'define-category 'doc-string-elt 2) 167;; CL 168(put 'defconstant 'doc-string-elt 3) 169(put 'defparameter 'doc-string-elt 3) 170 171(defvar lisp-doc-string-elt-property 'doc-string-elt 172 "The symbol property that holds the docstring position info.") 173 174(defconst lisp-prettify-symbols-alist '(("lambda" . ?λ)) 175 "Alist of symbol/\"pretty\" characters to be displayed.") 176 177;;;; Font-lock support. 178 179(defun lisp--match-hidden-arg (limit) 180 (let ((res nil)) 181 (forward-line 0) 182 (while 183 (let ((ppss (parse-partial-sexp (point) 184 (line-end-position) 185 -1))) 186 (skip-syntax-forward " )") 187 (if (or (>= (car ppss) 0) 188 (eolp) 189 (looking-at ";") 190 (nth 8 (syntax-ppss))) ;Within a string or comment. 191 (progn 192 (forward-line 1) 193 (< (point) limit)) 194 (looking-at ".*") ;Set the match-data. 195 (forward-line 1) 196 (setq res (point)) 197 nil))) 198 res)) 199 200(defun lisp--el-non-funcall-position-p (pos) 201 "Heuristically determine whether POS is an evaluated position." 202 (declare (obsolete lisp--el-funcall-position-p "28.1")) 203 (not (lisp--el-funcall-position-p pos))) 204 205(defun lisp--el-funcall-position-p (pos) 206 "Heuristically determine whether POS is an evaluated position." 207 (save-match-data 208 (save-excursion 209 (ignore-errors 210 (goto-char pos) 211 ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is. 212 (if (eql (char-before) ?\') 213 (eql (char-before (1- (point))) ?#) 214 (let* ((ppss (syntax-ppss)) 215 (paren-posns (nth 9 ppss)) 216 (parent 217 (when paren-posns 218 (goto-char (car (last paren-posns))) ;(up-list -1) 219 (cond 220 ((ignore-errors 221 (and (eql (char-after) ?\() 222 (when (cdr paren-posns) 223 (goto-char (car (last paren-posns 2))) 224 (looking-at "(\\_<let\\*?\\_>")))) 225 (goto-char (match-end 0)) 226 'let) 227 ((looking-at 228 (rx "(" 229 (group-n 1 (+ (or (syntax w) (syntax _)))) 230 symbol-end)) 231 (prog1 (intern-soft (match-string-no-properties 1)) 232 (goto-char (match-end 1)))))))) 233 (pcase parent 234 ('declare nil) 235 ('let 236 (forward-sexp 1) 237 (>= pos (point))) 238 ('condition-case 239 ;; If (cdr paren-posns), then we're in the BODY 240 ;; of HANDLERS. 241 (or (cdr paren-posns) 242 (progn 243 (forward-sexp 1) 244 ;; If we're in the second form, then we're in 245 ;; a funcall position. 246 (< (point) pos (progn (forward-sexp 1) 247 (point)))))) 248 (_ t)))))))) 249 250(defun lisp--el-match-keyword (limit) 251 ;; FIXME: Move to elisp-mode.el. 252 (catch 'found 253 (while (re-search-forward 254 (eval-when-compile 255 (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>")) 256 limit t) 257 (let ((sym (intern-soft (match-string 1)))) 258 (when (and (or (special-form-p sym) (macrop sym)) 259 (not (get sym 'no-font-lock-keyword)) 260 (lisp--el-funcall-position-p (match-beginning 0))) 261 (throw 'found t)))))) 262 263(defmacro let-when-compile (bindings &rest body) 264 "Like `let*', but allow for compile time optimization. 265Use BINDINGS as in regular `let*', but in BODY each usage should 266be wrapped in `eval-when-compile'. 267This will generate compile-time constants from BINDINGS." 268 (declare (indent 1) (debug let)) 269 (letrec ((loop 270 (lambda (bindings) 271 (if (null bindings) 272 (macroexpand-all (macroexp-progn body) 273 macroexpand-all-environment) 274 (let ((binding (pop bindings))) 275 (cl-progv (list (car binding)) 276 (list (eval (nth 1 binding) t)) 277 (funcall loop bindings))))))) 278 (funcall loop bindings))) 279 280(defun elisp--font-lock-backslash () 281 (let* ((beg0 (match-beginning 0)) 282 (end0 (match-end 0)) 283 (ppss (save-excursion (syntax-ppss beg0)))) 284 (and (nth 3 ppss) ;Inside a string. 285 (not (nth 5 ppss)) ;The \ is not itself \-escaped. 286 ;; Don't highlight the \( introduced because of 287 ;; `open-paren-in-column-0-is-defun-start'. 288 (not (eq ?\n (char-before beg0))) 289 (equal (ignore-errors 290 (car (read-from-string 291 (format "\"%s\"" 292 (buffer-substring-no-properties 293 beg0 end0))))) 294 (buffer-substring-no-properties (1+ beg0) end0)) 295 `(face ,font-lock-warning-face 296 help-echo "This \\ has no effect")))) 297 298(defun lisp--match-confusable-symbol-character (limit) 299 ;; Match a confusable character within a Lisp symbol. 300 (catch 'matched 301 (while t 302 (if (re-search-forward help-uni-confusables-regexp limit t) 303 ;; Skip confusables which are backslash escaped, or inside 304 ;; strings or comments. 305 (save-match-data 306 (unless (or (eq (char-before (match-beginning 0)) ?\\) 307 (nth 8 (syntax-ppss))) 308 (throw 'matched t))) 309 (throw 'matched nil))))) 310 311(let-when-compile 312 ((lisp-fdefs '("defmacro" "defun")) 313 (lisp-vdefs '("defvar")) 314 (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" 315 "prog2" "lambda" "unwind-protect" "condition-case" 316 "when" "unless" "with-output-to-string" 317 "ignore-errors" "dotimes" "dolist" "declare")) 318 (lisp-errs '("warn" "error" "signal")) 319 ;; Elisp constructs. Now they are update dynamically 320 ;; from obarray but they are also used for setting up 321 ;; the keywords for Common Lisp. 322 (el-fdefs '("defsubst" "cl-defsubst" "define-inline" 323 "define-advice" "defadvice" "defalias" 324 "define-derived-mode" "define-minor-mode" 325 "define-generic-mode" "define-global-minor-mode" 326 "define-globalized-minor-mode" "define-skeleton" 327 "define-widget" "ert-deftest")) 328 (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" 329 "defface")) 330 (el-tdefs '("defgroup" "deftheme")) 331 (el-errs '("user-error")) 332 ;; Common-Lisp constructs supported by EIEIO. FIXME: namespace. 333 (eieio-fdefs '("defgeneric" "defmethod")) 334 (eieio-tdefs '("defclass")) 335 ;; Common-Lisp constructs supported by cl-lib. 336 (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod" "defgeneric")) 337 (cl-lib-tdefs '("defstruct" "deftype")) 338 (cl-lib-errs '("assert" "check-type")) 339 ;; Common-Lisp constructs not supported by cl-lib. 340 (cl-fdefs '("defsetf" "define-method-combination" 341 "define-condition" "define-setf-expander" 342 ;; "define-function"?? 343 "define-compiler-macro" "define-modify-macro")) 344 (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter")) 345 (cl-tdefs '("defpackage" "defstruct" "deftype")) 346 (cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase" 347 "declaim" "destructuring-bind" "do" "do*" 348 "ecase" "etypecase" "eval-when" "flet" "flet*" 349 "go" "handler-case" "handler-bind" "in-package" ;; "inline" 350 "labels" "letf" "locally" "loop" 351 "macrolet" "multiple-value-bind" "multiple-value-prog1" 352 "proclaim" "prog" "prog*" "progv" 353 "restart-case" "restart-bind" "return" "return-from" 354 "symbol-macrolet" "tagbody" "the" "typecase" 355 "with-accessors" "with-compilation-unit" 356 "with-condition-restarts" "with-hash-table-iterator" 357 "with-input-from-string" "with-open-file" 358 "with-open-stream" "with-package-iterator" 359 "with-simple-restart" "with-slots" "with-standard-io-syntax")) 360 (cl-errs '("abort" "cerror"))) 361 (let ((vdefs (eval-when-compile 362 (append lisp-vdefs el-vdefs cl-vdefs))) 363 (tdefs (eval-when-compile 364 (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs 365 (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs)))) 366 ;; Elisp and Common Lisp definers. 367 (el-defs-re (eval-when-compile 368 (regexp-opt (append lisp-fdefs lisp-vdefs 369 el-fdefs el-vdefs el-tdefs 370 (mapcar (lambda (s) (concat "cl-" s)) 371 (append cl-lib-fdefs cl-lib-tdefs)) 372 eieio-fdefs eieio-tdefs) 373 t))) 374 (cl-defs-re (eval-when-compile 375 (regexp-opt (append lisp-fdefs lisp-vdefs 376 cl-lib-fdefs cl-lib-tdefs 377 eieio-fdefs eieio-tdefs 378 cl-fdefs cl-vdefs cl-tdefs) 379 t))) 380 ;; Common Lisp keywords (Elisp keywords are handled dynamically). 381 (cl-kws-re (eval-when-compile 382 (regexp-opt (append lisp-kw cl-kw) t))) 383 ;; Elisp and Common Lisp "errors". 384 (el-errs-re (eval-when-compile 385 (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s)) 386 cl-lib-errs) 387 lisp-errs el-errs) 388 t))) 389 (cl-errs-re (eval-when-compile 390 (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t)))) 391 (dolist (v vdefs) 392 (put (intern v) 'lisp-define-type 'var)) 393 (dolist (v tdefs) 394 (put (intern v) 'lisp-define-type 'type)) 395 396 (define-obsolete-variable-alias 'lisp-font-lock-keywords-1 397 'lisp-el-font-lock-keywords-1 "24.4") 398 (defconst lisp-el-font-lock-keywords-1 399 `( ;; Definitions. 400 (,(concat "(" el-defs-re "\\_>" 401 ;; Any whitespace and defined object. 402 "[ \t']*" 403 "\\(([ \t']*\\)?" ;; An opening paren. 404 "\\(\\(setf\\)[ \t]+" lisp-mode-symbol-regexp 405 "\\|" lisp-mode-symbol-regexp "\\)?") 406 (1 font-lock-keyword-face) 407 (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) 408 (cond ((eq type 'var) font-lock-variable-name-face) 409 ((eq type 'type) font-lock-type-face) 410 ;; If match-string 2 is non-nil, we encountered a 411 ;; form like (defalias (intern (concat s "-p"))), 412 ;; unless match-string 4 is also there. Then its a 413 ;; defmethod with (setf foo) as name. 414 ((or (not (match-string 2)) ;; Normal defun. 415 (and (match-string 2) ;; Setf method. 416 (match-string 4))) 417 font-lock-function-name-face))) 418 nil t)) 419 ;; Emacs Lisp autoload cookies. Supports the slightly different 420 ;; forms used by mh-e, calendar, etc. 421 ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend)) 422 "Subdued level highlighting for Emacs Lisp mode.") 423 424 (defconst lisp-cl-font-lock-keywords-1 425 `( ;; Definitions. 426 (,(concat "(" cl-defs-re "\\_>" 427 ;; Any whitespace and defined object. 428 "[ \t']*" 429 "\\(([ \t']*\\)?" ;; An opening paren. 430 "\\(\\(setf\\)[ \t]+" lisp-mode-symbol-regexp 431 "\\|" lisp-mode-symbol-regexp "\\)?") 432 (1 font-lock-keyword-face) 433 (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type))) 434 (cond ((eq type 'var) font-lock-variable-name-face) 435 ((eq type 'type) font-lock-type-face) 436 ((or (not (match-string 2)) ;; Normal defun. 437 (and (match-string 2) ;; Setf function. 438 (match-string 4))) 439 font-lock-function-name-face))) 440 nil t))) 441 "Subdued level highlighting for Lisp modes.") 442 443 (define-obsolete-variable-alias 'lisp-font-lock-keywords-2 444 'lisp-el-font-lock-keywords-2 "24.4") 445 (defconst lisp-el-font-lock-keywords-2 446 (append 447 lisp-el-font-lock-keywords-1 448 `( ;; Regexp negated char group. 449 ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) 450 ;; Erroneous structures. 451 (,(concat "(" el-errs-re "\\_>") 452 (1 font-lock-warning-face)) 453 ;; Control structures. Common Lisp forms. 454 (lisp--el-match-keyword . 1) 455 ;; Exit/Feature symbols as constants. 456 (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>" 457 "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?") 458 (1 font-lock-keyword-face) 459 (2 font-lock-constant-face nil t)) 460 ;; Words inside \\[] tend to be for `substitute-command-keys'. 461 (,(concat "\\\\\\\\\\[\\(" lisp-mode-symbol-regexp "\\)\\]") 462 (1 font-lock-constant-face prepend)) 463 ;; Ineffective backslashes (typically in need of doubling). 464 ("\\(\\\\\\)\\([^\"\\]\\)" 465 (1 (elisp--font-lock-backslash) prepend)) 466 ;; Words inside ‘’, '' and `' tend to be symbol names. 467 (,(concat "[`‘']\\(" lisp-mode-symbol-regexp "\\)['’]") 468 (1 font-lock-constant-face prepend)) 469 ;; Constant values. 470 (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") 471 (0 font-lock-builtin-face)) 472 ;; ELisp and CLisp `&' keywords as types. 473 (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>") 474 . font-lock-type-face) 475 ;; ELisp regexp grouping constructs 476 (,(lambda (bound) 477 (catch 'found 478 ;; The following loop is needed to continue searching after matches 479 ;; that do not occur in strings. The associated regexp matches one 480 ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to 481 ;; avoid highlighting, for example, `\\(' in `\\\\('. 482 (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t) 483 (unless (match-beginning 2) 484 (let ((face (get-text-property (1- (point)) 'face))) 485 (when (or (and (listp face) 486 (memq 'font-lock-string-face face)) 487 (eq 'font-lock-string-face face)) 488 (throw 'found t))))))) 489 (1 'font-lock-regexp-grouping-backslash prepend) 490 (3 'font-lock-regexp-grouping-construct prepend)) 491 (lisp--match-hidden-arg 492 (0 '(face font-lock-warning-face 493 help-echo "Easy to misread; consider moving the element to the next line") 494 prepend)) 495 (lisp--match-confusable-symbol-character 496 0 '(face font-lock-warning-face 497 help-echo "Confusable character")) 498 )) 499 "Gaudy level highlighting for Emacs Lisp mode.") 500 501 (defconst lisp-cl-font-lock-keywords-2 502 (append 503 lisp-cl-font-lock-keywords-1 504 `( ;; Regexp negated char group. 505 ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend) 506 ;; Control structures. Common Lisp forms. 507 (,(concat "(" cl-kws-re "\\_>") . 1) 508 ;; Exit/Feature symbols as constants. 509 (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>" 510 "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?") 511 (1 font-lock-keyword-face) 512 (2 font-lock-constant-face nil t)) 513 ;; Erroneous structures. 514 (,(concat "(" cl-errs-re "\\_>") 515 (1 font-lock-warning-face)) 516 ;; Words inside ‘’ and `' tend to be symbol names. 517 (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]") 518 (1 font-lock-constant-face prepend)) 519 ;; Uninterned symbols, e.g., (defpackage #:my-package ...) 520 ;; must come before keywords below to have effect 521 (,(concat "#:" lisp-mode-symbol-regexp "") 0 font-lock-builtin-face) 522 ;; Constant values. 523 (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") 524 (0 font-lock-builtin-face)) 525 ;; ELisp and CLisp `&' keywords as types. 526 (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>") 527 . font-lock-type-face) 528 ;; This is too general -- rms. 529 ;; A user complained that he has functions whose names start with `do' 530 ;; and that they get the wrong color. 531 ;; That user has violated the https://www.cliki.net/Naming+conventions: 532 ;; CL (but not EL!) `with-' (context) and `do-' (iteration) 533 (,(concat "(\\(\\(do-\\|with-\\)" lisp-mode-symbol-regexp "\\)") 534 (1 font-lock-keyword-face)) 535 (lisp--match-hidden-arg 536 (0 '(face font-lock-warning-face 537 help-echo "Easy to misread; consider moving the element to the next line") 538 prepend)) 539 )) 540 "Gaudy level highlighting for Lisp modes."))) 541 542(define-obsolete-variable-alias 'lisp-font-lock-keywords 543 'lisp-el-font-lock-keywords "24.4") 544(defvar lisp-el-font-lock-keywords lisp-el-font-lock-keywords-1 545 "Default expressions to highlight in Emacs Lisp mode.") 546(defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 547 "Default expressions to highlight in Lisp modes.") 548 549;; Support backtrace mode. 550(defconst lisp-el-font-lock-keywords-for-backtraces lisp-el-font-lock-keywords 551 "Default highlighting from Emacs Lisp mode used in Backtrace mode.") 552(defconst lisp-el-font-lock-keywords-for-backtraces-1 lisp-el-font-lock-keywords-1 553 "Subdued highlighting from Emacs Lisp mode used in Backtrace mode.") 554(defconst lisp-el-font-lock-keywords-for-backtraces-2 555 (remove (assoc 'lisp--match-hidden-arg lisp-el-font-lock-keywords-2) 556 lisp-el-font-lock-keywords-2) 557 "Gaudy highlighting from Emacs Lisp mode used in Backtrace mode.") 558 559(defun lisp-string-in-doc-position-p (listbeg startpos) 560 "Return non-nil if a doc string may occur at STARTPOS inside a list. 561LISTBEG is the position of the start of the innermost list 562containing STARTPOS." 563 (let* ((firstsym (and listbeg 564 (save-excursion 565 (goto-char listbeg) 566 (and (looking-at 567 (eval-when-compile 568 (concat "([ \t\n]*\\(" 569 lisp-mode-symbol-regexp "\\)"))) 570 (match-string 1))))) 571 (docelt (and firstsym 572 (function-get (intern-soft firstsym) 573 lisp-doc-string-elt-property)))) 574 (and docelt 575 ;; It's a string in a form that can have a docstring. 576 ;; Check whether it's in docstring position. 577 (save-excursion 578 (when (functionp docelt) 579 (goto-char (match-end 1)) 580 (setq docelt (funcall docelt))) 581 (goto-char listbeg) 582 (forward-char 1) 583 (condition-case nil 584 (while (and (> docelt 0) (< (point) startpos) 585 (progn (forward-sexp 1) t)) 586 (setq docelt (1- docelt))) 587 (error nil)) 588 (and (zerop docelt) (<= (point) startpos) 589 (progn (forward-comment (point-max)) t) 590 (= (point) startpos)))))) 591 592(defun lisp-string-after-doc-keyword-p (listbeg startpos) 593 "Return non-nil if `:documentation' symbol ends at STARTPOS inside a list. 594`:doc' can also be used. 595 596LISTBEG is the position of the start of the innermost list 597containing STARTPOS." 598 (and listbeg ; We are inside a Lisp form. 599 (save-excursion 600 (goto-char startpos) 601 (ignore-errors 602 (progn (backward-sexp 1) 603 (looking-at ":documentation\\_>\\|:doc\\_>")))))) 604 605(defun lisp-font-lock-syntactic-face-function (state) 606 "Return syntactic face function for the position represented by STATE. 607STATE is a `parse-partial-sexp' state, and the returned function is the 608Lisp font lock syntactic face function." 609 (if (nth 3 state) 610 ;; This might be a (doc)string or a |...| symbol. 611 (let ((startpos (nth 8 state))) 612 (if (eq (char-after startpos) ?|) 613 ;; This is not a string, but a |...| symbol. 614 nil 615 (let ((listbeg (nth 1 state))) 616 (if (or (lisp-string-in-doc-position-p listbeg startpos) 617 (lisp-string-after-doc-keyword-p listbeg startpos)) 618 font-lock-doc-face 619 font-lock-string-face)))) 620 font-lock-comment-face)) 621 622(defun lisp-adaptive-fill () 623 "Return fill prefix found at point. 624Value for `adaptive-fill-function'." 625 ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of 626 ;; a single docstring. Let's fix it here. 627 (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")) 628 629;; Maybe this should be discouraged/obsoleted and users should be 630;; encouraged to use 'lisp-data-mode' instead. 631(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive 632 elisp) 633 "Common initialization routine for Lisp modes. 634The LISP-SYNTAX argument is used by code in inf-lisp.el and is 635\(uselessly) passed from pp.el, chistory.el, gnus-kill.el and 636score-mode.el. KEYWORDS-CASE-INSENSITIVE non-nil means that for 637font-lock keywords will not be case sensitive." 638 (when lisp-syntax 639 (set-syntax-table lisp-mode-syntax-table)) 640 (setq-local paragraph-ignore-fill-prefix t) 641 (setq-local fill-paragraph-function 'lisp-fill-paragraph) 642 (setq-local adaptive-fill-function #'lisp-adaptive-fill) 643 ;; Adaptive fill mode gets in the way of auto-fill, 644 ;; and should make no difference for explicit fill 645 ;; because lisp-fill-paragraph should do the job. 646 ;; I believe that newcomment's auto-fill code properly deals with it -stef 647 ;;(setq-local adaptive-fill-mode nil) 648 (setq-local indent-line-function 'lisp-indent-line) 649 (setq-local indent-region-function 'lisp-indent-region) 650 (setq-local comment-indent-function #'lisp-comment-indent) 651 (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") 652 (setq-local outline-level 'lisp-outline-level) 653 (setq-local add-log-current-defun-function #'lisp-current-defun-name) 654 (setq-local comment-start ";") 655 (setq-local comment-start-skip ";+ *") 656 (setq-local comment-add 1) ;default to `;;' in comment-region 657 (setq-local comment-column 40) 658 (setq-local comment-use-syntax t) 659 (setq-local imenu-generic-expression lisp-imenu-generic-expression) 660 (setq-local multibyte-syntax-as-symbol t) 661 ;; (setq-local syntax-begin-function 'beginning-of-defun) ;;Bug#16247. 662 (setq font-lock-defaults 663 `(,(if elisp '(lisp-el-font-lock-keywords 664 lisp-el-font-lock-keywords-1 665 lisp-el-font-lock-keywords-2) 666 '(lisp-cl-font-lock-keywords 667 lisp-cl-font-lock-keywords-1 668 lisp-cl-font-lock-keywords-2)) 669 nil ,keywords-case-insensitive nil nil 670 (font-lock-mark-block-function . mark-defun) 671 (font-lock-extra-managed-props help-echo) 672 (font-lock-syntactic-face-function 673 . lisp-font-lock-syntactic-face-function))) 674 (setq-local prettify-symbols-alist lisp-prettify-symbols-alist) 675 (setq-local electric-pair-skip-whitespace 'chomp) 676 (setq-local electric-pair-open-newline-between-pairs nil)) 677 678;;;###autoload 679(define-derived-mode lisp-data-mode prog-mode "Lisp-Data" 680 "Major mode for buffers holding data written in Lisp syntax." 681 :group 'lisp 682 (lisp-mode-variables nil t nil) 683 (setq-local electric-quote-string t) 684 (setq imenu-case-fold-search nil)) 685 686(defun lisp-outline-level () 687 "Lisp mode `outline-level' function." 688 ;; Expects outline-regexp is ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(" 689 ;; and point is at the beginning of a matching line. 690 (let ((len (- (match-end 0) (match-beginning 0)))) 691 (cond ((looking-at "(\\|;;;###autoload") 692 1000) 693 ((looking-at ";;\\(;+\\) ") 694 (- (match-end 1) (match-beginning 1))) 695 ;; Above should match everything but just in case. 696 (t 697 len)))) 698 699(defun lisp-current-defun-name () 700 "Return the name of the defun at point, or nil." 701 (save-excursion 702 (let ((location (point))) 703 ;; If we are now precisely at the beginning of a defun, make sure 704 ;; beginning-of-defun finds that one rather than the previous one. 705 (or (eobp) (forward-char 1)) 706 (beginning-of-defun) 707 ;; Make sure we are really inside the defun found, not after it. 708 (when (and (looking-at "\\s(") 709 (progn (end-of-defun) 710 (< location (point))) 711 (progn (forward-sexp -1) 712 (>= location (point)))) 713 (if (looking-at "\\s(") 714 (forward-char 1)) 715 ;; Skip the defining construct name, typically "defun" or 716 ;; "defvar". 717 (forward-sexp 1) 718 ;; The second element is usually a symbol being defined. If it 719 ;; is not, use the first symbol in it. 720 (skip-chars-forward " \t\n'(") 721 (buffer-substring-no-properties (point) 722 (progn (forward-sexp 1) 723 (point))))))) 724 725(defvar lisp-mode-shared-map 726 (let ((map (make-sparse-keymap))) 727 (set-keymap-parent map prog-mode-map) 728 (define-key map "\e\C-q" 'indent-sexp) 729 (define-key map "\177" 'backward-delete-char-untabify) 730 ;; This gets in the way when viewing a Lisp file in view-mode. As 731 ;; long as [backspace] is mapped into DEL via the 732 ;; function-key-map, this should remain disabled!! 733 ;;;(define-key map [backspace] 'backward-delete-char-untabify) 734 map) 735 "Keymap for commands shared by all sorts of Lisp modes.") 736 737(defcustom lisp-mode-hook nil 738 "Hook run when entering Lisp mode." 739 :options '(imenu-add-menubar-index) 740 :type 'hook 741 :group 'lisp) 742 743(defcustom lisp-interaction-mode-hook nil 744 "Hook run when entering Lisp Interaction mode." 745 :options '(eldoc-mode) 746 :type 'hook 747 :group 'lisp) 748 749;;; Generic Lisp mode. 750 751(defvar lisp-mode-map 752 (let ((map (make-sparse-keymap))) 753 (set-keymap-parent map lisp-mode-shared-map) 754 (define-key map "\e\C-x" 'lisp-eval-defun) 755 (define-key map "\C-c\C-z" 'run-lisp) 756 map) 757 "Keymap for ordinary Lisp mode. 758All commands in `lisp-mode-shared-map' are inherited by this map.") 759 760(easy-menu-define lisp-mode-menu lisp-mode-map 761 "Menu for ordinary Lisp mode." 762 '("Lisp" 763 ["Indent sexp" indent-sexp 764 :help "Indent each line of the list starting just after point"] 765 ["Eval defun" lisp-eval-defun 766 :help "Send the current defun to the Lisp process made by M-x run-lisp"] 767 ["Run inferior Lisp" run-lisp 768 :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"])) 769 770(define-derived-mode lisp-mode lisp-data-mode "Lisp" 771 "Major mode for editing programs in Common Lisp and other similar Lisps. 772Commands: 773Delete converts tabs to spaces as it moves back. 774Blank lines separate paragraphs. Semicolons start comments. 775 776\\{lisp-mode-map} 777Note that `run-lisp' may be used either to start an inferior Lisp job 778or to switch back to an existing one." 779 (setq-local lisp-indent-function 'common-lisp-indent-function) 780 (setq-local find-tag-default-function 'lisp-find-tag-default) 781 (setq-local comment-start-skip 782 "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") 783 (setq-local comment-end-skip "[ \t]*\\(\\s>\\||#\\)") 784 (setq-local font-lock-comment-end-skip "|#") 785 (setq imenu-case-fold-search t)) 786 787(defun lisp-find-tag-default () 788 (let ((default (find-tag-default))) 789 (when (stringp default) 790 (if (string-match ":+" default) 791 (substring default (match-end 0)) 792 default)))) 793 794;; Used in old LispM code. 795(defalias 'common-lisp-mode 'lisp-mode) 796 797(autoload 'lisp-eval-defun "inf-lisp" nil t) 798 799(defun lisp-comment-indent () 800 "Like `comment-indent-default', but don't put space after open paren." 801 (or (when (looking-at "\\s<\\s<") 802 (let ((pt (point))) 803 (skip-syntax-backward " ") 804 (if (eq (preceding-char) ?\() 805 (cons (current-column) (current-column)) 806 (goto-char pt) 807 nil))) 808 (comment-indent-default))) 809 810(defcustom lisp-indent-offset nil 811 "If non-nil, indent second line of expressions that many more columns." 812 :group 'lisp 813 :type '(choice (const nil) integer)) 814(put 'lisp-indent-offset 'safe-local-variable 815 (lambda (x) (or (null x) (integerp x)))) 816 817(defcustom lisp-indent-function 'lisp-indent-function 818 "A function to be called by `calculate-lisp-indent'. 819It indents the arguments of a Lisp function call. This function 820should accept two arguments: the indent-point, and the 821`parse-partial-sexp' state at that position. One option for this 822function is `common-lisp-indent-function'." 823 :type 'function 824 :group 'lisp) 825 826(defun lisp-ppss (&optional pos) 827 "Return Parse-Partial-Sexp State at POS, defaulting to point. 828Like `syntax-ppss' but includes the character address of the last 829complete sexp in the innermost containing list at position 8302 (counting from 0). This is important for Lisp indentation." 831 (unless pos (setq pos (point))) 832 (let ((pss (syntax-ppss pos))) 833 (if (nth 9 pss) 834 (let ((sexp-start (car (last (nth 9 pss))))) 835 (parse-partial-sexp sexp-start pos nil nil (syntax-ppss sexp-start))) 836 pss))) 837 838(cl-defstruct (lisp-indent-state 839 (:constructor nil) 840 (:constructor lisp-indent-initial-state 841 (&aux (ppss (lisp-ppss)) 842 (ppss-point (point)) 843 (stack (make-list (1+ (car ppss)) nil))))) 844 stack ;; Cached indentation, per depth. 845 ppss 846 ppss-point) 847 848(defun lisp-indent-calc-next (state) 849 "Move to next line and return calculated indent for it. 850STATE is updated by side effect, the first state should be 851created by `lisp-indent-initial-state'. This function may move 852by more than one line to cross a string literal." 853 (pcase-let* (((cl-struct lisp-indent-state 854 (stack indent-stack) ppss ppss-point) 855 state) 856 (indent-depth (car ppss)) ; Corresponding to indent-stack. 857 (depth indent-depth)) 858 ;; Parse this line so we can learn the state to indent the 859 ;; next line. 860 (while (let ((last-sexp (nth 2 ppss))) 861 (setq ppss (parse-partial-sexp 862 ppss-point (progn (end-of-line) (point)) 863 nil nil ppss)) 864 ;; Preserve last sexp of state (position 2) for 865 ;; `calculate-lisp-indent', if we're at the same depth. 866 (if (and (not (nth 2 ppss)) (= depth (car ppss))) 867 (setf (nth 2 ppss) last-sexp) 868 (setq last-sexp (nth 2 ppss))) 869 (setq depth (car ppss)) 870 ;; Skip over newlines within strings. 871 (and (not (eobp)) (nth 3 ppss))) 872 (let ((string-start (nth 8 ppss))) 873 (setq ppss (parse-partial-sexp (point) (point-max) 874 nil nil ppss 'syntax-table)) 875 (setf (nth 2 ppss) string-start) ; Finished a complete string. 876 (setq depth (car ppss))) 877 (setq ppss-point (point))) 878 (setq ppss-point (point)) 879 (let* ((depth-delta (- depth indent-depth))) 880 (cond ((< depth-delta 0) 881 (setq indent-stack (nthcdr (- depth-delta) indent-stack))) 882 ((> depth-delta 0) 883 (setq indent-stack (nconc (make-list depth-delta nil) 884 indent-stack))))) 885 (prog1 886 (let (indent) 887 (cond ((= (forward-line 1) 1) 888 ;; Can't move to the next line, apparently end of buffer. 889 nil) 890 ((null indent-stack) 891 ;; Negative depth, probably some kind of syntax 892 ;; error. Reset the state. 893 (setq ppss (parse-partial-sexp (point) (point)))) 894 ((car indent-stack)) 895 ((integerp (setq indent (calculate-lisp-indent ppss))) 896 (setf (car indent-stack) indent)) 897 ((consp indent) ; (COLUMN CONTAINING-SEXP-START) 898 (car indent)) 899 ;; This only happens if we're in a string, but the 900 ;; loop should always skip over strings (unless we hit 901 ;; end of buffer, which is taken care of by the first 902 ;; clause). 903 (t (error "This shouldn't happen")))) 904 (setf (lisp-indent-state-stack state) indent-stack) 905 (setf (lisp-indent-state-ppss-point state) ppss-point) 906 (setf (lisp-indent-state-ppss state) ppss)))) 907 908(defun lisp-indent-region (start end) 909 "Indent region as Lisp code, efficiently." 910 (save-excursion 911 (setq end (copy-marker end)) 912 (goto-char start) 913 (beginning-of-line) 914 ;; The default `indent-region-line-by-line' doesn't hold a running 915 ;; parse state, which forces each indent call to reparse from the 916 ;; beginning. That has O(n^2) complexity. 917 (let* ((parse-state (lisp-indent-initial-state)) 918 (pr (unless (minibufferp) 919 (make-progress-reporter "Indenting region..." (point) end)))) 920 (let ((ppss (lisp-indent-state-ppss parse-state))) 921 (unless (or (and (bolp) (eolp)) (nth 3 ppss)) 922 (lisp-indent-line (calculate-lisp-indent ppss)))) 923 (let ((indent nil)) 924 (while (progn (setq indent (lisp-indent-calc-next parse-state)) 925 (< (point) end)) 926 (unless (or (and (bolp) (eolp)) (not indent)) 927 (lisp-indent-line indent)) 928 (and pr (progress-reporter-update pr (point))))) 929 (and pr (progress-reporter-done pr)) 930 (move-marker end nil)))) 931 932(defun lisp-indent-line (&optional indent) 933 "Indent current line as Lisp code." 934 (interactive) 935 (let ((pos (- (point-max) (point))) 936 (indent (progn (beginning-of-line) 937 (or indent (calculate-lisp-indent (lisp-ppss)))))) 938 (skip-chars-forward " \t") 939 (if (or (null indent) (looking-at "\\s<\\s<\\s<")) 940 ;; Don't alter indentation of a ;;; comment line 941 ;; or a line that starts in a string. 942 ;; FIXME: inconsistency: comment-indent moves ;;; to column 0. 943 (goto-char (- (point-max) pos)) 944 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<"))) 945 ;; Single-semicolon comment lines should be indented 946 ;; as comment lines, not as code. 947 (progn (indent-for-comment) (forward-char -1)) 948 (if (listp indent) (setq indent (car indent))) 949 (indent-line-to indent)) 950 ;; If initial point was within line's indentation, 951 ;; position after the indentation. Else stay at same point in text. 952 (if (> (- (point-max) pos) (point)) 953 (goto-char (- (point-max) pos)))))) 954 955(defvar calculate-lisp-indent-last-sexp) 956 957(defun calculate-lisp-indent (&optional parse-start) 958 "Return appropriate indentation for current line as Lisp code. 959In usual case returns an integer: the column to indent to. 960If the value is nil, that means don't change the indentation 961because the line starts inside a string. 962 963PARSE-START may be a buffer position to start parsing from, or a 964parse state as returned by calling `parse-partial-sexp' up to the 965beginning of the current line. 966 967The value can also be a list of the form (COLUMN CONTAINING-SEXP-START). 968This means that following lines at the same level of indentation 969should not necessarily be indented the same as this line. 970Then COLUMN is the column to indent to, and CONTAINING-SEXP-START 971is the buffer position of the start of the containing expression." 972 (save-excursion 973 (beginning-of-line) 974 (let ((indent-point (point)) 975 state 976 ;; setting this to a number inhibits calling hook 977 (desired-indent nil) 978 (retry t) 979 whitespace-after-open-paren 980 calculate-lisp-indent-last-sexp containing-sexp) 981 (cond ((or (markerp parse-start) (integerp parse-start)) 982 (goto-char parse-start)) 983 ((null parse-start) (beginning-of-defun)) 984 (t (setq state parse-start))) 985 (unless state 986 ;; Find outermost containing sexp 987 (while (< (point) indent-point) 988 (setq state (parse-partial-sexp (point) indent-point 0)))) 989 ;; Find innermost containing sexp 990 (while (and retry 991 state 992 (> (elt state 0) 0)) 993 (setq retry nil) 994 (setq calculate-lisp-indent-last-sexp (elt state 2)) 995 (setq containing-sexp (elt state 1)) 996 ;; Position following last unclosed open. 997 (goto-char (1+ containing-sexp)) 998 ;; Is there a complete sexp since then? 999 (if (and calculate-lisp-indent-last-sexp 1000 (> calculate-lisp-indent-last-sexp (point))) 1001 ;; Yes, but is there a containing sexp after that? 1002 (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp 1003 indent-point 0))) 1004 (if (setq retry (car (cdr peek))) (setq state peek))))) 1005 (if retry 1006 nil 1007 ;; Innermost containing sexp found 1008 (goto-char (1+ containing-sexp)) 1009 (setq whitespace-after-open-paren (looking-at (rx whitespace))) 1010 (if (not calculate-lisp-indent-last-sexp) 1011 ;; indent-point immediately follows open paren. 1012 ;; Don't call hook. 1013 (setq desired-indent (current-column)) 1014 ;; Find the start of first element of containing sexp. 1015 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 1016 (cond ((looking-at "\\s(") 1017 ;; First element of containing sexp is a list. 1018 ;; Indent under that list. 1019 ) 1020 ((> (save-excursion (forward-line 1) (point)) 1021 calculate-lisp-indent-last-sexp) 1022 ;; This is the first line to start within the containing sexp. 1023 ;; It's almost certainly a function call. 1024 (if (or (= (point) calculate-lisp-indent-last-sexp) 1025 whitespace-after-open-paren) 1026 ;; Containing sexp has nothing before this line 1027 ;; except the first element, or the first element is 1028 ;; preceded by whitespace. Indent under that element. 1029 nil 1030 ;; Skip the first element, find start of second (the first 1031 ;; argument of the function call) and indent under. 1032 (progn (forward-sexp 1) 1033 (parse-partial-sexp (point) 1034 calculate-lisp-indent-last-sexp 1035 0 t))) 1036 (backward-prefix-chars)) 1037 (t 1038 ;; Indent beneath first sexp on same line as 1039 ;; `calculate-lisp-indent-last-sexp'. Again, it's 1040 ;; almost certainly a function call. 1041 (goto-char calculate-lisp-indent-last-sexp) 1042 (beginning-of-line) 1043 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 1044 0 t) 1045 (backward-prefix-chars))))) 1046 ;; Point is at the point to indent under unless we are inside a string. 1047 ;; Call indentation hook except when overridden by lisp-indent-offset 1048 ;; or if the desired indentation has already been computed. 1049 (let ((normal-indent (current-column))) 1050 (cond ((elt state 3) 1051 ;; Inside a string, don't change indentation. 1052 nil) 1053 ((and (integerp lisp-indent-offset) containing-sexp) 1054 ;; Indent by constant offset 1055 (goto-char containing-sexp) 1056 (+ (current-column) lisp-indent-offset)) 1057 ;; in this case calculate-lisp-indent-last-sexp is not nil 1058 (calculate-lisp-indent-last-sexp 1059 (or 1060 ;; try to align the parameters of a known function 1061 (and lisp-indent-function 1062 (not retry) 1063 (funcall lisp-indent-function indent-point state)) 1064 ;; If the function has no special alignment 1065 ;; or it does not apply to this argument, 1066 ;; try to align a constant-symbol under the last 1067 ;; preceding constant symbol, if there is such one of 1068 ;; the last 2 preceding symbols, in the previous 1069 ;; uncommented line. 1070 (and (save-excursion 1071 (goto-char indent-point) 1072 (skip-chars-forward " \t") 1073 (looking-at ":")) 1074 ;; The last sexp may not be at the indentation 1075 ;; where it begins, so find that one, instead. 1076 (save-excursion 1077 (goto-char calculate-lisp-indent-last-sexp) 1078 ;; Handle prefix characters and whitespace 1079 ;; following an open paren. (Bug#1012) 1080 (backward-prefix-chars) 1081 (while (not (save-excursion 1082 (skip-chars-backward " \t") 1083 (or (= (point) (line-beginning-position)) 1084 (and containing-sexp 1085 (= (point) (1+ containing-sexp)))))) 1086 (forward-sexp -1) 1087 (backward-prefix-chars)) 1088 (setq calculate-lisp-indent-last-sexp (point))) 1089 (> calculate-lisp-indent-last-sexp 1090 (save-excursion 1091 (goto-char (1+ containing-sexp)) 1092 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 1093 (point))) 1094 (let ((parse-sexp-ignore-comments t) 1095 indent) 1096 (goto-char calculate-lisp-indent-last-sexp) 1097 (or (and (looking-at ":") 1098 (setq indent (current-column))) 1099 (and (< (line-beginning-position) 1100 (prog2 (backward-sexp) (point))) 1101 (looking-at ":") 1102 (setq indent (current-column)))) 1103 indent)) 1104 ;; another symbols or constants not preceded by a constant 1105 ;; as defined above. 1106 normal-indent)) 1107 ;; in this case calculate-lisp-indent-last-sexp is nil 1108 (desired-indent) 1109 (t 1110 normal-indent)))))) 1111 1112(defun lisp--local-defform-body-p (state) 1113 "Return non-nil when at local definition body according to STATE. 1114STATE is the `parse-partial-sexp' state for current position." 1115 (when-let ((start-of-innermost-containing-list (nth 1 state))) 1116 (let* ((parents (nth 9 state)) 1117 (first-cons-after (cdr parents)) 1118 (second-cons-after (cdr first-cons-after)) 1119 first-order-parent second-order-parent) 1120 (while second-cons-after 1121 (when (= start-of-innermost-containing-list 1122 (car second-cons-after)) 1123 (setq second-order-parent (pop parents) 1124 first-order-parent (pop parents) 1125 ;; Leave the loop. 1126 second-cons-after nil)) 1127 (pop second-cons-after) 1128 (pop parents)) 1129 (when second-order-parent 1130 (let (local-definitions-starting-point) 1131 (and (save-excursion 1132 (goto-char (1+ second-order-parent)) 1133 (when-let ((head (ignore-errors 1134 ;; FIXME: This does not distinguish 1135 ;; between reading nil and a read error. 1136 ;; We don't care but still, better fix this. 1137 (read (current-buffer))))) 1138 (when (memq head '( cl-flet cl-labels cl-macrolet cl-flet* 1139 cl-symbol-macrolet)) 1140 ;; In what follows, we rely on (point) returning non-nil. 1141 (setq local-definitions-starting-point 1142 (progn 1143 (parse-partial-sexp 1144 (point) first-order-parent nil 1145 ;; From docstring of `parse-partial-sexp': 1146 ;; Fourth arg non-nil means stop 1147 ;; when we come to any character 1148 ;; that starts a sexp. 1149 t) 1150 (point)))))) 1151 (save-excursion 1152 (when (ignore-errors 1153 ;; We rely on `backward-up-list' working 1154 ;; even when sexp is incomplete “to the right”. 1155 (backward-up-list 2) 1156 t) 1157 (= local-definitions-starting-point (point)))))))))) 1158 1159(defun lisp-indent-function (indent-point state) 1160 "This function is the normal value of the variable `lisp-indent-function'. 1161The function `calculate-lisp-indent' calls this to determine 1162if the arguments of a Lisp function call should be indented specially. 1163 1164INDENT-POINT is the position at which the line being indented begins. 1165Point is located at the point to indent under (for default indentation); 1166STATE is the `parse-partial-sexp' state for that position. 1167 1168If the current line is in a call to a Lisp function that has a non-nil 1169property `lisp-indent-function' (or the deprecated `lisp-indent-hook'), 1170it specifies how to indent. The property value can be: 1171 1172* `defun', meaning indent `defun'-style 1173 (this is also the case if there is no property and the function 1174 has a name that begins with \"def\", and three or more arguments); 1175 1176* an integer N, meaning indent the first N arguments specially 1177 (like ordinary function arguments), and then indent any further 1178 arguments like a body; 1179 1180* a function to call that returns the indentation (or nil). 1181 `lisp-indent-function' calls this function with the same two arguments 1182 that it itself received. 1183 1184This function returns either the indentation to use, or nil if the 1185Lisp function does not specify a special indentation." 1186 (let ((normal-indent (current-column))) 1187 (goto-char (1+ (elt state 1))) 1188 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 1189 (if (and (elt state 2) 1190 (not (looking-at "\\sw\\|\\s_"))) 1191 ;; car of form doesn't seem to be a symbol 1192 (if (lisp--local-defform-body-p state) 1193 ;; We nevertheless check whether we are in flet-like form 1194 ;; as we presume local function names could be non-symbols. 1195 (lisp-indent-defform state indent-point) 1196 (if (not (> (save-excursion (forward-line 1) (point)) 1197 calculate-lisp-indent-last-sexp)) 1198 (progn (goto-char calculate-lisp-indent-last-sexp) 1199 (beginning-of-line) 1200 (parse-partial-sexp (point) 1201 calculate-lisp-indent-last-sexp 0 t))) 1202 ;; Indent under the list or under the first sexp on the same 1203 ;; line as calculate-lisp-indent-last-sexp. Note that first 1204 ;; thing on that line has to be complete sexp since we are 1205 ;; inside the innermost containing sexp. 1206 (backward-prefix-chars) 1207 (current-column)) 1208 (let ((function (buffer-substring (point) 1209 (progn (forward-sexp 1) (point)))) 1210 method) 1211 (setq method (or (function-get (intern-soft function) 1212 'lisp-indent-function) 1213 (get (intern-soft function) 'lisp-indent-hook))) 1214 (cond ((or (eq method 'defun) 1215 ;; Check whether we are in flet-like form. 1216 (lisp--local-defform-body-p state)) 1217 (lisp-indent-defform state indent-point)) 1218 ((integerp method) 1219 (lisp-indent-specform method state 1220 indent-point normal-indent)) 1221 (method 1222 (funcall method indent-point state))))))) 1223 1224(defcustom lisp-body-indent 2 1225 "Number of columns to indent the second line of a `(def...)' form." 1226 :group 'lisp 1227 :type 'integer) 1228(put 'lisp-body-indent 'safe-local-variable 'integerp) 1229 1230(defun lisp-indent-specform (count state indent-point normal-indent) 1231 (let ((containing-form-start (elt state 1)) 1232 (i count) 1233 body-indent containing-form-column) 1234 ;; Move to the start of containing form, calculate indentation 1235 ;; to use for non-distinguished forms (> count), and move past the 1236 ;; function symbol. lisp-indent-function guarantees that there is at 1237 ;; least one word or symbol character following open paren of containing 1238 ;; form. 1239 (goto-char containing-form-start) 1240 (setq containing-form-column (current-column)) 1241 (setq body-indent (+ lisp-body-indent containing-form-column)) 1242 (forward-char 1) 1243 (forward-sexp 1) 1244 ;; Now find the start of the last form. 1245 (parse-partial-sexp (point) indent-point 1 t) 1246 (while (and (< (point) indent-point) 1247 (condition-case () 1248 (progn 1249 (setq count (1- count)) 1250 (forward-sexp 1) 1251 (parse-partial-sexp (point) indent-point 1 t)) 1252 (error nil)))) 1253 ;; Point is sitting on first character of last (or count) sexp. 1254 (if (> count 0) 1255 ;; A distinguished form. If it is the first or second form use double 1256 ;; lisp-body-indent, else normal indent. With lisp-body-indent bound 1257 ;; to 2 (the default), this just happens to work the same with if as 1258 ;; the older code, but it makes unwind-protect, condition-case, 1259 ;; with-output-to-temp-buffer, et. al. much more tasteful. The older, 1260 ;; less hacked, behavior can be obtained by replacing below with 1261 ;; (list normal-indent containing-form-start). 1262 (if (<= (- i count) 1) 1263 (list (+ containing-form-column (* 2 lisp-body-indent)) 1264 containing-form-start) 1265 (list normal-indent containing-form-start)) 1266 ;; A non-distinguished form. Use body-indent if there are no 1267 ;; distinguished forms and this is the first undistinguished form, 1268 ;; or if this is the first undistinguished form and the preceding 1269 ;; distinguished form has indentation at least as great as body-indent. 1270 (if (or (and (= i 0) (= count 0)) 1271 (and (= count 0) (<= body-indent normal-indent))) 1272 body-indent 1273 normal-indent)))) 1274 1275(defun lisp-indent-defform (state _indent-point) 1276 (goto-char (car (cdr state))) 1277 (forward-line 1) 1278 (if (> (point) (car (cdr (cdr state)))) 1279 (progn 1280 (goto-char (car (cdr state))) 1281 (+ lisp-body-indent (current-column))))) 1282 1283 1284;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented 1285;; like defun if the first form is placed on the next line, otherwise 1286;; it is indented like any other form (i.e. forms line up under first). 1287 1288(put 'autoload 'lisp-indent-function 'defun) ;Elisp 1289(put 'progn 'lisp-indent-function 0) 1290(put 'defvar 'lisp-indent-function 'defun) 1291(put 'defalias 'lisp-indent-function 'defun) 1292(put 'defvaralias 'lisp-indent-function 'defun) 1293(put 'defconst 'lisp-indent-function 'defun) 1294(put 'define-category 'lisp-indent-function 'defun) 1295(put 'define-charset-internal 'lisp-indent-function 'defun) 1296(put 'define-fringe-bitmap 'lisp-indent-function 'defun) 1297(put 'prog1 'lisp-indent-function 1) 1298(put 'save-excursion 'lisp-indent-function 0) ;Elisp 1299(put 'save-restriction 'lisp-indent-function 0) ;Elisp 1300(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp 1301(put 'let 'lisp-indent-function 1) 1302(put 'let* 'lisp-indent-function 1) 1303(put 'while 'lisp-indent-function 1) 1304(put 'if 'lisp-indent-function 2) 1305(put 'catch 'lisp-indent-function 1) 1306(put 'condition-case 'lisp-indent-function 2) 1307(put 'handler-case 'lisp-indent-function 1) ;CL 1308(put 'handler-bind 'lisp-indent-function 1) ;CL 1309(put 'unwind-protect 'lisp-indent-function 1) 1310(put 'with-output-to-temp-buffer 'lisp-indent-function 1) 1311(put 'closure 'lisp-indent-function 2) 1312 1313(defun indent-sexp (&optional endpos) 1314 "Indent each line of the list starting just after point. 1315If optional arg ENDPOS is given, indent each line, stopping when 1316ENDPOS is encountered." 1317 (interactive) 1318 (let* ((parse-state (lisp-indent-initial-state))) 1319 ;; We need a marker because we modify the buffer 1320 ;; text preceding endpos. 1321 (setq endpos (copy-marker 1322 (if endpos endpos 1323 ;; Get error now if we don't have a complete sexp 1324 ;; after point. 1325 (save-excursion 1326 (forward-sexp 1) 1327 (let ((eol (line-end-position))) 1328 ;; We actually look for a sexp which ends 1329 ;; after the current line so that we properly 1330 ;; indent things like #s(...). This might not 1331 ;; be needed if Bug#15998 is fixed. 1332 (when (and (< (point) eol) 1333 ;; Check if eol is within a sexp. 1334 (> (nth 0 (save-excursion 1335 (parse-partial-sexp 1336 (point) eol))) 1337 0)) 1338 (condition-case () 1339 (while (< (point) eol) 1340 (forward-sexp 1)) 1341 ;; But don't signal an error for incomplete 1342 ;; sexps following the first complete sexp 1343 ;; after point. 1344 (scan-error nil)))) 1345 (point))))) 1346 (save-excursion 1347 (while (let ((indent (lisp-indent-calc-next parse-state)) 1348 (ppss (lisp-indent-state-ppss parse-state))) 1349 ;; If the line contains a comment indent it now with 1350 ;; `indent-for-comment'. 1351 (when (and (nth 4 ppss) (<= (nth 8 ppss) endpos)) 1352 (save-excursion 1353 (goto-char (lisp-indent-state-ppss-point parse-state)) 1354 (indent-for-comment) 1355 (setf (lisp-indent-state-ppss-point parse-state) 1356 (line-end-position)))) 1357 (when (< (point) endpos) 1358 ;; Indent the next line, unless it's blank, or just a 1359 ;; comment (we will `indent-for-comment' the latter). 1360 (skip-chars-forward " \t") 1361 (unless (or (eolp) (not indent) 1362 (eq (char-syntax (char-after)) ?<)) 1363 (indent-line-to indent)) 1364 t)))) 1365 (move-marker endpos nil))) 1366 1367(defun indent-pp-sexp (&optional arg) 1368 "Indent each line of the list starting just after point, or prettyprint it. 1369A prefix argument specifies pretty-printing." 1370 (interactive "P") 1371 (if arg 1372 (save-excursion 1373 (save-restriction 1374 (narrow-to-region (point) (progn (forward-sexp 1) (point))) 1375 (pp-buffer) 1376 (goto-char (point-max)) 1377 (if (eq (char-before) ?\n) 1378 (delete-char -1))))) 1379 (indent-sexp)) 1380 1381;;;; Lisp paragraph filling commands. 1382 1383(defcustom emacs-lisp-docstring-fill-column 65 1384 "Value of `fill-column' to use when filling a docstring. 1385Any non-integer value means do not use a different value of 1386`fill-column' when filling docstrings." 1387 :type '(choice (integer) 1388 (const :tag "Use the current `fill-column'" t)) 1389 :group 'lisp) 1390(put 'emacs-lisp-docstring-fill-column 'safe-local-variable 1391 (lambda (x) (or (eq x t) (integerp x)))) 1392 1393(defun lisp-fill-paragraph (&optional justify) 1394 "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. 1395If any of the current line is a comment, fill the comment or the 1396paragraph of it that point is in, preserving the comment's indentation 1397and initial semicolons." 1398 (interactive "P") 1399 (or (fill-comment-paragraph justify) 1400 ;; Since fill-comment-paragraph returned nil, that means we're not in 1401 ;; a comment: Point is on a program line; we are interested 1402 ;; particularly in docstring lines. 1403 ;; 1404 ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They 1405 ;; are buffer-local, but we avoid changing them so that they can be set 1406 ;; to make `forward-paragraph' and friends do something the user wants. 1407 ;; 1408 ;; `paragraph-start': The `(' in the character alternative and the 1409 ;; left-singlequote plus `(' sequence after the \\| alternative prevent 1410 ;; sexps and backquoted sexps that follow a docstring from being filled 1411 ;; with the docstring. This setting has the consequence of inhibiting 1412 ;; filling many program lines that are not docstrings, which is sensible, 1413 ;; because the user probably asked to fill program lines by accident, or 1414 ;; expecting indentation (perhaps we should try to do indenting in that 1415 ;; case). The `;' and `:' stop the paragraph being filled at following 1416 ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are 1417 ;; escaped to keep font-locking, filling, & paren matching in the source 1418 ;; file happy. The `:' must be preceded by whitespace so that keywords 1419 ;; inside of the docstring don't start new paragraphs (Bug#7751). 1420 ;; 1421 ;; `paragraph-separate': A clever regexp distinguishes the first line of 1422 ;; a docstring and identifies it as a paragraph separator, so that it 1423 ;; won't be filled. (Since the first line of documentation stands alone 1424 ;; in some contexts, filling should not alter the contents the author has 1425 ;; chosen.) Only the first line of a docstring begins with whitespace 1426 ;; and a quotation mark and ends with a period or (rarely) a comma. 1427 ;; 1428 ;; The `fill-column' is temporarily bound to 1429 ;; `emacs-lisp-docstring-fill-column' if that value is an integer. 1430 (let ((paragraph-start 1431 (concat paragraph-start 1432 "\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)")) 1433 (paragraph-separate 1434 (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) 1435 (fill-column (if (and (integerp emacs-lisp-docstring-fill-column) 1436 (derived-mode-p 'emacs-lisp-mode)) 1437 emacs-lisp-docstring-fill-column 1438 fill-column))) 1439 (save-restriction 1440 (save-excursion 1441 (let ((ppss (syntax-ppss)) 1442 (start (point))) 1443 ;; If we're in a string, then narrow (roughly) to that 1444 ;; string before filling. This avoids filling Lisp 1445 ;; statements that follow the string. 1446 (when (ppss-string-terminator ppss) 1447 (goto-char (ppss-comment-or-string-start ppss)) 1448 (beginning-of-line) 1449 ;; The string may be unterminated -- in that case, don't 1450 ;; narrow. 1451 (when (ignore-errors 1452 (progn 1453 (forward-sexp 1) 1454 t)) 1455 (narrow-to-region (ppss-comment-or-string-start ppss) 1456 (point)))) 1457 ;; Move back to where we were. 1458 (goto-char start) 1459 (fill-paragraph justify))))) 1460 ;; Never return nil. 1461 t)) 1462 1463(defun indent-code-rigidly (start end arg &optional nochange-regexp) 1464 "Indent all lines of code, starting in the region, sideways by ARG columns. 1465Does not affect lines starting inside comments or strings, assuming that 1466the start of the region is not inside them. 1467 1468Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP. 1469The last is a regexp which, if matched at the beginning of a line, 1470means don't indent that line." 1471 (interactive "r\np") 1472 (let (state) 1473 (save-excursion 1474 (goto-char end) 1475 (setq end (point-marker)) 1476 (goto-char start) 1477 (or (bolp) 1478 (setq state (parse-partial-sexp (point) 1479 (progn 1480 (forward-line 1) (point)) 1481 nil nil state))) 1482 (while (< (point) end) 1483 (or (car (nthcdr 3 state)) 1484 (and nochange-regexp 1485 (looking-at nochange-regexp)) 1486 ;; If line does not start in string, indent it 1487 (let ((indent (current-indentation))) 1488 (delete-region (point) (progn (skip-chars-forward " \t") (point))) 1489 (or (eolp) 1490 (indent-to (max 0 (+ indent arg)) 0)))) 1491 (setq state (parse-partial-sexp (point) 1492 (progn 1493 (forward-line 1) (point)) 1494 nil nil state)))))) 1495 1496(provide 'lisp-mode) 1497 1498;;; lisp-mode.el ends here 1499