0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
2
|
|
3 ;;; ilisp-ext.el --
|
|
4
|
|
5 ;;; This file is part of ILISP.
|
4
|
6 ;;; Version: 5.8
|
0
|
7 ;;;
|
|
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
|
|
9 ;;; 1993, 1994 Ivan Vasquez
|
4
|
10 ;;; 1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
|
|
11 ;;; 1996 Marco Antoniotti and Rick Campbell
|
0
|
12 ;;;
|
|
13 ;;; Other authors' names for which this Copyright notice also holds
|
|
14 ;;; may appear later in this file.
|
|
15 ;;;
|
4
|
16 ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
|
|
17 ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
|
0
|
18 ;;; mailing list were bugs and improvements are discussed.
|
|
19 ;;;
|
|
20 ;;; ILISP is freely redistributable under the terms found in the file
|
|
21 ;;; COPYING.
|
|
22
|
|
23
|
|
24 ;;; Lisp mode extensions from the ILISP package.
|
|
25 ;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
|
|
26
|
|
27 ;;; This file may become part of GNU Emacs.
|
|
28
|
|
29 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
30 ;;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
31 ;;; accepts responsibility to anyone for the consequences of using it
|
|
32 ;;; or for whether it serves any particular purpose or works at all,
|
|
33 ;;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
34 ;;; License for full details.
|
|
35
|
|
36 ;;; Everyone is granted permission to copy, modify and redistribute
|
|
37 ;;; GNU Emacs, but only under the conditions described in the
|
|
38 ;;; GNU Emacs General Public License. A copy of this license is
|
|
39 ;;; supposed to have been given to you along with GNU Emacs so you
|
|
40 ;;; can know your rights and responsibilities. It should be in a
|
|
41 ;;; file named COPYING. Among other things, the copyright notice
|
|
42 ;;; and this notice must be preserved on all copies.
|
|
43
|
|
44 ;;; When loaded this file adds new functionality to emacs lisp mode
|
|
45 ;;; and lisp mode.
|
|
46 ;;;
|
|
47 ;;; Default bindings:
|
|
48 ;;;
|
|
49 ;;; M-x find-unbalanced-lisp find unbalanced parens in the current
|
|
50 ;;; buffer. With a prefix in the current region.
|
|
51 ;;;
|
|
52 ;;; ] Close all open parentheses back to the start of the containing
|
|
53 ;;; sexp, or to a previous left bracket which will be converted to a
|
|
54 ;;; left paren.
|
|
55 ;;;
|
|
56 ;;; M-q Reindent comments or strings in paragraph chunks or reindent
|
|
57 ;;; the containing sexp.
|
|
58 ;;;
|
|
59 ;;; M-x comment-region-lisp inserts prefix copies of the comment-start
|
|
60 ;;; character before lines in the region and the comment-end character
|
|
61 ;;; at the end of each line. If called with a negative prefix, that
|
|
62 ;;; many copies are removed.
|
|
63 ;;;
|
|
64 ;;; C-M-r repositions the first line of the current defun to the top
|
|
65 ;;; of the current window.
|
|
66 ;;;
|
|
67 ;;; C-M-l switches the current window to the previously seen buffer.
|
|
68 ;;;
|
|
69 ;;; EXAMPLE .emacs:
|
|
70 ;;;
|
|
71 ;;; (setq ilisp-ext-load-hook
|
|
72 ;;; '(lambda () (define-key global-map "\C-\M-l" 'previous-buffer-lisp)))
|
|
73 ;;; (require 'ilisp-ext)
|
|
74
|
|
75 ;;;%Syntax
|
|
76 ;;; This makes it so that .'s are treated as normal characters so that
|
|
77 ;;; 3.141 gets treated as a single lisp token. This does cause dotted
|
|
78 ;;; pairs to be treated weird though.
|
|
79 (modify-syntax-entry ?. "_" lisp-mode-syntax-table)
|
|
80
|
|
81 ;;; Brackets match
|
|
82 (modify-syntax-entry ?\[ "(]" lisp-mode-syntax-table)
|
|
83 (modify-syntax-entry ?\] ")[" lisp-mode-syntax-table)
|
|
84
|
|
85
|
|
86
|
|
87 ;;;%Superbrackets
|
|
88 (defun close-all-lisp (arg)
|
|
89 "Unless you are in a string, insert right parentheses as necessary
|
|
90 to balance unmatched left parentheses back to the start of the current
|
|
91 defun or to a previous left bracket which is then replaced with a left
|
|
92 parentheses. If there are too many right parentheses, remove them
|
|
93 unless there is text after the extra right parentheses. If called
|
|
94 with a prefix, the entire expression will be closed and all open left
|
|
95 brackets will be replaced with left parentheses."
|
|
96 (interactive "P")
|
|
97 (let* ((point (point))
|
|
98 (begin (lisp-defun-begin))
|
|
99 (end (lisp-end-defun-text))
|
|
100 inserted
|
|
101 (closed nil))
|
|
102 (goto-char point)
|
|
103 (if (or (car (cdr (cdr (lisp-in-string begin end))))
|
|
104 (save-excursion (beginning-of-line)
|
|
105 (looking-at "[ \t]*;")))
|
|
106 (insert "]")
|
|
107 (if (= begin end)
|
|
108 (error "No sexp to close.")
|
|
109 (save-restriction
|
|
110 (narrow-to-region begin end)
|
|
111 (if (< point begin)
|
|
112 (setq point begin)
|
|
113 (if (> point end)
|
|
114 (setq point end)))
|
|
115 ;; Add parens at point until either the defun is closed, or we
|
|
116 ;; hit a square bracket.
|
|
117 (goto-char point)
|
|
118 (insert ?\)) ;So we have an sexp
|
|
119 (while (progn
|
|
120 (setq inserted (point))
|
|
121 (condition-case ()
|
|
122 (progn (backward-sexp)
|
|
123 (or arg
|
|
124 (not (eq (char-after (point)) ?\[))))
|
|
125 (error (setq closed t) nil)))
|
|
126 ;; With an arg replace all left brackets
|
|
127 (if (and arg (= (char-after (point)) ?\[))
|
|
128 (progn
|
|
129 (delete-char 1)
|
|
130 (insert ?\()
|
|
131 (backward-char)))
|
|
132 (forward-sexp)
|
|
133 (insert ?\)))
|
|
134 (if (< (point) point)
|
|
135 ;; We are at a left bracket
|
|
136 (let ((left (point)))
|
|
137 (delete-char 1)
|
|
138 (insert ?\()
|
|
139 (backward-char)
|
|
140 (forward-sexp))
|
|
141 ;; There was not an open left bracket so close at end
|
|
142 (delete-region point inserted)
|
|
143 (goto-char begin)
|
|
144 (if (condition-case () (progn
|
|
145 (forward-sexp)
|
|
146 (<= (point) end))
|
|
147 (error nil))
|
|
148 ;; Delete extra right parens
|
|
149 (let ((point (point)))
|
|
150 (skip-chars-forward " \t)\n")
|
|
151 (if (or (bolp) (eobp))
|
|
152 (progn
|
|
153 (skip-chars-backward " \t\n")
|
|
154 (delete-region point (point)))
|
|
155 (error
|
|
156 "There is text after the last right parentheses.")))
|
|
157 ;; Insert parens at end changing any left brackets
|
|
158 (goto-char end)
|
|
159 (while
|
|
160 (progn
|
|
161 (insert ?\))
|
|
162 (save-excursion
|
|
163 (condition-case ()
|
|
164 (progn (backward-sexp)
|
|
165 (if (= (char-after (point)) ?\[)
|
|
166 (progn
|
|
167 (delete-char 1)
|
|
168 (insert ?\()
|
|
169 (backward-char)))
|
|
170 (> (point) begin))
|
|
171 (error (delete-backward-char 1)
|
|
172 nil))))))))))))
|
|
173
|
|
174 ;;;%Reindentation
|
|
175
|
|
176 ;;;
|
|
177 (defun reindent-lisp ()
|
|
178 "Indents code depending partially on context (comments or strings).
|
|
179 If in a comment, indent the comment paragraph bounded by
|
|
180 non-comments, blank lines or empty comment lines. If in a string,
|
|
181 indent the paragraph bounded by string delimiters or blank lines.
|
|
182 Otherwise go to the containing defun, close it and reindent the code
|
|
183 block."
|
|
184 (interactive)
|
|
185 (let ((region (lisp-in-string))
|
|
186 (comment (concat "[ \t]*" comment-start "+[ \t]*")))
|
|
187 (set-marker lisp-fill-marker (point))
|
|
188 (back-to-indentation)
|
|
189 (cond (region
|
|
190 (or (= (char-after (point)) ?\")
|
|
191 (and (< (point) (car region)) (goto-char (car region)))
|
|
192 (re-search-backward "^$" (car region) 'end))
|
|
193 (let ((begin (point))
|
|
194 (end (car (cdr region)))
|
|
195 (fill-prefix nil))
|
|
196 (forward-char)
|
|
197 (re-search-forward "^$" end 'end)
|
|
198 (if (= (point) end)
|
|
199 (progn (skip-chars-forward "^\n")
|
|
200 (if (not (eobp)) (forward-char))))
|
|
201 (fill-region-as-paragraph begin (point))))
|
|
202 ((looking-at comment)
|
|
203 (let ((fill-prefix
|
|
204 (buffer-substring
|
|
205 (progn (beginning-of-line) (point))
|
|
206 (match-end 0))))
|
|
207 (while (and (not (bobp)) (lisp-in-comment comment))
|
|
208 (forward-line -1))
|
|
209 (if (not (bobp)) (forward-line 1))
|
|
210 (let ((begin (point)))
|
|
211 (while (and (lisp-in-comment comment) (not (eobp)))
|
|
212 (replace-match fill-prefix)
|
|
213 (forward-line 1))
|
|
214 (if (not (eobp))
|
|
215 (progn (forward-line -1)
|
|
216 (end-of-line)
|
|
217 (forward-char 1)))
|
|
218 (fill-region-as-paragraph begin (point)))))
|
|
219 (t
|
|
220 (goto-char lisp-fill-marker)
|
|
221 (close-all-lisp 1)
|
|
222 (lisp-defun-begin)
|
|
223 (indent-sexp-ilisp)))
|
|
224 (goto-char lisp-fill-marker)
|
|
225 (set-marker lisp-fill-marker nil)
|
|
226 (message "Done")))
|
|
227
|
|
228 ;;;%Comment region
|
|
229 (defun comment-region-lisp (start end prefix)
|
|
230 "If prefix is positive, insert prefix copies of comment-start at the
|
|
231 start and comment-end at the end of each line in region. If prefix is
|
|
232 negative, remove all comment-start and comment-end strings from the
|
|
233 region."
|
|
234 (interactive "r\np")
|
|
235 (save-excursion
|
|
236 (goto-char end)
|
|
237 (if (and (not (= start end)) (bolp)) (setq end (1- end)))
|
|
238 (goto-char end)
|
|
239 (beginning-of-line)
|
|
240 (set-marker ilisp-comment-marker (point))
|
|
241 (untabify start end)
|
|
242 (goto-char start)
|
|
243 (beginning-of-line)
|
|
244 (let* ((count 1)
|
|
245 (comment comment-start)
|
|
246 (comment-end (if (not (equal comment-end "")) comment-end)))
|
|
247 (if (> prefix 0)
|
|
248 (progn
|
|
249 (while (< count prefix)
|
|
250 (setq comment (concat comment-start comment)
|
|
251 count (1+ count)))
|
|
252 (while (<= (point) ilisp-comment-marker)
|
|
253 (beginning-of-line)
|
|
254 (insert comment)
|
|
255 (if comment-end (progn (end-of-line) (insert comment-end)))
|
|
256 (forward-line 1)))
|
|
257 (setq comment (concat comment "+"))
|
|
258 (while (<= (point) ilisp-comment-marker)
|
|
259 (back-to-indentation)
|
|
260 (if (looking-at comment) (replace-match ""))
|
|
261 (if comment-end
|
|
262 (progn
|
|
263 (re-search-backward comment-end)
|
|
264 (replace-match "")))
|
|
265 (forward-line 1)))
|
|
266 (set-marker ilisp-comment-marker nil))))
|
|
267
|
|
268 ;;;%Movement
|
|
269 ;;; beginning-of-defun-lisp and end-of-defun-lisp are overloaded by ilisp.el
|
|
270 (defun beginning-of-defun-lisp (&optional stay)
|
|
271 "Go to the next left paren that starts at the left margin."
|
|
272 (interactive)
|
|
273 (beginning-of-defun))
|
|
274
|
|
275 ;;;
|
|
276 (defun end-of-defun-lisp ()
|
|
277 "Go to the next left paren that starts at the left margin."
|
|
278 (interactive)
|
|
279 (let ((point (point)))
|
|
280 (beginning-of-line)
|
|
281 (re-search-forward "^[ \t\n]*[^; \t\n]" nil t)
|
|
282 (back-to-indentation)
|
|
283 (if (not (bolp)) (beginning-of-defun-lisp t))
|
|
284 (lisp-end-defun-text t)
|
|
285 (if (= point (point)) ;Already at end so move to next end
|
|
286 (lisp-skip (point-max))
|
|
287 (if (not (or (eobp)
|
|
288 (= (char-after (point)) ?\n)))
|
|
289 (lisp-end-defun-text t)))))
|
|
290
|
|
291 ;;;%%Reposition-window
|
|
292 (defun count-screen-lines-lisp (start end)
|
|
293 "Return the number of screen lines between start and end."
|
|
294 (save-excursion
|
|
295 (save-restriction
|
|
296 (narrow-to-region start end)
|
|
297 (goto-char (point-min))
|
|
298 (vertical-motion (- (point-max) (point-min))))))
|
|
299
|
|
300 ;;;
|
|
301 (defun count-screen-lines-signed-lisp (start end)
|
|
302 "Return number of screen lines between START and END; returns a negative
|
|
303 number if END precedes START."
|
|
304 (interactive "r")
|
|
305 (let ((lines (count-screen-lines-lisp start end)))
|
|
306 (if (< start end) lines (- lines))))
|
|
307
|
|
308 ;;; This was written by Michael D. Ernst
|
|
309 (defun reposition-window-lisp (&optional arg)
|
|
310 "Make the current definition and/or comment visible, move it to the
|
|
311 top of the window, or toggle the visibility of comments that precede
|
|
312 it. Leaves point unchanged unless supplied with prefix ARG. If the
|
|
313 definition is fully onscreen, it is moved to the top of the window.
|
|
314 If it is partly offscreen, the window is scrolled to get the
|
|
315 definition \(or as much as will fit) onscreen, unless point is in a
|
|
316 comment which is also partly offscreen, in which case the scrolling
|
|
317 attempts to get as much of the comment onscreen as possible.
|
|
318 Initially reposition-window attempts to make both the definition and
|
|
319 preceding comments visible. Further invocations toggle the visibility
|
|
320 of the comment lines. If ARG is non-nil, point may move in order to
|
|
321 make the whole defun visible \(if only part could otherwise be made
|
|
322 so), to make the defun line visible \(if point is in code and it could
|
|
323 not be made so, or if only comments, including the first comment line,
|
|
324 are visible), or to make the first comment line visible \(if point is
|
|
325 in a comment)."
|
|
326 (interactive "P")
|
|
327 (let* ((here (point))
|
|
328 ;; change this name once I've gotten rid of references to ht.
|
|
329 ;; this is actually the number of the last screen line
|
|
330 (ht (- (window-height (selected-window)) 2))
|
|
331 (line (count-screen-lines-lisp (window-start) (point)))
|
|
332 (comment-height
|
|
333 ;; The max deals with the case of cursor between defuns.
|
|
334 (max 0
|
|
335 (count-screen-lines-signed-lisp
|
|
336 ;; the beginning of the preceding comment
|
|
337 (save-excursion
|
|
338 (if (not (and (bolp) (eq (char-after (point)) ?\()))
|
|
339 (beginning-of-defun-lisp))
|
|
340 (beginning-of-defun-lisp)
|
|
341 (end-of-defun-lisp)
|
|
342 ;; Skip whitespace, newlines, and form feeds.
|
|
343 (re-search-forward "[^\\s \n\014]")
|
|
344 (backward-char 1)
|
|
345 (point))
|
|
346 here)))
|
|
347 (defun-height
|
|
348 (count-screen-lines-signed-lisp
|
|
349 (save-excursion
|
|
350 (end-of-defun-lisp) ;associate comment with next defun
|
|
351 (beginning-of-defun-lisp)
|
|
352 (point))
|
|
353 here))
|
|
354 ;; This must be positive, so don't use the signed version.
|
|
355 (defun-depth
|
|
356 (count-screen-lines-lisp
|
|
357 here
|
|
358 (save-excursion (end-of-defun-lisp) (point))))
|
|
359 (defun-line-onscreen-p
|
|
360 (and (<= defun-height line) (<= (- line defun-height) ht))))
|
|
361 (cond ((or (= comment-height line)
|
|
362 (and (= line ht)
|
|
363 (> comment-height line)
|
|
364 ;; if defun line offscreen, we should be in case 4
|
|
365 defun-line-onscreen-p))
|
|
366 ;; Either first comment line is at top of screen or (point at
|
|
367 ;; bottom of screen, defun line onscreen, and first comment line
|
|
368 ;; off top of screen). That is, it looks like we just did
|
|
369 ;; recenter-definition, trying to fit as much of the comment
|
|
370 ;; onscreen as possible. Put defun line at top of screen; that
|
|
371 ;; is, show as much code, and as few comments, as possible.
|
|
372 (if (and arg (> defun-depth (1+ ht)))
|
|
373 ;; Can't fit whole defun onscreen without moving point.
|
|
374 (progn (end-of-defun-lisp) (beginning-of-defun-lisp)
|
|
375 (recenter 0))
|
|
376 (recenter (max defun-height 0))))
|
|
377 ((or (= defun-height line)
|
|
378 (= line 0)
|
|
379 (and (< line comment-height)
|
|
380 (< defun-height 0)))
|
|
381 ;; Defun line or cursor at top of screen, OR cursor in comment
|
|
382 ;; whose first line is offscreen.
|
|
383 ;; Avoid moving definition up even if defun runs offscreen;
|
|
384 ;; we care more about getting the comment onscreen.
|
|
385 (cond ((= line ht)
|
|
386 ;; cursor on last screen line (and so in a comment)
|
|
387 (if arg (progn (end-of-defun-lisp)
|
|
388 (beginning-of-defun-lisp)))
|
|
389 (recenter 0))
|
|
390 ;; This condition, copied from case 4, may not be quite right
|
|
391 ((and arg (< ht comment-height))
|
|
392 ;; Can't get first comment line onscreen.
|
|
393 ;; Go there and try again.
|
|
394 (forward-line (- comment-height))
|
|
395 (beginning-of-line)
|
|
396 ;; was (reposition-window)
|
|
397 (recenter 0))
|
|
398 (t
|
|
399 (recenter (min ht comment-height))))
|
|
400 ;; (recenter (min ht comment-height))
|
|
401 )
|
|
402 ((and (> (+ line defun-depth -1) ht)
|
|
403 defun-line-onscreen-p)
|
|
404 ;; Defun runs off the bottom of the screen and the defun
|
|
405 ;; line is onscreen. Move the defun up.
|
|
406 (recenter (max 0 (1+ (- ht defun-depth)) defun-height)))
|
|
407 (t
|
|
408 ;; If on the bottom line and comment start is offscreen
|
|
409 ;; then just move all comments offscreen, or at least as
|
|
410 ;; far as they'll go. Try to get as much of the comments
|
|
411 ;; onscreen as possible.
|
|
412 (if (and arg (< ht comment-height))
|
|
413 ;; Can't get defun line onscreen; go there and try again.
|
|
414 (progn (forward-line (- defun-height))
|
|
415 (beginning-of-line)
|
|
416 (reposition-window-lisp))
|
|
417 (recenter (min ht comment-height)))))))
|
|
418
|
|
419 ;;;
|
|
420 (defun previous-buffer-lisp (n)
|
|
421 "Switch to Nth previously selected buffer. N defaults to the number
|
|
422 of windows plus 1. That is, no argument switches to the most recently
|
|
423 selected buffer that is not visible. If N is 1, repeated calls will
|
|
424 cycle through all buffers; -1 cycles the other way. If N is greater
|
|
425 than 1, the first N buffers on the buffer list are rotated."
|
|
426 (interactive "P")
|
|
427 (if (not n)
|
|
428 (switch-to-buffer nil)
|
|
429 (let ((buffer-list (buffer-list)))
|
|
430 (setq n (prefix-numeric-value n))
|
|
431 (cond ((= n 1)
|
|
432 (bury-buffer (current-buffer))
|
|
433 (setq n 2))
|
|
434 ((< n 0)
|
|
435 (setq buffer-list (nreverse buffer-list)
|
|
436 n (- n)))
|
|
437 (t nil))
|
|
438 (while (and (> n 1) buffer-list)
|
|
439 (setq n (1- n)
|
|
440 buffer-list (cdr buffer-list))
|
|
441 (while (eq (elt (buffer-name (car buffer-list)) 0) ? )
|
|
442 (setq buffer-list (cdr buffer-list))))
|
|
443 (if buffer-list
|
|
444 (switch-to-buffer (car buffer-list))
|
|
445 (error "There aren't that many buffers")))))
|
|
446
|
|
447 ;;;%Bindings
|
|
448 (define-key emacs-lisp-mode-map "\M-q" 'reindent-lisp)
|
|
449 (define-key emacs-lisp-mode-map "\M-\C-a" 'beginning-of-defun-lisp)
|
|
450 (define-key emacs-lisp-mode-map "\M-\C-e" 'end-of-defun-lisp)
|
|
451 (define-key emacs-lisp-mode-map "\C-\M-r" 'reposition-window-lisp)
|
|
452 (define-key emacs-lisp-mode-map "]" 'close-all-lisp)
|
|
453 (define-key lisp-mode-map "\M-q" 'reindent-lisp)
|
|
454 (define-key lisp-mode-map "\C-\M-r" 'reposition-window-lisp)
|
|
455 (define-key lisp-mode-map "]" 'close-all-lisp)
|
|
456 (define-key global-map "\M-\C-l" 'previous-buffer-lisp)
|
|
457
|
|
458 ;;;
|
|
459 (run-hooks 'ilisp-ext-load-hook)
|
|
460 (provide 'ilisp-ext)
|