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