aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMartin Rudalics2008-09-23 17:59:28 +0000
committerMartin Rudalics2008-09-23 17:59:28 +0000
commitd6a3febd83a52db53f665b0987075af590c720a5 (patch)
treead19a3bb2656d24e0d15efc4565eae96850355e0
parent86ec740ec46b10860776c4ac73d55ad5fcde90b1 (diff)
downloademacs-d6a3febd83a52db53f665b0987075af590c720a5.tar.gz
emacs-d6a3febd83a52db53f665b0987075af590c720a5.zip
*** empty log message ***
-rw-r--r--lisp/emacs-lisp/lisp-mode.el2872
1 files changed, 1436 insertions, 1436 deletions
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 24c32675423..09c1e44b012 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1,1436 +1,1436 @@
1;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands 1;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
2 2
3;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. 4;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
7;; Keywords: lisp, languages 7;; Keywords: lisp, languages
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10 10
11;; GNU Emacs is free software: you can redistribute it and/or modify 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 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 13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version. 14;; (at your option) any later version.
15 15
16;; GNU Emacs is distributed in the hope that it will be useful, 16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details. 19;; GNU General Public License for more details.
20 20
21;; You should have received a copy of the GNU General Public License 21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 23
24;;; Commentary: 24;;; Commentary:
25 25
26;; The base major mode for editing Lisp code (used also for Emacs Lisp). 26;; The base major mode for editing Lisp code (used also for Emacs Lisp).
27;; This mode is documented in the Emacs manual. 27;; This mode is documented in the Emacs manual.
28 28
29;;; Code: 29;;; Code:
30 30
31(defvar font-lock-comment-face) 31(defvar font-lock-comment-face)
32(defvar font-lock-doc-face) 32(defvar font-lock-doc-face)
33(defvar font-lock-keywords-case-fold-search) 33(defvar font-lock-keywords-case-fold-search)
34(defvar font-lock-string-face) 34(defvar font-lock-string-face)
35 35
36(defvar lisp-mode-abbrev-table nil) 36(defvar lisp-mode-abbrev-table nil)
37 37
38(define-abbrev-table 'lisp-mode-abbrev-table ()) 38(define-abbrev-table 'lisp-mode-abbrev-table ())
39 39
40(defvar emacs-lisp-mode-syntax-table 40(defvar emacs-lisp-mode-syntax-table
41 (let ((table (make-syntax-table))) 41 (let ((table (make-syntax-table)))
42 (let ((i 0)) 42 (let ((i 0))
43 (while (< i ?0) 43 (while (< i ?0)
44 (modify-syntax-entry i "_ " table) 44 (modify-syntax-entry i "_ " table)
45 (setq i (1+ i))) 45 (setq i (1+ i)))
46 (setq i (1+ ?9)) 46 (setq i (1+ ?9))
47 (while (< i ?A) 47 (while (< i ?A)
48 (modify-syntax-entry i "_ " table) 48 (modify-syntax-entry i "_ " table)
49 (setq i (1+ i))) 49 (setq i (1+ i)))
50 (setq i (1+ ?Z)) 50 (setq i (1+ ?Z))
51 (while (< i ?a) 51 (while (< i ?a)
52 (modify-syntax-entry i "_ " table) 52 (modify-syntax-entry i "_ " table)
53 (setq i (1+ i))) 53 (setq i (1+ i)))
54 (setq i (1+ ?z)) 54 (setq i (1+ ?z))
55 (while (< i 128) 55 (while (< i 128)
56 (modify-syntax-entry i "_ " table) 56 (modify-syntax-entry i "_ " table)
57 (setq i (1+ i))) 57 (setq i (1+ i)))
58 (modify-syntax-entry ?\s " " table) 58 (modify-syntax-entry ?\s " " table)
59 ;; Non-break space acts as whitespace. 59 ;; Non-break space acts as whitespace.
60 (modify-syntax-entry ?\x8a0 " " table) 60 (modify-syntax-entry ?\x8a0 " " table)
61 (modify-syntax-entry ?\t " " table) 61 (modify-syntax-entry ?\t " " table)
62 (modify-syntax-entry ?\f " " table) 62 (modify-syntax-entry ?\f " " table)
63 (modify-syntax-entry ?\n "> " table) 63 (modify-syntax-entry ?\n "> " table)
64 ;; This is probably obsolete since nowadays such features use overlays. 64 ;; This is probably obsolete since nowadays such features use overlays.
65 ;; ;; Give CR the same syntax as newline, for selective-display. 65 ;; ;; Give CR the same syntax as newline, for selective-display.
66 ;; (modify-syntax-entry ?\^m "> " table) 66 ;; (modify-syntax-entry ?\^m "> " table)
67 (modify-syntax-entry ?\; "< " table) 67 (modify-syntax-entry ?\; "< " table)
68 (modify-syntax-entry ?` "' " table) 68 (modify-syntax-entry ?` "' " table)
69 (modify-syntax-entry ?' "' " table) 69 (modify-syntax-entry ?' "' " table)
70 (modify-syntax-entry ?, "' " table) 70 (modify-syntax-entry ?, "' " table)
71 (modify-syntax-entry ?@ "' " table) 71 (modify-syntax-entry ?@ "' " table)
72 ;; Used to be singlequote; changed for flonums. 72 ;; Used to be singlequote; changed for flonums.
73 (modify-syntax-entry ?. "_ " table) 73 (modify-syntax-entry ?. "_ " table)
74 (modify-syntax-entry ?# "' " table) 74 (modify-syntax-entry ?# "' " table)
75 (modify-syntax-entry ?\" "\" " table) 75 (modify-syntax-entry ?\" "\" " table)
76 (modify-syntax-entry ?\\ "\\ " table) 76 (modify-syntax-entry ?\\ "\\ " table)
77 (modify-syntax-entry ?\( "() " table) 77 (modify-syntax-entry ?\( "() " table)
78 (modify-syntax-entry ?\) ")( " table) 78 (modify-syntax-entry ?\) ")( " table)
79 (modify-syntax-entry ?\[ "(] " table) 79 (modify-syntax-entry ?\[ "(] " table)
80 (modify-syntax-entry ?\] ")[ " table)) 80 (modify-syntax-entry ?\] ")[ " table))
81 table)) 81 table))
82 82
83(defvar lisp-mode-syntax-table 83(defvar lisp-mode-syntax-table
84 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) 84 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
85 (modify-syntax-entry ?\[ "_ " table) 85 (modify-syntax-entry ?\[ "_ " table)
86 (modify-syntax-entry ?\] "_ " table) 86 (modify-syntax-entry ?\] "_ " table)
87 (modify-syntax-entry ?# "' 14b" table) 87 (modify-syntax-entry ?# "' 14b" table)
88 (modify-syntax-entry ?| "\" 23bn" table) 88 (modify-syntax-entry ?| "\" 23bn" table)
89 table)) 89 table))
90 90
91(defvar lisp-imenu-generic-expression 91(defvar lisp-imenu-generic-expression
92 (list 92 (list
93 (list nil 93 (list nil
94 (purecopy (concat "^\\s-*(" 94 (purecopy (concat "^\\s-*("
95 (eval-when-compile 95 (eval-when-compile
96 (regexp-opt 96 (regexp-opt
97 '("defun" "defun*" "defsubst" "defmacro" 97 '("defun" "defun*" "defsubst" "defmacro"
98 "defadvice" "define-skeleton" 98 "defadvice" "define-skeleton"
99 "define-minor-mode" "define-global-minor-mode" 99 "define-minor-mode" "define-global-minor-mode"
100 "define-globalized-minor-mode" 100 "define-globalized-minor-mode"
101 "define-derived-mode" "define-generic-mode" 101 "define-derived-mode" "define-generic-mode"
102 "define-compiler-macro" "define-modify-macro" 102 "define-compiler-macro" "define-modify-macro"
103 "defsetf" "define-setf-expander" 103 "defsetf" "define-setf-expander"
104 "define-method-combination" 104 "define-method-combination"
105 "defgeneric" "defmethod") t)) 105 "defgeneric" "defmethod") t))
106 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 106 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
107 2) 107 2)
108 (list (purecopy "Variables") 108 (list (purecopy "Variables")
109 (purecopy (concat "^\\s-*(" 109 (purecopy (concat "^\\s-*("
110 (eval-when-compile 110 (eval-when-compile
111 (regexp-opt 111 (regexp-opt
112 '("defvar" "defconst" "defconstant" "defcustom" 112 '("defvar" "defconst" "defconstant" "defcustom"
113 "defparameter" "define-symbol-macro") t)) 113 "defparameter" "define-symbol-macro") t))
114 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 114 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
115 2) 115 2)
116 (list (purecopy "Types") 116 (list (purecopy "Types")
117 (purecopy (concat "^\\s-*(" 117 (purecopy (concat "^\\s-*("
118 (eval-when-compile 118 (eval-when-compile
119 (regexp-opt 119 (regexp-opt
120 '("defgroup" "deftheme" "deftype" "defstruct" 120 '("defgroup" "deftheme" "deftype" "defstruct"
121 "defclass" "define-condition" "define-widget" 121 "defclass" "define-condition" "define-widget"
122 "defface" "defpackage") t)) 122 "defface" "defpackage") t))
123 "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)")) 123 "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))
124 2)) 124 2))
125 125
126 "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") 126 "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
127 127
128;; This was originally in autoload.el and is still used there. 128;; This was originally in autoload.el and is still used there.
129(put 'autoload 'doc-string-elt 3) 129(put 'autoload 'doc-string-elt 3)
130(put 'defun 'doc-string-elt 3) 130(put 'defun 'doc-string-elt 3)
131(put 'defun* 'doc-string-elt 3) 131(put 'defun* 'doc-string-elt 3)
132(put 'defvar 'doc-string-elt 3) 132(put 'defvar 'doc-string-elt 3)
133(put 'defcustom 'doc-string-elt 3) 133(put 'defcustom 'doc-string-elt 3)
134(put 'deftheme 'doc-string-elt 2) 134(put 'deftheme 'doc-string-elt 2)
135(put 'defconst 'doc-string-elt 3) 135(put 'defconst 'doc-string-elt 3)
136(put 'defmacro 'doc-string-elt 3) 136(put 'defmacro 'doc-string-elt 3)
137(put 'defmacro* 'doc-string-elt 3) 137(put 'defmacro* 'doc-string-elt 3)
138(put 'defsubst 'doc-string-elt 3) 138(put 'defsubst 'doc-string-elt 3)
139(put 'defstruct 'doc-string-elt 2) 139(put 'defstruct 'doc-string-elt 2)
140(put 'define-skeleton 'doc-string-elt 2) 140(put 'define-skeleton 'doc-string-elt 2)
141(put 'define-derived-mode 'doc-string-elt 4) 141(put 'define-derived-mode 'doc-string-elt 4)
142(put 'define-compilation-mode 'doc-string-elt 3) 142(put 'define-compilation-mode 'doc-string-elt 3)
143(put 'easy-mmode-define-minor-mode 'doc-string-elt 2) 143(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
144(put 'define-minor-mode 'doc-string-elt 2) 144(put 'define-minor-mode 'doc-string-elt 2)
145(put 'easy-mmode-define-global-mode 'doc-string-elt 2) 145(put 'easy-mmode-define-global-mode 'doc-string-elt 2)
146(put 'define-global-minor-mode 'doc-string-elt 2) 146(put 'define-global-minor-mode 'doc-string-elt 2)
147(put 'define-globalized-minor-mode 'doc-string-elt 2) 147(put 'define-globalized-minor-mode 'doc-string-elt 2)
148(put 'define-generic-mode 'doc-string-elt 7) 148(put 'define-generic-mode 'doc-string-elt 7)
149(put 'define-ibuffer-filter 'doc-string-elt 2) 149(put 'define-ibuffer-filter 'doc-string-elt 2)
150(put 'define-ibuffer-op 'doc-string-elt 3) 150(put 'define-ibuffer-op 'doc-string-elt 3)
151(put 'define-ibuffer-sorter 'doc-string-elt 2) 151(put 'define-ibuffer-sorter 'doc-string-elt 2)
152(put 'lambda 'doc-string-elt 2) 152(put 'lambda 'doc-string-elt 2)
153(put 'defalias 'doc-string-elt 3) 153(put 'defalias 'doc-string-elt 3)
154(put 'defvaralias 'doc-string-elt 3) 154(put 'defvaralias 'doc-string-elt 3)
155(put 'define-category 'doc-string-elt 2) 155(put 'define-category 'doc-string-elt 2)
156 156
157(defvar lisp-doc-string-elt-property 'doc-string-elt 157(defvar lisp-doc-string-elt-property 'doc-string-elt
158 "The symbol property that holds the docstring position info.") 158 "The symbol property that holds the docstring position info.")
159 159
160(defun lisp-font-lock-syntactic-face-function (state) 160(defun lisp-font-lock-syntactic-face-function (state)
161 (if (nth 3 state) 161 (if (nth 3 state)
162 ;; This might be a (doc)string or a |...| symbol. 162 ;; This might be a (doc)string or a |...| symbol.
163 (let ((startpos (nth 8 state))) 163 (let ((startpos (nth 8 state)))
164 (if (eq (char-after startpos) ?|) 164 (if (eq (char-after startpos) ?|)
165 ;; This is not a string, but a |...| symbol. 165 ;; This is not a string, but a |...| symbol.
166 nil 166 nil
167 (let* ((listbeg (nth 1 state)) 167 (let* ((listbeg (nth 1 state))
168 (firstsym (and listbeg 168 (firstsym (and listbeg
169 (save-excursion 169 (save-excursion
170 (goto-char listbeg) 170 (goto-char listbeg)
171 (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") 171 (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
172 (match-string 1))))) 172 (match-string 1)))))
173 (docelt (and firstsym (get (intern-soft firstsym) 173 (docelt (and firstsym (get (intern-soft firstsym)
174 lisp-doc-string-elt-property)))) 174 lisp-doc-string-elt-property))))
175 (if (and docelt 175 (if (and docelt
176 ;; It's a string in a form that can have a docstring. 176 ;; It's a string in a form that can have a docstring.
177 ;; Check whether it's in docstring position. 177 ;; Check whether it's in docstring position.
178 (save-excursion 178 (save-excursion
179 (when (functionp docelt) 179 (when (functionp docelt)
180 (goto-char (match-end 1)) 180 (goto-char (match-end 1))
181 (setq docelt (funcall docelt))) 181 (setq docelt (funcall docelt)))
182 (goto-char listbeg) 182 (goto-char listbeg)
183 (forward-char 1) 183 (forward-char 1)
184 (condition-case nil 184 (condition-case nil
185 (while (and (> docelt 0) (< (point) startpos) 185 (while (and (> docelt 0) (< (point) startpos)
186 (progn (forward-sexp 1) t)) 186 (progn (forward-sexp 1) t))
187 (setq docelt (1- docelt))) 187 (setq docelt (1- docelt)))
188 (error nil)) 188 (error nil))
189 (and (zerop docelt) (<= (point) startpos) 189 (and (zerop docelt) (<= (point) startpos)
190 (progn (forward-comment (point-max)) t) 190 (progn (forward-comment (point-max)) t)
191 (= (point) (nth 8 state))))) 191 (= (point) (nth 8 state)))))
192 font-lock-doc-face 192 font-lock-doc-face
193 font-lock-string-face)))) 193 font-lock-string-face))))
194 font-lock-comment-face)) 194 font-lock-comment-face))
195 195
196;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is 196;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is
197;; (uselessly) passed from pp.el, chistory.el, gnus-kill.el and score-mode.el 197;; (uselessly) passed from pp.el, chistory.el, gnus-kill.el and score-mode.el
198(defun lisp-mode-variables (&optional lisp-syntax) 198(defun lisp-mode-variables (&optional lisp-syntax)
199 (when lisp-syntax 199 (when lisp-syntax
200 (set-syntax-table lisp-mode-syntax-table)) 200 (set-syntax-table lisp-mode-syntax-table))
201 (setq local-abbrev-table lisp-mode-abbrev-table) 201 (setq local-abbrev-table lisp-mode-abbrev-table)
202 (make-local-variable 'paragraph-ignore-fill-prefix) 202 (make-local-variable 'paragraph-ignore-fill-prefix)
203 (setq paragraph-ignore-fill-prefix t) 203 (setq paragraph-ignore-fill-prefix t)
204 (make-local-variable 'fill-paragraph-function) 204 (make-local-variable 'fill-paragraph-function)
205 (setq fill-paragraph-function 'lisp-fill-paragraph) 205 (setq fill-paragraph-function 'lisp-fill-paragraph)
206 ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of 206 ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of
207 ;; a single docstring. Let's fix it here. 207 ;; a single docstring. Let's fix it here.
208 (set (make-local-variable 'adaptive-fill-function) 208 (set (make-local-variable 'adaptive-fill-function)
209 (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))) 209 (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")))
210 ;; Adaptive fill mode gets in the way of auto-fill, 210 ;; Adaptive fill mode gets in the way of auto-fill,
211 ;; and should make no difference for explicit fill 211 ;; and should make no difference for explicit fill
212 ;; because lisp-fill-paragraph should do the job. 212 ;; because lisp-fill-paragraph should do the job.
213 ;; I believe that newcomment's auto-fill code properly deals with it -stef 213 ;; I believe that newcomment's auto-fill code properly deals with it -stef
214 ;;(set (make-local-variable 'adaptive-fill-mode) nil) 214 ;;(set (make-local-variable 'adaptive-fill-mode) nil)
215 (make-local-variable 'indent-line-function) 215 (make-local-variable 'indent-line-function)
216 (setq indent-line-function 'lisp-indent-line) 216 (setq indent-line-function 'lisp-indent-line)
217 (make-local-variable 'parse-sexp-ignore-comments) 217 (make-local-variable 'parse-sexp-ignore-comments)
218 (setq parse-sexp-ignore-comments t) 218 (setq parse-sexp-ignore-comments t)
219 (make-local-variable 'outline-regexp) 219 (make-local-variable 'outline-regexp)
220 (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") 220 (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
221 (make-local-variable 'outline-level) 221 (make-local-variable 'outline-level)
222 (setq outline-level 'lisp-outline-level) 222 (setq outline-level 'lisp-outline-level)
223 (make-local-variable 'comment-start) 223 (make-local-variable 'comment-start)
224 (setq comment-start ";") 224 (setq comment-start ";")
225 (make-local-variable 'comment-start-skip) 225 (make-local-variable 'comment-start-skip)
226 ;; Look within the line for a ; following an even number of backslashes 226 ;; Look within the line for a ; following an even number of backslashes
227 ;; after either a non-backslash or the line beginning. 227 ;; after either a non-backslash or the line beginning.
228 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") 228 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
229 (make-local-variable 'font-lock-comment-start-skip) 229 (make-local-variable 'font-lock-comment-start-skip)
230 ;; Font lock mode uses this only when it KNOWS a comment is starting. 230 ;; Font lock mode uses this only when it KNOWS a comment is starting.
231 (setq font-lock-comment-start-skip ";+ *") 231 (setq font-lock-comment-start-skip ";+ *")
232 (make-local-variable 'comment-add) 232 (make-local-variable 'comment-add)
233 (setq comment-add 1) ;default to `;;' in comment-region 233 (setq comment-add 1) ;default to `;;' in comment-region
234 (make-local-variable 'comment-column) 234 (make-local-variable 'comment-column)
235 (setq comment-column 40) 235 (setq comment-column 40)
236 ;; Don't get confused by `;' in doc strings when paragraph-filling. 236 ;; Don't get confused by `;' in doc strings when paragraph-filling.
237 (set (make-local-variable 'comment-use-global-state) t) 237 (set (make-local-variable 'comment-use-global-state) t)
238 (make-local-variable 'imenu-generic-expression) 238 (make-local-variable 'imenu-generic-expression)
239 (setq imenu-generic-expression lisp-imenu-generic-expression) 239 (setq imenu-generic-expression lisp-imenu-generic-expression)
240 (make-local-variable 'multibyte-syntax-as-symbol) 240 (make-local-variable 'multibyte-syntax-as-symbol)
241 (setq multibyte-syntax-as-symbol t) 241 (setq multibyte-syntax-as-symbol t)
242 (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun) 242 (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun)
243 (setq font-lock-defaults 243 (setq font-lock-defaults
244 '((lisp-font-lock-keywords 244 '((lisp-font-lock-keywords
245 lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) 245 lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
246 nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) nil 246 nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) nil
247 (font-lock-mark-block-function . mark-defun) 247 (font-lock-mark-block-function . mark-defun)
248 (font-lock-syntactic-face-function 248 (font-lock-syntactic-face-function
249 . lisp-font-lock-syntactic-face-function)))) 249 . lisp-font-lock-syntactic-face-function))))
250 250
251(defun lisp-outline-level () 251(defun lisp-outline-level ()
252 "Lisp mode `outline-level' function." 252 "Lisp mode `outline-level' function."
253 (let ((len (- (match-end 0) (match-beginning 0)))) 253 (let ((len (- (match-end 0) (match-beginning 0))))
254 (if (looking-at "(\\|;;;###autoload") 254 (if (looking-at "(\\|;;;###autoload")
255 1000 255 1000
256 len))) 256 len)))
257 257
258(defvar lisp-mode-shared-map 258(defvar lisp-mode-shared-map
259 (let ((map (make-sparse-keymap))) 259 (let ((map (make-sparse-keymap)))
260 (define-key map "\e\C-q" 'indent-sexp) 260 (define-key map "\e\C-q" 'indent-sexp)
261 (define-key map "\177" 'backward-delete-char-untabify) 261 (define-key map "\177" 'backward-delete-char-untabify)
262 ;; This gets in the way when viewing a Lisp file in view-mode. As 262 ;; This gets in the way when viewing a Lisp file in view-mode. As
263 ;; long as [backspace] is mapped into DEL via the 263 ;; long as [backspace] is mapped into DEL via the
264 ;; function-key-map, this should remain disabled!! 264 ;; function-key-map, this should remain disabled!!
265 ;;;(define-key map [backspace] 'backward-delete-char-untabify) 265 ;;;(define-key map [backspace] 'backward-delete-char-untabify)
266 map) 266 map)
267 "Keymap for commands shared by all sorts of Lisp modes.") 267 "Keymap for commands shared by all sorts of Lisp modes.")
268 268
269(defvar emacs-lisp-mode-map 269(defvar emacs-lisp-mode-map
270 (let ((map (make-sparse-keymap "Emacs-Lisp")) 270 (let ((map (make-sparse-keymap "Emacs-Lisp"))
271 (menu-map (make-sparse-keymap "Emacs-Lisp")) 271 (menu-map (make-sparse-keymap "Emacs-Lisp"))
272 (prof-map (make-sparse-keymap)) 272 (prof-map (make-sparse-keymap))
273 (tracing-map (make-sparse-keymap))) 273 (tracing-map (make-sparse-keymap)))
274 (set-keymap-parent map lisp-mode-shared-map) 274 (set-keymap-parent map lisp-mode-shared-map)
275 (define-key map "\e\t" 'lisp-complete-symbol) 275 (define-key map "\e\t" 'lisp-complete-symbol)
276 (define-key map "\e\C-x" 'eval-defun) 276 (define-key map "\e\C-x" 'eval-defun)
277 (define-key map "\e\C-q" 'indent-pp-sexp) 277 (define-key map "\e\C-q" 'indent-pp-sexp)
278 (define-key map [menu-bar emacs-lisp] (cons "Emacs-Lisp" menu-map)) 278 (define-key map [menu-bar emacs-lisp] (cons "Emacs-Lisp" menu-map))
279 (define-key menu-map [eldoc] 279 (define-key menu-map [eldoc]
280 '(menu-item "Auto-Display Documentation Strings" eldoc-mode 280 '(menu-item "Auto-Display Documentation Strings" eldoc-mode
281 :button (:toggle . (bound-and-true-p eldoc-mode)) 281 :button (:toggle . (bound-and-true-p eldoc-mode))
282 :help "Display the documentation string for the item under cursor")) 282 :help "Display the documentation string for the item under cursor"))
283 (define-key menu-map [checkdoc] 283 (define-key menu-map [checkdoc]
284 '(menu-item "Check Documentation Strings" checkdoc 284 '(menu-item "Check Documentation Strings" checkdoc
285 :help "Check documentation strings for style requirements")) 285 :help "Check documentation strings for style requirements"))
286 (define-key menu-map [re-builder] 286 (define-key menu-map [re-builder]
287 '(menu-item "Construct Regexp" re-builder 287 '(menu-item "Construct Regexp" re-builder
288 :help "Construct a regexp interactively")) 288 :help "Construct a regexp interactively"))
289 (define-key menu-map [tracing] (cons "Tracing" tracing-map)) 289 (define-key menu-map [tracing] (cons "Tracing" tracing-map))
290 (define-key tracing-map [tr-a] 290 (define-key tracing-map [tr-a]
291 '(menu-item "Untrace all" untrace-all 291 '(menu-item "Untrace all" untrace-all
292 :help "Untraces all currently traced functions")) 292 :help "Untraces all currently traced functions"))
293 (define-key tracing-map [tr-uf] 293 (define-key tracing-map [tr-uf]
294 '(menu-item "Untrace function..." untrace-function 294 '(menu-item "Untrace function..." untrace-function
295 :help "Untraces FUNCTION and possibly activates all remaining advice")) 295 :help "Untraces FUNCTION and possibly activates all remaining advice"))
296 (define-key tracing-map [tr-sep] '("--")) 296 (define-key tracing-map [tr-sep] '("--"))
297 (define-key tracing-map [tr-q] 297 (define-key tracing-map [tr-q]
298 '(menu-item "Trace function quietly..." trace-function-background 298 '(menu-item "Trace function quietly..." trace-function-background
299 :help "Trace the function with trace output going quietly to a buffer")) 299 :help "Trace the function with trace output going quietly to a buffer"))
300 (define-key tracing-map [tr-f] 300 (define-key tracing-map [tr-f]
301 '(menu-item "Trace function..." trace-function 301 '(menu-item "Trace function..." trace-function
302 :help "Trace the function given as a argument")) 302 :help "Trace the function given as a argument"))
303 (define-key menu-map [profiling] (cons "Profiling" prof-map)) 303 (define-key menu-map [profiling] (cons "Profiling" prof-map))
304 (define-key prof-map [prof-restall] 304 (define-key prof-map [prof-restall]
305 '(menu-item "Remove Instrumentation for All Functions" elp-restore-all 305 '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
306 :help "Restore the original definitions of all functions being profiled")) 306 :help "Restore the original definitions of all functions being profiled"))
307 (define-key prof-map [prof-restfunc] 307 (define-key prof-map [prof-restfunc]
308 '(menu-item "Remove Instrumentation for Function..." elp-restore-function 308 '(menu-item "Remove Instrumentation for Function..." elp-restore-function
309 :help "Restore an instrumented function to its original definition")) 309 :help "Restore an instrumented function to its original definition"))
310 310
311 (define-key prof-map [sep-rem] '("--")) 311 (define-key prof-map [sep-rem] '("--"))
312 (define-key prof-map [prof-resall] 312 (define-key prof-map [prof-resall]
313 '(menu-item "Reset Counters for All Functions" elp-reset-all 313 '(menu-item "Reset Counters for All Functions" elp-reset-all
314 :help "Reset the profiling information for all functions being profiled")) 314 :help "Reset the profiling information for all functions being profiled"))
315 (define-key prof-map [prof-resfunc] 315 (define-key prof-map [prof-resfunc]
316 '(menu-item "Reset Counters for Function..." elp-reset-function 316 '(menu-item "Reset Counters for Function..." elp-reset-function
317 :help "Reset the profiling information for a function")) 317 :help "Reset the profiling information for a function"))
318 (define-key prof-map [prof-res] 318 (define-key prof-map [prof-res]
319 '(menu-item "Show Profiling Results" elp-results 319 '(menu-item "Show Profiling Results" elp-results
320 :help "Display current profiling results")) 320 :help "Display current profiling results"))
321 (define-key prof-map [prof-pack] 321 (define-key prof-map [prof-pack]
322 '(menu-item "Instrument Package..." elp-instrument-package 322 '(menu-item "Instrument Package..." elp-instrument-package
323 :help "Instrument for profiling all function that start with a prefix")) 323 :help "Instrument for profiling all function that start with a prefix"))
324 (define-key prof-map [prof-func] 324 (define-key prof-map [prof-func]
325 '(menu-item "Instrument Function..." elp-instrument-function 325 '(menu-item "Instrument Function..." elp-instrument-function
326 :help "Instrument a function for profiling")) 326 :help "Instrument a function for profiling"))
327 (define-key menu-map [edebug-defun] 327 (define-key menu-map [edebug-defun]
328 '(menu-item "Instrument Function for Debugging" edebug-defun 328 '(menu-item "Instrument Function for Debugging" edebug-defun
329 :help "Evaluate the top level form point is in, stepping through with Edebug" 329 :help "Evaluate the top level form point is in, stepping through with Edebug"
330 :keys "C-u C-M-x")) 330 :keys "C-u C-M-x"))
331 (define-key menu-map [separator-byte] '("--")) 331 (define-key menu-map [separator-byte] '("--"))
332 (define-key menu-map [disas] 332 (define-key menu-map [disas]
333 '(menu-item "Disassemble byte compiled object..." disassemble 333 '(menu-item "Disassemble byte compiled object..." disassemble
334 :help "Print disassembled code for OBJECT in a buffer")) 334 :help "Print disassembled code for OBJECT in a buffer"))
335 (define-key menu-map [byte-recompile] 335 (define-key menu-map [byte-recompile]
336 '(menu-item "Byte-recompile Directory..." byte-recompile-directory 336 '(menu-item "Byte-recompile Directory..." byte-recompile-directory
337 :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) 337 :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
338 (define-key menu-map [emacs-byte-compile-and-load] 338 (define-key menu-map [emacs-byte-compile-and-load]
339 '(menu-item "Byte-compile And Load" emacs-lisp-byte-compile-and-load 339 '(menu-item "Byte-compile And Load" emacs-lisp-byte-compile-and-load
340 :help "Byte-compile the current file (if it has changed), then load compiled code")) 340 :help "Byte-compile the current file (if it has changed), then load compiled code"))
341 (define-key menu-map [byte-compile] 341 (define-key menu-map [byte-compile]
342 '(menu-item "Byte-compile This File" emacs-lisp-byte-compile 342 '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
343 :help "Byte compile the file containing the current buffer")) 343 :help "Byte compile the file containing the current buffer"))
344 (define-key menu-map [separator-eval] '("--")) 344 (define-key menu-map [separator-eval] '("--"))
345 (define-key menu-map [ielm] 345 (define-key menu-map [ielm]
346 '(menu-item "Interactive Expression Evaluation" ielm 346 '(menu-item "Interactive Expression Evaluation" ielm
347 :help "Interactively evaluate Emacs Lisp expressions")) 347 :help "Interactively evaluate Emacs Lisp expressions"))
348 (define-key menu-map [eval-buffer] 348 (define-key menu-map [eval-buffer]
349 '(menu-item "Evaluate Buffer" eval-buffer 349 '(menu-item "Evaluate Buffer" eval-buffer
350 :help "Execute the current buffer as Lisp code")) 350 :help "Execute the current buffer as Lisp code"))
351 (define-key menu-map [eval-region] 351 (define-key menu-map [eval-region]
352 '(menu-item "Evaluate Region" eval-region 352 '(menu-item "Evaluate Region" eval-region
353 :help "Execute the region as Lisp code" 353 :help "Execute the region as Lisp code"
354 :enable mark-active)) 354 :enable mark-active))
355 (define-key menu-map [eval-sexp] 355 (define-key menu-map [eval-sexp]
356 '(menu-item "Evaluate Last S-expression" eval-last-sexp 356 '(menu-item "Evaluate Last S-expression" eval-last-sexp
357 :help "Evaluate sexp before point; print value in minibuffer")) 357 :help "Evaluate sexp before point; print value in minibuffer"))
358 (define-key menu-map [separator-format] '("--")) 358 (define-key menu-map [separator-format] '("--"))
359 (define-key menu-map [comment-region] 359 (define-key menu-map [comment-region]
360 '(menu-item "Comment Out Region" comment-region 360 '(menu-item "Comment Out Region" comment-region
361 :help "Comment or uncomment each line in the region" 361 :help "Comment or uncomment each line in the region"
362 :enable mark-active)) 362 :enable mark-active))
363 (define-key menu-map [indent-region] 363 (define-key menu-map [indent-region]
364 '(menu-item "Indent Region" indent-region 364 '(menu-item "Indent Region" indent-region
365 :help "Indent each nonblank line in the region" 365 :help "Indent each nonblank line in the region"
366 :enable mark-active)) 366 :enable mark-active))
367 (define-key menu-map [indent-line] '("Indent Line" . lisp-indent-line)) 367 (define-key menu-map [indent-line] '("Indent Line" . lisp-indent-line))
368 map) 368 map)
369 "Keymap for Emacs Lisp mode. 369 "Keymap for Emacs Lisp mode.
370All commands in `lisp-mode-shared-map' are inherited by this map.") 370All commands in `lisp-mode-shared-map' are inherited by this map.")
371 371
372(defun emacs-lisp-byte-compile () 372(defun emacs-lisp-byte-compile ()
373 "Byte compile the file containing the current buffer." 373 "Byte compile the file containing the current buffer."
374 (interactive) 374 (interactive)
375 (if buffer-file-name 375 (if buffer-file-name
376 (byte-compile-file buffer-file-name) 376 (byte-compile-file buffer-file-name)
377 (error "The buffer must be saved in a file first"))) 377 (error "The buffer must be saved in a file first")))
378 378
379(defun emacs-lisp-byte-compile-and-load () 379(defun emacs-lisp-byte-compile-and-load ()
380 "Byte-compile the current file (if it has changed), then load compiled code." 380 "Byte-compile the current file (if it has changed), then load compiled code."
381 (interactive) 381 (interactive)
382 (or buffer-file-name 382 (or buffer-file-name
383 (error "The buffer must be saved in a file first")) 383 (error "The buffer must be saved in a file first"))
384 (require 'bytecomp) 384 (require 'bytecomp)
385 ;; Recompile if file or buffer has changed since last compilation. 385 ;; Recompile if file or buffer has changed since last compilation.
386 (if (and (buffer-modified-p) 386 (if (and (buffer-modified-p)
387 (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) 387 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
388 (save-buffer)) 388 (save-buffer))
389 (let ((compiled-file-name (byte-compile-dest-file buffer-file-name))) 389 (let ((compiled-file-name (byte-compile-dest-file buffer-file-name)))
390 (if (file-newer-than-file-p compiled-file-name buffer-file-name) 390 (if (file-newer-than-file-p compiled-file-name buffer-file-name)
391 (load-file compiled-file-name) 391 (load-file compiled-file-name)
392 (byte-compile-file buffer-file-name t)))) 392 (byte-compile-file buffer-file-name t))))
393 393
394(defcustom emacs-lisp-mode-hook nil 394(defcustom emacs-lisp-mode-hook nil
395 "Hook run when entering Emacs Lisp mode." 395 "Hook run when entering Emacs Lisp mode."
396 :options '(turn-on-eldoc-mode imenu-add-menubar-index checkdoc-minor-mode) 396 :options '(turn-on-eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
397 :type 'hook 397 :type 'hook
398 :group 'lisp) 398 :group 'lisp)
399 399
400(defcustom lisp-mode-hook nil 400(defcustom lisp-mode-hook nil
401 "Hook run when entering Lisp mode." 401 "Hook run when entering Lisp mode."
402 :options '(imenu-add-menubar-index) 402 :options '(imenu-add-menubar-index)
403 :type 'hook 403 :type 'hook
404 :group 'lisp) 404 :group 'lisp)
405 405
406(defcustom lisp-interaction-mode-hook nil 406(defcustom lisp-interaction-mode-hook nil
407 "Hook run when entering Lisp Interaction mode." 407 "Hook run when entering Lisp Interaction mode."
408 :options '(turn-on-eldoc-mode) 408 :options '(turn-on-eldoc-mode)
409 :type 'hook 409 :type 'hook
410 :group 'lisp) 410 :group 'lisp)
411 411
412(defun emacs-lisp-mode () 412(defun emacs-lisp-mode ()
413 "Major mode for editing Lisp code to run in Emacs. 413 "Major mode for editing Lisp code to run in Emacs.
414Commands: 414Commands:
415Delete converts tabs to spaces as it moves back. 415Delete converts tabs to spaces as it moves back.
416Blank lines separate paragraphs. Semicolons start comments. 416Blank lines separate paragraphs. Semicolons start comments.
417\\{emacs-lisp-mode-map} 417\\{emacs-lisp-mode-map}
418Entry to this mode calls the value of `emacs-lisp-mode-hook' 418Entry to this mode calls the value of `emacs-lisp-mode-hook'
419if that value is non-nil." 419if that value is non-nil."
420 (interactive) 420 (interactive)
421 (kill-all-local-variables) 421 (kill-all-local-variables)
422 (use-local-map emacs-lisp-mode-map) 422 (use-local-map emacs-lisp-mode-map)
423 (set-syntax-table emacs-lisp-mode-syntax-table) 423 (set-syntax-table emacs-lisp-mode-syntax-table)
424 (setq major-mode 'emacs-lisp-mode) 424 (setq major-mode 'emacs-lisp-mode)
425 (setq mode-name "Emacs-Lisp") 425 (setq mode-name "Emacs-Lisp")
426 (lisp-mode-variables) 426 (lisp-mode-variables)
427 (setq imenu-case-fold-search nil) 427 (setq imenu-case-fold-search nil)
428 (run-mode-hooks 'emacs-lisp-mode-hook)) 428 (run-mode-hooks 'emacs-lisp-mode-hook))
429(put 'emacs-lisp-mode 'custom-mode-group 'lisp) 429(put 'emacs-lisp-mode 'custom-mode-group 'lisp)
430 430
431(defvar lisp-mode-map 431(defvar lisp-mode-map
432 (let ((map (make-sparse-keymap)) 432 (let ((map (make-sparse-keymap))
433 (menu-map (make-sparse-keymap "Lisp"))) 433 (menu-map (make-sparse-keymap "Lisp")))
434 (set-keymap-parent map lisp-mode-shared-map) 434 (set-keymap-parent map lisp-mode-shared-map)
435 (define-key map "\e\C-x" 'lisp-eval-defun) 435 (define-key map "\e\C-x" 'lisp-eval-defun)
436 (define-key map "\C-c\C-z" 'run-lisp) 436 (define-key map "\C-c\C-z" 'run-lisp)
437 (define-key map [menu-bar lisp] (cons "Lisp" menu-map)) 437 (define-key map [menu-bar lisp] (cons "Lisp" menu-map))
438 (define-key menu-map [run-lisp] 438 (define-key menu-map [run-lisp]
439 '(menu-item "Run inferior Lisp" run-lisp 439 '(menu-item "Run inferior Lisp" run-lisp
440 :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")) 440 :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))
441 (define-key menu-map [ev-def] 441 (define-key menu-map [ev-def]
442 '(menu-item "Eval defun" lisp-eval-defun 442 '(menu-item "Eval defun" lisp-eval-defun
443 :help "Send the current defun to the Lisp process made by M-x run-lisp")) 443 :help "Send the current defun to the Lisp process made by M-x run-lisp"))
444 (define-key menu-map [ind-sexp] 444 (define-key menu-map [ind-sexp]
445 '(menu-item "Indent sexp" indent-sexp 445 '(menu-item "Indent sexp" indent-sexp
446 :help "Indent each line of the list starting just after point")) 446 :help "Indent each line of the list starting just after point"))
447 map) 447 map)
448 "Keymap for ordinary Lisp mode. 448 "Keymap for ordinary Lisp mode.
449All commands in `lisp-mode-shared-map' are inherited by this map.") 449All commands in `lisp-mode-shared-map' are inherited by this map.")
450 450
451(defun lisp-mode () 451(defun lisp-mode ()
452 "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. 452 "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
453Commands: 453Commands:
454Delete converts tabs to spaces as it moves back. 454Delete converts tabs to spaces as it moves back.
455Blank lines separate paragraphs. Semicolons start comments. 455Blank lines separate paragraphs. Semicolons start comments.
456\\{lisp-mode-map} 456\\{lisp-mode-map}
457Note that `run-lisp' may be used either to start an inferior Lisp job 457Note that `run-lisp' may be used either to start an inferior Lisp job
458or to switch back to an existing one. 458or to switch back to an existing one.
459 459
460Entry to this mode calls the value of `lisp-mode-hook' 460Entry to this mode calls the value of `lisp-mode-hook'
461if that value is non-nil." 461if that value is non-nil."
462 (interactive) 462 (interactive)
463 (kill-all-local-variables) 463 (kill-all-local-variables)
464 (use-local-map lisp-mode-map) 464 (use-local-map lisp-mode-map)
465 (setq major-mode 'lisp-mode) 465 (setq major-mode 'lisp-mode)
466 (setq mode-name "Lisp") 466 (setq mode-name "Lisp")
467 (lisp-mode-variables) 467 (lisp-mode-variables)
468 (make-local-variable 'comment-start-skip) 468 (make-local-variable 'comment-start-skip)
469 (setq comment-start-skip 469 (setq comment-start-skip
470 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") 470 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
471 (make-local-variable 'font-lock-keywords-case-fold-search) 471 (make-local-variable 'font-lock-keywords-case-fold-search)
472 (setq font-lock-keywords-case-fold-search t) 472 (setq font-lock-keywords-case-fold-search t)
473 (setq imenu-case-fold-search t) 473 (setq imenu-case-fold-search t)
474 (set-syntax-table lisp-mode-syntax-table) 474 (set-syntax-table lisp-mode-syntax-table)
475 (run-mode-hooks 'lisp-mode-hook)) 475 (run-mode-hooks 'lisp-mode-hook))
476(put 'lisp-mode 'find-tag-default-function 'lisp-find-tag-default) 476(put 'lisp-mode 'find-tag-default-function 'lisp-find-tag-default)
477 477
478(defun lisp-find-tag-default () 478(defun lisp-find-tag-default ()
479 (let ((default (find-tag-default))) 479 (let ((default (find-tag-default)))
480 (when (stringp default) 480 (when (stringp default)
481 (if (string-match ":+" default) 481 (if (string-match ":+" default)
482 (substring default (match-end 0)) 482 (substring default (match-end 0))
483 default)))) 483 default))))
484 484
485;; Used in old LispM code. 485;; Used in old LispM code.
486(defalias 'common-lisp-mode 'lisp-mode) 486(defalias 'common-lisp-mode 'lisp-mode)
487 487
488;; This will do unless inf-lisp.el is loaded. 488;; This will do unless inf-lisp.el is loaded.
489(defun lisp-eval-defun (&optional and-go) 489(defun lisp-eval-defun (&optional and-go)
490 "Send the current defun to the Lisp process made by \\[run-lisp]." 490 "Send the current defun to the Lisp process made by \\[run-lisp]."
491 (interactive) 491 (interactive)
492 (error "Process lisp does not exist")) 492 (error "Process lisp does not exist"))
493 493
494(defvar lisp-interaction-mode-map 494(defvar lisp-interaction-mode-map
495 (let ((map (make-sparse-keymap)) 495 (let ((map (make-sparse-keymap))
496 (menu-map (make-sparse-keymap "Lisp-Interaction"))) 496 (menu-map (make-sparse-keymap "Lisp-Interaction")))
497 (set-keymap-parent map lisp-mode-shared-map) 497 (set-keymap-parent map lisp-mode-shared-map)
498 (define-key map "\e\C-x" 'eval-defun) 498 (define-key map "\e\C-x" 'eval-defun)
499 (define-key map "\e\C-q" 'indent-pp-sexp) 499 (define-key map "\e\C-q" 'indent-pp-sexp)
500 (define-key map "\e\t" 'lisp-complete-symbol) 500 (define-key map "\e\t" 'lisp-complete-symbol)
501 (define-key map "\n" 'eval-print-last-sexp) 501 (define-key map "\n" 'eval-print-last-sexp)
502 (define-key map [menu-bar lisp-interaction] (cons "Lisp-Interaction" menu-map)) 502 (define-key map [menu-bar lisp-interaction] (cons "Lisp-Interaction" menu-map))
503 (define-key menu-map [eval-defun] 503 (define-key menu-map [eval-defun]
504 '(menu-item "Evaluate Defun" eval-defun 504 '(menu-item "Evaluate Defun" eval-defun
505 :help "Evaluate the top-level form containing point, or after point")) 505 :help "Evaluate the top-level form containing point, or after point"))
506 (define-key menu-map [eval-print-last-sexp] 506 (define-key menu-map [eval-print-last-sexp]
507 '(menu-item "Evaluate and print" eval-print-last-sexp 507 '(menu-item "Evaluate and print" eval-print-last-sexp
508 :help "Evaluate sexp before point; print value into current buffer")) 508 :help "Evaluate sexp before point; print value into current buffer"))
509 (define-key menu-map [edebug-defun-lisp-interaction] 509 (define-key menu-map [edebug-defun-lisp-interaction]
510 '(menu-item "Instrument Function for Debugging" edebug-defun 510 '(menu-item "Instrument Function for Debugging" edebug-defun
511 :help "Evaluate the top level form point is in, stepping through with Edebug" 511 :help "Evaluate the top level form point is in, stepping through with Edebug"
512 :keys "C-u C-M-x")) 512 :keys "C-u C-M-x"))
513 (define-key menu-map [indent-pp-sexp] 513 (define-key menu-map [indent-pp-sexp]
514 '(menu-item "Indent or Pretty-Print" indent-pp-sexp 514 '(menu-item "Indent or Pretty-Print" indent-pp-sexp
515 :help "Indent each line of the list starting just after point, or prettyprint it")) 515 :help "Indent each line of the list starting just after point, or prettyprint it"))
516 (define-key menu-map [lisp-complete-symbol] 516 (define-key menu-map [lisp-complete-symbol]
517 '(menu-item "Complete Lisp Symbol" lisp-complete-symbol 517 '(menu-item "Complete Lisp Symbol" lisp-complete-symbol
518 :help "Perform completion on Lisp symbol preceding point")) 518 :help "Perform completion on Lisp symbol preceding point"))
519 map) 519 map)
520 "Keymap for Lisp Interaction mode. 520 "Keymap for Lisp Interaction mode.
521All commands in `lisp-mode-shared-map' are inherited by this map.") 521All commands in `lisp-mode-shared-map' are inherited by this map.")
522 522
523(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table) 523(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)
524(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction" 524(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
525 "Major mode for typing and evaluating Lisp forms. 525 "Major mode for typing and evaluating Lisp forms.
526Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression 526Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
527before point, and prints its value into the buffer, advancing point. 527before point, and prints its value into the buffer, advancing point.
528Note that printing is controlled by `eval-expression-print-length' 528Note that printing is controlled by `eval-expression-print-length'
529and `eval-expression-print-level'. 529and `eval-expression-print-level'.
530 530
531Commands: 531Commands:
532Delete converts tabs to spaces as it moves back. 532Delete converts tabs to spaces as it moves back.
533Paragraphs are separated only by blank lines. 533Paragraphs are separated only by blank lines.
534Semicolons start comments. 534Semicolons start comments.
535\\{lisp-interaction-mode-map} 535\\{lisp-interaction-mode-map}
536Entry to this mode calls the value of `lisp-interaction-mode-hook' 536Entry to this mode calls the value of `lisp-interaction-mode-hook'
537if that value is non-nil.") 537if that value is non-nil.")
538 538
539(defun eval-print-last-sexp () 539(defun eval-print-last-sexp ()
540 "Evaluate sexp before point; print value into current buffer. 540 "Evaluate sexp before point; print value into current buffer.
541 541
542If `eval-expression-debug-on-error' is non-nil, which is the default, 542If `eval-expression-debug-on-error' is non-nil, which is the default,
543this command arranges for all errors to enter the debugger. 543this command arranges for all errors to enter the debugger.
544 544
545Note that printing the result is controlled by the variables 545Note that printing the result is controlled by the variables
546`eval-expression-print-length' and `eval-expression-print-level', 546`eval-expression-print-length' and `eval-expression-print-level',
547which see." 547which see."
548 (interactive) 548 (interactive)
549 (let ((standard-output (current-buffer))) 549 (let ((standard-output (current-buffer)))
550 (terpri) 550 (terpri)
551 (eval-last-sexp t) 551 (eval-last-sexp t)
552 (terpri))) 552 (terpri)))
553 553
554 554
555(defun last-sexp-setup-props (beg end value alt1 alt2) 555(defun last-sexp-setup-props (beg end value alt1 alt2)
556 "Set up text properties for the output of `eval-last-sexp-1'. 556 "Set up text properties for the output of `eval-last-sexp-1'.
557BEG and END are the start and end of the output in current-buffer. 557BEG and END are the start and end of the output in current-buffer.
558VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the 558VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
559alternative printed representations that can be displayed." 559alternative printed representations that can be displayed."
560 (let ((map (make-sparse-keymap))) 560 (let ((map (make-sparse-keymap)))
561 (define-key map "\C-m" 'last-sexp-toggle-display) 561 (define-key map "\C-m" 'last-sexp-toggle-display)
562 (define-key map [down-mouse-2] 'mouse-set-point) 562 (define-key map [down-mouse-2] 'mouse-set-point)
563 (define-key map [mouse-2] 'last-sexp-toggle-display) 563 (define-key map [mouse-2] 'last-sexp-toggle-display)
564 (add-text-properties 564 (add-text-properties
565 beg end 565 beg end
566 `(printed-value (,value ,alt1 ,alt2) 566 `(printed-value (,value ,alt1 ,alt2)
567 mouse-face highlight 567 mouse-face highlight
568 keymap ,map 568 keymap ,map
569 help-echo "RET, mouse-2: toggle abbreviated display" 569 help-echo "RET, mouse-2: toggle abbreviated display"
570 rear-nonsticky (mouse-face keymap help-echo 570 rear-nonsticky (mouse-face keymap help-echo
571 printed-value))))) 571 printed-value)))))
572 572
573 573
574(defun last-sexp-toggle-display (&optional arg) 574(defun last-sexp-toggle-display (&optional arg)
575 "Toggle between abbreviated and unabbreviated printed representations." 575 "Toggle between abbreviated and unabbreviated printed representations."
576 (interactive "P") 576 (interactive "P")
577 (save-restriction 577 (save-restriction
578 (widen) 578 (widen)
579 (let ((value (get-text-property (point) 'printed-value))) 579 (let ((value (get-text-property (point) 'printed-value)))
580 (when value 580 (when value
581 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point))) 581 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
582 'printed-value) 582 'printed-value)
583 (point))) 583 (point)))
584 (end (or (next-single-char-property-change (point) 'printed-value) (point))) 584 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
585 (standard-output (current-buffer)) 585 (standard-output (current-buffer))
586 (point (point))) 586 (point (point)))
587 (delete-region beg end) 587 (delete-region beg end)
588 (insert (nth 1 value)) 588 (insert (nth 1 value))
589 (or (= beg point) 589 (or (= beg point)
590 (setq point (1- (point)))) 590 (setq point (1- (point))))
591 (last-sexp-setup-props beg (point) 591 (last-sexp-setup-props beg (point)
592 (nth 0 value) 592 (nth 0 value)
593 (nth 2 value) 593 (nth 2 value)
594 (nth 1 value)) 594 (nth 1 value))
595 (goto-char (min (point-max) point))))))) 595 (goto-char (min (point-max) point)))))))
596 596
597(defun prin1-char (char) 597(defun prin1-char (char)
598 "Return a string representing CHAR as a character rather than as an integer. 598 "Return a string representing CHAR as a character rather than as an integer.
599If CHAR is not a character, return nil." 599If CHAR is not a character, return nil."
600 (and (integerp char) 600 (and (integerp char)
601 (eventp char) 601 (eventp char)
602 (let ((c (event-basic-type char)) 602 (let ((c (event-basic-type char))
603 (mods (event-modifiers char)) 603 (mods (event-modifiers char))
604 string) 604 string)
605 ;; Prevent ?A from turning into ?\S-a. 605 ;; Prevent ?A from turning into ?\S-a.
606 (if (and (memq 'shift mods) 606 (if (and (memq 'shift mods)
607 (zerop (logand char ?\S-\^@)) 607 (zerop (logand char ?\S-\^@))
608 (not (let ((case-fold-search nil)) 608 (not (let ((case-fold-search nil))
609 (char-equal c (upcase c))))) 609 (char-equal c (upcase c)))))
610 (setq c (upcase c) mods nil)) 610 (setq c (upcase c) mods nil))
611 ;; What string are we considering using? 611 ;; What string are we considering using?
612 (condition-case nil 612 (condition-case nil
613 (setq string 613 (setq string
614 (concat 614 (concat
615 "?" 615 "?"
616 (mapconcat 616 (mapconcat
617 (lambda (modif) 617 (lambda (modif)
618 (cond ((eq modif 'super) "\\s-") 618 (cond ((eq modif 'super) "\\s-")
619 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) 619 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
620 mods "") 620 mods "")
621 (cond 621 (cond
622 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) 622 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
623 ((eq c 127) "\\C-?") 623 ((eq c 127) "\\C-?")
624 (t 624 (t
625 (string c))))) 625 (string c)))))
626 (error nil)) 626 (error nil))
627 ;; Verify the string reads a CHAR, not to some other character. 627 ;; Verify the string reads a CHAR, not to some other character.
628 ;; If it doesn't, return nil instead. 628 ;; If it doesn't, return nil instead.
629 (and string 629 (and string
630 (= (car (read-from-string string)) char) 630 (= (car (read-from-string string)) char)
631 string)))) 631 string))))
632 632
633 633
634(defun preceding-sexp () 634(defun preceding-sexp ()
635 "Return sexp before the point." 635 "Return sexp before the point."
636 (let ((opoint (point)) 636 (let ((opoint (point))
637 ignore-quotes 637 ignore-quotes
638 expr) 638 expr)
639 (save-excursion 639 (save-excursion
640 (with-syntax-table emacs-lisp-mode-syntax-table 640 (with-syntax-table emacs-lisp-mode-syntax-table
641 ;; If this sexp appears to be enclosed in `...' 641 ;; If this sexp appears to be enclosed in `...'
642 ;; then ignore the surrounding quotes. 642 ;; then ignore the surrounding quotes.
643 (setq ignore-quotes 643 (setq ignore-quotes
644 (or (eq (following-char) ?\') 644 (or (eq (following-char) ?\')
645 (eq (preceding-char) ?\'))) 645 (eq (preceding-char) ?\')))
646 (forward-sexp -1) 646 (forward-sexp -1)
647 ;; If we were after `?\e' (or similar case), 647 ;; If we were after `?\e' (or similar case),
648 ;; use the whole thing, not just the `e'. 648 ;; use the whole thing, not just the `e'.
649 (when (eq (preceding-char) ?\\) 649 (when (eq (preceding-char) ?\\)
650 (forward-char -1) 650 (forward-char -1)
651 (when (eq (preceding-char) ??) 651 (when (eq (preceding-char) ??)
652 (forward-char -1))) 652 (forward-char -1)))
653 653
654 ;; Skip over `#N='s. 654 ;; Skip over `#N='s.
655 (when (eq (preceding-char) ?=) 655 (when (eq (preceding-char) ?=)
656 (let (labeled-p) 656 (let (labeled-p)
657 (save-excursion 657 (save-excursion
658 (skip-chars-backward "0-9#=") 658 (skip-chars-backward "0-9#=")
659 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+"))) 659 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
660 (when labeled-p 660 (when labeled-p
661 (forward-sexp -1)))) 661 (forward-sexp -1))))
662 662
663 (save-restriction 663 (save-restriction
664 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in 664 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
665 ;; `variable' so that the value is returned, not the 665 ;; `variable' so that the value is returned, not the
666 ;; name 666 ;; name
667 (if (and ignore-quotes 667 (if (and ignore-quotes
668 (eq (following-char) ?`)) 668 (eq (following-char) ?`))
669 (forward-char)) 669 (forward-char))
670 (narrow-to-region (point-min) opoint) 670 (narrow-to-region (point-min) opoint)
671 (setq expr (read (current-buffer))) 671 (setq expr (read (current-buffer)))
672 ;; If it's an (interactive ...) form, it's more 672 ;; If it's an (interactive ...) form, it's more
673 ;; useful to show how an interactive call would 673 ;; useful to show how an interactive call would
674 ;; use it. 674 ;; use it.
675 (and (consp expr) 675 (and (consp expr)
676 (eq (car expr) 'interactive) 676 (eq (car expr) 'interactive)
677 (setq expr 677 (setq expr
678 (list 'call-interactively 678 (list 'call-interactively
679 (list 'quote 679 (list 'quote
680 (list 'lambda 680 (list 'lambda
681 '(&rest args) 681 '(&rest args)
682 expr 682 expr
683 'args))))) 683 'args)))))
684 expr))))) 684 expr)))))
685 685
686 686
687(defun eval-last-sexp-1 (eval-last-sexp-arg-internal) 687(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
688 "Evaluate sexp before point; print value in minibuffer. 688 "Evaluate sexp before point; print value in minibuffer.
689With argument, print output into current buffer." 689With argument, print output into current buffer."
690 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) 690 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
691 (eval-last-sexp-print-value (eval (preceding-sexp))))) 691 (eval-last-sexp-print-value (eval (preceding-sexp)))))
692 692
693 693
694(defun eval-last-sexp-print-value (value) 694(defun eval-last-sexp-print-value (value)
695 (let ((unabbreviated (let ((print-length nil) (print-level nil)) 695 (let ((unabbreviated (let ((print-length nil) (print-level nil))
696 (prin1-to-string value))) 696 (prin1-to-string value)))
697 (print-length eval-expression-print-length) 697 (print-length eval-expression-print-length)
698 (print-level eval-expression-print-level) 698 (print-level eval-expression-print-level)
699 (beg (point)) 699 (beg (point))
700 end) 700 end)
701 (prog1 701 (prog1
702 (prin1 value) 702 (prin1 value)
703 (let ((str (eval-expression-print-format value))) 703 (let ((str (eval-expression-print-format value)))
704 (if str (princ str))) 704 (if str (princ str)))
705 (setq end (point)) 705 (setq end (point))
706 (when (and (bufferp standard-output) 706 (when (and (bufferp standard-output)
707 (or (not (null print-length)) 707 (or (not (null print-length))
708 (not (null print-level))) 708 (not (null print-level)))
709 (not (string= unabbreviated 709 (not (string= unabbreviated
710 (buffer-substring-no-properties beg end)))) 710 (buffer-substring-no-properties beg end))))
711 (last-sexp-setup-props beg end value 711 (last-sexp-setup-props beg end value
712 unabbreviated 712 unabbreviated
713 (buffer-substring-no-properties beg end)) 713 (buffer-substring-no-properties beg end))
714 )))) 714 ))))
715 715
716 716
717(defvar eval-last-sexp-fake-value (make-symbol "t")) 717(defvar eval-last-sexp-fake-value (make-symbol "t"))
718 718
719(defun eval-last-sexp (eval-last-sexp-arg-internal) 719(defun eval-last-sexp (eval-last-sexp-arg-internal)
720 "Evaluate sexp before point; print value in minibuffer. 720 "Evaluate sexp before point; print value in minibuffer.
721Interactively, with prefix argument, print output into current buffer. 721Interactively, with prefix argument, print output into current buffer.
722 722
723If `eval-expression-debug-on-error' is non-nil, which is the default, 723If `eval-expression-debug-on-error' is non-nil, which is the default,
724this command arranges for all errors to enter the debugger." 724this command arranges for all errors to enter the debugger."
725 (interactive "P") 725 (interactive "P")
726 (if (null eval-expression-debug-on-error) 726 (if (null eval-expression-debug-on-error)
727 (eval-last-sexp-1 eval-last-sexp-arg-internal) 727 (eval-last-sexp-1 eval-last-sexp-arg-internal)
728 (let ((value 728 (let ((value
729 (let ((debug-on-error eval-last-sexp-fake-value)) 729 (let ((debug-on-error eval-last-sexp-fake-value))
730 (cons (eval-last-sexp-1 eval-last-sexp-arg-internal) 730 (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)
731 debug-on-error)))) 731 debug-on-error))))
732 (unless (eq (cdr value) eval-last-sexp-fake-value) 732 (unless (eq (cdr value) eval-last-sexp-fake-value)
733 (setq debug-on-error (cdr value))) 733 (setq debug-on-error (cdr value)))
734 (car value)))) 734 (car value))))
735 735
736(defun eval-defun-1 (form) 736(defun eval-defun-1 (form)
737 "Treat some expressions specially. 737 "Treat some expressions specially.
738Reset the `defvar' and `defcustom' variables to the initial value. 738Reset the `defvar' and `defcustom' variables to the initial value.
739Reinitialize the face according to the `defface' specification." 739Reinitialize the face according to the `defface' specification."
740 ;; The code in edebug-defun should be consistent with this, but not 740 ;; The code in edebug-defun should be consistent with this, but not
741 ;; the same, since this gets a macroexpended form. 741 ;; the same, since this gets a macroexpended form.
742 (cond ((not (listp form)) 742 (cond ((not (listp form))
743 form) 743 form)
744 ((and (eq (car form) 'defvar) 744 ((and (eq (car form) 'defvar)
745 (cdr-safe (cdr-safe form)) 745 (cdr-safe (cdr-safe form))
746 (boundp (cadr form))) 746 (boundp (cadr form)))
747 ;; Force variable to be re-set. 747 ;; Force variable to be re-set.
748 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form)) 748 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
749 (setq-default ,(nth 1 form) ,(nth 2 form)))) 749 (setq-default ,(nth 1 form) ,(nth 2 form))))
750 ;; `defcustom' is now macroexpanded to 750 ;; `defcustom' is now macroexpanded to
751 ;; `custom-declare-variable' with a quoted value arg. 751 ;; `custom-declare-variable' with a quoted value arg.
752 ((and (eq (car form) 'custom-declare-variable) 752 ((and (eq (car form) 'custom-declare-variable)
753 (default-boundp (eval (nth 1 form)))) 753 (default-boundp (eval (nth 1 form))))
754 ;; Force variable to be bound. 754 ;; Force variable to be bound.
755 (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form)))) 755 (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
756 form) 756 form)
757 ;; `defface' is macroexpanded to `custom-declare-face'. 757 ;; `defface' is macroexpanded to `custom-declare-face'.
758 ((eq (car form) 'custom-declare-face) 758 ((eq (car form) 'custom-declare-face)
759 ;; Reset the face. 759 ;; Reset the face.
760 (setq face-new-frame-defaults 760 (setq face-new-frame-defaults
761 (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults)) 761 (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
762 (put (eval (nth 1 form)) 'face-defface-spec nil) 762 (put (eval (nth 1 form)) 'face-defface-spec nil)
763 ;; Setting `customized-face' to the new spec after calling 763 ;; Setting `customized-face' to the new spec after calling
764 ;; the form, but preserving the old saved spec in `saved-face', 764 ;; the form, but preserving the old saved spec in `saved-face',
765 ;; imitates the situation when the new face spec is set 765 ;; imitates the situation when the new face spec is set
766 ;; temporarily for the current session in the customize 766 ;; temporarily for the current session in the customize
767 ;; buffer, thus allowing `face-user-default-spec' to use the 767 ;; buffer, thus allowing `face-user-default-spec' to use the
768 ;; new customized spec instead of the saved spec. 768 ;; new customized spec instead of the saved spec.
769 ;; Resetting `saved-face' temporarily to nil is needed to let 769 ;; Resetting `saved-face' temporarily to nil is needed to let
770 ;; `defface' change the spec, regardless of a saved spec. 770 ;; `defface' change the spec, regardless of a saved spec.
771 (prog1 `(prog1 ,form 771 (prog1 `(prog1 ,form
772 (put ,(nth 1 form) 'saved-face 772 (put ,(nth 1 form) 'saved-face
773 ',(get (eval (nth 1 form)) 'saved-face)) 773 ',(get (eval (nth 1 form)) 'saved-face))
774 (put ,(nth 1 form) 'customized-face 774 (put ,(nth 1 form) 'customized-face
775 ,(nth 2 form))) 775 ,(nth 2 form)))
776 (put (eval (nth 1 form)) 'saved-face nil))) 776 (put (eval (nth 1 form)) 'saved-face nil)))
777 ((eq (car form) 'progn) 777 ((eq (car form) 'progn)
778 (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) 778 (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
779 (t form))) 779 (t form)))
780 780
781(defun eval-defun-2 () 781(defun eval-defun-2 ()
782 "Evaluate defun that point is in or before. 782 "Evaluate defun that point is in or before.
783The value is displayed in the minibuffer. 783The value is displayed in the minibuffer.
784If the current defun is actually a call to `defvar', 784If the current defun is actually a call to `defvar',
785then reset the variable using the initial value expression 785then reset the variable using the initial value expression
786even if the variable already has some other value. 786even if the variable already has some other value.
787\(Normally `defvar' does not change the variable's value 787\(Normally `defvar' does not change the variable's value
788if it already has a value.\) 788if it already has a value.\)
789 789
790With argument, insert value in current buffer after the defun. 790With argument, insert value in current buffer after the defun.
791Return the result of evaluation." 791Return the result of evaluation."
792 (interactive "P") 792 (interactive "P")
793 ;; FIXME: the print-length/level bindings should only be applied while 793 ;; FIXME: the print-length/level bindings should only be applied while
794 ;; printing, not while evaluating. 794 ;; printing, not while evaluating.
795 (let ((debug-on-error eval-expression-debug-on-error) 795 (let ((debug-on-error eval-expression-debug-on-error)
796 (print-length eval-expression-print-length) 796 (print-length eval-expression-print-length)
797 (print-level eval-expression-print-level)) 797 (print-level eval-expression-print-level))
798 (save-excursion 798 (save-excursion
799 ;; Arrange for eval-region to "read" the (possibly) altered form. 799 ;; Arrange for eval-region to "read" the (possibly) altered form.
800 ;; eval-region handles recording which file defines a function or 800 ;; eval-region handles recording which file defines a function or
801 ;; variable. Re-written using `apply' to avoid capturing 801 ;; variable. Re-written using `apply' to avoid capturing
802 ;; variables like `end'. 802 ;; variables like `end'.
803 (apply 803 (apply
804 #'eval-region 804 #'eval-region
805 (let ((standard-output t) 805 (let ((standard-output t)
806 beg end form) 806 beg end form)
807 ;; Read the form from the buffer, and record where it ends. 807 ;; Read the form from the buffer, and record where it ends.
808 (save-excursion 808 (save-excursion
809 (end-of-defun) 809 (end-of-defun)
810 (beginning-of-defun) 810 (beginning-of-defun)
811 (setq beg (point)) 811 (setq beg (point))
812 (setq form (read (current-buffer))) 812 (setq form (read (current-buffer)))
813 (setq end (point))) 813 (setq end (point)))
814 ;; Alter the form if necessary. 814 ;; Alter the form if necessary.
815 (setq form (eval-defun-1 (macroexpand form))) 815 (setq form (eval-defun-1 (macroexpand form)))
816 (list beg end standard-output 816 (list beg end standard-output
817 `(lambda (ignore) 817 `(lambda (ignore)
818 ;; Skipping to the end of the specified region 818 ;; Skipping to the end of the specified region
819 ;; will make eval-region return. 819 ;; will make eval-region return.
820 (goto-char ,end) 820 (goto-char ,end)
821 ',form)))))) 821 ',form))))))
822 ;; The result of evaluation has been put onto VALUES. So return it. 822 ;; The result of evaluation has been put onto VALUES. So return it.
823 (car values)) 823 (car values))
824 824
825(defun eval-defun (edebug-it) 825(defun eval-defun (edebug-it)
826 "Evaluate the top-level form containing point, or after point. 826 "Evaluate the top-level form containing point, or after point.
827 827
828If the current defun is actually a call to `defvar' or `defcustom', 828If the current defun is actually a call to `defvar' or `defcustom',
829evaluating it this way resets the variable using its initial value 829evaluating it this way resets the variable using its initial value
830expression even if the variable already has some other value. 830expression even if the variable already has some other value.
831\(Normally `defvar' and `defcustom' do not alter the value if there 831\(Normally `defvar' and `defcustom' do not alter the value if there
832already is one.) In an analogous way, evaluating a `defface' 832already is one.) In an analogous way, evaluating a `defface'
833overrides any customizations of the face, so that it becomes 833overrides any customizations of the face, so that it becomes
834defined exactly as the `defface' expression says. 834defined exactly as the `defface' expression says.
835 835
836If `eval-expression-debug-on-error' is non-nil, which is the default, 836If `eval-expression-debug-on-error' is non-nil, which is the default,
837this command arranges for all errors to enter the debugger. 837this command arranges for all errors to enter the debugger.
838 838
839With a prefix argument, instrument the code for Edebug. 839With a prefix argument, instrument the code for Edebug.
840 840
841If acting on a `defun' for FUNCTION, and the function was 841If acting on a `defun' for FUNCTION, and the function was
842instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not 842instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not
843instrumented, just FUNCTION is printed. 843instrumented, just FUNCTION is printed.
844 844
845If not acting on a `defun', the result of evaluation is displayed in 845If not acting on a `defun', the result of evaluation is displayed in
846the minibuffer. This display is controlled by the variables 846the minibuffer. This display is controlled by the variables
847`eval-expression-print-length' and `eval-expression-print-level', 847`eval-expression-print-length' and `eval-expression-print-level',
848which see." 848which see."
849 (interactive "P") 849 (interactive "P")
850 (cond (edebug-it 850 (cond (edebug-it
851 (require 'edebug) 851 (require 'edebug)
852 (eval-defun (not edebug-all-defs))) 852 (eval-defun (not edebug-all-defs)))
853 (t 853 (t
854 (if (null eval-expression-debug-on-error) 854 (if (null eval-expression-debug-on-error)
855 (eval-defun-2) 855 (eval-defun-2)
856 (let ((old-value (make-symbol "t")) new-value value) 856 (let ((old-value (make-symbol "t")) new-value value)
857 (let ((debug-on-error old-value)) 857 (let ((debug-on-error old-value))
858 (setq value (eval-defun-2)) 858 (setq value (eval-defun-2))
859 (setq new-value debug-on-error)) 859 (setq new-value debug-on-error))
860 (unless (eq old-value new-value) 860 (unless (eq old-value new-value)
861 (setq debug-on-error new-value)) 861 (setq debug-on-error new-value))
862 value))))) 862 value)))))
863 863
864;; May still be used by some external Lisp-mode variant. 864;; May still be used by some external Lisp-mode variant.
865(define-obsolete-function-alias 'lisp-comment-indent 865(define-obsolete-function-alias 'lisp-comment-indent
866 'comment-indent-default "22.1") 866 'comment-indent-default "22.1")
867(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1") 867(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1")
868 868
869(defcustom lisp-indent-offset nil 869(defcustom lisp-indent-offset nil
870 "If non-nil, indent second line of expressions that many more columns." 870 "If non-nil, indent second line of expressions that many more columns."
871 :group 'lisp 871 :group 'lisp
872 :type '(choice (const nil) integer)) 872 :type '(choice (const nil) integer))
873(put 'lisp-body-indent 'safe-local-variable 873(put 'lisp-body-indent 'safe-local-variable
874 (lambda (x) (or (null x) (integerp x)))) 874 (lambda (x) (or (null x) (integerp x))))
875 875
876(defvar lisp-indent-function 'lisp-indent-function) 876(defvar lisp-indent-function 'lisp-indent-function)
877 877
878(defun lisp-indent-line (&optional whole-exp) 878(defun lisp-indent-line (&optional whole-exp)
879 "Indent current line as Lisp code. 879 "Indent current line as Lisp code.
880With argument, indent any additional lines of the same expression 880With argument, indent any additional lines of the same expression
881rigidly along with this one." 881rigidly along with this one."
882 (interactive "P") 882 (interactive "P")
883 (let ((indent (calculate-lisp-indent)) shift-amt end 883 (let ((indent (calculate-lisp-indent)) shift-amt end
884 (pos (- (point-max) (point))) 884 (pos (- (point-max) (point)))
885 (beg (progn (beginning-of-line) (point)))) 885 (beg (progn (beginning-of-line) (point))))
886 (skip-chars-forward " \t") 886 (skip-chars-forward " \t")
887 (if (or (null indent) (looking-at "\\s<\\s<\\s<")) 887 (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
888 ;; Don't alter indentation of a ;;; comment line 888 ;; Don't alter indentation of a ;;; comment line
889 ;; or a line that starts in a string. 889 ;; or a line that starts in a string.
890 (goto-char (- (point-max) pos)) 890 (goto-char (- (point-max) pos))
891 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<"))) 891 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
892 ;; Single-semicolon comment lines should be indented 892 ;; Single-semicolon comment lines should be indented
893 ;; as comment lines, not as code. 893 ;; as comment lines, not as code.
894 (progn (indent-for-comment) (forward-char -1)) 894 (progn (indent-for-comment) (forward-char -1))
895 (if (listp indent) (setq indent (car indent))) 895 (if (listp indent) (setq indent (car indent)))
896 (setq shift-amt (- indent (current-column))) 896 (setq shift-amt (- indent (current-column)))
897 (if (zerop shift-amt) 897 (if (zerop shift-amt)
898 nil 898 nil
899 (delete-region beg (point)) 899 (delete-region beg (point))
900 (indent-to indent))) 900 (indent-to indent)))
901 ;; If initial point was within line's indentation, 901 ;; If initial point was within line's indentation,
902 ;; position after the indentation. Else stay at same point in text. 902 ;; position after the indentation. Else stay at same point in text.
903 (if (> (- (point-max) pos) (point)) 903 (if (> (- (point-max) pos) (point))
904 (goto-char (- (point-max) pos))) 904 (goto-char (- (point-max) pos)))
905 ;; If desired, shift remaining lines of expression the same amount. 905 ;; If desired, shift remaining lines of expression the same amount.
906 (and whole-exp (not (zerop shift-amt)) 906 (and whole-exp (not (zerop shift-amt))
907 (save-excursion 907 (save-excursion
908 (goto-char beg) 908 (goto-char beg)
909 (forward-sexp 1) 909 (forward-sexp 1)
910 (setq end (point)) 910 (setq end (point))
911 (goto-char beg) 911 (goto-char beg)
912 (forward-line 1) 912 (forward-line 1)
913 (setq beg (point)) 913 (setq beg (point))
914 (> end beg)) 914 (> end beg))
915 (indent-code-rigidly beg end shift-amt))))) 915 (indent-code-rigidly beg end shift-amt)))))
916 916
917(defvar calculate-lisp-indent-last-sexp) 917(defvar calculate-lisp-indent-last-sexp)
918 918
919(defun calculate-lisp-indent (&optional parse-start) 919(defun calculate-lisp-indent (&optional parse-start)
920 "Return appropriate indentation for current line as Lisp code. 920 "Return appropriate indentation for current line as Lisp code.
921In usual case returns an integer: the column to indent to. 921In usual case returns an integer: the column to indent to.
922If the value is nil, that means don't change the indentation 922If the value is nil, that means don't change the indentation
923because the line starts inside a string. 923because the line starts inside a string.
924 924
925The value can also be a list of the form (COLUMN CONTAINING-SEXP-START). 925The value can also be a list of the form (COLUMN CONTAINING-SEXP-START).
926This means that following lines at the same level of indentation 926This means that following lines at the same level of indentation
927should not necessarily be indented the same as this line. 927should not necessarily be indented the same as this line.
928Then COLUMN is the column to indent to, and CONTAINING-SEXP-START 928Then COLUMN is the column to indent to, and CONTAINING-SEXP-START
929is the buffer position of the start of the containing expression." 929is the buffer position of the start of the containing expression."
930 (save-excursion 930 (save-excursion
931 (beginning-of-line) 931 (beginning-of-line)
932 (let ((indent-point (point)) 932 (let ((indent-point (point))
933 state paren-depth 933 state paren-depth
934 ;; setting this to a number inhibits calling hook 934 ;; setting this to a number inhibits calling hook
935 (desired-indent nil) 935 (desired-indent nil)
936 (retry t) 936 (retry t)
937 calculate-lisp-indent-last-sexp containing-sexp) 937 calculate-lisp-indent-last-sexp containing-sexp)
938 (if parse-start 938 (if parse-start
939 (goto-char parse-start) 939 (goto-char parse-start)
940 (beginning-of-defun)) 940 (beginning-of-defun))
941 ;; Find outermost containing sexp 941 ;; Find outermost containing sexp
942 (while (< (point) indent-point) 942 (while (< (point) indent-point)
943 (setq state (parse-partial-sexp (point) indent-point 0))) 943 (setq state (parse-partial-sexp (point) indent-point 0)))
944 ;; Find innermost containing sexp 944 ;; Find innermost containing sexp
945 (while (and retry 945 (while (and retry
946 state 946 state
947 (> (setq paren-depth (elt state 0)) 0)) 947 (> (setq paren-depth (elt state 0)) 0))
948 (setq retry nil) 948 (setq retry nil)
949 (setq calculate-lisp-indent-last-sexp (elt state 2)) 949 (setq calculate-lisp-indent-last-sexp (elt state 2))
950 (setq containing-sexp (elt state 1)) 950 (setq containing-sexp (elt state 1))
951 ;; Position following last unclosed open. 951 ;; Position following last unclosed open.
952 (goto-char (1+ containing-sexp)) 952 (goto-char (1+ containing-sexp))
953 ;; Is there a complete sexp since then? 953 ;; Is there a complete sexp since then?
954 (if (and calculate-lisp-indent-last-sexp 954 (if (and calculate-lisp-indent-last-sexp
955 (> calculate-lisp-indent-last-sexp (point))) 955 (> calculate-lisp-indent-last-sexp (point)))
956 ;; Yes, but is there a containing sexp after that? 956 ;; Yes, but is there a containing sexp after that?
957 (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp 957 (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
958 indent-point 0))) 958 indent-point 0)))
959 (if (setq retry (car (cdr peek))) (setq state peek))))) 959 (if (setq retry (car (cdr peek))) (setq state peek)))))
960 (if retry 960 (if retry
961 nil 961 nil
962 ;; Innermost containing sexp found 962 ;; Innermost containing sexp found
963 (goto-char (1+ containing-sexp)) 963 (goto-char (1+ containing-sexp))
964 (if (not calculate-lisp-indent-last-sexp) 964 (if (not calculate-lisp-indent-last-sexp)
965 ;; indent-point immediately follows open paren. 965 ;; indent-point immediately follows open paren.
966 ;; Don't call hook. 966 ;; Don't call hook.
967 (setq desired-indent (current-column)) 967 (setq desired-indent (current-column))
968 ;; Find the start of first element of containing sexp. 968 ;; Find the start of first element of containing sexp.
969 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 969 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
970 (cond ((looking-at "\\s(") 970 (cond ((looking-at "\\s(")
971 ;; First element of containing sexp is a list. 971 ;; First element of containing sexp is a list.
972 ;; Indent under that list. 972 ;; Indent under that list.
973 ) 973 )
974 ((> (save-excursion (forward-line 1) (point)) 974 ((> (save-excursion (forward-line 1) (point))
975 calculate-lisp-indent-last-sexp) 975 calculate-lisp-indent-last-sexp)
976 ;; This is the first line to start within the containing sexp. 976 ;; This is the first line to start within the containing sexp.
977 ;; It's almost certainly a function call. 977 ;; It's almost certainly a function call.
978 (if (= (point) calculate-lisp-indent-last-sexp) 978 (if (= (point) calculate-lisp-indent-last-sexp)
979 ;; Containing sexp has nothing before this line 979 ;; Containing sexp has nothing before this line
980 ;; except the first element. Indent under that element. 980 ;; except the first element. Indent under that element.
981 nil 981 nil
982 ;; Skip the first element, find start of second (the first 982 ;; Skip the first element, find start of second (the first
983 ;; argument of the function call) and indent under. 983 ;; argument of the function call) and indent under.
984 (progn (forward-sexp 1) 984 (progn (forward-sexp 1)
985 (parse-partial-sexp (point) 985 (parse-partial-sexp (point)
986 calculate-lisp-indent-last-sexp 986 calculate-lisp-indent-last-sexp
987 0 t))) 987 0 t)))
988 (backward-prefix-chars)) 988 (backward-prefix-chars))
989 (t 989 (t
990 ;; Indent beneath first sexp on same line as 990 ;; Indent beneath first sexp on same line as
991 ;; `calculate-lisp-indent-last-sexp'. Again, it's 991 ;; `calculate-lisp-indent-last-sexp'. Again, it's
992 ;; almost certainly a function call. 992 ;; almost certainly a function call.
993 (goto-char calculate-lisp-indent-last-sexp) 993 (goto-char calculate-lisp-indent-last-sexp)
994 (beginning-of-line) 994 (beginning-of-line)
995 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 995 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
996 0 t) 996 0 t)
997 (backward-prefix-chars))))) 997 (backward-prefix-chars)))))
998 ;; Point is at the point to indent under unless we are inside a string. 998 ;; Point is at the point to indent under unless we are inside a string.
999 ;; Call indentation hook except when overridden by lisp-indent-offset 999 ;; Call indentation hook except when overridden by lisp-indent-offset
1000 ;; or if the desired indentation has already been computed. 1000 ;; or if the desired indentation has already been computed.
1001 (let ((normal-indent (current-column))) 1001 (let ((normal-indent (current-column)))
1002 (cond ((elt state 3) 1002 (cond ((elt state 3)
1003 ;; Inside a string, don't change indentation. 1003 ;; Inside a string, don't change indentation.
1004 nil) 1004 nil)
1005 ((and (integerp lisp-indent-offset) containing-sexp) 1005 ((and (integerp lisp-indent-offset) containing-sexp)
1006 ;; Indent by constant offset 1006 ;; Indent by constant offset
1007 (goto-char containing-sexp) 1007 (goto-char containing-sexp)
1008 (+ (current-column) lisp-indent-offset)) 1008 (+ (current-column) lisp-indent-offset))
1009 ;; in this case calculate-lisp-indent-last-sexp is not nil 1009 ;; in this case calculate-lisp-indent-last-sexp is not nil
1010 (calculate-lisp-indent-last-sexp 1010 (calculate-lisp-indent-last-sexp
1011 (or 1011 (or
1012 ;; try to align the parameters of a known function 1012 ;; try to align the parameters of a known function
1013 (and lisp-indent-function 1013 (and lisp-indent-function
1014 (not retry) 1014 (not retry)
1015 (funcall lisp-indent-function indent-point state)) 1015 (funcall lisp-indent-function indent-point state))
1016 ;; If the function has no special alignment 1016 ;; If the function has no special alignment
1017 ;; or it does not apply to this argument, 1017 ;; or it does not apply to this argument,
1018 ;; try to align a constant-symbol under the last 1018 ;; try to align a constant-symbol under the last
1019 ;; preceding constant symbol, if there is such one of 1019 ;; preceding constant symbol, if there is such one of
1020 ;; the last 2 preceding symbols, in the previous 1020 ;; the last 2 preceding symbols, in the previous
1021 ;; uncommented line. 1021 ;; uncommented line.
1022 (and (save-excursion 1022 (and (save-excursion
1023 (goto-char indent-point) 1023 (goto-char indent-point)
1024 (skip-chars-forward " \t") 1024 (skip-chars-forward " \t")
1025 (looking-at ":")) 1025 (looking-at ":"))
1026 ;; The last sexp may not be at the indentation 1026 ;; The last sexp may not be at the indentation
1027 ;; where it begins, so find that one, instead. 1027 ;; where it begins, so find that one, instead.
1028 (save-excursion 1028 (save-excursion
1029 (goto-char calculate-lisp-indent-last-sexp) 1029 (goto-char calculate-lisp-indent-last-sexp)
1030 ;; Handle prefix characters and whitespace 1030 ;; Handle prefix characters and whitespace
1031 ;; following an open paren. (Bug#1012) 1031 ;; following an open paren. (Bug#1012)
1032 (backward-prefix-chars) 1032 (backward-prefix-chars)
1033 (while (and (not (looking-back "^[ \t]*\\|([ \t]+")) 1033 (while (and (not (looking-back "^[ \t]*\\|([ \t]+"))
1034 (or (not containing-sexp) 1034 (or (not containing-sexp)
1035 (< (1+ containing-sexp) (point)))) 1035 (< (1+ containing-sexp) (point))))
1036 (forward-sexp -1) 1036 (forward-sexp -1)
1037 (backward-prefix-chars)) 1037 (backward-prefix-chars))
1038 (setq calculate-lisp-indent-last-sexp (point))) 1038 (setq calculate-lisp-indent-last-sexp (point)))
1039 (> calculate-lisp-indent-last-sexp 1039 (> calculate-lisp-indent-last-sexp
1040 (save-excursion 1040 (save-excursion
1041 (goto-char (1+ containing-sexp)) 1041 (goto-char (1+ containing-sexp))
1042 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 1042 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
1043 (point))) 1043 (point)))
1044 (let ((parse-sexp-ignore-comments t) 1044 (let ((parse-sexp-ignore-comments t)
1045 indent) 1045 indent)
1046 (goto-char calculate-lisp-indent-last-sexp) 1046 (goto-char calculate-lisp-indent-last-sexp)
1047 (or (and (looking-at ":") 1047 (or (and (looking-at ":")
1048 (setq indent (current-column))) 1048 (setq indent (current-column)))
1049 (and (< (save-excursion (beginning-of-line) (point)) 1049 (and (< (save-excursion (beginning-of-line) (point))
1050 (prog2 (backward-sexp) (point))) 1050 (prog2 (backward-sexp) (point)))
1051 (looking-at ":") 1051 (looking-at ":")
1052 (setq indent (current-column)))) 1052 (setq indent (current-column))))
1053 indent)) 1053 indent))
1054 ;; another symbols or constants not preceded by a constant 1054 ;; another symbols or constants not preceded by a constant
1055 ;; as defined above. 1055 ;; as defined above.
1056 normal-indent)) 1056 normal-indent))
1057 ;; in this case calculate-lisp-indent-last-sexp is nil 1057 ;; in this case calculate-lisp-indent-last-sexp is nil
1058 (desired-indent) 1058 (desired-indent)
1059 (t 1059 (t
1060 normal-indent)))))) 1060 normal-indent))))))
1061 1061
1062(defun lisp-indent-function (indent-point state) 1062(defun lisp-indent-function (indent-point state)
1063 "This function is the normal value of the variable `lisp-indent-function'. 1063 "This function is the normal value of the variable `lisp-indent-function'.
1064It is used when indenting a line within a function call, to see if the 1064It is used when indenting a line within a function call, to see if the
1065called function says anything special about how to indent the line. 1065called function says anything special about how to indent the line.
1066 1066
1067INDENT-POINT is the position where the user typed TAB, or equivalent. 1067INDENT-POINT is the position where the user typed TAB, or equivalent.
1068Point is located at the point to indent under (for default indentation); 1068Point is located at the point to indent under (for default indentation);
1069STATE is the `parse-partial-sexp' state for that position. 1069STATE is the `parse-partial-sexp' state for that position.
1070 1070
1071If the current line is in a call to a Lisp function 1071If the current line is in a call to a Lisp function
1072which has a non-nil property `lisp-indent-function', 1072which has a non-nil property `lisp-indent-function',
1073that specifies how to do the indentation. The property value can be 1073that specifies how to do the indentation. The property value can be
1074* `defun', meaning indent `defun'-style; 1074* `defun', meaning indent `defun'-style;
1075* an integer N, meaning indent the first N arguments specially 1075* an integer N, meaning indent the first N arguments specially
1076 like ordinary function arguments and then indent any further 1076 like ordinary function arguments and then indent any further
1077 arguments like a body; 1077 arguments like a body;
1078* a function to call just as this function was called. 1078* a function to call just as this function was called.
1079 If that function returns nil, that means it doesn't specify 1079 If that function returns nil, that means it doesn't specify
1080 the indentation. 1080 the indentation.
1081 1081
1082This function also returns nil meaning don't specify the indentation." 1082This function also returns nil meaning don't specify the indentation."
1083 (let ((normal-indent (current-column))) 1083 (let ((normal-indent (current-column)))
1084 (goto-char (1+ (elt state 1))) 1084 (goto-char (1+ (elt state 1)))
1085 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 1085 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
1086 (if (and (elt state 2) 1086 (if (and (elt state 2)
1087 (not (looking-at "\\sw\\|\\s_"))) 1087 (not (looking-at "\\sw\\|\\s_")))
1088 ;; car of form doesn't seem to be a symbol 1088 ;; car of form doesn't seem to be a symbol
1089 (progn 1089 (progn
1090 (if (not (> (save-excursion (forward-line 1) (point)) 1090 (if (not (> (save-excursion (forward-line 1) (point))
1091 calculate-lisp-indent-last-sexp)) 1091 calculate-lisp-indent-last-sexp))
1092 (progn (goto-char calculate-lisp-indent-last-sexp) 1092 (progn (goto-char calculate-lisp-indent-last-sexp)
1093 (beginning-of-line) 1093 (beginning-of-line)
1094 (parse-partial-sexp (point) 1094 (parse-partial-sexp (point)
1095 calculate-lisp-indent-last-sexp 0 t))) 1095 calculate-lisp-indent-last-sexp 0 t)))
1096 ;; Indent under the list or under the first sexp on the same 1096 ;; Indent under the list or under the first sexp on the same
1097 ;; line as calculate-lisp-indent-last-sexp. Note that first 1097 ;; line as calculate-lisp-indent-last-sexp. Note that first
1098 ;; thing on that line has to be complete sexp since we are 1098 ;; thing on that line has to be complete sexp since we are
1099 ;; inside the innermost containing sexp. 1099 ;; inside the innermost containing sexp.
1100 (backward-prefix-chars) 1100 (backward-prefix-chars)
1101 (current-column)) 1101 (current-column))
1102 (let ((function (buffer-substring (point) 1102 (let ((function (buffer-substring (point)
1103 (progn (forward-sexp 1) (point)))) 1103 (progn (forward-sexp 1) (point))))
1104 method) 1104 method)
1105 (setq method (or (get (intern-soft function) 'lisp-indent-function) 1105 (setq method (or (get (intern-soft function) 'lisp-indent-function)
1106 (get (intern-soft function) 'lisp-indent-hook))) 1106 (get (intern-soft function) 'lisp-indent-hook)))
1107 (cond ((or (eq method 'defun) 1107 (cond ((or (eq method 'defun)
1108 (and (null method) 1108 (and (null method)
1109 (> (length function) 3) 1109 (> (length function) 3)
1110 (string-match "\\`def" function))) 1110 (string-match "\\`def" function)))
1111 (lisp-indent-defform state indent-point)) 1111 (lisp-indent-defform state indent-point))
1112 ((integerp method) 1112 ((integerp method)
1113 (lisp-indent-specform method state 1113 (lisp-indent-specform method state
1114 indent-point normal-indent)) 1114 indent-point normal-indent))
1115 (method 1115 (method
1116 (funcall method indent-point state))))))) 1116 (funcall method indent-point state)))))))
1117 1117
1118(defcustom lisp-body-indent 2 1118(defcustom lisp-body-indent 2
1119 "Number of columns to indent the second line of a `(def...)' form." 1119 "Number of columns to indent the second line of a `(def...)' form."
1120 :group 'lisp 1120 :group 'lisp
1121 :type 'integer) 1121 :type 'integer)
1122(put 'lisp-body-indent 'safe-local-variable 'integerp) 1122(put 'lisp-body-indent 'safe-local-variable 'integerp)
1123 1123
1124(defun lisp-indent-specform (count state indent-point normal-indent) 1124(defun lisp-indent-specform (count state indent-point normal-indent)
1125 (let ((containing-form-start (elt state 1)) 1125 (let ((containing-form-start (elt state 1))
1126 (i count) 1126 (i count)
1127 body-indent containing-form-column) 1127 body-indent containing-form-column)
1128 ;; Move to the start of containing form, calculate indentation 1128 ;; Move to the start of containing form, calculate indentation
1129 ;; to use for non-distinguished forms (> count), and move past the 1129 ;; to use for non-distinguished forms (> count), and move past the
1130 ;; function symbol. lisp-indent-function guarantees that there is at 1130 ;; function symbol. lisp-indent-function guarantees that there is at
1131 ;; least one word or symbol character following open paren of containing 1131 ;; least one word or symbol character following open paren of containing
1132 ;; form. 1132 ;; form.
1133 (goto-char containing-form-start) 1133 (goto-char containing-form-start)
1134 (setq containing-form-column (current-column)) 1134 (setq containing-form-column (current-column))
1135 (setq body-indent (+ lisp-body-indent containing-form-column)) 1135 (setq body-indent (+ lisp-body-indent containing-form-column))
1136 (forward-char 1) 1136 (forward-char 1)
1137 (forward-sexp 1) 1137 (forward-sexp 1)
1138 ;; Now find the start of the last form. 1138 ;; Now find the start of the last form.
1139 (parse-partial-sexp (point) indent-point 1 t) 1139 (parse-partial-sexp (point) indent-point 1 t)
1140 (while (and (< (point) indent-point) 1140 (while (and (< (point) indent-point)
1141 (condition-case () 1141 (condition-case ()
1142 (progn 1142 (progn
1143 (setq count (1- count)) 1143 (setq count (1- count))
1144 (forward-sexp 1) 1144 (forward-sexp 1)
1145 (parse-partial-sexp (point) indent-point 1 t)) 1145 (parse-partial-sexp (point) indent-point 1 t))
1146 (error nil)))) 1146 (error nil))))
1147 ;; Point is sitting on first character of last (or count) sexp. 1147 ;; Point is sitting on first character of last (or count) sexp.
1148 (if (> count 0) 1148 (if (> count 0)
1149 ;; A distinguished form. If it is the first or second form use double 1149 ;; A distinguished form. If it is the first or second form use double
1150 ;; lisp-body-indent, else normal indent. With lisp-body-indent bound 1150 ;; lisp-body-indent, else normal indent. With lisp-body-indent bound
1151 ;; to 2 (the default), this just happens to work the same with if as 1151 ;; to 2 (the default), this just happens to work the same with if as
1152 ;; the older code, but it makes unwind-protect, condition-case, 1152 ;; the older code, but it makes unwind-protect, condition-case,
1153 ;; with-output-to-temp-buffer, et. al. much more tasteful. The older, 1153 ;; with-output-to-temp-buffer, et. al. much more tasteful. The older,
1154 ;; less hacked, behavior can be obtained by replacing below with 1154 ;; less hacked, behavior can be obtained by replacing below with
1155 ;; (list normal-indent containing-form-start). 1155 ;; (list normal-indent containing-form-start).
1156 (if (<= (- i count) 1) 1156 (if (<= (- i count) 1)
1157 (list (+ containing-form-column (* 2 lisp-body-indent)) 1157 (list (+ containing-form-column (* 2 lisp-body-indent))
1158 containing-form-start) 1158 containing-form-start)
1159 (list normal-indent containing-form-start)) 1159 (list normal-indent containing-form-start))
1160 ;; A non-distinguished form. Use body-indent if there are no 1160 ;; A non-distinguished form. Use body-indent if there are no
1161 ;; distinguished forms and this is the first undistinguished form, 1161 ;; distinguished forms and this is the first undistinguished form,
1162 ;; or if this is the first undistinguished form and the preceding 1162 ;; or if this is the first undistinguished form and the preceding
1163 ;; distinguished form has indentation at least as great as body-indent. 1163 ;; distinguished form has indentation at least as great as body-indent.
1164 (if (or (and (= i 0) (= count 0)) 1164 (if (or (and (= i 0) (= count 0))
1165 (and (= count 0) (<= body-indent normal-indent))) 1165 (and (= count 0) (<= body-indent normal-indent)))
1166 body-indent 1166 body-indent
1167 normal-indent)))) 1167 normal-indent))))
1168 1168
1169(defun lisp-indent-defform (state indent-point) 1169(defun lisp-indent-defform (state indent-point)
1170 (goto-char (car (cdr state))) 1170 (goto-char (car (cdr state)))
1171 (forward-line 1) 1171 (forward-line 1)
1172 (if (> (point) (car (cdr (cdr state)))) 1172 (if (> (point) (car (cdr (cdr state))))
1173 (progn 1173 (progn
1174 (goto-char (car (cdr state))) 1174 (goto-char (car (cdr state)))
1175 (+ lisp-body-indent (current-column))))) 1175 (+ lisp-body-indent (current-column)))))
1176 1176
1177 1177
1178;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented 1178;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
1179;; like defun if the first form is placed on the next line, otherwise 1179;; like defun if the first form is placed on the next line, otherwise
1180;; it is indented like any other form (i.e. forms line up under first). 1180;; it is indented like any other form (i.e. forms line up under first).
1181 1181
1182(put 'lambda 'lisp-indent-function 'defun) 1182(put 'lambda 'lisp-indent-function 'defun)
1183(put 'autoload 'lisp-indent-function 'defun) 1183(put 'autoload 'lisp-indent-function 'defun)
1184(put 'progn 'lisp-indent-function 0) 1184(put 'progn 'lisp-indent-function 0)
1185(put 'prog1 'lisp-indent-function 1) 1185(put 'prog1 'lisp-indent-function 1)
1186(put 'prog2 'lisp-indent-function 2) 1186(put 'prog2 'lisp-indent-function 2)
1187(put 'save-excursion 'lisp-indent-function 0) 1187(put 'save-excursion 'lisp-indent-function 0)
1188(put 'save-window-excursion 'lisp-indent-function 0) 1188(put 'save-window-excursion 'lisp-indent-function 0)
1189(put 'save-selected-window 'lisp-indent-function 0) 1189(put 'save-selected-window 'lisp-indent-function 0)
1190(put 'save-restriction 'lisp-indent-function 0) 1190(put 'save-restriction 'lisp-indent-function 0)
1191(put 'save-match-data 'lisp-indent-function 0) 1191(put 'save-match-data 'lisp-indent-function 0)
1192(put 'save-current-buffer 'lisp-indent-function 0) 1192(put 'save-current-buffer 'lisp-indent-function 0)
1193(put 'with-current-buffer 'lisp-indent-function 1) 1193(put 'with-current-buffer 'lisp-indent-function 1)
1194(put 'combine-after-change-calls 'lisp-indent-function 0) 1194(put 'combine-after-change-calls 'lisp-indent-function 0)
1195(put 'with-output-to-string 'lisp-indent-function 0) 1195(put 'with-output-to-string 'lisp-indent-function 0)
1196(put 'with-temp-file 'lisp-indent-function 1) 1196(put 'with-temp-file 'lisp-indent-function 1)
1197(put 'with-temp-buffer 'lisp-indent-function 0) 1197(put 'with-temp-buffer 'lisp-indent-function 0)
1198(put 'with-temp-message 'lisp-indent-function 1) 1198(put 'with-temp-message 'lisp-indent-function 1)
1199(put 'with-syntax-table 'lisp-indent-function 1) 1199(put 'with-syntax-table 'lisp-indent-function 1)
1200(put 'let 'lisp-indent-function 1) 1200(put 'let 'lisp-indent-function 1)
1201(put 'let* 'lisp-indent-function 1) 1201(put 'let* 'lisp-indent-function 1)
1202(put 'while 'lisp-indent-function 1) 1202(put 'while 'lisp-indent-function 1)
1203(put 'if 'lisp-indent-function 2) 1203(put 'if 'lisp-indent-function 2)
1204(put 'read-if 'lisp-indent-function 2) 1204(put 'read-if 'lisp-indent-function 2)
1205(put 'catch 'lisp-indent-function 1) 1205(put 'catch 'lisp-indent-function 1)
1206(put 'condition-case 'lisp-indent-function 2) 1206(put 'condition-case 'lisp-indent-function 2)
1207(put 'unwind-protect 'lisp-indent-function 1) 1207(put 'unwind-protect 'lisp-indent-function 1)
1208(put 'with-output-to-temp-buffer 'lisp-indent-function 1) 1208(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
1209(put 'eval-after-load 'lisp-indent-function 1) 1209(put 'eval-after-load 'lisp-indent-function 1)
1210(put 'dolist 'lisp-indent-function 1) 1210(put 'dolist 'lisp-indent-function 1)
1211(put 'dotimes 'lisp-indent-function 1) 1211(put 'dotimes 'lisp-indent-function 1)
1212(put 'when 'lisp-indent-function 1) 1212(put 'when 'lisp-indent-function 1)
1213(put 'unless 'lisp-indent-function 1) 1213(put 'unless 'lisp-indent-function 1)
1214 1214
1215(defun indent-sexp (&optional endpos) 1215(defun indent-sexp (&optional endpos)
1216 "Indent each line of the list starting just after point. 1216 "Indent each line of the list starting just after point.
1217If optional arg ENDPOS is given, indent each line, stopping when 1217If optional arg ENDPOS is given, indent each line, stopping when
1218ENDPOS is encountered." 1218ENDPOS is encountered."
1219 (interactive) 1219 (interactive)
1220 (let ((indent-stack (list nil)) 1220 (let ((indent-stack (list nil))
1221 (next-depth 0) 1221 (next-depth 0)
1222 ;; If ENDPOS is non-nil, use nil as STARTING-POINT 1222 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
1223 ;; so that calculate-lisp-indent will find the beginning of 1223 ;; so that calculate-lisp-indent will find the beginning of
1224 ;; the defun we are in. 1224 ;; the defun we are in.
1225 ;; If ENDPOS is nil, it is safe not to scan before point 1225 ;; If ENDPOS is nil, it is safe not to scan before point
1226 ;; since every line we indent is more deeply nested than point is. 1226 ;; since every line we indent is more deeply nested than point is.
1227 (starting-point (if endpos nil (point))) 1227 (starting-point (if endpos nil (point)))
1228 (last-point (point)) 1228 (last-point (point))
1229 last-depth bol outer-loop-done inner-loop-done state this-indent) 1229 last-depth bol outer-loop-done inner-loop-done state this-indent)
1230 (or endpos 1230 (or endpos
1231 ;; Get error now if we don't have a complete sexp after point. 1231 ;; Get error now if we don't have a complete sexp after point.
1232 (save-excursion (forward-sexp 1))) 1232 (save-excursion (forward-sexp 1)))
1233 (save-excursion 1233 (save-excursion
1234 (setq outer-loop-done nil) 1234 (setq outer-loop-done nil)
1235 (while (if endpos (< (point) endpos) 1235 (while (if endpos (< (point) endpos)
1236 (not outer-loop-done)) 1236 (not outer-loop-done))
1237 (setq last-depth next-depth 1237 (setq last-depth next-depth
1238 inner-loop-done nil) 1238 inner-loop-done nil)
1239 ;; Parse this line so we can learn the state 1239 ;; Parse this line so we can learn the state
1240 ;; to indent the next line. 1240 ;; to indent the next line.
1241 ;; This inner loop goes through only once 1241 ;; This inner loop goes through only once
1242 ;; unless a line ends inside a string. 1242 ;; unless a line ends inside a string.
1243 (while (and (not inner-loop-done) 1243 (while (and (not inner-loop-done)
1244 (not (setq outer-loop-done (eobp)))) 1244 (not (setq outer-loop-done (eobp))))
1245 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) 1245 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
1246 nil nil state)) 1246 nil nil state))
1247 (setq next-depth (car state)) 1247 (setq next-depth (car state))
1248 ;; If the line contains a comment other than the sort 1248 ;; If the line contains a comment other than the sort
1249 ;; that is indented like code, 1249 ;; that is indented like code,
1250 ;; indent it now with indent-for-comment. 1250 ;; indent it now with indent-for-comment.
1251 ;; Comments indented like code are right already. 1251 ;; Comments indented like code are right already.
1252 ;; In any case clear the in-comment flag in the state 1252 ;; In any case clear the in-comment flag in the state
1253 ;; because parse-partial-sexp never sees the newlines. 1253 ;; because parse-partial-sexp never sees the newlines.
1254 (if (car (nthcdr 4 state)) 1254 (if (car (nthcdr 4 state))
1255 (progn (indent-for-comment) 1255 (progn (indent-for-comment)
1256 (end-of-line) 1256 (end-of-line)
1257 (setcar (nthcdr 4 state) nil))) 1257 (setcar (nthcdr 4 state) nil)))
1258 ;; If this line ends inside a string, 1258 ;; If this line ends inside a string,
1259 ;; go straight to next line, remaining within the inner loop, 1259 ;; go straight to next line, remaining within the inner loop,
1260 ;; and turn off the \-flag. 1260 ;; and turn off the \-flag.
1261 (if (car (nthcdr 3 state)) 1261 (if (car (nthcdr 3 state))
1262 (progn 1262 (progn
1263 (forward-line 1) 1263 (forward-line 1)
1264 (setcar (nthcdr 5 state) nil)) 1264 (setcar (nthcdr 5 state) nil))
1265 (setq inner-loop-done t))) 1265 (setq inner-loop-done t)))
1266 (and endpos 1266 (and endpos
1267 (<= next-depth 0) 1267 (<= next-depth 0)
1268 (progn 1268 (progn
1269 (setq indent-stack (nconc indent-stack 1269 (setq indent-stack (nconc indent-stack
1270 (make-list (- next-depth) nil)) 1270 (make-list (- next-depth) nil))
1271 last-depth (- last-depth next-depth) 1271 last-depth (- last-depth next-depth)
1272 next-depth 0))) 1272 next-depth 0)))
1273 (forward-line 1) 1273 (forward-line 1)
1274 ;; Decide whether to exit. 1274 ;; Decide whether to exit.
1275 (if endpos 1275 (if endpos
1276 ;; If we have already reached the specified end, 1276 ;; If we have already reached the specified end,
1277 ;; give up and do not reindent this line. 1277 ;; give up and do not reindent this line.
1278 (if (<= endpos (point)) 1278 (if (<= endpos (point))
1279 (setq outer-loop-done t)) 1279 (setq outer-loop-done t))
1280 ;; If no specified end, we are done if we have finished one sexp. 1280 ;; If no specified end, we are done if we have finished one sexp.
1281 (if (<= next-depth 0) 1281 (if (<= next-depth 0)
1282 (setq outer-loop-done t))) 1282 (setq outer-loop-done t)))
1283 (unless outer-loop-done 1283 (unless outer-loop-done
1284 (while (> last-depth next-depth) 1284 (while (> last-depth next-depth)
1285 (setq indent-stack (cdr indent-stack) 1285 (setq indent-stack (cdr indent-stack)
1286 last-depth (1- last-depth))) 1286 last-depth (1- last-depth)))
1287 (while (< last-depth next-depth) 1287 (while (< last-depth next-depth)
1288 (setq indent-stack (cons nil indent-stack) 1288 (setq indent-stack (cons nil indent-stack)
1289 last-depth (1+ last-depth))) 1289 last-depth (1+ last-depth)))
1290 ;; Now indent the next line according 1290 ;; Now indent the next line according
1291 ;; to what we learned from parsing the previous one. 1291 ;; to what we learned from parsing the previous one.
1292 (setq bol (point)) 1292 (setq bol (point))
1293 (skip-chars-forward " \t") 1293 (skip-chars-forward " \t")
1294 ;; But not if the line is blank, or just a comment 1294 ;; But not if the line is blank, or just a comment
1295 ;; (except for double-semi comments; indent them as usual). 1295 ;; (except for double-semi comments; indent them as usual).
1296 (if (or (eobp) (looking-at "\\s<\\|\n")) 1296 (if (or (eobp) (looking-at "\\s<\\|\n"))
1297 nil 1297 nil
1298 (if (and (car indent-stack) 1298 (if (and (car indent-stack)
1299 (>= (car indent-stack) 0)) 1299 (>= (car indent-stack) 0))
1300 (setq this-indent (car indent-stack)) 1300 (setq this-indent (car indent-stack))
1301 (let ((val (calculate-lisp-indent 1301 (let ((val (calculate-lisp-indent
1302 (if (car indent-stack) (- (car indent-stack)) 1302 (if (car indent-stack) (- (car indent-stack))
1303 starting-point)))) 1303 starting-point))))
1304 (if (null val) 1304 (if (null val)
1305 (setq this-indent val) 1305 (setq this-indent val)
1306 (if (integerp val) 1306 (if (integerp val)
1307 (setcar indent-stack 1307 (setcar indent-stack
1308 (setq this-indent val)) 1308 (setq this-indent val))
1309 (setcar indent-stack (- (car (cdr val)))) 1309 (setcar indent-stack (- (car (cdr val))))
1310 (setq this-indent (car val)))))) 1310 (setq this-indent (car val))))))
1311 (if (and this-indent (/= (current-column) this-indent)) 1311 (if (and this-indent (/= (current-column) this-indent))
1312 (progn (delete-region bol (point)) 1312 (progn (delete-region bol (point))
1313 (indent-to this-indent))))) 1313 (indent-to this-indent)))))
1314 (or outer-loop-done 1314 (or outer-loop-done
1315 (setq outer-loop-done (= (point) last-point)) 1315 (setq outer-loop-done (= (point) last-point))
1316 (setq last-point (point))))))) 1316 (setq last-point (point)))))))
1317 1317
1318(defun lisp-indent-region (start end) 1318(defun lisp-indent-region (start end)
1319 "Indent every line whose first char is between START and END inclusive." 1319 "Indent every line whose first char is between START and END inclusive."
1320 (save-excursion 1320 (save-excursion
1321 (let ((endmark (copy-marker end))) 1321 (let ((endmark (copy-marker end)))
1322 (goto-char start) 1322 (goto-char start)
1323 (and (bolp) (not (eolp)) 1323 (and (bolp) (not (eolp))
1324 (lisp-indent-line)) 1324 (lisp-indent-line))
1325 (indent-sexp endmark) 1325 (indent-sexp endmark)
1326 (set-marker endmark nil)))) 1326 (set-marker endmark nil))))
1327 1327
1328(defun indent-pp-sexp (&optional arg) 1328(defun indent-pp-sexp (&optional arg)
1329 "Indent each line of the list starting just after point, or prettyprint it. 1329 "Indent each line of the list starting just after point, or prettyprint it.
1330A prefix argument specifies pretty-printing." 1330A prefix argument specifies pretty-printing."
1331 (interactive "P") 1331 (interactive "P")
1332 (if arg 1332 (if arg
1333 (save-excursion 1333 (save-excursion
1334 (save-restriction 1334 (save-restriction
1335 (narrow-to-region (point) (progn (forward-sexp 1) (point))) 1335 (narrow-to-region (point) (progn (forward-sexp 1) (point)))
1336 (pp-buffer) 1336 (pp-buffer)
1337 (goto-char (point-max)) 1337 (goto-char (point-max))
1338 (if (eq (char-before) ?\n) 1338 (if (eq (char-before) ?\n)
1339 (delete-char -1))))) 1339 (delete-char -1)))))
1340 (indent-sexp)) 1340 (indent-sexp))
1341 1341
1342;;;; Lisp paragraph filling commands. 1342;;;; Lisp paragraph filling commands.
1343 1343
1344(defcustom emacs-lisp-docstring-fill-column 65 1344(defcustom emacs-lisp-docstring-fill-column 65
1345 "Value of `fill-column' to use when filling a docstring. 1345 "Value of `fill-column' to use when filling a docstring.
1346Any non-integer value means do not use a different value of 1346Any non-integer value means do not use a different value of
1347`fill-column' when filling docstrings." 1347`fill-column' when filling docstrings."
1348 :type '(choice (integer) 1348 :type '(choice (integer)
1349 (const :tag "Use the current `fill-column'" t)) 1349 (const :tag "Use the current `fill-column'" t))
1350 :group 'lisp) 1350 :group 'lisp)
1351 1351
1352(defun lisp-fill-paragraph (&optional justify) 1352(defun lisp-fill-paragraph (&optional justify)
1353 "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. 1353 "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.
1354If any of the current line is a comment, fill the comment or the 1354If any of the current line is a comment, fill the comment or the
1355paragraph of it that point is in, preserving the comment's indentation 1355paragraph of it that point is in, preserving the comment's indentation
1356and initial semicolons." 1356and initial semicolons."
1357 (interactive "P") 1357 (interactive "P")
1358 (or (fill-comment-paragraph justify) 1358 (or (fill-comment-paragraph justify)
1359 ;; Since fill-comment-paragraph returned nil, that means we're not in 1359 ;; Since fill-comment-paragraph returned nil, that means we're not in
1360 ;; a comment: Point is on a program line; we are interested 1360 ;; a comment: Point is on a program line; we are interested
1361 ;; particularly in docstring lines. 1361 ;; particularly in docstring lines.
1362 ;; 1362 ;;
1363 ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They 1363 ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They
1364 ;; are buffer-local, but we avoid changing them so that they can be set 1364 ;; are buffer-local, but we avoid changing them so that they can be set
1365 ;; to make `forward-paragraph' and friends do something the user wants. 1365 ;; to make `forward-paragraph' and friends do something the user wants.
1366 ;; 1366 ;;
1367 ;; `paragraph-start': The `(' in the character alternative and the 1367 ;; `paragraph-start': The `(' in the character alternative and the
1368 ;; left-singlequote plus `(' sequence after the \\| alternative prevent 1368 ;; left-singlequote plus `(' sequence after the \\| alternative prevent
1369 ;; sexps and backquoted sexps that follow a docstring from being filled 1369 ;; sexps and backquoted sexps that follow a docstring from being filled
1370 ;; with the docstring. This setting has the consequence of inhibiting 1370 ;; with the docstring. This setting has the consequence of inhibiting
1371 ;; filling many program lines that are not docstrings, which is sensible, 1371 ;; filling many program lines that are not docstrings, which is sensible,
1372 ;; because the user probably asked to fill program lines by accident, or 1372 ;; because the user probably asked to fill program lines by accident, or
1373 ;; expecting indentation (perhaps we should try to do indenting in that 1373 ;; expecting indentation (perhaps we should try to do indenting in that
1374 ;; case). The `;' and `:' stop the paragraph being filled at following 1374 ;; case). The `;' and `:' stop the paragraph being filled at following
1375 ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are 1375 ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are
1376 ;; escaped to keep font-locking, filling, & paren matching in the source 1376 ;; escaped to keep font-locking, filling, & paren matching in the source
1377 ;; file happy. 1377 ;; file happy.
1378 ;; 1378 ;;
1379 ;; `paragraph-separate': A clever regexp distinguishes the first line of 1379 ;; `paragraph-separate': A clever regexp distinguishes the first line of
1380 ;; a docstring and identifies it as a paragraph separator, so that it 1380 ;; a docstring and identifies it as a paragraph separator, so that it
1381 ;; won't be filled. (Since the first line of documentation stands alone 1381 ;; won't be filled. (Since the first line of documentation stands alone
1382 ;; in some contexts, filling should not alter the contents the author has 1382 ;; in some contexts, filling should not alter the contents the author has
1383 ;; chosen.) Only the first line of a docstring begins with whitespace 1383 ;; chosen.) Only the first line of a docstring begins with whitespace
1384 ;; and a quotation mark and ends with a period or (rarely) a comma. 1384 ;; and a quotation mark and ends with a period or (rarely) a comma.
1385 ;; 1385 ;;
1386 ;; The `fill-column' is temporarily bound to 1386 ;; The `fill-column' is temporarily bound to
1387 ;; `emacs-lisp-docstring-fill-column' if that value is an integer. 1387 ;; `emacs-lisp-docstring-fill-column' if that value is an integer.
1388 (let ((paragraph-start (concat paragraph-start 1388 (let ((paragraph-start (concat paragraph-start
1389 "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)")) 1389 "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
1390 (paragraph-separate 1390 (paragraph-separate
1391 (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) 1391 (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
1392 (fill-column (if (and (integerp emacs-lisp-docstring-fill-column) 1392 (fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
1393 (derived-mode-p 'emacs-lisp-mode)) 1393 (derived-mode-p 'emacs-lisp-mode))
1394 emacs-lisp-docstring-fill-column 1394 emacs-lisp-docstring-fill-column
1395 fill-column))) 1395 fill-column)))
1396 (fill-paragraph justify)) 1396 (fill-paragraph justify))
1397 ;; Never return nil. 1397 ;; Never return nil.
1398 t)) 1398 t))
1399 1399
1400(defun indent-code-rigidly (start end arg &optional nochange-regexp) 1400(defun indent-code-rigidly (start end arg &optional nochange-regexp)
1401 "Indent all lines of code, starting in the region, sideways by ARG columns. 1401 "Indent all lines of code, starting in the region, sideways by ARG columns.
1402Does not affect lines starting inside comments or strings, assuming that 1402Does not affect lines starting inside comments or strings, assuming that
1403the start of the region is not inside them. 1403the start of the region is not inside them.
1404 1404
1405Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP. 1405Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
1406The last is a regexp which, if matched at the beginning of a line, 1406The last is a regexp which, if matched at the beginning of a line,
1407means don't indent that line." 1407means don't indent that line."
1408 (interactive "r\np") 1408 (interactive "r\np")
1409 (let (state) 1409 (let (state)
1410 (save-excursion 1410 (save-excursion
1411 (goto-char end) 1411 (goto-char end)
1412 (setq end (point-marker)) 1412 (setq end (point-marker))
1413 (goto-char start) 1413 (goto-char start)
1414 (or (bolp) 1414 (or (bolp)
1415 (setq state (parse-partial-sexp (point) 1415 (setq state (parse-partial-sexp (point)
1416 (progn 1416 (progn
1417 (forward-line 1) (point)) 1417 (forward-line 1) (point))
1418 nil nil state))) 1418 nil nil state)))
1419 (while (< (point) end) 1419 (while (< (point) end)
1420 (or (car (nthcdr 3 state)) 1420 (or (car (nthcdr 3 state))
1421 (and nochange-regexp 1421 (and nochange-regexp
1422 (looking-at nochange-regexp)) 1422 (looking-at nochange-regexp))
1423 ;; If line does not start in string, indent it 1423 ;; If line does not start in string, indent it
1424 (let ((indent (current-indentation))) 1424 (let ((indent (current-indentation)))
1425 (delete-region (point) (progn (skip-chars-forward " \t") (point))) 1425 (delete-region (point) (progn (skip-chars-forward " \t") (point)))
1426 (or (eolp) 1426 (or (eolp)
1427 (indent-to (max 0 (+ indent arg)) 0)))) 1427 (indent-to (max 0 (+ indent arg)) 0))))
1428 (setq state (parse-partial-sexp (point) 1428 (setq state (parse-partial-sexp (point)
1429 (progn 1429 (progn
1430 (forward-line 1) (point)) 1430 (forward-line 1) (point))
1431 nil nil state)))))) 1431 nil nil state))))))
1432 1432
1433(provide 'lisp-mode) 1433(provide 'lisp-mode)
1434 1434
1435;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf 1435;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
1436;;; lisp-mode.el ends here 1436;;; lisp-mode.el ends here