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.
+ − 63 (if (and (> arg 0) (looking-at "#s("))
+ − 64 (goto-char (+ (point) 2)))
+ − 65 (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
+ − 66 (if (< arg 0) (backward-prefix-chars))
+ − 67 ;; XEmacs: evil hack! Skip back over #s so that structures are read
+ − 68 ;; properly. the current cheesified syntax tables just aren't up to
+ − 69 ;; this.
+ − 70 (if (and (< arg 0)
+ − 71 (eq (char-after (point)) ?\()
+ − 72 (>= (- (point) (point-min)) 2)
+ − 73 (eq (char-after (- (point) 1)) ?s)
+ − 74 (eq (char-after (- (point) 2)) ?#))
+ − 75 (goto-char (- (point) 2))))
+ − 76
+ − 77 (defun backward-sexp (&optional arg)
+ − 78 "Move backward across one balanced expression (sexp).
+ − 79 With argument, do it that many times. Negative arg -N means
+ − 80 move forward across N balanced expressions."
+ − 81 ;; XEmacs change (for zmacs regions)
+ − 82 (interactive "_p")
444
+ − 83 (forward-sexp (- (or arg 1))))
428
+ − 84
444
+ − 85 (defun mark-sexp (&optional arg)
428
+ − 86 "Set mark ARG sexps from point.
+ − 87 The place mark goes is the same place \\[forward-sexp] would
+ − 88 move to with the same argument.
+ − 89 Repeat this command to mark more sexps in the same direction."
+ − 90 (interactive "p")
444
+ − 91 (mark-something 'mark-sexp 'forward-sexp (or arg 1)))
428
+ − 92
+ − 93 (defun forward-list (&optional arg)
+ − 94 "Move forward across one balanced group of parentheses.
+ − 95 With argument, do it that many times.
+ − 96 Negative arg -N means move backward across N groups of parentheses."
+ − 97 ;; XEmacs change
+ − 98 (interactive "_p")
444
+ − 99 (goto-char (or (scan-lists (point) (or arg 1) 0) (buffer-end (or arg 1)))))
428
+ − 100
+ − 101 (defun backward-list (&optional arg)
+ − 102 "Move backward across one balanced group of parentheses.
+ − 103 With argument, do it that many times.
+ − 104 Negative arg -N means move forward across N groups of parentheses."
+ − 105 ;; XEmacs change (for zmacs regions)
+ − 106 (interactive "_p")
444
+ − 107 (forward-list (- (or arg 1))))
428
+ − 108
444
+ − 109 (defun down-list (&optional arg)
428
+ − 110 "Move forward down one level of parentheses.
+ − 111 With argument, do this that many times.
444
+ − 112 A negative argument means move backward but still go down a level."
428
+ − 113 ;; XEmacs change (for zmacs regions)
+ − 114 (interactive "_p")
444
+ − 115 (or arg (setq arg 1))
428
+ − 116 (let ((inc (if (> arg 0) 1 -1)))
+ − 117 (while (/= arg 0)
+ − 118 (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
+ − 119 (setq arg (- arg inc)))))
+ − 120
444
+ − 121 (defun backward-up-list (&optional arg)
428
+ − 122 "Move backward out of one level of parentheses.
+ − 123 With argument, do this that many times.
444
+ − 124 A negative argument means move forward but still to a less deep spot."
428
+ − 125 (interactive "_p")
444
+ − 126 (up-list (- (or arg 1))))
428
+ − 127
444
+ − 128 (defun up-list (&optional arg)
428
+ − 129 "Move forward out of one level of parentheses.
+ − 130 With argument, do this that many times.
+ − 131 A negative argument means move backward but still to a less deep spot.
+ − 132 In Lisp programs, an argument is required."
+ − 133 ;; XEmacs change (for zmacs regions)
+ − 134 (interactive "_p")
444
+ − 135 (or arg (setq arg 1))
428
+ − 136 (let ((inc (if (> arg 0) 1 -1)))
+ − 137 (while (/= arg 0)
+ − 138 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
+ − 139 (setq arg (- arg inc)))))
+ − 140
444
+ − 141 (defun kill-sexp (&optional arg)
428
+ − 142 "Kill the sexp (balanced expression) following the cursor.
+ − 143 With argument, kill that many sexps after the cursor.
+ − 144 Negative arg -N means kill N sexps before the cursor."
+ − 145 (interactive "p")
+ − 146 (let ((opoint (point)))
444
+ − 147 (forward-sexp (or arg 1))
428
+ − 148 (kill-region opoint (point))))
+ − 149
444
+ − 150 (defun backward-kill-sexp (&optional arg)
428
+ − 151 "Kill the sexp (balanced expression) preceding the cursor.
+ − 152 With argument, kill that many sexps before the cursor.
+ − 153 Negative arg -N means kill N sexps after the cursor."
+ − 154 (interactive "p")
444
+ − 155 (kill-sexp (- (or arg 1))))
428
+ − 156
+ − 157 (defun beginning-of-defun (&optional arg)
+ − 158 "Move backward to the beginning of a defun.
+ − 159 With argument, do it that many times. Negative arg -N
+ − 160 means move forward to Nth following beginning of defun.
+ − 161 Returns t unless search stops due to beginning or end of buffer.
+ − 162
+ − 163 Normally a defun starts when there is an char with open-parenthesis
+ − 164 syntax at the beginning of a line. If `defun-prompt-regexp' is
+ − 165 non-nil, then a string which matches that regexp may precede the
+ − 166 open-parenthesis, and point ends up at the beginning of the line."
+ − 167 ;; XEmacs change (for zmacs regions)
+ − 168 (interactive "_p")
+ − 169 (and (beginning-of-defun-raw arg)
+ − 170 (progn (beginning-of-line) t)))
+ − 171
+ − 172 (defun beginning-of-defun-raw (&optional arg)
+ − 173 "Move point to the character that starts a defun.
+ − 174 This is identical to beginning-of-defun, except that point does not move
+ − 175 to the beginning of the line when `defun-prompt-regexp' is non-nil."
+ − 176 (interactive "p")
+ − 177 (and arg (< arg 0) (not (eobp)) (forward-char 1))
+ − 178 (and (re-search-backward (if defun-prompt-regexp
+ − 179 (concat "^\\s(\\|"
+ − 180 "\\(" defun-prompt-regexp "\\)\\s(")
+ − 181 "^\\s(")
+ − 182 nil 'move (or arg 1))
+ − 183 (progn (goto-char (1- (match-end 0)))) t))
+ − 184
+ − 185 ;; XEmacs change (optional buffer parameter)
+ − 186 (defun buffer-end (arg &optional buffer)
+ − 187 "Return `point-max' of BUFFER if ARG is > 0; return `point-min' otherwise.
+ − 188 BUFFER defaults to the current buffer if omitted."
+ − 189 (if (> arg 0) (point-max buffer) (point-min buffer)))
+ − 190
+ − 191 (defun end-of-defun (&optional arg)
+ − 192 "Move forward to next end of defun. With argument, do it that many times.
+ − 193 Negative argument -N means move back to Nth preceding end of defun.
+ − 194
+ − 195 An end of a defun occurs right after the close-parenthesis that matches
+ − 196 the open-parenthesis that starts a defun; see `beginning-of-defun'."
+ − 197 ;; XEmacs change (for zmacs regions)
+ − 198 (interactive "_p")
+ − 199 (if (or (null arg) (= arg 0)) (setq arg 1))
+ − 200 (let ((first t))
+ − 201 (while (and (> arg 0) (< (point) (point-max)))
+ − 202 (let ((pos (point))) ; XEmacs -- remove unused npos.
+ − 203 (while (progn
+ − 204 (if (and first
+ − 205 (progn
+ − 206 (end-of-line 1)
+ − 207 (beginning-of-defun-raw 1)))
+ − 208 nil
446
+ − 209 (or (bobp) (backward-char 1))
428
+ − 210 (beginning-of-defun-raw -1))
+ − 211 (setq first nil)
+ − 212 (forward-list 1)
+ − 213 (skip-chars-forward " \t")
+ − 214 (if (looking-at "\\s<\\|\n")
+ − 215 (forward-line 1))
+ − 216 (<= (point) pos))))
+ − 217 (setq arg (1- arg)))
+ − 218 (while (< arg 0)
+ − 219 (let ((pos (point)))
+ − 220 (beginning-of-defun-raw 1)
+ − 221 (forward-sexp 1)
+ − 222 (forward-line 1)
+ − 223 (if (>= (point) pos)
+ − 224 (if (beginning-of-defun-raw 2)
+ − 225 (progn
+ − 226 (forward-list 1)
+ − 227 (skip-chars-forward " \t")
+ − 228 (if (looking-at "\\s<\\|\n")
+ − 229 (forward-line 1)))
+ − 230 (goto-char (point-min)))))
+ − 231 (setq arg (1+ arg)))))
+ − 232
+ − 233 (defun mark-defun ()
+ − 234 "Put mark at end of this defun, point at beginning.
+ − 235 The defun marked is the one that contains point or follows point."
+ − 236 (interactive)
+ − 237 (push-mark (point))
+ − 238 (end-of-defun)
+ − 239 (push-mark (point) nil t)
+ − 240 (beginning-of-defun)
+ − 241 (re-search-backward "^\n" (- (point) 1) t))
+ − 242
+ − 243 (defun narrow-to-defun (&optional arg)
+ − 244 "Make text outside current defun invisible.
+ − 245 The defun visible is the one that contains point or follows point."
+ − 246 (interactive)
+ − 247 (save-excursion
+ − 248 (widen)
+ − 249 (end-of-defun)
+ − 250 (let ((end (point)))
+ − 251 (beginning-of-defun)
+ − 252 (narrow-to-region (point) end))))
+ − 253
+ − 254 (defun insert-parentheses (arg)
+ − 255 "Enclose following ARG sexps in parentheses. Leave point after open-paren.
+ − 256 A negative ARG encloses the preceding ARG sexps instead.
+ − 257 No argument is equivalent to zero: just insert `()' and leave point between.
+ − 258 If `parens-require-spaces' is non-nil, this command also inserts a space
+ − 259 before and after, depending on the surrounding characters."
+ − 260 (interactive "P")
+ − 261 (if arg (setq arg (prefix-numeric-value arg))
+ − 262 (setq arg 0))
+ − 263 (cond ((> arg 0) (skip-chars-forward " \t"))
+ − 264 ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
+ − 265 (and parens-require-spaces
+ − 266 (not (bobp))
+ − 267 (memq (char-syntax (char-before (point))) '(?w ?_ ?\) ))
+ − 268 (insert " "))
+ − 269 (insert ?\()
+ − 270 (save-excursion
+ − 271 (or (eq arg 0) (forward-sexp arg))
+ − 272 (insert ?\))
+ − 273 (and parens-require-spaces
+ − 274 (not (eobp))
+ − 275 (memq (char-syntax (char-after (point))) '(?w ?_ ?\( ))
+ − 276 (insert " "))))
+ − 277
+ − 278 (defun move-past-close-and-reindent ()
+ − 279 "Move past next `)', delete indentation before it, then indent after it."
+ − 280 (interactive)
+ − 281 (up-list 1)
446
+ − 282 (backward-char 1)
428
+ − 283 (while (save-excursion ; this is my contribution
+ − 284 (let ((before-paren (point)))
+ − 285 (back-to-indentation)
+ − 286 (= (point) before-paren)))
+ − 287 (delete-indentation))
+ − 288 (forward-char 1)
+ − 289 (newline-and-indent))
+ − 290
+ − 291 (defun lisp-complete-symbol ()
+ − 292 "Perform completion on Lisp symbol preceding point.
+ − 293 Compare that symbol against the known Lisp symbols.
+ − 294
+ − 295 The context determines which symbols are considered.
+ − 296 If the symbol starts just after an open-parenthesis, only symbols
+ − 297 with function definitions are considered. Otherwise, all symbols with
+ − 298 function definitions, values or properties are considered."
+ − 299 (interactive)
+ − 300 (let* ((end (point))
+ − 301 (buffer-syntax (syntax-table))
+ − 302 (beg (unwind-protect
+ − 303 (save-excursion
+ − 304 ;; XEmacs change
+ − 305 (if emacs-lisp-mode-syntax-table
+ − 306 (set-syntax-table emacs-lisp-mode-syntax-table))
+ − 307 (backward-sexp 1)
+ − 308 (while (eq (char-syntax (char-after (point))) ?\')
+ − 309 (forward-char 1))
+ − 310 (point))
+ − 311 (set-syntax-table buffer-syntax)))
+ − 312 (pattern (buffer-substring beg end))
+ − 313 (predicate
+ − 314 (if (eq (char-after (1- beg)) ?\()
+ − 315 'fboundp
+ − 316 ;; XEmacs change
+ − 317 #'(lambda (sym)
+ − 318 (or (boundp sym) (fboundp sym)
+ − 319 (symbol-plist sym)))))
+ − 320 (completion (try-completion pattern obarray predicate)))
+ − 321 (cond ((eq completion t))
+ − 322 ((null completion)
+ − 323 (message "Can't find completion for \"%s\"" pattern)
+ − 324 (ding))
+ − 325 ((not (string= pattern completion))
+ − 326 (delete-region beg end)
+ − 327 (insert completion))
+ − 328 (t
+ − 329 (message "Making completion list...")
+ − 330 (let ((list (all-completions pattern obarray predicate))
+ − 331 ;FSFmacs crock unnecessary in XEmacs
+ − 332 ;see minibuf.el
+ − 333 ;(completion-fixup-function
+ − 334 ; (function (lambda () (if (save-excursion
+ − 335 ; (goto-char (max (point-min)
+ − 336 ; (- (point) 4)))
+ − 337 ; (looking-at " <f>"))
+ − 338 ; (forward-char -4))))
+ − 339 )
+ − 340 (or (eq predicate 'fboundp)
+ − 341 (let (new)
+ − 342 (while list
+ − 343 (setq new (cons (if (fboundp (intern (car list)))
+ − 344 (list (car list) " <f>")
+ − 345 (car list))
+ − 346 new))
+ − 347 (setq list (cdr list)))
+ − 348 (setq list (nreverse new))))
+ − 349 (with-output-to-temp-buffer "*Completions*"
+ − 350 (display-completion-list list)))
+ − 351 (message "Making completion list...%s" "done")))))
+ − 352
+ − 353 ;;; lisp.el ends here