![[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 [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to lisp.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (defun forward-sexp (&optional arg)
23: "Move forward across one balanced expression.
24: With argument, do this that many times."
25: (interactive "p")
26: (or arg (setq arg 1))
27: (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
28: (if (< arg 0) (backward-prefix-chars)))
29:
30: (defun backward-sexp (&optional arg)
31: "Move backward across one balanced expression.
32: With argument, do this that many times."
33: (interactive "p")
34: (or arg (setq arg 1))
35: (forward-sexp (- arg)))
36:
37: (defun mark-sexp (arg)
38: "Set mark ARG sexps from point."
39: (interactive "p")
40: (push-mark
41: (save-excursion
42: (forward-sexp arg)
43: (point))))
44:
45: (defun forward-list (&optional arg)
46: "Move forward across one balanced group of parentheses.
47: With argument, do this that many times."
48: (interactive "p")
49: (or arg (setq arg 1))
50: (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
51:
52: (defun backward-list (&optional arg)
53: "Move backward across one balanced group of parentheses.
54: With argument, do this that many times."
55: (interactive "p")
56: (or arg (setq arg 1))
57: (forward-list (- arg)))
58:
59: (defun down-list (arg)
60: "Move forward down one level of parentheses.
61: With argument, do this that many times.
62: A negative argument means move backward but still go down a level."
63: (interactive "p")
64: (let ((inc (if (> arg 0) 1 -1)))
65: (while (/= arg 0)
66: (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
67: (setq arg (- arg inc)))))
68:
69: (defun backward-up-list (arg)
70: "Move backward out of one level of parentheses.
71: With argument, do this that many times.
72: A negative argument means move forward but still to a less deep spot."
73: (interactive "p")
74: (up-list (- arg)))
75:
76: (defun up-list (arg)
77: "Move forward out of one level of parentheses.
78: With argument, do this that many times.
79: A negative argument means move backward but still to a less deep spot."
80: (interactive "p")
81: (let ((inc (if (> arg 0) 1 -1)))
82: (while (/= arg 0)
83: (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
84: (setq arg (- arg inc)))))
85:
86: (defun kill-sexp (arg)
87: "Kill the syntactic expression following the cursor.
88: With argument, kill that many expressions after (or before) the cursor."
89: (interactive "p")
90: (let ((opoint (point)))
91: (forward-sexp arg)
92: (kill-region opoint (point))))
93:
94: (defun backward-kill-sexp (arg)
95: "Kill the syntactic expression preceding the cursor.
96: With argument, kill that many expressions before (or after) the cursor."
97: (interactive "p")
98: (kill-sexp (- arg)))
99:
100: (defun beginning-of-defun (&optional arg)
101: "Move backward to next beginning-of-defun.
102: With argument, do this that many times.
103: Returns t unless search stops due to end of buffer."
104: (interactive "p")
105: (and arg (< arg 0) (forward-char 1))
106: (and (re-search-backward "^\\s(" nil 'move (or arg 1))
107: (progn (beginning-of-line) t)))
108:
109: (defun buffer-end (arg)
110: (if (> arg 0) (point-max) (point-min)))
111:
112: (defun end-of-defun (&optional arg)
113: "Move forward to next end of defun.
114: An end of a defun is found by moving forward from the beginning of one."
115: (interactive "p")
116: (if (or (null arg) (= arg 0)) (setq arg 1))
117: (let ((first t))
118: (while (and (> arg 0) (< (point) (point-max)))
119: (let ((pos (point)) npos)
120: (while (progn
121: (if (and first
122: (progn
123: (forward-char 1)
124: (beginning-of-defun 1)))
125: nil
126: (or (bobp) (forward-char -1))
127: (beginning-of-defun -1))
128: (setq first nil)
129: (forward-list 1)
130: (skip-chars-forward " \t")
131: (if (looking-at "[;\n]")
132: (forward-line 1))
133: (<= (point) pos))))
134: (setq arg (1- arg)))
135: (while (< arg 0)
136: (let ((pos (point)))
137: (beginning-of-defun 1)
138: (forward-sexp 1)
139: (forward-line 1)
140: (if (>= (point) pos)
141: (if (beginning-of-defun 2)
142: (progn
143: (forward-list 1)
144: (skip-chars-forward " \t")
145: (if (looking-at "[;\n]")
146: (forward-line 1)))
147: (goto-char (point-min)))))
148: (setq arg (1+ arg)))))
149:
150: (defun mark-defun ()
151: "Put mark at end of defun, point at beginning."
152: (interactive)
153: (push-mark (point))
154: (end-of-defun)
155: (push-mark (point))
156: (beginning-of-defun)
157: (re-search-backward "^\n" (- (point) 1) t))
158:
159: (defun insert-parentheses (arg)
160: "Put parentheses around next ARG sexps. Leave point after open-paren.
161: No argument is equivalent to zero: just insert () and leave point between."
162: (interactive "P")
163: ;Install these commented-out lines for version 19.
164: ; (if arg (skip-chars-forward " \t")
165: ; (or (memq (char-syntax (preceding-char)) '(?\ ?> ?\( ))
166: ; (insert " ")))
167: (insert ?\()
168: (save-excursion
169: (if arg
170: (forward-sexp (prefix-numeric-value arg)))
171: (insert ?\))
172: ; (or (memq (char-syntax (following-char)) '(?\ ?> ?\( ))
173: ; (insert " "))
174: ))
175:
176: (defun move-past-close-and-reindent ()
177: "Move past next ), delete indentation before it, then indent after it."
178: (interactive)
179: (up-list 1)
180: (forward-char -1)
181: (while (save-excursion ; this is my contribution
182: (let ((before-paren (point)))
183: (back-to-indentation)
184: (= (point) before-paren)))
185: (delete-indentation))
186: (forward-char 1)
187: (newline-and-indent))
188:
189: (defun lisp-complete-symbol ()
190: "Perform completion on Lisp symbol preceding point.
191: That symbol is compared against the symbols that exist
192: and any additional characters determined by what is there
193: are inserted.
194: If the symbol starts just after an open-parenthesis,
195: only symbols with function definitions are considered.
196: Otherwise, all symbols with function definitions, values
197: or properties are considered."
198: (interactive)
199: (let* ((end (point))
200: (beg (save-excursion
201: (backward-sexp 1)
202: (while (= (char-syntax (following-char)) ?\')
203: (forward-char 1))
204: (point)))
205: (pattern (buffer-substring beg end))
206: (predicate
207: (if (eq (char-after (1- beg)) ?\()
208: 'fboundp
209: (function (lambda (sym)
210: (or (boundp sym) (fboundp sym)
211: (symbol-plist sym))))))
212: (completion (try-completion pattern obarray predicate)))
213: (cond ((eq completion t))
214: ((null completion)
215: (message "Can't find completion for \"%s\"" pattern)
216: (ding))
217: ((not (string= pattern completion))
218: (delete-region beg end)
219: (insert completion))
220: (t
221: (message "Making completion list...")
222: (let ((list (all-completions pattern obarray predicate)))
223: (or (eq predicate 'fboundp)
224: (let (new)
225: (while list
226: (setq new (cons (if (fboundp (intern (car list)))
227: (list (car list) " <f>")
228: (car list))
229: new))
230: (setq list (cdr list)))
231: (setq list (nreverse new))))
232: (with-output-to-temp-buffer "*Help*"
233: (display-completion-list list)))
234: (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.