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