|
0
|
1 ;;; lisp.el --- Lisp editing commands for XEmacs
|
|
|
2
|
|
155
|
3 ;; Copyright (C) 1985, 1986, 1994, 1997 Free Software Foundation, Inc.
|
|
0
|
4
|
|
|
5 ;; Maintainer: FSF
|
|
|
6 ;; Keywords: lisp, languages
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
2
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
0
|
24
|
|
155
|
25 ;;; Synched up with: Emacs/Mule zeta.
|
|
0
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; Lisp editing commands to go with Lisp major mode.
|
|
|
30
|
|
159
|
31 ;; 06/11/1997 - Use char-(after|before) instead of
|
|
|
32 ;; (following|preceding)-char. -slb
|
|
|
33
|
|
0
|
34 ;;; Code:
|
|
|
35
|
|
|
36 ;; Note that this variable is used by non-lisp modes too.
|
|
163
|
37 (defcustom defun-prompt-regexp nil
|
|
0
|
38 "*Non-nil => regexp to ignore, before the character that starts a defun.
|
|
|
39 This is only necessary if the opening paren or brace is not in column 0.
|
|
163
|
40 See `beginning-of-defun'."
|
|
|
41 :type '(choice (const :tag "none" nil)
|
|
|
42 regexp)
|
|
|
43 :group 'lisp)
|
|
|
44
|
|
0
|
45 (make-variable-buffer-local 'defun-prompt-regexp)
|
|
|
46
|
|
163
|
47 (defcustom parens-require-spaces t
|
|
|
48 "Non-nil => `insert-parentheses' should insert whitespace as needed."
|
|
|
49 :type 'boolean
|
|
|
50 :group 'editing-basics
|
|
|
51 :group 'lisp)
|
|
0
|
52
|
|
|
53 (defun forward-sexp (&optional arg)
|
|
|
54 "Move forward across one balanced expression (sexp).
|
|
2
|
55 With argument, do it that many times. Negative arg -N means
|
|
|
56 move backward across N balanced expressions."
|
|
|
57 ;; XEmacs change (for zmacs regions)
|
|
0
|
58 (interactive "_p")
|
|
|
59 (or arg (setq arg 1))
|
|
2
|
60 ;; XEmacs: evil hack! The other half of the evil hack below.
|
|
0
|
61 (if (and (> arg 0) (looking-at "#s("))
|
|
|
62 (goto-char (+ (point) 2)))
|
|
126
|
63 ;; XEmacs change -- don't bomb out if unbalanced sexp
|
|
0
|
64 (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
|
|
|
65 (if (< arg 0) (backward-prefix-chars))
|
|
2
|
66 ;; XEmacs: evil hack! Skip back over #s so that structures are read
|
|
|
67 ;; properly. the current cheesified syntax tables just aren't up to
|
|
|
68 ;; this.
|
|
0
|
69 (if (and (< arg 0)
|
|
|
70 (eq (char-after (point)) ?\()
|
|
|
71 (>= (- (point) (point-min)) 2)
|
|
|
72 (eq (char-after (- (point) 1)) ?s)
|
|
|
73 (eq (char-after (- (point) 2)) ?#))
|
|
|
74 (goto-char (- (point) 2))))
|
|
|
75
|
|
|
76 (defun backward-sexp (&optional arg)
|
|
|
77 "Move backward across one balanced expression (sexp).
|
|
2
|
78 With argument, do it that many times. Negative arg -N means
|
|
|
79 move forward across N balanced expressions."
|
|
|
80 ;; XEmacs change (for zmacs regions)
|
|
0
|
81 (interactive "_p")
|
|
|
82 (or arg (setq arg 1))
|
|
|
83 (forward-sexp (- arg)))
|
|
|
84
|
|
|
85 (defun mark-sexp (arg)
|
|
|
86 "Set mark ARG sexps from point.
|
|
2
|
87 The place mark goes is the same place \\[forward-sexp] would
|
|
|
88 move to with the same argument.
|
|
0
|
89 Repeat this command to mark more sexps in the same direction."
|
|
|
90 (interactive "p")
|
|
2
|
91 ;; XEmacs change
|
|
0
|
92 (mark-something 'mark-sexp 'forward-sexp arg))
|
|
|
93
|
|
|
94 (defun forward-list (&optional arg)
|
|
|
95 "Move forward across one balanced group of parentheses.
|
|
|
96 With argument, do it that many times.
|
|
|
97 Negative arg -N means move backward across N groups of parentheses."
|
|
2
|
98 ;; XEmacs change
|
|
0
|
99 (interactive "_p")
|
|
|
100 (or arg (setq arg 1))
|
|
|
101 (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
|
|
|
102
|
|
|
103 (defun backward-list (&optional arg)
|
|
|
104 "Move backward across one balanced group of parentheses.
|
|
|
105 With argument, do it that many times.
|
|
|
106 Negative arg -N means move forward across N groups of parentheses."
|
|
2
|
107 ;; XEmacs change (for zmacs regions)
|
|
0
|
108 (interactive "_p")
|
|
|
109 (or arg (setq arg 1))
|
|
|
110 (forward-list (- arg)))
|
|
|
111
|
|
|
112 (defun down-list (arg)
|
|
|
113 "Move forward down one level of parentheses.
|
|
|
114 With argument, do this that many times.
|
|
|
115 A negative argument means move backward but still go down a level.
|
|
|
116 In Lisp programs, an argument is required."
|
|
2
|
117 ;; XEmacs change (for zmacs regions)
|
|
0
|
118 (interactive "_p")
|
|
|
119 (let ((inc (if (> arg 0) 1 -1)))
|
|
|
120 (while (/= arg 0)
|
|
|
121 (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
|
|
|
122 (setq arg (- arg inc)))))
|
|
|
123
|
|
|
124 (defun backward-up-list (arg)
|
|
|
125 "Move backward out of one level of parentheses.
|
|
|
126 With argument, do this that many times.
|
|
|
127 A negative argument means move forward but still to a less deep spot.
|
|
|
128 In Lisp programs, an argument is required."
|
|
74
|
129 (interactive "_p")
|
|
0
|
130 (up-list (- arg)))
|
|
|
131
|
|
|
132 (defun up-list (arg)
|
|
|
133 "Move forward out of one level of parentheses.
|
|
|
134 With argument, do this that many times.
|
|
|
135 A negative argument means move backward but still to a less deep spot.
|
|
|
136 In Lisp programs, an argument is required."
|
|
2
|
137 ;; XEmacs change (for zmacs regions)
|
|
0
|
138 (interactive "_p")
|
|
|
139 (let ((inc (if (> arg 0) 1 -1)))
|
|
|
140 (while (/= arg 0)
|
|
|
141 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
|
|
|
142 (setq arg (- arg inc)))))
|
|
|
143
|
|
|
144 (defun kill-sexp (arg)
|
|
|
145 "Kill the sexp (balanced expression) following the cursor.
|
|
|
146 With argument, kill that many sexps after the cursor.
|
|
|
147 Negative arg -N means kill N sexps before the cursor."
|
|
|
148 (interactive "p")
|
|
|
149 (let ((opoint (point)))
|
|
|
150 (forward-sexp arg)
|
|
|
151 (kill-region opoint (point))))
|
|
|
152
|
|
|
153 (defun backward-kill-sexp (arg)
|
|
|
154 "Kill the sexp (balanced expression) preceding the cursor.
|
|
|
155 With argument, kill that many sexps before the cursor.
|
|
|
156 Negative arg -N means kill N sexps after the cursor."
|
|
|
157 (interactive "p")
|
|
|
158 (kill-sexp (- arg)))
|
|
|
159
|
|
|
160 (defun beginning-of-defun (&optional arg)
|
|
|
161 "Move backward to the beginning of a defun.
|
|
|
162 With argument, do it that many times. Negative arg -N
|
|
|
163 means move forward to Nth following beginning of defun.
|
|
|
164 Returns t unless search stops due to beginning or end of buffer.
|
|
|
165
|
|
|
166 Normally a defun starts when there is an char with open-parenthesis
|
|
|
167 syntax at the beginning of a line. If `defun-prompt-regexp' is
|
|
|
168 non-nil, then a string which matches that regexp may precede the
|
|
|
169 open-parenthesis, and point ends up at the beginning of the line."
|
|
2
|
170 ;; XEmacs change (for zmacs regions)
|
|
0
|
171 (interactive "_p")
|
|
|
172 (and (beginning-of-defun-raw arg)
|
|
|
173 (progn (beginning-of-line) t)))
|
|
|
174
|
|
|
175 (defun beginning-of-defun-raw (&optional arg)
|
|
|
176 "Move point to the character that starts a defun.
|
|
|
177 This is identical to beginning-of-defun, except that point does not move
|
|
|
178 to the beginning of the line when `defun-prompt-regexp' is non-nil."
|
|
|
179 (interactive "p")
|
|
|
180 (and arg (< arg 0) (not (eobp)) (forward-char 1))
|
|
|
181 (and (re-search-backward (if defun-prompt-regexp
|
|
|
182 (concat "^\\s(\\|"
|
|
|
183 "\\(" defun-prompt-regexp "\\)\\s(")
|
|
|
184 "^\\s(")
|
|
|
185 nil 'move (or arg 1))
|
|
|
186 (progn (goto-char (1- (match-end 0)))) t))
|
|
|
187
|
|
2
|
188 ;; XEmacs change (optional buffer parameter)
|
|
0
|
189 (defun buffer-end (arg &optional buffer)
|
|
|
190 "Return `point-max' of BUFFER if ARG is > 0; return `point-min' otherwise.
|
|
|
191 BUFFER defaults to the current buffer if omitted."
|
|
|
192 (if (> arg 0) (point-max buffer) (point-min buffer)))
|
|
|
193
|
|
|
194 (defun end-of-defun (&optional arg)
|
|
|
195 "Move forward to next end of defun. With argument, do it that many times.
|
|
|
196 Negative argument -N means move back to Nth preceding end of defun.
|
|
|
197
|
|
|
198 An end of a defun occurs right after the close-parenthesis that matches
|
|
|
199 the open-parenthesis that starts a defun; see `beginning-of-defun'."
|
|
2
|
200 ;; XEmacs change (for zmacs regions)
|
|
0
|
201 (interactive "_p")
|
|
|
202 (if (or (null arg) (= arg 0)) (setq arg 1))
|
|
|
203 (let ((first t))
|
|
|
204 (while (and (> arg 0) (< (point) (point-max)))
|
|
155
|
205 (let ((pos (point))) ; XEmacs -- remove unused npos.
|
|
0
|
206 (while (progn
|
|
|
207 (if (and first
|
|
|
208 (progn
|
|
|
209 (end-of-line 1)
|
|
|
210 (beginning-of-defun-raw 1)))
|
|
|
211 nil
|
|
|
212 (or (bobp) (forward-char -1))
|
|
|
213 (beginning-of-defun-raw -1))
|
|
|
214 (setq first nil)
|
|
|
215 (forward-list 1)
|
|
|
216 (skip-chars-forward " \t")
|
|
|
217 (if (looking-at "\\s<\\|\n")
|
|
|
218 (forward-line 1))
|
|
|
219 (<= (point) pos))))
|
|
|
220 (setq arg (1- arg)))
|
|
|
221 (while (< arg 0)
|
|
|
222 (let ((pos (point)))
|
|
|
223 (beginning-of-defun-raw 1)
|
|
|
224 (forward-sexp 1)
|
|
|
225 (forward-line 1)
|
|
|
226 (if (>= (point) pos)
|
|
|
227 (if (beginning-of-defun-raw 2)
|
|
|
228 (progn
|
|
|
229 (forward-list 1)
|
|
|
230 (skip-chars-forward " \t")
|
|
|
231 (if (looking-at "\\s<\\|\n")
|
|
|
232 (forward-line 1)))
|
|
|
233 (goto-char (point-min)))))
|
|
|
234 (setq arg (1+ arg)))))
|
|
|
235
|
|
|
236 (defun mark-defun ()
|
|
|
237 "Put mark at end of this defun, point at beginning.
|
|
|
238 The defun marked is the one that contains point or follows point."
|
|
|
239 (interactive)
|
|
|
240 (push-mark (point))
|
|
|
241 (end-of-defun)
|
|
|
242 (push-mark (point) nil t)
|
|
|
243 (beginning-of-defun)
|
|
|
244 (re-search-backward "^\n" (- (point) 1) t))
|
|
|
245
|
|
155
|
246 (defun narrow-to-defun (&optional arg)
|
|
|
247 "Make text outside current defun invisible.
|
|
|
248 The defun visible is the one that contains point or follows point."
|
|
|
249 (interactive)
|
|
|
250 (save-excursion
|
|
|
251 (widen)
|
|
|
252 (end-of-defun)
|
|
|
253 (let ((end (point)))
|
|
|
254 (beginning-of-defun)
|
|
|
255 (narrow-to-region (point) end))))
|
|
|
256
|
|
0
|
257 (defun insert-parentheses (arg)
|
|
155
|
258 "Enclose following ARG sexps in parentheses. Leave point after open-paren.
|
|
|
259 A negative ARG encloses the preceding ARG sexps instead.
|
|
0
|
260 No argument is equivalent to zero: just insert `()' and leave point between.
|
|
|
261 If `parens-require-spaces' is non-nil, this command also inserts a space
|
|
|
262 before and after, depending on the surrounding characters."
|
|
|
263 (interactive "P")
|
|
|
264 (if arg (setq arg (prefix-numeric-value arg))
|
|
|
265 (setq arg 0))
|
|
155
|
266 (cond ((> arg 0) (skip-chars-forward " \t"))
|
|
|
267 ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
|
|
0
|
268 (and parens-require-spaces
|
|
|
269 (not (bobp))
|
|
159
|
270 (memq (char-syntax (char-before (point))) '(?w ?_ ?\) ))
|
|
0
|
271 (insert " "))
|
|
|
272 (insert ?\()
|
|
|
273 (save-excursion
|
|
|
274 (or (eq arg 0) (forward-sexp arg))
|
|
|
275 (insert ?\))
|
|
|
276 (and parens-require-spaces
|
|
|
277 (not (eobp))
|
|
159
|
278 (memq (char-syntax (char-after (point))) '(?w ?_ ?\( ))
|
|
0
|
279 (insert " "))))
|
|
|
280
|
|
|
281 (defun move-past-close-and-reindent ()
|
|
|
282 "Move past next `)', delete indentation before it, then indent after it."
|
|
|
283 (interactive)
|
|
|
284 (up-list 1)
|
|
|
285 (forward-char -1)
|
|
|
286 (while (save-excursion ; this is my contribution
|
|
|
287 (let ((before-paren (point)))
|
|
|
288 (back-to-indentation)
|
|
|
289 (= (point) before-paren)))
|
|
|
290 (delete-indentation))
|
|
|
291 (forward-char 1)
|
|
|
292 (newline-and-indent))
|
|
|
293
|
|
|
294 (defun lisp-complete-symbol ()
|
|
|
295 "Perform completion on Lisp symbol preceding point.
|
|
2
|
296 Compare that symbol against the known Lisp symbols.
|
|
|
297
|
|
|
298 The context determines which symbols are considered.
|
|
|
299 If the symbol starts just after an open-parenthesis, only symbols
|
|
|
300 with function definitions are considered. Otherwise, all symbols with
|
|
|
301 function definitions, values or properties are considered."
|
|
0
|
302 (interactive)
|
|
|
303 (let* ((end (point))
|
|
|
304 (buffer-syntax (syntax-table))
|
|
|
305 (beg (unwind-protect
|
|
|
306 (save-excursion
|
|
2
|
307 ;; XEmacs change
|
|
0
|
308 (if emacs-lisp-mode-syntax-table
|
|
|
309 (set-syntax-table emacs-lisp-mode-syntax-table))
|
|
|
310 (backward-sexp 1)
|
|
159
|
311 (while (eq (char-syntax (char-after (point))) ?\')
|
|
0
|
312 (forward-char 1))
|
|
|
313 (point))
|
|
|
314 (set-syntax-table buffer-syntax)))
|
|
|
315 (pattern (buffer-substring beg end))
|
|
|
316 (predicate
|
|
|
317 (if (eq (char-after (1- beg)) ?\()
|
|
|
318 'fboundp
|
|
2
|
319 ;; XEmacs change
|
|
0
|
320 #'(lambda (sym)
|
|
|
321 (or (boundp sym) (fboundp sym)
|
|
|
322 (symbol-plist sym)))))
|
|
|
323 (completion (try-completion pattern obarray predicate)))
|
|
|
324 (cond ((eq completion t))
|
|
|
325 ((null completion)
|
|
|
326 (message "Can't find completion for \"%s\"" pattern)
|
|
|
327 (ding))
|
|
|
328 ((not (string= pattern completion))
|
|
|
329 (delete-region beg end)
|
|
|
330 (insert completion))
|
|
|
331 (t
|
|
|
332 (message "Making completion list...")
|
|
|
333 (let ((list (all-completions pattern obarray predicate))
|
|
155
|
334 ;FSFmacs crock unnecessary in XEmacs
|
|
0
|
335 ;see minibuf.el
|
|
|
336 ;(completion-fixup-function
|
|
2
|
337 ; (function (lambda () (if (save-excursion
|
|
0
|
338 ; (goto-char (max (point-min)
|
|
|
339 ; (- (point) 4)))
|
|
|
340 ; (looking-at " <f>"))
|
|
|
341 ; (forward-char -4))))
|
|
|
342 )
|
|
|
343 (or (eq predicate 'fboundp)
|
|
|
344 (let (new)
|
|
|
345 (while list
|
|
|
346 (setq new (cons (if (fboundp (intern (car list)))
|
|
|
347 (list (car list) " <f>")
|
|
|
348 (car list))
|
|
|
349 new))
|
|
|
350 (setq list (cdr list)))
|
|
|
351 (setq list (nreverse new))))
|
|
|
352 (with-output-to-temp-buffer "*Completions*"
|
|
116
|
353 (display-completion-list list)))
|
|
2
|
354 (message "Making completion list...%s" "done")))))
|
|
0
|
355
|
|
|
356 ;;; lisp.el ends here
|
