Mercurial > hg > xemacs-beta

comparison lisp/prim/lisp.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 27bc7f280385
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 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 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 23 ;; 02111-1307, USA.
24 ;;; Synched up with: FSF 19.30. 24
25 ;;; Synched up with: FSF 19.34.
25 26
26 ;;; Commentary: 27 ;;; Commentary:
27 28
28 ;; Lisp editing commands to go with Lisp major mode. 29 ;; Lisp editing commands to go with Lisp major mode.
29 30
39 (defvar parens-require-spaces t 40 (defvar parens-require-spaces t
40 "Non-nil => `insert-parentheses' should insert whitespace as needed.") 41 "Non-nil => `insert-parentheses' should insert whitespace as needed.")
41 42
42 (defun forward-sexp (&optional arg) 43 (defun forward-sexp (&optional arg)
43 "Move forward across one balanced expression (sexp). 44 "Move forward across one balanced expression (sexp).
44 With argument, do it that many times. 45 With argument, do it that many times. Negative arg -N means
45 Negative arg -N means move backward across N balanced expressions." 46 move backward across N balanced expressions."
47 ;; XEmacs change (for zmacs regions)
46 (interactive "_p") 48 (interactive "_p")
47 (or arg (setq arg 1)) 49 (or arg (setq arg 1))
48 ;; #### evil hack! The other half of the evil hack below. 50 ;; XEmacs: evil hack! The other half of the evil hack below.
49 (if (and (> arg 0) (looking-at "#s(")) 51 (if (and (> arg 0) (looking-at "#s("))
50 (goto-char (+ (point) 2))) 52 (goto-char (+ (point) 2)))
51 (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) 53 (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
52 (if (< arg 0) (backward-prefix-chars)) 54 (if (< arg 0) (backward-prefix-chars))
53 ;; #### evil hack! Skip back over #s so that structures are read properly. 55 ;; XEmacs: evil hack! Skip back over #s so that structures are read
54 ;; the current cheesified syntax tables just aren't up to this. 56 ;; properly. the current cheesified syntax tables just aren't up to
57 ;; this.
55 (if (and (< arg 0) 58 (if (and (< arg 0)
56 (eq (char-after (point)) ?\() 59 (eq (char-after (point)) ?\()
57 (>= (- (point) (point-min)) 2) 60 (>= (- (point) (point-min)) 2)
58 (eq (char-after (- (point) 1)) ?s) 61 (eq (char-after (- (point) 1)) ?s)
59 (eq (char-after (- (point) 2)) ?#)) 62 (eq (char-after (- (point) 2)) ?#))
60 (goto-char (- (point) 2)))) 63 (goto-char (- (point) 2))))
61 64
62 (defun backward-sexp (&optional arg) 65 (defun backward-sexp (&optional arg)
63 "Move backward across one balanced expression (sexp). 66 "Move backward across one balanced expression (sexp).
64 With argument, do it that many times. 67 With argument, do it that many times. Negative arg -N means
65 Negative arg -N means move forward across N balanced expressions." 68 move forward across N balanced expressions."
69 ;; XEmacs change (for zmacs regions)
66 (interactive "_p") 70 (interactive "_p")
67 (or arg (setq arg 1)) 71 (or arg (setq arg 1))
68 (forward-sexp (- arg))) 72 (forward-sexp (- arg)))
69 73
70 (defun mark-sexp (arg) 74 (defun mark-sexp (arg)
71 "Set mark ARG sexps from point. 75 "Set mark ARG sexps from point.
72 The place mark goes is the same place \\[forward-sexp] would move to 76 The place mark goes is the same place \\[forward-sexp] would
73 with the same argument. 77 move to with the same argument.
74 Repeat this command to mark more sexps in the same direction." 78 Repeat this command to mark more sexps in the same direction."
75 (interactive "p") 79 (interactive "p")
80 ;; XEmacs change
76 (mark-something 'mark-sexp 'forward-sexp arg)) 81 (mark-something 'mark-sexp 'forward-sexp arg))
77 82
78 (defun forward-list (&optional arg) 83 (defun forward-list (&optional arg)
79 "Move forward across one balanced group of parentheses. 84 "Move forward across one balanced group of parentheses.
80 With argument, do it that many times. 85 With argument, do it that many times.
81 Negative arg -N means move backward across N groups of parentheses." 86 Negative arg -N means move backward across N groups of parentheses."
87 ;; XEmacs change
82 (interactive "_p") 88 (interactive "_p")
83 (or arg (setq arg 1)) 89 (or arg (setq arg 1))
84 (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) 90 (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
85 91
86 (defun backward-list (&optional arg) 92 (defun backward-list (&optional arg)
87 "Move backward across one balanced group of parentheses. 93 "Move backward across one balanced group of parentheses.
88 With argument, do it that many times. 94 With argument, do it that many times.
89 Negative arg -N means move forward across N groups of parentheses." 95 Negative arg -N means move forward across N groups of parentheses."
96 ;; XEmacs change (for zmacs regions)
90 (interactive "_p") 97 (interactive "_p")
91 (or arg (setq arg 1)) 98 (or arg (setq arg 1))
92 (forward-list (- arg))) 99 (forward-list (- arg)))
93 100
94 (defun down-list (arg) 101 (defun down-list (arg)
95 "Move forward down one level of parentheses. 102 "Move forward down one level of parentheses.
96 With argument, do this that many times. 103 With argument, do this that many times.
97 A negative argument means move backward but still go down a level. 104 A negative argument means move backward but still go down a level.
98 In Lisp programs, an argument is required." 105 In Lisp programs, an argument is required."
106 ;; XEmacs change (for zmacs regions)
99 (interactive "_p") 107 (interactive "_p")
100 (let ((inc (if (> arg 0) 1 -1))) 108 (let ((inc (if (> arg 0) 1 -1)))
101 (while (/= arg 0) 109 (while (/= arg 0)
102 (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) 110 (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
103 (setq arg (- arg inc))))) 111 (setq arg (- arg inc)))))
113 (defun up-list (arg) 121 (defun up-list (arg)
114 "Move forward out of one level of parentheses. 122 "Move forward out of one level of parentheses.
115 With argument, do this that many times. 123 With argument, do this that many times.
116 A negative argument means move backward but still to a less deep spot. 124 A negative argument means move backward but still to a less deep spot.
117 In Lisp programs, an argument is required." 125 In Lisp programs, an argument is required."
126 ;; XEmacs change (for zmacs regions)
118 (interactive "_p") 127 (interactive "_p")
119 (let ((inc (if (> arg 0) 1 -1))) 128 (let ((inc (if (> arg 0) 1 -1)))
120 (while (/= arg 0) 129 (while (/= arg 0)
121 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) 130 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
122 (setq arg (- arg inc))))) 131 (setq arg (- arg inc)))))
145 154
146 Normally a defun starts when there is an char with open-parenthesis 155 Normally a defun starts when there is an char with open-parenthesis
147 syntax at the beginning of a line. If `defun-prompt-regexp' is 156 syntax at the beginning of a line. If `defun-prompt-regexp' is
148 non-nil, then a string which matches that regexp may precede the 157 non-nil, then a string which matches that regexp may precede the
149 open-parenthesis, and point ends up at the beginning of the line." 158 open-parenthesis, and point ends up at the beginning of the line."
159 ;; XEmacs change (for zmacs regions)
150 (interactive "_p") 160 (interactive "_p")
151 (and (beginning-of-defun-raw arg) 161 (and (beginning-of-defun-raw arg)
152 (progn (beginning-of-line) t))) 162 (progn (beginning-of-line) t)))
153 163
154 (defun beginning-of-defun-raw (&optional arg) 164 (defun beginning-of-defun-raw (&optional arg)
162 "\\(" defun-prompt-regexp "\\)\\s(") 172 "\\(" defun-prompt-regexp "\\)\\s(")
163 "^\\s(") 173 "^\\s(")
164 nil 'move (or arg 1)) 174 nil 'move (or arg 1))
165 (progn (goto-char (1- (match-end 0)))) t)) 175 (progn (goto-char (1- (match-end 0)))) t))
166 176
177 ;; XEmacs change (optional buffer parameter)
167 (defun buffer-end (arg &optional buffer) 178 (defun buffer-end (arg &optional buffer)
168 "Return `point-max' of BUFFER if ARG is > 0; return `point-min' otherwise. 179 "Return `point-max' of BUFFER if ARG is > 0; return `point-min' otherwise.
169 BUFFER defaults to the current buffer if omitted." 180 BUFFER defaults to the current buffer if omitted."
170 (if (> arg 0) (point-max buffer) (point-min buffer))) 181 (if (> arg 0) (point-max buffer) (point-min buffer)))
171 182
173 "Move forward to next end of defun. With argument, do it that many times. 184 "Move forward to next end of defun. With argument, do it that many times.
174 Negative argument -N means move back to Nth preceding end of defun. 185 Negative argument -N means move back to Nth preceding end of defun.
175 186
176 An end of a defun occurs right after the close-parenthesis that matches 187 An end of a defun occurs right after the close-parenthesis that matches
177 the open-parenthesis that starts a defun; see `beginning-of-defun'." 188 the open-parenthesis that starts a defun; see `beginning-of-defun'."
189 ;; XEmacs change (for zmacs regions)
178 (interactive "_p") 190 (interactive "_p")
179 (if (or (null arg) (= arg 0)) (setq arg 1)) 191 (if (or (null arg) (= arg 0)) (setq arg 1))
180 (let ((first t)) 192 (let ((first t))
181 (while (and (> arg 0) (< (point) (point-max))) 193 (while (and (> arg 0) (< (point) (point-max)))
182 (let ((pos (point))) 194 (let ((pos (point)) npos)
183 (while (progn 195 (while (progn
184 (if (and first 196 (if (and first
185 (progn 197 (progn
186 (end-of-line 1) 198 (end-of-line 1)
187 (beginning-of-defun-raw 1))) 199 (beginning-of-defun-raw 1)))
255 (forward-char 1) 267 (forward-char 1)
256 (newline-and-indent)) 268 (newline-and-indent))
257 269
258 (defun lisp-complete-symbol () 270 (defun lisp-complete-symbol ()
259 "Perform completion on Lisp symbol preceding point. 271 "Perform completion on Lisp symbol preceding point.
260 That symbol is compared against the symbols that exist 272 Compare that symbol against the known Lisp symbols.
261 and any additional characters determined by what is there 273
262 are inserted. 274 The context determines which symbols are considered.
263 If the symbol starts just after an open-parenthesis, 275 If the symbol starts just after an open-parenthesis, only symbols
264 only symbols with function definitions are considered. 276 with function definitions are considered. Otherwise, all symbols with
265 Otherwise, all symbols with function definitions, values 277 function definitions, values or properties are considered."
266 or properties are considered."
267 (interactive) 278 (interactive)
268 (let* ((end (point)) 279 (let* ((end (point))
269 (buffer-syntax (syntax-table)) 280 (buffer-syntax (syntax-table))
270 (beg (unwind-protect 281 (beg (unwind-protect
271 (save-excursion 282 (save-excursion
283 ;; XEmacs change
272 (if emacs-lisp-mode-syntax-table 284 (if emacs-lisp-mode-syntax-table
273 (set-syntax-table emacs-lisp-mode-syntax-table)) 285 (set-syntax-table emacs-lisp-mode-syntax-table))
274 (backward-sexp 1) 286 (backward-sexp 1)
275 (while (= (char-syntax (following-char)) ?\') 287 (while (= (char-syntax (following-char)) ?\')
276 (forward-char 1)) 288 (forward-char 1))
278 (set-syntax-table buffer-syntax))) 290 (set-syntax-table buffer-syntax)))
279 (pattern (buffer-substring beg end)) 291 (pattern (buffer-substring beg end))
280 (predicate 292 (predicate
281 (if (eq (char-after (1- beg)) ?\() 293 (if (eq (char-after (1- beg)) ?\()
282 'fboundp 294 'fboundp
295 ;; XEmacs change
283 #'(lambda (sym) 296 #'(lambda (sym)
284 (or (boundp sym) (fboundp sym) 297 (or (boundp sym) (fboundp sym)
285 (symbol-plist sym))))) 298 (symbol-plist sym)))))
286 (completion (try-completion pattern obarray predicate))) 299 (completion (try-completion pattern obarray predicate)))
287 (cond ((eq completion t)) 300 (cond ((eq completion t))
292 (delete-region beg end) 305 (delete-region beg end)
293 (insert completion)) 306 (insert completion))
294 (t 307 (t
295 (message "Making completion list...") 308 (message "Making completion list...")
296 (let ((list (all-completions pattern obarray predicate)) 309 (let ((list (all-completions pattern obarray predicate))
297 ;FSFmacs crock unnecessary in XEmacs 310 ;FSFmacs crock unnecessary in XEmacs (ROTFL -sb)
298 ;see minibuf.el 311 ;see minibuf.el
299 ;(completion-fixup-function 312 ;(completion-fixup-function
300 ; #'(lambda () (if (save-excursion 313 ; (function (lambda () (if (save-excursion
301 ; (goto-char (max (point-min) 314 ; (goto-char (max (point-min)
302 ; (- (point) 4))) 315 ; (- (point) 4)))
303 ; (looking-at " <f>")) 316 ; (looking-at " <f>"))
304 ; (forward-char -4)))) 317 ; (forward-char -4))))
305 ) 318 )
312 new)) 325 new))
313 (setq list (cdr list))) 326 (setq list (cdr list)))
314 (setq list (nreverse new)))) 327 (setq list (nreverse new))))
315 (with-output-to-temp-buffer "*Completions*" 328 (with-output-to-temp-buffer "*Completions*"
316 (display-completion-list list))) 329 (display-completion-list list)))
317 (message "Making completion list...done"))))) 330 (message "Making completion list...%s" "done")))))
318 331
319 ;;; lisp.el ends here 332 ;;; lisp.el ends here