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