Commit | Line | Data |
---|---|---|
481fa7aa C |
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 | \f | |
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 | \f | |
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"))))) |