![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lisp.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to lisp.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Lisp editing commands for Emacs
2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20:
21: (defun forward-sexp (&optional arg)
22: "Move forward across one balanced expression.
23: With argument, do this that many times."
24: (interactive "p")
25: (or arg (setq arg 1))
26: (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
27: (if (< arg 0) (backward-prefix-chars)))
28:
29: (defun backward-sexp (&optional arg)
30: "Move backward across one balanced expression.
31: With argument, do this that many times."
32: (interactive "p")
33: (or arg (setq arg 1))
34: (forward-sexp (- arg)))
35:
36: (defun mark-sexp (arg)
37: "Set mark ARG sexps from point."
38: (interactive "p")
39: (push-mark
40: (save-excursion
41: (forward-sexp arg)
42: (point))))
43:
44: (defun forward-list (&optional arg)
45: "Move forward across one balanced group of parentheses.
46: With argument, do this that many times."
47: (interactive "p")
48: (or arg (setq arg 1))
49: (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
50:
51: (defun backward-list (&optional arg)
52: "Move backward across one balanced group of parentheses.
53: With argument, do this that many times."
54: (interactive "p")
55: (or arg (setq arg 1))
56: (forward-list (- arg)))
57:
58: (defun down-list (arg)
59: "Move forward down one level of parentheses.
60: With argument, do this that many times.
61: A negative argument means move backward but still go down a level."
62: (interactive "p")
63: (let ((inc (if (> arg 0) 1 -1)))
64: (while (/= arg 0)
65: (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
66: (setq arg (- arg inc)))))
67:
68: (defun backward-up-list (arg)
69: "Move backward out of one level of parentheses.
70: With argument, do this that many times.
71: A negative argument means move forward but still to a less deep spot."
72: (interactive "p")
73: (up-list (- arg)))
74:
75: (defun up-list (arg)
76: "Move forward out of one level of parentheses.
77: With argument, do this that many times.
78: A negative argument means move backward but still to a less deep spot."
79: (interactive "p")
80: (let ((inc (if (> arg 0) 1 -1)))
81: (while (/= arg 0)
82: (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
83: (setq arg (- arg inc)))))
84:
85: (defun kill-sexp (arg)
86: "Kill the syntactic expression following the cursor.
87: With argument, kill that many expressions after (or before) the cursor."
88: (interactive "p")
89: (let ((opoint (point)))
90: (forward-sexp arg)
91: (kill-region opoint (point))))
92:
93: (defun backward-kill-sexp (arg)
94: "Kill the syntactic expression preceding the cursor.
95: With argument, kill that many expressions before (or after) the cursor."
96: (interactive "p")
97: (kill-sexp (- arg)))
98:
99: (defun beginning-of-defun (&optional arg)
100: "Move backward to next beginning-of-defun.
101: With argument, do this that many times.
102: Returns t unless search stops due to end of buffer."
103: (interactive "p")
104: (and arg (< arg 0) (forward-char 1))
105: (and (re-search-backward "^\\s(" nil 'move (or arg 1))
106: (progn (beginning-of-line) t)))
107:
108: (defun buffer-end (arg)
109: (if (> arg 0) (point-max) (point-min)))
110:
111: (defun end-of-defun (&optional arg)
112: "Move forward to next end of defun.
113: An end of a defun is found by moving forward from the beginning of one."
114: (interactive "p")
115: (if (or (null arg) (= arg 0)) (setq arg 1))
116: (let ((first t))
117: (while (and (> arg 0) (< (point) (point-max)))
118: (let ((pos (point)) npos)
119: (while (progn
120: (if (and first
121: (progn
122: (forward-char 1)
123: (beginning-of-defun 1)))
124: nil
125: (or (bobp) (forward-char -1))
126: (beginning-of-defun -1))
127: (setq first nil)
128: (forward-list 1)
129: (skip-chars-forward " \t")
130: (if (looking-at "[;\n]")
131: (forward-line 1))
132: (<= (point) pos))))
133: (setq arg (1- arg)))
134: (while (< arg 0)
135: (let ((pos (point)))
136: (beginning-of-defun 1)
137: (forward-sexp 1)
138: (forward-line 1)
139: (if (>= (point) pos)
140: (if (beginning-of-defun 2)
141: (progn
142: (forward-list 1)
143: (skip-chars-forward " \t")
144: (if (looking-at "[;\n]")
145: (forward-line 1)))
146: (goto-char (point-min)))))
147: (setq arg (1+ arg)))))
148:
149: (defun mark-defun ()
150: "Put mark at end of defun, point at beginning."
151: (interactive)
152: (push-mark (point))
153: (end-of-defun)
154: (push-mark (point))
155: (beginning-of-defun)
156: (re-search-backward "^\n" (- (point) 1) t))
157:
158: (defun insert-parentheses (arg)
159: "Put parentheses around next ARG sexps. Leave point after open-paren.
160: No argument is equivalent to zero: just insert () and leave point between."
161: (interactive "P")
162: ;Install these commented-out lines for version 19.
163: ; (if arg (skip-chars-forward " \t")
164: ; (or (memq (char-syntax (preceding-char)) '(?\ ?> ?\( ))
165: ; (insert " ")))
166: (insert ?\()
167: (save-excursion
168: (if arg
169: (forward-sexp (prefix-numeric-value arg)))
170: (insert ?\))
171: ; (or (memq (char-syntax (following-char)) '(?\ ?> ?\( ))
172: ; (insert " "))
173: ))
174:
175: (defun move-past-close-and-reindent ()
176: "Move past next ), delete indentation before it, then indent after it."
177: (interactive)
178: (up-list 1)
179: (forward-char -1)
180: (while (save-excursion ; this is my contribution
181: (let ((before-paren (point)))
182: (back-to-indentation)
183: (= (point) before-paren)))
184: (delete-indentation))
185: (forward-char 1)
186: (newline-and-indent))
187:
188: (defun lisp-complete-symbol ()
189: "Perform completion on Lisp symbol preceding point.
190: That symbol is compared against the symbols that exist
191: and any additional characters determined by what is there
192: are inserted.
193: If the symbol starts just after an open-parenthesis,
194: only symbols with function definitions are considered.
195: Otherwise, all symbols with function definitions, values
196: or properties are considered."
197: (interactive)
198: (let* ((end (point))
199: (buffer-syntax (syntax-table))
200: (beg (unwind-protect
201: (save-excursion
202: (set-syntax-table emacs-lisp-mode-syntax-table)
203: (backward-sexp 1)
204: (while (= (char-syntax (following-char)) ?\')
205: (forward-char 1))
206: (point))
207: (set-syntax-table buffer-syntax)))
208: (pattern (buffer-substring beg end))
209: (predicate
210: (if (eq (char-after (1- beg)) ?\()
211: 'fboundp
212: (function (lambda (sym)
213: (or (boundp sym) (fboundp sym)
214: (symbol-plist sym))))))
215: (completion (try-completion pattern obarray predicate)))
216: (cond ((eq completion t))
217: ((null completion)
218: (message "Can't find completion for \"%s\"" pattern)
219: (ding))
220: ((not (string= pattern completion))
221: (delete-region beg end)
222: (insert completion))
223: (t
224: (message "Making completion list...")
225: (let ((list (all-completions pattern obarray predicate)))
226: (or (eq predicate 'fboundp)
227: (let (new)
228: (while list
229: (setq new (cons (if (fboundp (intern (car list)))
230: (list (car list) " <f>")
231: (car list))
232: new))
233: (setq list (cdr list)))
234: (setq list (nreverse new))))
235: (with-output-to-temp-buffer " *Completions*"
236: (display-completion-list list)))
237: (message "Making completion list...%s" "done")))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.