Mercurial > emacs
annotate lisp/=mim-mode.el @ 15420:877d4b6fd768
(term-terminal-menu): Don't make a self-recursive keymap.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 12 Jun 1996 21:45:45 +0000 |
parents | aee68b0d23e1 |
children |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; mim-mode.el --- Mim (MDL in MDL) mode. |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
5 ;; Author: K. Shane Hartman |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
6 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
7 ;; Keywords: languages |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
8 |
229 | 9 ;; This file is part of GNU Emacs. |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
13 ;; the Free Software Foundation; either version 2, or (at your option) |
229 | 14 ;; any later version. |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
25 ;;; Code: |
229 | 26 |
27 (autoload 'fast-syntax-check-mim "mim-syntax" | |
28 "Checks Mim syntax quickly. | |
29 Answers correct or incorrect, cannot point out the error context." | |
30 t) | |
31 | |
32 (autoload 'slow-syntax-check-mim "mim-syntax" | |
33 "Check Mim syntax slowly. | |
34 Points out the context of the error, if the syntax is incorrect." | |
35 t) | |
36 | |
37 (defvar mim-mode-hysterical-bindings t | |
38 "*Non-nil means bind list manipulation commands to Meta keys as well as | |
39 Control-Meta keys for historical reasons. Otherwise, only the latter keys | |
40 are bound.") | |
41 | |
42 (defvar mim-mode-map nil) | |
43 | |
44 (defvar mim-mode-syntax-table nil) | |
45 | |
46 (if mim-mode-syntax-table | |
47 () | |
48 (let ((i -1)) | |
49 (setq mim-mode-syntax-table (make-syntax-table)) | |
50 (while (< i ?\ ) | |
51 (modify-syntax-entry (setq i (1+ i)) " " mim-mode-syntax-table)) | |
52 (while (< i 127) | |
53 (modify-syntax-entry (setq i (1+ i)) "_ " mim-mode-syntax-table)) | |
54 (setq i (1- ?a)) | |
55 (while (< i ?z) | |
56 (modify-syntax-entry (setq i (1+ i)) "w " mim-mode-syntax-table)) | |
57 (setq i (1- ?A)) | |
58 (while (< i ?Z) | |
59 (modify-syntax-entry (setq i (1+ i)) "w " mim-mode-syntax-table)) | |
60 (setq i (1- ?0)) | |
61 (while (< i ?9) | |
62 (modify-syntax-entry (setq i (1+ i)) "w " mim-mode-syntax-table)) | |
63 (modify-syntax-entry ?: " " mim-mode-syntax-table) ; make : symbol delimiter | |
64 (modify-syntax-entry ?, "' " mim-mode-syntax-table) | |
65 (modify-syntax-entry ?. "' " mim-mode-syntax-table) | |
66 (modify-syntax-entry ?' "' " mim-mode-syntax-table) | |
67 (modify-syntax-entry ?` "' " mim-mode-syntax-table) | |
68 (modify-syntax-entry ?~ "' " mim-mode-syntax-table) | |
69 (modify-syntax-entry ?\; "' " mim-mode-syntax-table) ; comments are prefixed objects | |
70 (modify-syntax-entry ?# "' " mim-mode-syntax-table) | |
71 (modify-syntax-entry ?% "' " mim-mode-syntax-table) | |
72 (modify-syntax-entry ?! "' " mim-mode-syntax-table) | |
73 (modify-syntax-entry ?\" "\" " mim-mode-syntax-table) | |
74 (modify-syntax-entry ?\\ "\\ " mim-mode-syntax-table) | |
75 (modify-syntax-entry ?\( "\() " mim-mode-syntax-table) | |
76 (modify-syntax-entry ?\< "\(> " mim-mode-syntax-table) | |
77 (modify-syntax-entry ?\{ "\(} " mim-mode-syntax-table) | |
78 (modify-syntax-entry ?\[ "\(] " mim-mode-syntax-table) | |
79 (modify-syntax-entry ?\) "\)( " mim-mode-syntax-table) | |
80 (modify-syntax-entry ?\> "\)< " mim-mode-syntax-table) | |
81 (modify-syntax-entry ?\} "\){ " mim-mode-syntax-table) | |
82 (modify-syntax-entry ?\] "\)[ " mim-mode-syntax-table))) | |
83 | |
84 (defconst mim-whitespace "\000- ") | |
85 | |
86 (defvar mim-mode-hook nil | |
87 "*User function run after mim mode initialization. Usage: | |
88 \(setq mim-mode-hook '(lambda () ... your init forms ...)).") | |
89 | |
90 (define-abbrev-table 'mim-mode-abbrev-table nil) | |
91 | |
92 (defconst indent-mim-function 'indent-mim-function | |
93 "Controls (via properties) indenting of special forms. | |
94 \(put 'FOO 'indent-mim-function n\), integer n, means lines inside | |
95 <FOO ...> will be indented n spaces from start of form. | |
96 \(put 'FOO 'indent-mim-function 'DEFINE\) is like above but means use | |
97 value of mim-body-indent as offset from start of form. | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
98 \(put 'FOO 'indent-mim-function <cons>\) where <cons> is a list or pointed list |
229 | 99 of integers, means indent each form in <FOO ...> by the amount specified |
100 in <cons>. When <cons> is exhausted, indent remaining forms by | |
101 `mim-body-indent' unless <cons> is a pointed list, in which case the last | |
102 cdr is used. Confused? Here is an example: | |
103 \(put 'FROBIT 'indent-mim-function '\(4 2 . 1\)\) | |
104 <FROBIT | |
105 <CHOMP-IT> | |
106 <CHOMP-SOME-MORE> | |
107 <DIGEST> | |
108 <BELCH> | |
109 ...> | |
110 Finally, the property can be a function name (read the code).") | |
111 | |
112 (defvar indent-mim-comment t | |
113 "*Non-nil means indent string comments.") | |
114 | |
115 (defvar mim-body-indent 2 | |
116 "*Amount to indent in special forms which have DEFINE property on | |
117 `indent-mim-function'.") | |
118 | |
119 (defvar indent-mim-arglist t | |
120 "*nil means indent arglists like ordinary lists. | |
121 t means strings stack under start of arglist and variables stack to | |
122 right of them. Otherwise, strings stack under last string (or start | |
123 of arglist if none) and variables stack to right of them. | |
124 Examples (for values 'stack, t, nil): | |
125 | |
126 \(FOO \"OPT\" BAR \(FOO \"OPT\" BAR \(FOO \"OPT\" BAR | |
127 BAZ MUMBLE BAZ MUMBLE BAZ MUMBLE | |
128 \"AUX\" \"AUX\" \"AUX\" | |
129 BLETCH ... BLETCH ... BLETCH ...") | |
130 | |
131 (put 'DEFINE 'indent-mim-function 'DEFINE) | |
132 (put 'DEFMAC 'indent-mim-function 'DEFINE) | |
133 (put 'BIND 'indent-mim-function 'DEFINE) | |
134 (put 'PROG 'indent-mim-function 'DEFINE) | |
135 (put 'REPEAT 'indent-mim-function 'DEFINE) | |
136 (put 'CASE 'indent-mim-function 'DEFINE) | |
137 (put 'FUNCTION 'indent-mim-function 'DEFINE) | |
138 (put 'MAPF 'indent-mim-function 'DEFINE) | |
139 (put 'MAPR 'indent-mim-function 'DEFINE) | |
140 (put 'UNWIND 'indent-mim-function (cons (* 2 mim-body-indent) mim-body-indent)) | |
141 | |
142 (defvar mim-down-parens-only t | |
143 "*nil means treat ADECLs and ATOM trailers like structures when | |
144 moving down a level of structure.") | |
145 | |
146 (defvar mim-stop-for-slop t | |
147 "*Non-nil means {next previous}-mim-object consider any | |
148 non-whitespace character in column 0 to be a toplevel object, otherwise | |
149 only open paren syntax characters will be considered.") | |
150 | |
2571
b65cf676a09b
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
151 (defalias 'mdl-mode 'mim-mode) |
229 | 152 |
153 (defun mim-mode () | |
154 "Major mode for editing Mim (MDL in MDL) code. | |
155 Commands: | |
156 If value of `mim-mode-hysterical-bindings' is non-nil, then following | |
157 commands are assigned to escape keys as well (e.g. ESC f = ESC C-f). | |
158 The default action is bind the escape keys. | |
159 \\{mim-mode-map} | |
160 Other Commands: | |
161 Use \\[describe-function] to obtain documentation. | |
162 replace-in-mim-object find-mim-definition fast-syntax-check-mim | |
163 slow-syntax-check-mim backward-down-mim-object forward-up-mim-object | |
164 Variables: | |
165 Use \\[describe-variable] to obtain documentation. | |
166 mim-mode-hook indent-mim-comment indent-mim-arglist indent-mim-function | |
167 mim-body-indent mim-down-parens-only mim-stop-for-slop | |
168 mim-mode-hysterical-bindings | |
169 Entry to this mode calls the value of mim-mode-hook if non-nil." | |
170 (interactive) | |
171 (kill-all-local-variables) | |
172 (if (not mim-mode-map) | |
173 (progn | |
174 (setq mim-mode-map (make-sparse-keymap)) | |
175 (define-key mim-mode-map "\e\^o" 'open-mim-line) | |
176 (define-key mim-mode-map "\e\^q" 'indent-mim-object) | |
177 (define-key mim-mode-map "\e\^p" 'previous-mim-object) | |
178 (define-key mim-mode-map "\e\^n" 'next-mim-object) | |
179 (define-key mim-mode-map "\e\^a" 'beginning-of-DEFINE) | |
180 (define-key mim-mode-map "\e\^e" 'end-of-DEFINE) | |
181 (define-key mim-mode-map "\e\^t" 'transpose-mim-objects) | |
182 (define-key mim-mode-map "\e\^u" 'backward-up-mim-object) | |
183 (define-key mim-mode-map "\e\^d" 'forward-down-mim-object) | |
184 (define-key mim-mode-map "\e\^h" 'mark-mim-object) | |
185 (define-key mim-mode-map "\e\^k" 'forward-kill-mim-object) | |
186 (define-key mim-mode-map "\e\^f" 'forward-mim-object) | |
187 (define-key mim-mode-map "\e\^b" 'backward-mim-object) | |
188 (define-key mim-mode-map "\e^" 'raise-mim-line) | |
189 (define-key mim-mode-map "\e\\" 'fixup-whitespace) | |
190 (define-key mim-mode-map "\177" 'backward-delete-char-untabify) | |
191 (define-key mim-mode-map "\e\177" 'backward-kill-mim-object) | |
192 (define-key mim-mode-map "\^j" 'newline-and-mim-indent) | |
193 (define-key mim-mode-map "\e;" 'begin-mim-comment) | |
194 (define-key mim-mode-map "\t" 'indent-mim-line) | |
195 (define-key mim-mode-map "\e\t" 'indent-mim-object) | |
196 (if (not mim-mode-hysterical-bindings) | |
197 nil | |
198 ;; i really hate this but too many people are accustomed to these. | |
199 (define-key mim-mode-map "\e!" 'line-to-top-of-window) | |
200 (define-key mim-mode-map "\eo" 'open-mim-line) | |
201 (define-key mim-mode-map "\ep" 'previous-mim-object) | |
202 (define-key mim-mode-map "\en" 'next-mim-object) | |
203 (define-key mim-mode-map "\ea" 'beginning-of-DEFINE) | |
204 (define-key mim-mode-map "\ee" 'end-of-DEFINE) | |
205 (define-key mim-mode-map "\et" 'transpose-mim-objects) | |
206 (define-key mim-mode-map "\eu" 'backward-up-mim-object) | |
207 (define-key mim-mode-map "\ed" 'forward-down-mim-object) | |
208 (define-key mim-mode-map "\ek" 'forward-kill-mim-object) | |
209 (define-key mim-mode-map "\ef" 'forward-mim-object) | |
210 (define-key mim-mode-map "\eb" 'backward-mim-object)))) | |
211 (use-local-map mim-mode-map) | |
212 (set-syntax-table mim-mode-syntax-table) | |
213 (make-local-variable 'paragraph-start) | |
10884
aee68b0d23e1
(mim-mode): Remove ^ from paragraph-start & paragraph-separate.
Boris Goldowsky <boris@gnu.org>
parents:
3591
diff
changeset
|
214 (setq paragraph-start (concat "$\\|" page-delimiter)) |
229 | 215 (make-local-variable 'paragraph-separate) |
216 (setq paragraph-separate paragraph-start) | |
217 (make-local-variable 'paragraph-ignore-fill-prefix) | |
218 (setq paragraph-ignore-fill-prefix t) | |
219 ;; Most people use string comments. | |
220 (make-local-variable 'comment-start) | |
221 (setq comment-start ";\"") | |
222 (make-local-variable 'comment-start-skip) | |
223 (setq comment-start-skip ";\"") | |
224 (make-local-variable 'comment-end) | |
225 (setq comment-end "\"") | |
226 (make-local-variable 'comment-column) | |
227 (setq comment-column 40) | |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
228 (make-local-variable 'comment-indent-function) |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
229 (setq comment-indent-function 'indent-mim-comment) |
229 | 230 ;; tell generic indenter how to indent. |
231 (make-local-variable 'indent-line-function) | |
232 (setq indent-line-function 'indent-mim-line) | |
233 ;; look for that paren | |
234 (make-local-variable 'blink-matching-paren-distance) | |
235 (setq blink-matching-paren-distance nil) | |
236 ;; so people who dont like tabs can turn them off locally in indenter. | |
237 (make-local-variable 'indent-tabs-mode) | |
238 (setq indent-tabs-mode t) | |
239 (setq local-abbrev-table mim-mode-abbrev-table) | |
240 (setq major-mode 'mim-mode) | |
241 (setq mode-name "Mim") | |
242 (run-hooks 'mim-mode-hook)) | |
243 | |
244 (defun line-to-top-of-window () | |
245 "Move current line to top of window." | |
246 (interactive) ; for lazy people | |
247 (recenter 0)) | |
248 | |
249 (defun forward-mim-object (arg) | |
250 "Move forward across Mim object. | |
251 With ARG, move forward that many objects." | |
252 (interactive "p") | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
253 ;; this function is weird because it emulates the behavior of the old |
229 | 254 ;; (gosling) mim-mode - if the arg is 1 and we are `inside' an ADECL, |
255 ;; more than one character into the ATOM part and not sitting on the | |
256 ;; colon, then we move to the DECL part (just past colon) instead of | |
257 ;; the end of the object (the entire ADECL). otherwise, ADECL's are | |
258 ;; atomic objects. likewise for ATOM trailers. | |
259 (if (= (abs arg) 1) | |
260 (if (inside-atom-p) | |
261 ;; Move to end of ATOM or to trailer (!) or to ADECL (:). | |
262 (forward-sexp arg) | |
263 ;; Either scan an sexp or move over one bracket. | |
264 (forward-mim-objects arg t)) | |
265 ;; in the multi-object case, don't perform any magic. | |
266 ;; treats ATOM trailers and ADECLs atomically, stops at unmatched | |
267 ;; brackets with error. | |
268 (forward-mim-objects arg))) | |
269 | |
270 (defun inside-atom-p () | |
271 ;; Returns t iff inside an atom (takes account of trailers) | |
272 (let ((c1 (preceding-char)) | |
273 (c2 (following-char))) | |
274 (and (or (= (char-syntax c1) ?w) (= (char-syntax c1) ?_) (= c1 ?!)) | |
275 (or (= (char-syntax c2) ?w) (= (char-syntax c2) ?_) (= c2 ?!))))) | |
276 | |
277 (defun forward-mim-objects (arg &optional skip-bracket-p) | |
278 ;; Move over arg objects ignoring ADECLs and trailers. If | |
279 ;; skip-bracket-p is non-nil, then move over one bracket on error. | |
280 (let ((direction (sign arg))) | |
281 (condition-case conditions | |
282 (while (/= arg 0) | |
283 (forward-sexp direction) | |
284 (if (not (inside-adecl-or-trailer-p direction)) | |
285 (setq arg (- arg direction)))) | |
286 (error (if (not skip-bracket-p) | |
287 (signal 'error (cdr conditions)) | |
288 (skip-mim-whitespace direction) | |
289 (goto-char (+ (point) direction))))) | |
290 ;; If we moved too far move back to first interesting character. | |
291 (if (= (point) (buffer-end direction)) (skip-mim-whitespace (- direction))))) | |
292 | |
293 (defun backward-mim-object (&optional arg) | |
294 "Move backward across Mim object. | |
295 With ARG, move backward that many objects." | |
296 (interactive "p") | |
297 (forward-mim-object (if arg (- arg) -1))) | |
298 | |
299 (defun mark-mim-object (&optional arg) | |
300 "Mark following Mim object. | |
301 With ARG, mark that many following (preceding, ARG < 0) objects." | |
302 (interactive "p") | |
303 (push-mark (save-excursion (forward-mim-object (or arg 1)) (point)))) | |
304 | |
305 (defun forward-kill-mim-object (&optional arg) | |
306 "Kill following Mim object. | |
307 With ARG, kill that many objects." | |
308 (interactive "*p") | |
309 (kill-region (point) (progn (forward-mim-object (or arg 1)) (point)))) | |
310 | |
311 (defun backward-kill-mim-object (&optional arg) | |
312 "Kill preceding Mim object. | |
313 With ARG, kill that many objects." | |
314 (interactive "*p") | |
315 (forward-kill-mim-object (- (or arg 1)))) | |
316 | |
317 (defun raise-mim-line (&optional arg) | |
318 "Raise following line, fixing up whitespace at join. | |
319 With ARG raise that many following lines. | |
320 A negative ARG will raise current line and previous lines." | |
321 (interactive "*p") | |
322 (let* ((increment (sign (or arg (setq arg 1)))) | |
323 (direction (if (> arg 0) 1 0))) | |
324 (save-excursion | |
325 (while (/= arg 0) | |
326 ;; move over eol and kill it | |
327 (forward-line direction) | |
328 (delete-region (point) (1- (point))) | |
329 (fixup-whitespace) | |
330 (setq arg (- arg increment)))))) | |
331 | |
332 (defun forward-down-mim-object (&optional arg) | |
333 "Move down a level of Mim structure forwards. | |
334 With ARG, move down that many levels forwards (backwards, ARG < 0)." | |
335 (interactive "p") | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
336 ;; another weirdo - going down `inside' an ADECL or ATOM trailer |
229 | 337 ;; depends on the value of mim-down-parens-only. if nil, treat |
338 ;; ADECLs and trailers as structured objects. | |
339 (let ((direction (sign (or arg (setq arg 1))))) | |
340 (if (and (= (abs arg) 1) (not mim-down-parens-only)) | |
341 (goto-char | |
342 (save-excursion | |
343 (skip-mim-whitespace direction) | |
344 (if (> direction 0) (re-search-forward "\\s'*")) | |
345 (or (and (let ((c (next-char direction))) | |
346 (or (= (char-syntax c) ?_) | |
347 (= (char-syntax c) ?w))) | |
348 (progn (forward-sexp direction) | |
349 (if (inside-adecl-or-trailer-p direction) | |
350 (point)))) | |
351 (scan-lists (point) direction -1) | |
352 (buffer-end direction)))) | |
353 (while (/= arg 0) | |
354 (goto-char (or (scan-lists (point) direction -1) (buffer-end direction))) | |
355 (setq arg (- arg direction)))))) | |
356 | |
357 (defun backward-down-mim-object (&optional arg) | |
358 "Move down a level of Mim structure backwards. | |
359 With ARG, move down that many levels backwards (forwards, ARG < 0)." | |
360 (interactive "p") | |
361 (forward-down-mim-object (if arg (- arg) -1))) | |
362 | |
363 (defun forward-up-mim-object (&optional arg) | |
364 "Move up a level of Mim structure forwards | |
365 With ARG, move up that many levels forwards (backwards, ARG < 0)." | |
366 (interactive "p") | |
367 (let ((direction (sign (or arg (setq arg 1))))) | |
368 (while (/= arg 0) | |
369 (goto-char (or (scan-lists (point) direction 1) (buffer-end arg))) | |
370 (setq arg (- arg direction))) | |
371 (if (< direction 0) (backward-prefix-chars)))) | |
372 | |
373 (defun backward-up-mim-object (&optional arg) | |
374 "Move up a level of Mim structure backwards | |
375 With ARG, move up that many levels backwards (forwards, ARG > 0)." | |
376 (interactive "p") | |
377 (forward-up-mim-object (if arg (- arg) -1))) | |
378 | |
379 (defun replace-in-mim-object (old new) | |
380 "Replace string in following Mim object." | |
381 (interactive "*sReplace in object: \nsReplace %s with: ") | |
382 (save-restriction | |
383 (narrow-to-region (point) (save-excursion (forward-mim-object 1) (point))) | |
384 (replace-string old new))) | |
385 | |
386 (defun transpose-mim-objects (&optional arg) | |
387 "Transpose Mim objects around point. | |
388 With ARG, transpose preceding object that many times with following objects. | |
389 A negative ARG will transpose backwards." | |
390 (interactive "*p") | |
391 (transpose-subr 'forward-mim-object (or arg 1))) | |
392 | |
393 (defun beginning-of-DEFINE (&optional arg move) | |
394 "Move backward to beginning of surrounding or previous toplevel Mim form. | |
395 With ARG, do it that many times. Stops at last toplevel form seen if buffer | |
396 end is reached." | |
397 (interactive "p") | |
398 (let ((direction (sign (or arg (setq arg 1))))) | |
399 (if (not move) (setq move t)) | |
400 (if (< direction 0) (goto-char (1+ (point)))) | |
401 (while (and (/= arg 0) (re-search-backward "^<" nil move direction)) | |
402 (setq arg (- arg direction))) | |
403 (if (< direction 0) | |
404 (goto-char (1- (point)))))) | |
405 | |
406 (defun end-of-DEFINE (&optional arg) | |
407 "Move forward to end of surrounding or next toplevel mim form. | |
408 With ARG, do it that many times. Stops at end of last toplevel form seen | |
409 if buffer end is reached." | |
410 (interactive "p") | |
411 (if (not arg) (setq arg 1)) | |
412 (if (< arg 0) | |
413 (beginning-of-DEFINE (- (1- arg))) | |
414 (if (not (looking-at "^<")) (setq arg (1+ arg))) | |
415 (beginning-of-DEFINE (- arg) 'move) | |
416 (beginning-of-DEFINE 1)) | |
417 (forward-mim-object 1) | |
418 (forward-line 1)) | |
419 | |
420 (defun next-mim-object (&optional arg) | |
421 "Move to beginning of next toplevel Mim object. | |
422 With ARG, do it that many times. Stops at last object seen if buffer end | |
423 is reached." | |
424 (interactive "p") | |
425 (let ((search-string (if mim-stop-for-slop "^\\S " "^\\s(")) | |
426 (direction (sign (or arg (setq arg 1))))) | |
427 (if (> direction 0) | |
428 (goto-char (1+ (point)))) ; no error if end of buffer | |
429 (while (and (/= arg 0) | |
430 (re-search-forward search-string nil t direction)) | |
431 (setq arg (- arg direction))) | |
432 (if (> direction 0) | |
433 (goto-char (1- (point)))) ; no error if beginning of buffer | |
434 ;; scroll to top of window if moving forward and end not visible. | |
435 (if (not (or (< direction 0) | |
436 (save-excursion (forward-mim-object 1) | |
437 (pos-visible-in-window-p (point))))) | |
438 (recenter 0)))) | |
439 | |
440 (defun previous-mim-object (&optional arg) | |
441 "Move to beginning of previous toplevel Mim object. | |
442 With ARG do it that many times. Stops at last object seen if buffer end | |
443 is reached." | |
444 (interactive "p") | |
445 (next-mim-object (- (or arg 1)))) | |
446 | |
447 (defun calculate-mim-indent (&optional parse-start) | |
448 "Calculate indentation for Mim line. Returns column." | |
449 (save-excursion ; some excursion, huh, toto? | |
450 (beginning-of-line) | |
451 (let ((indent-point (point)) retry state containing-sexp last-sexp | |
452 desired-indent start peek where paren-depth) | |
453 (if parse-start | |
454 (goto-char parse-start) ; should be containing environment | |
455 (catch 'from-the-top | |
456 ;; find a place to start parsing. going backwards is fastest. | |
457 ;; forward-sexp signals error on encountering unmatched open. | |
458 (setq retry t) | |
459 (while retry | |
460 (condition-case nil (forward-sexp -1) (error (setq retry nil))) | |
461 (if (looking-at ".?[ \t]*\"") | |
462 ;; cant parse backward in presence of strings, go forward. | |
463 (progn | |
464 (goto-char indent-point) | |
465 (re-search-backward "^\\s(" nil 'move 1) ; to top of object | |
466 (throw 'from-the-top nil))) | |
467 (setq retry (and retry (/= (current-column) 0)))) | |
468 (skip-chars-backward mim-whitespace) | |
469 (if (not (bobp)) (forward-char -1)) ; onto unclosed open | |
470 (backward-prefix-chars))) | |
471 ;; find outermost containing sexp if we started inside an sexp. | |
472 (while (< (point) indent-point) | |
473 (setq state (parse-partial-sexp (point) indent-point 0))) | |
474 ;; find usual column to indent under (not in string or toplevel). | |
475 ;; on termination, state will correspond to containing environment | |
476 ;; (if retry is nil), where will be position of character to indent | |
477 ;; under normally, and desired-indent will be the column to indent to | |
478 ;; except if inside form, string, or at toplevel. point will be in | |
479 ;; in column to indent to unless inside string. | |
480 (setq retry t) | |
481 (while (and retry (setq paren-depth (car state)) (> paren-depth 0)) | |
482 ;; find innermost containing sexp. | |
483 (setq retry nil) | |
484 (setq last-sexp (car (nthcdr 2 state))) | |
485 (setq containing-sexp (car (cdr state))) | |
486 (goto-char (1+ containing-sexp)) ; to last unclosed open | |
487 (if (and last-sexp (> last-sexp (point))) | |
488 ;; is the last sexp a containing sexp? | |
489 (progn (setq peek (parse-partial-sexp last-sexp indent-point 0)) | |
490 (if (setq retry (car (cdr peek))) (setq state peek)))) | |
491 (if retry | |
492 nil | |
493 (setq where (1+ containing-sexp)) ; innermost containing sexp | |
494 (goto-char where) | |
495 (cond | |
496 ((not last-sexp) ; indent-point after bracket | |
497 (setq desired-indent (current-column))) | |
498 ((= (preceding-char) ?\<) ; it's a form | |
499 (cond ((> (progn (forward-sexp 1) (point)) last-sexp) | |
500 (goto-char where)) ; only one frob | |
501 ((> (save-excursion (forward-line 1) (point)) last-sexp) | |
502 (skip-chars-forward " \t") ; last-sexp is on same line | |
503 (setq where (point))) ; as containing-sexp | |
504 ((progn | |
505 (goto-char last-sexp) | |
506 (beginning-of-line) | |
507 (parse-partial-sexp (point) last-sexp 0 t) | |
508 (or (= (point) last-sexp) | |
509 (save-excursion | |
510 (= (car (parse-partial-sexp (point) last-sexp 0)) | |
511 0)))) | |
512 (backward-prefix-chars) ; last-sexp 1st on line or 1st | |
513 (setq where (point))) ; frob on that line level 0 | |
514 (t (goto-char where)))) ; punt, should never occur | |
515 ((and indent-mim-arglist ; maybe hack arglist | |
516 (= (preceding-char) ?\() ; its a list | |
517 (save-excursion ; look for magic atoms | |
518 (setq peek 0) ; using peek as counter | |
519 (forward-char -1) ; back over containing paren | |
520 (while (and (< (setq peek (1+ peek)) 6) | |
521 (condition-case nil | |
522 (progn (forward-sexp -1) t) | |
523 (error nil)))) | |
524 (and (< peek 6) (looking-at "DEFINE\\|DEFMAC\\|FUNCTION")))) | |
525 ;; frobs stack under strings they belong to or under first | |
526 ;; frob to right of strings they belong to unless luser has | |
527 ;; frob (non-string) on preceding line with different | |
528 ;; indentation. strings stack under start of arglist unless | |
529 ;; mim-indent-arglist is not t, in which case they stack | |
530 ;; under the last string, if any, else the start of the arglist. | |
531 (let ((eol 0) last-string) | |
532 (while (< (point) last-sexp) ; find out where the strings are | |
533 (skip-chars-forward mim-whitespace last-sexp) | |
534 (if (> (setq start (point)) eol) | |
535 (progn ; simultaneously keeping track | |
536 (setq where (min where start)) | |
537 (end-of-line) ; of indentation of first frob | |
538 (setq eol (point)) ; on each line | |
539 (goto-char start))) | |
540 (if (= (following-char) ?\") | |
541 (progn (setq last-string (point)) | |
542 (forward-sexp 1) | |
543 (if (= last-string last-sexp) | |
544 (setq where last-sexp) | |
545 (skip-chars-forward mim-whitespace last-sexp) | |
546 (setq where (point)))) | |
547 (forward-sexp 1))) | |
548 (goto-char indent-point) ; if string is first on | |
549 (skip-chars-forward " \t" (point-max)) ; line we are indenting, it | |
550 (if (= (following-char) ?\") ; goes under arglist start | |
551 (if (and last-string (not (equal indent-mim-arglist t))) | |
552 (setq where last-string) ; or under last string. | |
553 (setq where (1+ containing-sexp))))) | |
554 (goto-char where) | |
555 (setq desired-indent (current-column))) | |
556 (t ; plain vanilla structure | |
557 (cond ((> (save-excursion (forward-line 1) (point)) last-sexp) | |
558 (skip-chars-forward " \t") ; last-sexp is on same line | |
559 (setq where (point))) ; as containing-sexp | |
560 ((progn | |
561 (goto-char last-sexp) | |
562 (beginning-of-line) | |
563 (parse-partial-sexp (point) last-sexp 0 t) | |
564 (or (= (point) last-sexp) | |
565 (save-excursion | |
566 (= (car (parse-partial-sexp (point) last-sexp 0)) | |
567 0)))) | |
568 (backward-prefix-chars) ; last-sexp 1st on line or 1st | |
569 (setq where (point))) ; frob on that line level 0 | |
570 (t (goto-char where))) ; punt, should never occur | |
571 (setq desired-indent (current-column)))))) | |
572 ;; state is innermost containing environment unless toplevel or string. | |
573 (if (car (nthcdr 3 state)) ; inside string | |
574 (progn | |
575 (if last-sexp ; string must be next | |
576 (progn (goto-char last-sexp) | |
577 (forward-sexp 1) | |
578 (search-forward "\"") | |
579 (forward-char -1)) | |
580 (goto-char indent-point) ; toplevel string, look for it | |
581 (re-search-backward "[^\\]\"") | |
582 (forward-char 1)) | |
583 (setq start (point)) ; opening double quote | |
584 (skip-chars-backward " \t") | |
585 (backward-prefix-chars) | |
586 ;; see if the string is really a comment. | |
587 (if (and (looking-at ";[ \t]*\"") indent-mim-comment) | |
588 ;; it's a comment, line up under the start unless disabled. | |
589 (goto-char (1+ start)) | |
590 ;; it's a string, dont mung the indentation. | |
591 (goto-char indent-point) | |
592 (skip-chars-forward " \t")) | |
593 (setq desired-indent (current-column)))) | |
594 ;; point is sitting in usual column to indent to and if retry is nil | |
595 ;; then state corresponds to containing environment. if desired | |
596 ;; indentation not determined, we are inside a form, so call hook. | |
597 (or desired-indent | |
598 (and indent-mim-function | |
599 (not retry) | |
600 (setq desired-indent | |
601 (funcall indent-mim-function state indent-point))) | |
602 (setq desired-indent (current-column))) | |
603 (goto-char indent-point) ; back to where we started | |
604 desired-indent))) ; return column to indent to | |
605 | |
606 (defun indent-mim-function (state indent-point) | |
607 "Compute indentation for Mim special forms. Returns column or nil." | |
608 (let ((containing-sexp (car (cdr state))) (current-indent (point))) | |
609 (save-excursion | |
610 (goto-char (1+ containing-sexp)) | |
611 (backward-prefix-chars) | |
612 ;; make sure we are looking at a symbol. if so, see if it is a special | |
613 ;; symbol. if so, add the special indentation to the indentation of | |
614 ;; the start of the special symbol, unless the property is not | |
615 ;; an integer and not nil (in this case, call the property, it must | |
616 ;; be a function which returns the appropriate indentation or nil and | |
617 ;; does not change the buffer). | |
618 (if (looking-at "\\sw\\|\\s_") | |
619 (let* ((start (current-column)) | |
620 (function | |
621 (intern-soft (buffer-substring (point) | |
622 (progn (forward-sexp 1) | |
623 (point))))) | |
624 (method (get function 'indent-mim-function))) | |
625 (if (or (if (equal method 'DEFINE) (setq method mim-body-indent)) | |
626 (integerp method)) | |
627 ;; only use method if its first line after containing-sexp. | |
628 ;; we could have done this in calculate-mim-indent, but someday | |
629 ;; someone might want to format frobs in a special form based | |
630 ;; on position instead of indenting uniformly (like lisp if), | |
631 ;; so preserve right for posterity. if not first line, | |
632 ;; calculate-mim-indent already knows right indentation - | |
633 ;; give luser chance to change indentation manually by changing | |
634 ;; 1st line after containing-sexp. | |
635 (if (> (progn (forward-line 1) (point)) (car (nthcdr 2 state))) | |
636 (+ method start)) | |
637 (goto-char current-indent) | |
638 (if (consp method) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
639 ;; list or pointed list of explicit indentations |
229 | 640 (indent-mim-offset state indent-point) |
641 (if (and (symbolp method) (fboundp method)) | |
642 ;; luser function - s/he better know what's going on. | |
643 ;; should take state and indent-point as arguments - for | |
644 ;; description of state, see parse-partial-sexp | |
645 ;; documentation the function is guaranteed the following: | |
646 ;; (1) state describes the closest surrounding form, | |
647 ;; (2) indent-point is the beginning of the line being | |
648 ;; indented, (3) point points to char in column that would | |
649 ;; normally be used for indentation, (4) function is bound | |
650 ;; to the special ATOM. See indent-mim-offset for example | |
651 ;; of a special function. | |
652 (funcall method state indent-point))))))))) | |
653 | |
654 (defun indent-mim-offset (state indent-point) | |
655 ;; offset forms explicitly according to list of indentations. | |
656 (let ((mim-body-indent mim-body-indent) | |
657 (indentations (get function 'indent-mim-function)) | |
658 (containing-sexp (car (cdr state))) | |
659 (last-sexp (car (nthcdr 2 state))) | |
660 indentation) | |
661 (goto-char (1+ containing-sexp)) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2571
diff
changeset
|
662 ;; determine which of the indentations to use. |
229 | 663 (while (and (< (point) indent-point) |
664 (condition-case nil | |
665 (progn (forward-sexp 1) | |
666 (parse-partial-sexp (point) indent-point 1 t)) | |
667 (error nil))) | |
668 (skip-chars-backward " \t") | |
669 (backward-prefix-chars) | |
670 (if (= (following-char) ?\;) | |
671 nil ; ignore comments | |
672 (setq indentation (car indentations)) | |
673 (if (integerp (setq indentations (cdr indentations))) | |
674 ;; if last cdr is integer, that is indentation to use for all | |
675 ;; all the rest of the forms. | |
676 (progn (setq mim-body-indent indentations) | |
677 (setq indentations nil))))) | |
678 (goto-char (1+ containing-sexp)) | |
679 (+ (current-column) (or indentation mim-body-indent)))) | |
680 | |
681 (defun indent-mim-comment (&optional start) | |
682 "Indent a one line (string) Mim comment following object, if any." | |
683 (let* ((old-point (point)) (eol (progn (end-of-line) (point))) state last-sexp) | |
684 ;; this function assumes that comment indenting is enabled. it is caller's | |
685 ;; responsibility to check the indent-mim-comment flag before calling. | |
686 (beginning-of-line) | |
687 (catch 'no-comment | |
688 (setq state (parse-partial-sexp (point) eol)) | |
689 ;; determine if there is an existing regular comment. a `regular' | |
690 ;; comment is defined as a commented string which is the last thing | |
691 ;; on the line and does not extend beyond the end of the line. | |
692 (if (or (not (setq last-sexp (car (nthcdr 2 state)))) | |
693 (car (nthcdr 3 state))) | |
694 ;; empty line or inside string (multiple line). | |
695 (throw 'no-comment nil)) | |
696 ;; could be a comment, but make sure its not the only object. | |
697 (beginning-of-line) | |
698 (parse-partial-sexp (point) eol 0 t) | |
699 (if (= (point) last-sexp) | |
700 ;; only one object on line | |
701 (throw 'no-comment t)) | |
702 (goto-char last-sexp) | |
703 (skip-chars-backward " \t") | |
704 (backward-prefix-chars) | |
705 (if (not (looking-at ";[ \t]*\"")) | |
706 ;; aint no comment | |
707 (throw 'no-comment nil)) | |
708 ;; there is an existing regular comment | |
709 (delete-horizontal-space) | |
710 ;; move it to comment-column if possible else to tab-stop | |
711 (if (< (current-column) comment-column) | |
712 (indent-to comment-column) | |
713 (tab-to-tab-stop))) | |
714 (goto-char old-point))) | |
715 | |
716 (defun indent-mim-line () | |
717 "Indent line of Mim code." | |
718 (interactive "*") | |
719 (let* ((position (- (point-max) (point))) | |
720 (bol (progn (beginning-of-line) (point))) | |
721 (indent (calculate-mim-indent))) | |
722 (skip-chars-forward " \t") | |
723 (if (/= (current-column) indent) | |
724 (progn (delete-region bol (point)) (indent-to indent))) | |
725 (if (> (- (point-max) position) (point)) (goto-char (- (point-max) position))))) | |
726 | |
727 (defun newline-and-mim-indent () | |
728 "Insert newline at point and indent." | |
729 (interactive "*") | |
730 ;; commented code would correct indentation of line in arglist which | |
731 ;; starts with string, but it would indent every line twice. luser can | |
732 ;; just say tab after typing string to get same effect. | |
733 ;(if indent-mim-arglist (indent-mim-line)) | |
734 (newline) | |
735 (indent-mim-line)) | |
736 | |
737 (defun open-mim-line (&optional lines) | |
738 "Insert newline before point and indent. | |
739 With ARG insert that many newlines." | |
740 (interactive "*p") | |
741 (beginning-of-line) | |
742 (let ((indent (calculate-mim-indent))) | |
743 (while (> lines 0) | |
744 (newline) | |
745 (forward-line -1) | |
746 (indent-to indent) | |
747 (setq lines (1- lines))))) | |
748 | |
749 (defun indent-mim-object (&optional dont-indent-first-line) | |
750 "Indent object following point and all lines contained inside it. | |
751 With ARG, idents only contained lines (skips first line)." | |
752 (interactive "*P") | |
753 (let (end bol indent start) | |
754 (save-excursion (parse-partial-sexp (point) (point-max) 0 t) | |
755 (setq start (point)) | |
756 (forward-sexp 1) | |
757 (setq end (- (point-max) (point)))) | |
758 (save-excursion | |
759 (if (not dont-indent-first-line) (indent-mim-line)) | |
760 (while (progn (forward-line 1) (> (- (point-max) (point)) end)) | |
761 (setq indent (calculate-mim-indent start)) | |
762 (setq bol (point)) | |
763 (skip-chars-forward " \t") | |
764 (if (/= indent (current-column)) | |
765 (progn (delete-region bol (point)) (indent-to indent))) | |
766 (if indent-mim-comment (indent-mim-comment)))))) | |
767 | |
768 (defun find-mim-definition (name) | |
769 "Search for definition of function, macro, or gfcn. | |
770 You need type only enough of the name to be unambiguous." | |
771 (interactive "sName: ") | |
772 (let (where) | |
773 (save-excursion | |
774 (goto-char (point-min)) | |
775 (condition-case nil | |
776 (progn | |
777 (re-search-forward | |
778 (concat "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ \t]*\\)" | |
779 name)) | |
780 (setq where (point))) | |
781 (error (error "Can't find %s" name)))) | |
782 (if where | |
783 (progn (push-mark) | |
784 (goto-char where) | |
785 (beginning-of-line) | |
786 (recenter 0))))) | |
787 | |
788 (defun begin-mim-comment () | |
789 "Move to existing comment or insert empty comment." | |
790 (interactive "*") | |
791 (let* ((eol (progn (end-of-line) (point))) | |
792 (bol (progn (beginning-of-line) (point)))) | |
793 ;; check for existing comment first. | |
794 (if (re-search-forward ";[ \t]*\"" eol t) | |
795 ;; found it. indent if desired and go there. | |
796 (if indent-mim-comment | |
797 (let ((where (- (point-max) (point)))) | |
798 (indent-mim-comment) | |
799 (goto-char (- (point-max) where)))) | |
800 ;; nothing there, make a comment. | |
801 (let (state last-sexp) | |
802 ;; skip past all the sexps on the line | |
803 (goto-char bol) | |
804 (while (and (equal (car (setq state (parse-partial-sexp (point) eol 0))) | |
805 0) | |
806 (car (nthcdr 2 state))) | |
807 (setq last-sexp (car (nthcdr 2 state)))) | |
808 (if (car (nthcdr 3 state)) | |
809 nil ; inside a string, punt | |
810 (delete-region (point) eol) ; flush trailing whitespace | |
811 (if (and (not last-sexp) (equal (car state) 0)) | |
812 (indent-to (calculate-mim-indent)) ; empty, indent like code | |
813 (if (> (current-column) comment-column) ; indent to comment column | |
814 (tab-to-tab-stop) ; unless past it, else to | |
815 (indent-to comment-column))) ; tab-stop | |
816 ;; if luser changes comment-{start end} to something besides semi | |
817 ;; followed by zero or more whitespace characters followed by string | |
818 ;; delimiters, the code above fails to find existing comments, but as | |
819 ;; taa says, `let the losers lose'. | |
820 (insert comment-start) | |
821 (save-excursion (insert comment-end))))))) | |
822 | |
823 (defun skip-mim-whitespace (direction) | |
824 (if (>= direction 0) | |
825 (skip-chars-forward mim-whitespace (point-max)) | |
826 (skip-chars-backward mim-whitespace (point-min)))) | |
827 | |
828 (defun inside-adecl-or-trailer-p (direction) | |
829 (if (>= direction 0) | |
830 (looking-at ":\\|!-") | |
831 (or (= (preceding-char) ?:) | |
832 (looking-at "!-")))) | |
833 | |
834 (defun sign (n) | |
835 "Returns -1 if N < 0, else 1." | |
836 (if (>= n 0) 1 -1)) | |
837 | |
838 (defun abs (n) | |
839 "Returns the absolute value of N." | |
840 (if (>= n 0) n (- n))) | |
841 | |
842 (defun next-char (direction) | |
843 "Returns preceding-char if DIRECTION < 0, otherwise following-char." | |
844 (if (>= direction 0) (following-char) (preceding-char))) | |
584 | 845 |
846 (provide 'mim-mode) | |
847 | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
848 ;;; mim-mode.el ends here |