|
658
|
1 ;;; simple.el --- basic editing commands for Emacs
|
|
|
2
|
|
35346
|
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
|
|
17663
|
4 ;; Free Software Foundation, Inc.
|
|
475
|
5
|
|
|
6 ;; This file is part of GNU Emacs.
|
|
|
7
|
|
|
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
9 ;; it under the terms of the GNU General Public License as published by
|
|
846
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
475
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
16 ;; GNU General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
14169
|
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
21 ;; Boston, MA 02111-1307, USA.
|
|
475
|
22
|
|
2315
|
23 ;;; Commentary:
|
|
|
24
|
|
|
25 ;; A grab-bag of basic Emacs commands not specifically related to some
|
|
|
26 ;; major mode or to file-handling.
|
|
|
27
|
|
846
|
28 ;;; Code:
|
|
475
|
29
|
|
26466
|
30 (eval-when-compile
|
|
30820
|
31 (autoload 'widget-convert "wid-edit")
|
|
31573
|
32 (autoload 'shell-mode "shell")
|
|
26466
|
33 (require 'cl))
|
|
|
34
|
|
|
35
|
|
17663
|
36 (defgroup killing nil
|
|
|
37 "Killing and yanking commands"
|
|
|
38 :group 'editing)
|
|
|
39
|
|
|
40 (defgroup paren-matching nil
|
|
|
41 "Highlight (un)matching of parens and expressions."
|
|
|
42 :group 'matching)
|
|
|
43
|
|
|
44
|
|
25292
|
45 (defun fundamental-mode ()
|
|
|
46 "Major mode not specialized for anything in particular.
|
|
|
47 Other major modes are defined by comparison with this one."
|
|
|
48 (interactive)
|
|
|
49 (kill-all-local-variables))
|
|
33786
|
50
|
|
25292
|
51 ;; Making and deleting lines.
|
|
|
52
|
|
10863
|
53 (defun newline (&optional arg)
|
|
11324
|
54 "Insert a newline, and move to left margin of the new line if it's blank.
|
|
10863
|
55 The newline is marked with the text-property `hard'.
|
|
31978
|
56 With ARG, insert that many newlines.
|
|
10863
|
57 In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
|
|
|
58 (interactive "*P")
|
|
13137
|
59 (barf-if-buffer-read-only)
|
|
10863
|
60 ;; Inserting a newline at the end of a line produces better redisplay in
|
|
|
61 ;; try_window_id than inserting at the beginning of a line, and the textual
|
|
|
62 ;; result is the same. So, if we're at beginning of line, pretend to be at
|
|
|
63 ;; the end of the previous line.
|
|
26457
|
64 (let ((flag (and (not (bobp))
|
|
10863
|
65 (bolp)
|
17214
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
66 ;; Make sure no functions want to be told about
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
67 ;; the range of the changes.
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
68 (not after-change-functions)
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
69 (not before-change-functions)
|
|
16417
|
70 ;; Make sure there are no markers here.
|
|
|
71 (not (buffer-has-markers-at (1- (point))))
|
|
21459
|
72 (not (buffer-has-markers-at (point)))
|
17214
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
73 ;; Make sure no text properties want to know
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
74 ;; where the change was.
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
75 (not (get-char-property (1- (point)) 'modification-hooks))
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
76 (not (get-char-property (1- (point)) 'insert-behind-hooks))
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
77 (or (eobp)
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
78 (not (get-char-property (point) 'insert-in-front-hooks)))
|
|
15605
|
79 ;; Make sure the newline before point isn't intangible.
|
|
|
80 (not (get-char-property (1- (point)) 'intangible))
|
|
|
81 ;; Make sure the newline before point isn't read-only.
|
|
|
82 (not (get-char-property (1- (point)) 'read-only))
|
|
|
83 ;; Make sure the newline before point isn't invisible.
|
|
|
84 (not (get-char-property (1- (point)) 'invisible))
|
|
|
85 ;; Make sure the newline before point has the same
|
|
|
86 ;; properties as the char before it (if any).
|
|
26457
|
87 (< (or (previous-property-change (point)) -2)
|
|
11324
|
88 (- (point) 2))))
|
|
|
89 (was-page-start (and (bolp)
|
|
|
90 (looking-at page-delimiter)))
|
|
|
91 (beforepos (point)))
|
|
10863
|
92 (if flag (backward-char 1))
|
|
|
93 ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
|
|
|
94 ;; Set last-command-char to tell self-insert what to insert.
|
|
|
95 (let ((last-command-char ?\n)
|
|
|
96 ;; Don't auto-fill if we have a numeric argument.
|
11362
b51e4c4cb0de
(newline): Don't auto-fill if flag is on; it was filling wrong line.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
97 ;; Also not if flag is true (it would fill wrong line);
|
b51e4c4cb0de
(newline): Don't auto-fill if flag is on; it was filling wrong line.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
98 ;; there is no need to since we're at BOL.
|
b51e4c4cb0de
(newline): Don't auto-fill if flag is on; it was filling wrong line.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
99 (auto-fill-function (if (or arg flag) nil auto-fill-function)))
|
|
12400
|
100 (unwind-protect
|
|
|
101 (self-insert-command (prefix-numeric-value arg))
|
|
|
102 ;; If we get an error in self-insert-command, put point at right place.
|
|
|
103 (if flag (forward-char 1))))
|
|
21459
|
104 ;; Even if we did *not* get an error, keep that forward-char;
|
|
|
105 ;; all further processing should apply to the newline that the user
|
|
|
106 ;; thinks he inserted.
|
|
|
107
|
|
10863
|
108 ;; Mark the newline(s) `hard'.
|
|
|
109 (if use-hard-newlines
|
|
21459
|
110 (set-hard-newline-properties
|
|
16018
|
111 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
|
|
11324
|
112 ;; If the newline leaves the previous line blank,
|
|
|
113 ;; and we have a left margin, delete that from the blank line.
|
|
|
114 (or flag
|
|
|
115 (save-excursion
|
|
|
116 (goto-char beforepos)
|
|
|
117 (beginning-of-line)
|
|
|
118 (and (looking-at "[ \t]$")
|
|
|
119 (> (current-left-margin) 0)
|
|
|
120 (delete-region (point) (progn (end-of-line) (point))))))
|
|
|
121 ;; Indent the line after the newline, except in one case:
|
|
|
122 ;; when we added the newline at the beginning of a line
|
|
|
123 ;; which starts a page.
|
|
|
124 (or was-page-start
|
|
|
125 (move-to-left-margin nil t)))
|
|
10863
|
126 nil)
|
|
|
127
|
|
16018
|
128 (defun set-hard-newline-properties (from to)
|
|
|
129 (let ((sticky (get-text-property from 'rear-nonsticky)))
|
|
|
130 (put-text-property from to 'hard 't)
|
|
|
131 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
|
|
|
132 (if (and (listp sticky) (not (memq 'hard sticky)))
|
|
|
133 (put-text-property from (point) 'rear-nonsticky
|
|
|
134 (cons 'hard sticky)))))
|
|
33786
|
135
|
|
475
|
136 (defun open-line (arg)
|
|
1027
|
137 "Insert a newline and leave point before it.
|
|
10813
|
138 If there is a fill prefix and/or a left-margin, insert them on the new line
|
|
11324
|
139 if the line would have been blank.
|
|
1063
|
140 With arg N, insert N newlines."
|
|
475
|
141 (interactive "*p")
|
|
1063
|
142 (let* ((do-fill-prefix (and fill-prefix (bolp)))
|
|
10813
|
143 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
|
|
35589
|
144 (loc (point))
|
|
|
145 ;; Don't expand an abbrev before point.
|
|
|
146 (abbrev-mode nil))
|
|
11324
|
147 (newline arg)
|
|
|
148 (goto-char loc)
|
|
10422
|
149 (while (> arg 0)
|
|
11324
|
150 (cond ((bolp)
|
|
|
151 (if do-left-margin (indent-to (current-left-margin)))
|
|
|
152 (if do-fill-prefix (insert-and-inherit fill-prefix))))
|
|
|
153 (forward-line 1)
|
|
10422
|
154 (setq arg (1- arg)))
|
|
11324
|
155 (goto-char loc)
|
|
|
156 (end-of-line)))
|
|
475
|
157
|
|
|
158 (defun split-line ()
|
|
|
159 "Split current line, moving portion beyond point vertically down."
|
|
|
160 (interactive "*")
|
|
|
161 (skip-chars-forward " \t")
|
|
|
162 (let ((col (current-column))
|
|
|
163 (pos (point)))
|
|
10422
|
164 (newline 1)
|
|
475
|
165 (indent-to col 0)
|
|
|
166 (goto-char pos)))
|
|
|
167
|
|
|
168 (defun delete-indentation (&optional arg)
|
|
|
169 "Join this line to previous and fix up whitespace at join.
|
|
892
|
170 If there is a fill prefix, delete it from the beginning of this line.
|
|
475
|
171 With argument, join this line to following line."
|
|
|
172 (interactive "*P")
|
|
|
173 (beginning-of-line)
|
|
|
174 (if arg (forward-line 1))
|
|
|
175 (if (eq (preceding-char) ?\n)
|
|
|
176 (progn
|
|
|
177 (delete-region (point) (1- (point)))
|
|
892
|
178 ;; If the second line started with the fill prefix,
|
|
|
179 ;; delete the prefix.
|
|
|
180 (if (and fill-prefix
|
|
1276
|
181 (<= (+ (point) (length fill-prefix)) (point-max))
|
|
892
|
182 (string= fill-prefix
|
|
|
183 (buffer-substring (point)
|
|
|
184 (+ (point) (length fill-prefix)))))
|
|
|
185 (delete-region (point) (+ (point) (length fill-prefix))))
|
|
475
|
186 (fixup-whitespace))))
|
|
|
187
|
|
24078
|
188 (defalias 'join-line #'delete-indentation) ; easier to find
|
|
33786
|
189
|
|
475
|
190 (defun delete-blank-lines ()
|
|
|
191 "On blank line, delete all surrounding blank lines, leaving just one.
|
|
|
192 On isolated blank line, delete that one.
|
|
7817
|
193 On nonblank line, delete any immediately following blank lines."
|
|
475
|
194 (interactive "*")
|
|
|
195 (let (thisblank singleblank)
|
|
|
196 (save-excursion
|
|
|
197 (beginning-of-line)
|
|
|
198 (setq thisblank (looking-at "[ \t]*$"))
|
|
715
|
199 ;; Set singleblank if there is just one blank line here.
|
|
475
|
200 (setq singleblank
|
|
|
201 (and thisblank
|
|
|
202 (not (looking-at "[ \t]*\n[ \t]*$"))
|
|
|
203 (or (bobp)
|
|
|
204 (progn (forward-line -1)
|
|
|
205 (not (looking-at "[ \t]*$")))))))
|
|
715
|
206 ;; Delete preceding blank lines, and this one too if it's the only one.
|
|
475
|
207 (if thisblank
|
|
|
208 (progn
|
|
|
209 (beginning-of-line)
|
|
|
210 (if singleblank (forward-line 1))
|
|
|
211 (delete-region (point)
|
|
|
212 (if (re-search-backward "[^ \t\n]" nil t)
|
|
|
213 (progn (forward-line 1) (point))
|
|
|
214 (point-min)))))
|
|
715
|
215 ;; Delete following blank lines, unless the current line is blank
|
|
|
216 ;; and there are no following blank lines.
|
|
475
|
217 (if (not (and thisblank singleblank))
|
|
|
218 (save-excursion
|
|
|
219 (end-of-line)
|
|
|
220 (forward-line 1)
|
|
|
221 (delete-region (point)
|
|
|
222 (if (re-search-forward "[^ \t\n]" nil t)
|
|
|
223 (progn (beginning-of-line) (point))
|
|
715
|
224 (point-max)))))
|
|
|
225 ;; Handle the special case where point is followed by newline and eob.
|
|
|
226 ;; Delete the line, leaving point at eob.
|
|
|
227 (if (looking-at "^[ \t]*\n\\'")
|
|
|
228 (delete-region (point) (point-max)))))
|
|
475
|
229
|
|
33786
|
230 (defun delete-trailing-whitespace ()
|
|
|
231 "Delete all the trailing whitespace across the current buffer.
|
|
|
232 All whitespace after the last non-whitespace character in a line is deleted.
|
|
36030
|
233 This respects narrowing, created by \\[narrow-to-region] and friends.
|
|
|
234 A formfeed is not considered whitespace by this function."
|
|
33786
|
235 (interactive "*")
|
|
|
236 (save-match-data
|
|
|
237 (save-excursion
|
|
|
238 (goto-char (point-min))
|
|
34141
|
239 (while (re-search-forward "\\s-$" nil t)
|
|
|
240 (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
|
|
35709
|
241 ;; Don't delete formfeeds, even if they are considered whitespace.
|
|
|
242 (if (looking-at ".*\f")
|
|
|
243 (goto-char (match-end 0)))
|
|
34619
|
244 (delete-region (point) (match-end 0))))))
|
|
33786
|
245
|
|
475
|
246 (defun newline-and-indent ()
|
|
|
247 "Insert a newline, then indent according to major mode.
|
|
1027
|
248 Indentation is done using the value of `indent-line-function'.
|
|
475
|
249 In programming language modes, this is the same as TAB.
|
|
1027
|
250 In some text modes, where TAB inserts a tab, this command indents to the
|
|
10469
|
251 column specified by the function `current-left-margin'."
|
|
475
|
252 (interactive "*")
|
|
34462
|
253 (delete-horizontal-space t)
|
|
617
|
254 (newline)
|
|
475
|
255 (indent-according-to-mode))
|
|
|
256
|
|
|
257 (defun reindent-then-newline-and-indent ()
|
|
|
258 "Reindent current line, insert newline, then indent the new line.
|
|
|
259 Indentation of both lines is done according to the current major mode,
|
|
1027
|
260 which means calling the current value of `indent-line-function'.
|
|
475
|
261 In programming language modes, this is the same as TAB.
|
|
|
262 In some text modes, where TAB inserts a tab, this indents to the
|
|
10469
|
263 column specified by the function `current-left-margin'."
|
|
475
|
264 (interactive "*")
|
|
|
265 (save-excursion
|
|
34462
|
266 (delete-horizontal-space t)
|
|
475
|
267 (indent-according-to-mode))
|
|
617
|
268 (newline)
|
|
475
|
269 (indent-according-to-mode))
|
|
33786
|
270
|
|
25292
|
271 (defun quoted-insert (arg)
|
|
|
272 "Read next input character and insert it.
|
|
|
273 This is useful for inserting control characters.
|
|
|
274
|
|
|
275 If the first character you type after this command is an octal digit,
|
|
|
276 you should type a sequence of octal digits which specify a character code.
|
|
|
277 Any nondigit terminates the sequence. If the terminator is a RET,
|
|
|
278 it is discarded; any other terminator is used itself as input.
|
|
|
279 The variable `read-quoted-char-radix' specifies the radix for this feature;
|
|
|
280 set it to 10 or 16 to use decimal or hex instead of octal.
|
|
|
281
|
|
|
282 In overwrite mode, this function inserts the character anyway, and
|
|
|
283 does not handle octal digits specially. This means that if you use
|
|
|
284 overwrite as your normal editing mode, you can use this function to
|
|
|
285 insert characters when necessary.
|
|
|
286
|
|
|
287 In binary overwrite mode, this function does overwrite, and octal
|
|
|
288 digits are interpreted as a character code. This is intended to be
|
|
|
289 useful for editing binary files."
|
|
|
290 (interactive "*p")
|
|
|
291 (let ((char (if (or (not overwrite-mode)
|
|
|
292 (eq overwrite-mode 'overwrite-mode-binary))
|
|
|
293 (read-quoted-char)
|
|
|
294 (read-char))))
|
|
|
295 ;; Assume character codes 0240 - 0377 stand for characters in some
|
|
|
296 ;; single-byte character set, and convert them to Emacs
|
|
|
297 ;; characters.
|
|
|
298 (if (and enable-multibyte-characters
|
|
|
299 (>= char ?\240)
|
|
|
300 (<= char ?\377))
|
|
|
301 (setq char (unibyte-char-to-multibyte char)))
|
|
|
302 (if (> arg 0)
|
|
|
303 (if (eq overwrite-mode 'overwrite-mode-binary)
|
|
|
304 (delete-char arg)))
|
|
|
305 (while (> arg 0)
|
|
|
306 (insert-and-inherit char)
|
|
|
307 (setq arg (1- arg)))))
|
|
33786
|
308
|
|
25292
|
309 (defun forward-to-indentation (arg)
|
|
|
310 "Move forward ARG lines and position at first nonblank character."
|
|
|
311 (interactive "p")
|
|
|
312 (forward-line arg)
|
|
|
313 (skip-chars-forward " \t"))
|
|
|
314
|
|
|
315 (defun backward-to-indentation (arg)
|
|
|
316 "Move backward ARG lines and position at first nonblank character."
|
|
|
317 (interactive "p")
|
|
|
318 (forward-line (- arg))
|
|
|
319 (skip-chars-forward " \t"))
|
|
|
320
|
|
|
321 (defun back-to-indentation ()
|
|
|
322 "Move point to the first non-whitespace character on this line."
|
|
|
323 (interactive)
|
|
|
324 (beginning-of-line 1)
|
|
|
325 (skip-chars-forward " \t"))
|
|
|
326
|
|
|
327 (defun fixup-whitespace ()
|
|
|
328 "Fixup white space between objects around point.
|
|
|
329 Leave one space or none, according to the context."
|
|
|
330 (interactive "*")
|
|
|
331 (save-excursion
|
|
|
332 (delete-horizontal-space)
|
|
|
333 (if (or (looking-at "^\\|\\s)")
|
|
|
334 (save-excursion (forward-char -1)
|
|
|
335 (looking-at "$\\|\\s(\\|\\s'")))
|
|
|
336 nil
|
|
|
337 (insert ?\ ))))
|
|
|
338
|
|
34462
|
339 (defun delete-horizontal-space (&optional backward-only)
|
|
|
340 "Delete all spaces and tabs around point.
|
|
|
341 If BACKWARD-ONLY is non-nil, only delete spaces before point."
|
|
25292
|
342 (interactive "*")
|
|
34462
|
343 (delete-region
|
|
|
344 (if backward-only
|
|
|
345 (point)
|
|
|
346 (progn
|
|
|
347 (skip-chars-forward " \t" (field-end))
|
|
|
348 (point)))
|
|
|
349 (progn
|
|
|
350 (skip-chars-backward " \t" (field-beginning nil t))
|
|
|
351 (point))))
|
|
25292
|
352
|
|
|
353 (defun just-one-space ()
|
|
|
354 "Delete all spaces and tabs around point, leaving one space."
|
|
|
355 (interactive "*")
|
|
34462
|
356 (skip-chars-backward " \t" (field-beginning))
|
|
25292
|
357 (if (= (following-char) ? )
|
|
|
358 (forward-char 1)
|
|
|
359 (insert ? ))
|
|
34462
|
360 (delete-region
|
|
|
361 (point)
|
|
|
362 (progn
|
|
|
363 (skip-chars-forward " \t" (field-end nil t))
|
|
|
364 (point))))
|
|
33786
|
365
|
|
475
|
366 (defun beginning-of-buffer (&optional arg)
|
|
|
367 "Move point to the beginning of the buffer; leave mark at previous position.
|
|
10085
|
368 With arg N, put point N/10 of the way from the beginning.
|
|
|
369
|
|
|
370 If the buffer is narrowed, this command uses the beginning and size
|
|
|
371 of the accessible part of the buffer.
|
|
1027
|
372
|
|
|
373 Don't use this command in Lisp programs!
|
|
475
|
374 \(goto-char (point-min)) is faster and avoids clobbering the mark."
|
|
|
375 (interactive "P")
|
|
|
376 (push-mark)
|
|
10085
|
377 (let ((size (- (point-max) (point-min))))
|
|
|
378 (goto-char (if arg
|
|
|
379 (+ (point-min)
|
|
|
380 (if (> size 10000)
|
|
|
381 ;; Avoid overflow for large buffer sizes!
|
|
|
382 (* (prefix-numeric-value arg)
|
|
|
383 (/ size 10))
|
|
|
384 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
|
|
|
385 (point-min))))
|
|
475
|
386 (if arg (forward-line 1)))
|
|
|
387
|
|
|
388 (defun end-of-buffer (&optional arg)
|
|
|
389 "Move point to the end of the buffer; leave mark at previous position.
|
|
10085
|
390 With arg N, put point N/10 of the way from the end.
|
|
|
391
|
|
|
392 If the buffer is narrowed, this command uses the beginning and size
|
|
|
393 of the accessible part of the buffer.
|
|
1027
|
394
|
|
|
395 Don't use this command in Lisp programs!
|
|
475
|
396 \(goto-char (point-max)) is faster and avoids clobbering the mark."
|
|
|
397 (interactive "P")
|
|
|
398 (push-mark)
|
|
10085
|
399 (let ((size (- (point-max) (point-min))))
|
|
|
400 (goto-char (if arg
|
|
|
401 (- (point-max)
|
|
|
402 (if (> size 10000)
|
|
|
403 ;; Avoid overflow for large buffer sizes!
|
|
|
404 (* (prefix-numeric-value arg)
|
|
|
405 (/ size 10))
|
|
|
406 (/ (* size (prefix-numeric-value arg)) 10)))
|
|
|
407 (point-max))))
|
|
846
|
408 ;; If we went to a place in the middle of the buffer,
|
|
|
409 ;; adjust it to the beginning of a line.
|
|
26265
|
410 (cond (arg (forward-line 1))
|
|
|
411 ((< (point) (window-end nil t))
|
|
|
412 ;; If the end of the buffer is not already on the screen,
|
|
|
413 ;; then scroll specially to put it near, but not at, the bottom.
|
|
|
414 (overlay-recenter (point))
|
|
|
415 (recenter -3))))
|
|
475
|
416
|
|
|
417 (defun mark-whole-buffer ()
|
|
715
|
418 "Put point at beginning and mark at end of buffer.
|
|
|
419 You probably should not use this function in Lisp programs;
|
|
|
420 it is usually a mistake for a Lisp function to use any subroutine
|
|
|
421 that uses or sets the mark."
|
|
475
|
422 (interactive)
|
|
|
423 (push-mark (point))
|
|
2824
|
424 (push-mark (point-max) nil t)
|
|
475
|
425 (goto-char (point-min)))
|
|
28624
|
426
|
|
33786
|
427
|
|
25292
|
428 ;; Counting lines, one way or another.
|
|
|
429
|
|
|
430 (defun goto-line (arg)
|
|
|
431 "Goto line ARG, counting from line 1 at beginning of buffer."
|
|
|
432 (interactive "NGoto line: ")
|
|
|
433 (setq arg (prefix-numeric-value arg))
|
|
|
434 (save-restriction
|
|
|
435 (widen)
|
|
|
436 (goto-char 1)
|
|
|
437 (if (eq selective-display t)
|
|
|
438 (re-search-forward "[\n\C-m]" nil 'end (1- arg))
|
|
|
439 (forward-line (1- arg)))))
|
|
475
|
440
|
|
|
441 (defun count-lines-region (start end)
|
|
3591
|
442 "Print number of lines and characters in the region."
|
|
475
|
443 (interactive "r")
|
|
|
444 (message "Region has %d lines, %d characters"
|
|
|
445 (count-lines start end) (- end start)))
|
|
|
446
|
|
|
447 (defun what-line ()
|
|
12939
|
448 "Print the current buffer line number and narrowed line number of point."
|
|
475
|
449 (interactive)
|
|
12939
|
450 (let ((opoint (point)) start)
|
|
475
|
451 (save-excursion
|
|
12939
|
452 (save-restriction
|
|
|
453 (goto-char (point-min))
|
|
|
454 (widen)
|
|
|
455 (beginning-of-line)
|
|
|
456 (setq start (point))
|
|
|
457 (goto-char opoint)
|
|
|
458 (beginning-of-line)
|
|
|
459 (if (/= start 1)
|
|
|
460 (message "line %d (narrowed line %d)"
|
|
|
461 (1+ (count-lines 1 (point)))
|
|
|
462 (1+ (count-lines start (point))))
|
|
|
463 (message "Line %d" (1+ (count-lines 1 (point)))))))))
|
|
|
464
|
|
475
|
465 (defun count-lines (start end)
|
|
|
466 "Return number of lines between START and END.
|
|
|
467 This is usually the number of newlines between them,
|
|
1027
|
468 but can be one more if START is not equal to END
|
|
475
|
469 and the greater of them is not at the start of a line."
|
|
9554
|
470 (save-excursion
|
|
|
471 (save-restriction
|
|
|
472 (narrow-to-region start end)
|
|
|
473 (goto-char (point-min))
|
|
|
474 (if (eq selective-display t)
|
|
|
475 (save-match-data
|
|
2421
|
476 (let ((done 0))
|
|
|
477 (while (re-search-forward "[\n\C-m]" nil t 40)
|
|
|
478 (setq done (+ 40 done)))
|
|
|
479 (while (re-search-forward "[\n\C-m]" nil t 1)
|
|
|
480 (setq done (+ 1 done)))
|
|
5151
|
481 (goto-char (point-max))
|
|
|
482 (if (and (/= start end)
|
|
|
483 (not (bolp)))
|
|
|
484 (1+ done)
|
|
9554
|
485 done)))
|
|
|
486 (- (buffer-size) (forward-line (buffer-size)))))))
|
|
33786
|
487
|
|
16999
|
488 (defun what-cursor-position (&optional detail)
|
|
|
489 "Print info on cursor position (on screen and within buffer).
|
|
23963
|
490 Also describe the character after point, and give its character code
|
|
24398
|
491 in octal, decimal and hex.
|
|
|
492
|
|
|
493 For a non-ASCII multibyte character, also give its encoding in the
|
|
|
494 buffer's selected coding system if the coding system encodes the
|
|
|
495 character safely. If the character is encoded into one byte, that
|
|
|
496 code is shown in hex. If the character is encoded into more than one
|
|
|
497 byte, just \"...\" is shown.
|
|
23963
|
498
|
|
28896
|
499 In addition, with prefix argument, show details about that character
|
|
|
500 in *Help* buffer. See also the command `describe-char-after'."
|
|
16999
|
501 (interactive "P")
|
|
475
|
502 (let* ((char (following-char))
|
|
|
503 (beg (point-min))
|
|
|
504 (end (point-max))
|
|
|
505 (pos (point))
|
|
|
506 (total (buffer-size))
|
|
|
507 (percent (if (> total 50000)
|
|
|
508 ;; Avoid overflow from multiplying by 100!
|
|
|
509 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
|
|
|
510 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
|
|
|
511 (hscroll (if (= (window-hscroll) 0)
|
|
|
512 ""
|
|
|
513 (format " Hscroll=%d" (window-hscroll))))
|
|
|
514 (col (current-column)))
|
|
|
515 (if (= pos end)
|
|
|
516 (if (or (/= beg 1) (/= end (1+ total)))
|
|
27477
|
517 (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
|
|
475
|
518 pos total percent beg end col hscroll)
|
|
27477
|
519 (message "point=%d of %d (%d%%) column %d %s"
|
|
475
|
520 pos total percent col hscroll))
|
|
24398
|
521 (let ((coding buffer-file-coding-system)
|
|
|
522 encoded encoding-msg)
|
|
|
523 (if (or (not coding)
|
|
|
524 (eq (coding-system-type coding) t))
|
|
|
525 (setq coding default-buffer-file-coding-system))
|
|
24508
|
526 (if (not (char-valid-p char))
|
|
|
527 (setq encoding-msg
|
|
|
528 (format "(0%o, %d, 0x%x, invalid)" char char char))
|
|
|
529 (setq encoded (and (>= char 128) (encode-coding-char char coding)))
|
|
|
530 (setq encoding-msg
|
|
|
531 (if encoded
|
|
28896
|
532 (format "(0%o, %d, 0x%x, file %s)"
|
|
24508
|
533 char char char
|
|
28896
|
534 (if (> (length encoded) 1)
|
|
24508
|
535 "..."
|
|
28896
|
536 (encoded-string-description encoded coding)))
|
|
24508
|
537 (format "(0%o, %d, 0x%x)" char char char))))
|
|
23944
|
538 (if detail
|
|
28896
|
539 ;; We show the detailed information about CHAR.
|
|
|
540 (describe-char-after (point)))
|
|
|
541 (if (or (/= beg 1) (/= end (1+ total)))
|
|
|
542 (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
|
|
26884
|
543 (if (< char 256)
|
|
|
544 (single-key-description char)
|
|
|
545 (buffer-substring-no-properties (point) (1+ (point))))
|
|
28896
|
546 encoding-msg pos total percent beg end col hscroll)
|
|
|
547 (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
|
|
|
548 (if (< char 256)
|
|
|
549 (single-key-description char)
|
|
|
550 (buffer-substring-no-properties (point) (1+ (point))))
|
|
|
551 encoding-msg pos total percent col hscroll))))))
|
|
33786
|
552
|
|
31978
|
553 (defvar read-expression-map
|
|
|
554 (let ((m (make-sparse-keymap)))
|
|
|
555 (define-key m "\M-\t" 'lisp-complete-symbol)
|
|
|
556 (set-keymap-parent m minibuffer-local-map)
|
|
|
557 m)
|
|
1135
|
558 "Minibuffer keymap used for reading Lisp expressions.")
|
|
|
559
|
|
4289
|
560 (defvar read-expression-history nil)
|
|
|
561
|
|
25702
|
562 (defcustom eval-expression-print-level 4
|
|
|
563 "*Value to use for `print-level' when printing value in `eval-expression'."
|
|
|
564 :group 'lisp
|
|
|
565 :type 'integer
|
|
|
566 :version "21.1")
|
|
|
567
|
|
|
568 (defcustom eval-expression-print-length 12
|
|
|
569 "*Value to use for `print-length' when printing value in `eval-expression'."
|
|
|
570 :group 'lisp
|
|
30189
|
571 :type '(choice (const nil) integer)
|
|
25702
|
572 :version "21.1")
|
|
|
573
|
|
|
574 (defcustom eval-expression-debug-on-error t
|
|
27302
|
575 "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
|
|
|
576 If nil, don't change the value of `debug-on-error'."
|
|
25702
|
577 :group 'lisp
|
|
|
578 :type 'boolean
|
|
|
579 :version "21.1")
|
|
|
580
|
|
4289
|
581 ;; We define this, rather than making `eval' interactive,
|
|
475
|
582 ;; for the sake of completion of names like eval-region, eval-current-buffer.
|
19514
9f6b375ce842
(eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
583 (defun eval-expression (eval-expression-arg
|
9f6b375ce842
(eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
584 &optional eval-expression-insert-value)
|
|
36021
|
585 "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
|
|
|
586 Value is also consed on to front of the variable `values'.
|
|
|
587 Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
|
|
|
588 insert the result into the current buffer instead of printing it in
|
|
|
589 the echo area."
|
|
4886
|
590 (interactive
|
|
5068
|
591 (list (read-from-minibuffer "Eval: "
|
|
|
592 nil read-expression-map t
|
19514
9f6b375ce842
(eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
593 'read-expression-history)
|
9f6b375ce842
(eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
594 current-prefix-arg))
|
|
33786
|
595
|
|
27302
|
596 (if (null eval-expression-debug-on-error)
|
|
|
597 (setq values (cons (eval eval-expression-arg) values))
|
|
|
598 (let ((old-value (make-symbol "t")) new-value)
|
|
|
599 ;; Bind debug-on-error to something unique so that we can
|
|
|
600 ;; detect when evaled code changes it.
|
|
|
601 (let ((debug-on-error old-value))
|
|
|
602 (setq values (cons (eval eval-expression-arg) values))
|
|
|
603 (setq new-value debug-on-error))
|
|
|
604 ;; If evaled code has changed the value of debug-on-error,
|
|
|
605 ;; propagate that change to the global binding.
|
|
|
606 (unless (eq old-value new-value)
|
|
|
607 (setq debug-on-error new-value))))
|
|
33786
|
608
|
|
25702
|
609 (let ((print-length eval-expression-print-length)
|
|
|
610 (print-level eval-expression-print-level))
|
|
|
611 (prin1 (car values)
|
|
|
612 (if eval-expression-insert-value (current-buffer) t))))
|
|
475
|
613
|
|
|
614 (defun edit-and-eval-command (prompt command)
|
|
|
615 "Prompting with PROMPT, let user edit COMMAND and eval result.
|
|
|
616 COMMAND is a Lisp expression. Let user edit that expression in
|
|
|
617 the minibuffer, then read and evaluate the result."
|
|
5068
|
618 (let ((command (read-from-minibuffer prompt
|
|
|
619 (prin1-to-string command)
|
|
|
620 read-expression-map t
|
|
|
621 '(command-history . 1))))
|
9629
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
622 ;; If command was added to command-history as a string,
|
|
13960
|
623 ;; get rid of that. We want only evaluable expressions there.
|
9629
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
624 (if (stringp (car command-history))
|
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
625 (setq command-history (cdr command-history)))
|
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
626
|
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
627 ;; If command to be redone does not match front of history,
|
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
628 ;; add it to the history.
|
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
629 (or (equal command (car command-history))
|
53e092e189c6
(edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
630 (setq command-history (cons command command-history)))
|
|
475
|
631 (eval command)))
|
|
|
632
|
|
874
|
633 (defun repeat-complex-command (arg)
|
|
|
634 "Edit and re-evaluate last complex command, or ARGth from last.
|
|
|
635 A complex command is one which used the minibuffer.
|
|
|
636 The command is placed in the minibuffer as a Lisp form for editing.
|
|
|
637 The result is executed, repeating the command as changed.
|
|
|
638 If the command has been changed or is not the most recent previous command
|
|
|
639 it is added to the front of the command history.
|
|
|
640 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
|
|
|
641 to get different commands to edit and resubmit."
|
|
|
642 (interactive "p")
|
|
|
643 (let ((elt (nth (1- arg) command-history))
|
|
|
644 newcmd)
|
|
|
645 (if elt
|
|
1135
|
646 (progn
|
|
4821
|
647 (setq newcmd
|
|
16803
|
648 (let ((print-level nil)
|
|
|
649 (minibuffer-history-position arg)
|
|
20022
|
650 (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
|
|
8734
|
651 (read-from-minibuffer
|
|
|
652 "Redo: " (prin1-to-string elt) read-expression-map t
|
|
|
653 (cons 'command-history arg))))
|
|
4821
|
654
|
|
5135
|
655 ;; If command was added to command-history as a string,
|
|
13960
|
656 ;; get rid of that. We want only evaluable expressions there.
|
|
5135
|
657 (if (stringp (car command-history))
|
|
|
658 (setq command-history (cdr command-history)))
|
|
|
659
|
|
|
660 ;; If command to be redone does not match front of history,
|
|
|
661 ;; add it to the history.
|
|
|
662 (or (equal newcmd (car command-history))
|
|
|
663 (setq command-history (cons newcmd command-history)))
|
|
874
|
664 (eval newcmd))
|
|
|
665 (ding))))
|
|
33786
|
666
|
|
1135
|
667 (defvar minibuffer-history nil
|
|
|
668 "Default minibuffer history list.
|
|
|
669 This is used for all minibuffer input
|
|
|
670 except when an alternate history list is specified.")
|
|
|
671 (defvar minibuffer-history-sexp-flag nil
|
|
7373
|
672 "Non-nil when doing history operations on `command-history'.
|
|
1135
|
673 More generally, indicates that the history list being acted on
|
|
20022
|
674 contains expressions rather than strings.
|
|
|
675 It is only valid if its value equals the current minibuffer depth,
|
|
|
676 to handle recursive uses of the minibuffer.")
|
|
862
|
677 (setq minibuffer-history-variable 'minibuffer-history)
|
|
|
678 (setq minibuffer-history-position nil)
|
|
1135
|
679 (defvar minibuffer-history-search-history nil)
|
|
858
|
680
|
|
921
|
681 (mapcar
|
|
1811
|
682 (lambda (key-and-command)
|
|
|
683 (mapcar
|
|
|
684 (lambda (keymap-and-completionp)
|
|
|
685 ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
|
|
|
686 ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
|
|
|
687 ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
|
|
|
688 (define-key (symbol-value (car keymap-and-completionp))
|
|
|
689 (car key-and-command)
|
|
|
690 (let ((command (cdr key-and-command)))
|
|
|
691 (if (consp command)
|
1826
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
692 ;; (and ... nil) => ... turns back on the completion-oriented
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
693 ;; history commands which rms turned off since they seem to
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
694 ;; do things he doesn't like.
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
695 (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
|
|
1838
|
696 (progn (error "EMACS BUG!") (cdr command))
|
|
1811
|
697 (car command))
|
|
|
698 command))))
|
|
|
699 '((minibuffer-local-map . nil)
|
|
|
700 (minibuffer-local-ns-map . nil)
|
|
|
701 (minibuffer-local-completion-map . t)
|
|
|
702 (minibuffer-local-must-match-map . t)
|
|
|
703 (read-expression-map . nil))))
|
|
1838
|
704 '(("\en" . (next-history-element . next-complete-history-element))
|
|
|
705 ([next] . (next-history-element . next-complete-history-element))
|
|
|
706 ("\ep" . (previous-history-element . previous-complete-history-element))
|
|
|
707 ([prior] . (previous-history-element . previous-complete-history-element))
|
|
921
|
708 ("\er" . previous-matching-history-element)
|
|
|
709 ("\es" . next-matching-history-element)))
|
|
874
|
710
|
|
17662
|
711 (defvar minibuffer-text-before-history nil
|
|
|
712 "Text that was in this minibuffer before any history commands.
|
|
|
713 This is nil if there have not yet been any history commands
|
|
|
714 in this use of the minibuffer.")
|
|
|
715
|
|
|
716 (add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
|
|
|
717
|
|
|
718 (defun minibuffer-history-initialize ()
|
|
|
719 (setq minibuffer-text-before-history nil))
|
|
|
720
|
|
33683
|
721 (defun minibuffer-avoid-prompt (new old)
|
|
|
722 "A point-motion hook for the minibuffer, that moves point out of the prompt."
|
|
|
723 (constrain-to-field nil (point-max)))
|
|
|
724
|
|
22257
|
725 (defcustom minibuffer-history-case-insensitive-variables nil
|
|
|
726 "*Minibuffer history variables for which matching should ignore case.
|
|
|
727 If a history variable is a member of this list, then the
|
|
|
728 \\[previous-matching-history-element] and \\[next-matching-history-element]\
|
|
|
729 commands ignore case when searching it, regardless of `case-fold-search'."
|
|
|
730 :type '(repeat variable)
|
|
|
731 :group 'minibuffer)
|
|
|
732
|
|
874
|
733 (defun previous-matching-history-element (regexp n)
|
|
1135
|
734 "Find the previous history element that matches REGEXP.
|
|
|
735 \(Previous history elements refer to earlier actions.)
|
|
|
736 With prefix argument N, search for Nth previous match.
|
|
20510
|
737 If N is negative, find the next or Nth next match.
|
35940
74a0bc65686f
(previous-matching-history-element, next-matching-history-element): Doc fix.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
738 Normally, history elements are matched case-insensitively if
|
74a0bc65686f
(previous-matching-history-element, next-matching-history-element): Doc fix.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
739 `case-fold-search' is non-nil, but an uppercase letter in REGEXP
|
74a0bc65686f
(previous-matching-history-element, next-matching-history-element): Doc fix.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
740 makes the search case-sensitive.
|
|
22257
|
741 See also `minibuffer-history-case-insensitive-variables'."
|
|
1135
|
742 (interactive
|
|
2681
|
743 (let* ((enable-recursive-minibuffers t)
|
|
|
744 (regexp (read-from-minibuffer "Previous element matching (regexp): "
|
|
|
745 nil
|
|
|
746 minibuffer-local-map
|
|
|
747 nil
|
|
|
748 'minibuffer-history-search-history)))
|
|
|
749 ;; Use the last regexp specified, by default, if input is empty.
|
|
|
750 (list (if (string= regexp "")
|
|
11961
|
751 (if minibuffer-history-search-history
|
|
|
752 (car minibuffer-history-search-history)
|
|
|
753 (error "No previous history search regexp"))
|
|
2681
|
754 regexp)
|
|
1135
|
755 (prefix-numeric-value current-prefix-arg))))
|
|
32897
|
756 (unless (zerop n)
|
|
|
757 (if (and (zerop minibuffer-history-position)
|
|
|
758 (null minibuffer-text-before-history))
|
|
|
759 (setq minibuffer-text-before-history (field-string (point-max))))
|
|
|
760 (let ((history (symbol-value minibuffer-history-variable))
|
|
|
761 (case-fold-search
|
|
|
762 (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
|
|
|
763 ;; On some systems, ignore case for file names.
|
|
|
764 (if (memq minibuffer-history-variable
|
|
|
765 minibuffer-history-case-insensitive-variables)
|
|
|
766 t
|
|
|
767 ;; Respect the user's setting for case-fold-search:
|
|
|
768 case-fold-search)
|
|
|
769 nil))
|
|
|
770 prevpos
|
|
|
771 match-string
|
|
|
772 match-offset
|
|
|
773 (pos minibuffer-history-position))
|
|
|
774 (while (/= n 0)
|
|
|
775 (setq prevpos pos)
|
|
|
776 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
|
|
|
777 (when (= pos prevpos)
|
|
874
|
778 (error (if (= pos 1)
|
|
892
|
779 "No later matching history item"
|
|
|
780 "No earlier matching history item")))
|
|
32897
|
781 (setq match-string
|
|
|
782 (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
|
|
|
783 (let ((print-level nil))
|
|
|
784 (prin1-to-string (nth (1- pos) history)))
|
|
|
785 (nth (1- pos) history)))
|
|
|
786 (setq match-offset
|
|
|
787 (if (< n 0)
|
|
|
788 (and (string-match regexp match-string)
|
|
|
789 (match-end 0))
|
|
|
790 (and (string-match (concat ".*\\(" regexp "\\)") match-string)
|
|
|
791 (match-beginning 1))))
|
|
|
792 (when match-offset
|
|
1135
|
793 (setq n (+ n (if (< n 0) 1 -1)))))
|
|
32897
|
794 (setq minibuffer-history-position pos)
|
|
|
795 (goto-char (point-max))
|
|
|
796 (delete-field)
|
|
|
797 (insert match-string)
|
|
|
798 (goto-char (+ (field-beginning) match-offset))))
|
|
1135
|
799 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
|
|
|
800 (eq (car (car command-history)) 'next-matching-history-element))
|
|
|
801 (setq command-history (cdr command-history))))
|
|
874
|
802
|
|
|
803 (defun next-matching-history-element (regexp n)
|
|
1135
|
804 "Find the next history element that matches REGEXP.
|
|
|
805 \(The next history element refers to a more recent action.)
|
|
|
806 With prefix argument N, search for Nth next match.
|
|
20510
|
807 If N is negative, find the previous or Nth previous match.
|
35940
74a0bc65686f
(previous-matching-history-element, next-matching-history-element): Doc fix.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
808 Normally, history elements are matched case-insensitively if
|
74a0bc65686f
(previous-matching-history-element, next-matching-history-element): Doc fix.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
809 `case-fold-search' is non-nil, but an uppercase letter in REGEXP
|
74a0bc65686f
(previous-matching-history-element, next-matching-history-element): Doc fix.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
810 makes the search case-sensitive."
|
|
1135
|
811 (interactive
|
|
2681
|
812 (let* ((enable-recursive-minibuffers t)
|
|
|
813 (regexp (read-from-minibuffer "Next element matching (regexp): "
|
|
|
814 nil
|
|
|
815 minibuffer-local-map
|
|
|
816 nil
|
|
|
817 'minibuffer-history-search-history)))
|
|
|
818 ;; Use the last regexp specified, by default, if input is empty.
|
|
|
819 (list (if (string= regexp "")
|
|
|
820 (setcar minibuffer-history-search-history
|
|
|
821 (nth 1 minibuffer-history-search-history))
|
|
|
822 regexp)
|
|
1135
|
823 (prefix-numeric-value current-prefix-arg))))
|
|
874
|
824 (previous-matching-history-element regexp (- n)))
|
|
475
|
825
|
|
32105
|
826 (defvar minibuffer-temporary-goal-position nil)
|
|
|
827
|
|
858
|
828 (defun next-history-element (n)
|
|
|
829 "Insert the next element of the minibuffer history into the minibuffer."
|
|
475
|
830 (interactive "p")
|
|
10722
|
831 (or (zerop n)
|
|
17662
|
832 (let ((narg (- minibuffer-history-position n))
|
|
|
833 (minimum (if minibuffer-default -1 0))
|
|
24814
|
834 elt minibuffer-returned-to-present)
|
|
17662
|
835 (if (and (zerop minibuffer-history-position)
|
|
|
836 (null minibuffer-text-before-history))
|
|
26054
|
837 (setq minibuffer-text-before-history (field-string (point-max))))
|
|
17662
|
838 (if (< narg minimum)
|
|
23472
|
839 (if minibuffer-default
|
|
|
840 (error "End of history; no next item")
|
|
|
841 (error "End of history; no default available")))
|
|
17662
|
842 (if (> narg (length (symbol-value minibuffer-history-variable)))
|
|
|
843 (error "Beginning of history; no preceding item"))
|
|
32105
|
844 (unless (or (eq last-command 'next-history-element)
|
|
|
845 (eq last-command 'previous-history-element))
|
|
|
846 (let ((prompt-end (field-beginning (point-max))))
|
|
|
847 (set (make-local-variable 'minibuffer-temporary-goal-position)
|
|
|
848 (cond ((<= (point) prompt-end) prompt-end)
|
|
|
849 ((eobp) nil)
|
|
|
850 (t (point))))))
|
|
26054
|
851 (goto-char (point-max))
|
|
26349
|
852 (delete-field)
|
|
17662
|
853 (setq minibuffer-history-position narg)
|
|
|
854 (cond ((= narg -1)
|
|
|
855 (setq elt minibuffer-default))
|
|
|
856 ((= narg 0)
|
|
19888
|
857 (setq elt (or minibuffer-text-before-history ""))
|
|
24814
|
858 (setq minibuffer-returned-to-present t)
|
|
17662
|
859 (setq minibuffer-text-before-history nil))
|
|
|
860 (t (setq elt (nth (1- minibuffer-history-position)
|
|
|
861 (symbol-value minibuffer-history-variable)))))
|
|
|
862 (insert
|
|
24814
|
863 (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
|
|
|
864 (not minibuffer-returned-to-present))
|
|
17662
|
865 (let ((print-level nil))
|
|
|
866 (prin1-to-string elt))
|
|
|
867 elt))
|
|
32105
|
868 (goto-char (or minibuffer-temporary-goal-position (point-max))))))
|
|
475
|
869
|
|
858
|
870 (defun previous-history-element (n)
|
|
1145
|
871 "Inserts the previous element of the minibuffer history into the minibuffer."
|
|
475
|
872 (interactive "p")
|
|
859
|
873 (next-history-element (- n)))
|
|
1811
|
874
|
|
|
875 (defun next-complete-history-element (n)
|
|
26054
|
876 "Get next history element which completes the minibuffer before the point.
|
|
|
877 The contents of the minibuffer after the point are deleted, and replaced
|
|
|
878 by the new completion."
|
|
1811
|
879 (interactive "p")
|
1826
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
880 (let ((point-at-start (point)))
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
881 (next-matching-history-element
|
|
26054
|
882 (concat
|
|
|
883 "^" (regexp-quote (buffer-substring (field-beginning) (point))))
|
|
|
884 n)
|
1826
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
885 ;; next-matching-history-element always puts us at (point-min).
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
886 ;; Move to the position we were at before changing the buffer contents.
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
887 ;; This is still sensical, because the text before point has not changed.
|
6ca05c5f8979
(next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
diff
changeset
|
888 (goto-char point-at-start)))
|
|
1811
|
889
|
|
|
890 (defun previous-complete-history-element (n)
|
|
5324
|
891 "\
|
|
26054
|
892 Get previous history element which completes the minibuffer before the point.
|
|
|
893 The contents of the minibuffer after the point are deleted, and replaced
|
|
|
894 by the new completion."
|
|
1811
|
895 (interactive "p")
|
|
|
896 (next-complete-history-element (- n)))
|
|
26054
|
897
|
|
|
898 ;; These two functions are for compatibility with the old subrs of the
|
|
|
899 ;; same name.
|
|
|
900
|
|
|
901 (defun minibuffer-prompt-width ()
|
|
|
902 "Return the display width of the minibuffer prompt.
|
|
|
903 Return 0 if current buffer is not a mini-buffer."
|
|
|
904 ;; Return the width of everything before the field at the end of
|
|
|
905 ;; the buffer; this should be 0 for normal buffers.
|
|
|
906 (1- (field-beginning (point-max))))
|
|
|
907
|
|
|
908 (defun minibuffer-prompt-end ()
|
|
|
909 "Return the buffer position of the end of the minibuffer prompt.
|
|
34071
|
910 Return (point-min) if current buffer is not a mini-buffer."
|
|
26063
|
911 (field-beginning (point-max)))
|
|
|
912
|
|
34071
|
913 (defun minibuffer-contents ()
|
|
|
914 "Return the user input in a minbuffer as a string.
|
|
|
915 The current buffer must be a minibuffer."
|
|
|
916 (field-string (point-max)))
|
|
|
917
|
|
|
918 (defun minibuffer-contents-no-properties ()
|
|
|
919 "Return the user input in a minbuffer as a string, without text-properties.
|
|
|
920 The current buffer must be a minibuffer."
|
|
|
921 (field-string-no-properties (point-max)))
|
|
|
922
|
|
|
923 (defun delete-minibuffer-contents ()
|
|
|
924 "Delete all user input in a minibuffer.
|
|
|
925 The current buffer must be a minibuffer."
|
|
|
926 (delete-field (point-max)))
|
|
33786
|
927
|
|
475
|
928 ;Put this on C-x u, so we can force that rather than C-_ into startup msg
|
|
16436
|
929 (defalias 'advertised-undo 'undo)
|
|
475
|
930
|
|
|
931 (defun undo (&optional arg)
|
|
|
932 "Undo some previous changes.
|
|
|
933 Repeat this command to undo more changes.
|
|
21175
|
934 A numeric argument serves as a repeat count.
|
|
|
935
|
|
32899
|
936 In Transient Mark mode when the mark is active, only undo changes within
|
|
|
937 the current region. Similarly, when not in Transient Mark mode, just C-u
|
|
|
938 as an argument limits undo to changes within the current region."
|
|
21175
|
939 (interactive "*P")
|
|
5935
|
940 ;; If we don't get all the way thru, make last-command indicate that
|
|
|
941 ;; for the following command.
|
|
|
942 (setq this-command t)
|
|
3408
|
943 (let ((modified (buffer-modified-p))
|
|
|
944 (recent-save (recent-auto-save-p)))
|
|
582
|
945 (or (eq (selected-window) (minibuffer-window))
|
|
|
946 (message "Undo!"))
|
|
32899
|
947 (unless (eq last-command 'undo)
|
|
|
948 (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
|
|
|
949 (undo-start (region-beginning) (region-end))
|
|
|
950 (undo-start))
|
|
|
951 ;; get rid of initial undo boundary
|
|
|
952 (undo-more 1))
|
|
|
953 (undo-more
|
|
|
954 (if (or transient-mark-mode (numberp arg))
|
|
|
955 (prefix-numeric-value arg)
|
|
|
956 1))
|
|
6386
|
957 ;; Don't specify a position in the undo record for the undo command.
|
|
|
958 ;; Instead, undoing this should move point to where the change is.
|
|
|
959 (let ((tail buffer-undo-list)
|
|
|
960 done)
|
|
|
961 (while (and tail (not done) (not (null (car tail))))
|
|
|
962 (if (integerp (car tail))
|
|
|
963 (progn
|
|
|
964 (setq done t)
|
|
|
965 (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
|
|
|
966 (setq tail (cdr tail))))
|
|
475
|
967 (and modified (not (buffer-modified-p))
|
|
5935
|
968 (delete-auto-save-file-if-necessary recent-save)))
|
|
|
969 ;; If we do get all the way thru, make this-command indicate that.
|
|
|
970 (setq this-command 'undo))
|
|
475
|
971
|
|
2947
|
972 (defvar pending-undo-list nil
|
|
|
973 "Within a run of consecutive undo commands, list remaining to be undone.")
|
|
|
974
|
|
22725
|
975 (defvar undo-in-progress nil
|
|
|
976 "Non-nil while performing an undo.
|
|
|
977 Some change-hooks test this variable to do something different.")
|
|
|
978
|
|
475
|
979 (defun undo-more (count)
|
|
|
980 "Undo back N undo-boundaries beyond what was already undone recently.
|
|
1027
|
981 Call `undo-start' to get ready to undo recent changes,
|
|
|
982 then call `undo-more' one or more times to undo them."
|
|
475
|
983 (or pending-undo-list
|
|
|
984 (error "No further undo information"))
|
|
22725
|
985 (let ((undo-in-progress t))
|
|
|
986 (setq pending-undo-list (primitive-undo count pending-undo-list))))
|
|
475
|
987
|
|
21175
|
988 ;; Deep copy of a list
|
|
|
989 (defun undo-copy-list (list)
|
|
|
990 "Make a copy of undo list LIST."
|
|
|
991 (mapcar 'undo-copy-list-1 list))
|
|
|
992
|
|
|
993 (defun undo-copy-list-1 (elt)
|
|
|
994 (if (consp elt)
|
|
|
995 (cons (car elt) (undo-copy-list-1 (cdr elt)))
|
|
|
996 elt))
|
|
|
997
|
|
|
998 (defun undo-start (&optional beg end)
|
|
|
999 "Set `pending-undo-list' to the front of the undo list.
|
|
|
1000 The next call to `undo-more' will undo the most recently made change.
|
|
|
1001 If BEG and END are specified, then only undo elements
|
|
|
1002 that apply to text between BEG and END are used; other undo elements
|
|
|
1003 are ignored. If BEG and END are nil, all undo elements are used."
|
|
|
1004 (if (eq buffer-undo-list t)
|
|
|
1005 (error "No undo information in this buffer"))
|
|
26457
|
1006 (setq pending-undo-list
|
|
21175
|
1007 (if (and beg end (not (= beg end)))
|
|
|
1008 (undo-make-selective-list (min beg end) (max beg end))
|
|
|
1009 buffer-undo-list)))
|
|
|
1010
|
|
|
1011 (defvar undo-adjusted-markers)
|
|
|
1012
|
|
|
1013 (defun undo-make-selective-list (start end)
|
|
|
1014 "Return a list of undo elements for the region START to END.
|
|
|
1015 The elements come from `buffer-undo-list', but we keep only
|
|
|
1016 the elements inside this region, and discard those outside this region.
|
|
|
1017 If we find an element that crosses an edge of this region,
|
|
|
1018 we stop and ignore all further elements."
|
|
|
1019 (let ((undo-list-copy (undo-copy-list buffer-undo-list))
|
|
|
1020 (undo-list (list nil))
|
|
|
1021 undo-adjusted-markers
|
|
|
1022 some-rejected
|
|
|
1023 undo-elt undo-elt temp-undo-list delta)
|
|
|
1024 (while undo-list-copy
|
|
|
1025 (setq undo-elt (car undo-list-copy))
|
|
|
1026 (let ((keep-this
|
|
|
1027 (cond ((and (consp undo-elt) (eq (car undo-elt) t))
|
|
|
1028 ;; This is a "was unmodified" element.
|
|
|
1029 ;; Keep it if we have kept everything thus far.
|
|
|
1030 (not some-rejected))
|
|
|
1031 (t
|
|
|
1032 (undo-elt-in-region undo-elt start end)))))
|
|
|
1033 (if keep-this
|
|
|
1034 (progn
|
|
|
1035 (setq end (+ end (cdr (undo-delta undo-elt))))
|
|
|
1036 ;; Don't put two nils together in the list
|
|
|
1037 (if (not (and (eq (car undo-list) nil)
|
|
|
1038 (eq undo-elt nil)))
|
|
|
1039 (setq undo-list (cons undo-elt undo-list))))
|
|
|
1040 (if (undo-elt-crosses-region undo-elt start end)
|
|
|
1041 (setq undo-list-copy nil)
|
|
|
1042 (setq some-rejected t)
|
|
|
1043 (setq temp-undo-list (cdr undo-list-copy))
|
|
|
1044 (setq delta (undo-delta undo-elt))
|
|
|
1045
|
|
|
1046 (when (/= (cdr delta) 0)
|
|
|
1047 (let ((position (car delta))
|
|
|
1048 (offset (cdr delta)))
|
|
|
1049
|
|
|
1050 ;; Loop down the earlier events adjusting their buffer positions
|
|
|
1051 ;; to reflect the fact that a change to the buffer isn't being
|
|
|
1052 ;; undone. We only need to process those element types which
|
|
|
1053 ;; undo-elt-in-region will return as being in the region since
|
|
|
1054 ;; only those types can ever get into the output
|
|
|
1055
|
|
|
1056 (while temp-undo-list
|
|
|
1057 (setq undo-elt (car temp-undo-list))
|
|
|
1058 (cond ((integerp undo-elt)
|
|
|
1059 (if (>= undo-elt position)
|
|
|
1060 (setcar temp-undo-list (- undo-elt offset))))
|
|
|
1061 ((atom undo-elt) nil)
|
|
|
1062 ((stringp (car undo-elt))
|
|
|
1063 ;; (TEXT . POSITION)
|
|
|
1064 (let ((text-pos (abs (cdr undo-elt)))
|
|
|
1065 (point-at-end (< (cdr undo-elt) 0 )))
|
|
|
1066 (if (>= text-pos position)
|
|
26457
|
1067 (setcdr undo-elt (* (if point-at-end -1 1)
|
|
21175
|
1068 (- text-pos offset))))))
|
|
|
1069 ((integerp (car undo-elt))
|
|
|
1070 ;; (BEGIN . END)
|
|
|
1071 (when (>= (car undo-elt) position)
|
|
|
1072 (setcar undo-elt (- (car undo-elt) offset))
|
|
|
1073 (setcdr undo-elt (- (cdr undo-elt) offset))))
|
|
|
1074 ((null (car undo-elt))
|
|
|
1075 ;; (nil PROPERTY VALUE BEG . END)
|
|
|
1076 (let ((tail (nthcdr 3 undo-elt)))
|
|
|
1077 (when (>= (car tail) position)
|
|
|
1078 (setcar tail (- (car tail) offset))
|
|
|
1079 (setcdr tail (- (cdr tail) offset))))))
|
|
|
1080 (setq temp-undo-list (cdr temp-undo-list))))))))
|
|
|
1081 (setq undo-list-copy (cdr undo-list-copy)))
|
|
|
1082 (nreverse undo-list)))
|
|
|
1083
|
|
|
1084 (defun undo-elt-in-region (undo-elt start end)
|
|
|
1085 "Determine whether UNDO-ELT falls inside the region START ... END.
|
|
|
1086 If it crosses the edge, we return nil."
|
|
|
1087 (cond ((integerp undo-elt)
|
|
|
1088 (and (>= undo-elt start)
|
|
|
1089 (< undo-elt end)))
|
|
|
1090 ((eq undo-elt nil)
|
|
|
1091 t)
|
|
|
1092 ((atom undo-elt)
|
|
|
1093 nil)
|
|
|
1094 ((stringp (car undo-elt))
|
|
|
1095 ;; (TEXT . POSITION)
|
|
|
1096 (and (>= (abs (cdr undo-elt)) start)
|
|
|
1097 (< (abs (cdr undo-elt)) end)))
|
|
|
1098 ((and (consp undo-elt) (markerp (car undo-elt)))
|
|
|
1099 ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
|
|
|
1100 ;; See if MARKER is inside the region.
|
|
|
1101 (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
|
|
|
1102 (unless alist-elt
|
|
|
1103 (setq alist-elt (cons (car undo-elt)
|
|
|
1104 (marker-position (car undo-elt))))
|
|
|
1105 (setq undo-adjusted-markers
|
|
|
1106 (cons alist-elt undo-adjusted-markers)))
|
|
|
1107 (and (cdr alist-elt)
|
|
|
1108 (>= (cdr alist-elt) start)
|
|
|
1109 (< (cdr alist-elt) end))))
|
|
|
1110 ((null (car undo-elt))
|
|
|
1111 ;; (nil PROPERTY VALUE BEG . END)
|
|
|
1112 (let ((tail (nthcdr 3 undo-elt)))
|
|
|
1113 (and (>= (car tail) start)
|
|
|
1114 (< (cdr tail) end))))
|
|
|
1115 ((integerp (car undo-elt))
|
|
|
1116 ;; (BEGIN . END)
|
|
|
1117 (and (>= (car undo-elt) start)
|
|
|
1118 (< (cdr undo-elt) end)))))
|
|
|
1119
|
|
|
1120 (defun undo-elt-crosses-region (undo-elt start end)
|
|
|
1121 "Test whether UNDO-ELT crosses one edge of that region START ... END.
|
|
|
1122 This assumes we have already decided that UNDO-ELT
|
|
|
1123 is not *inside* the region START...END."
|
|
|
1124 (cond ((atom undo-elt) nil)
|
|
|
1125 ((null (car undo-elt))
|
|
|
1126 ;; (nil PROPERTY VALUE BEG . END)
|
|
|
1127 (let ((tail (nthcdr 3 undo-elt)))
|
|
|
1128 (not (or (< (car tail) end)
|
|
|
1129 (> (cdr tail) start)))))
|
|
|
1130 ((integerp (car undo-elt))
|
|
|
1131 ;; (BEGIN . END)
|
|
|
1132 (not (or (< (car undo-elt) end)
|
|
|
1133 (> (cdr undo-elt) start))))))
|
|
|
1134
|
|
|
1135 ;; Return the first affected buffer position and the delta for an undo element
|
|
|
1136 ;; delta is defined as the change in subsequent buffer positions if we *did*
|
|
|
1137 ;; the undo.
|
|
|
1138 (defun undo-delta (undo-elt)
|
|
|
1139 (if (consp undo-elt)
|
|
|
1140 (cond ((stringp (car undo-elt))
|
|
|
1141 ;; (TEXT . POSITION)
|
|
|
1142 (cons (abs (cdr undo-elt)) (length (car undo-elt))))
|
|
|
1143 ((integerp (car undo-elt))
|
|
|
1144 ;; (BEGIN . END)
|
|
|
1145 (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
|
|
|
1146 (t
|
|
|
1147 '(0 . 0)))
|
|
|
1148 '(0 . 0)))
|
|
33786
|
1149
|
|
4374
|
1150 (defvar shell-command-history nil
|
|
|
1151 "History list for some commands that read shell commands.")
|
|
|
1152
|
|
9779
|
1153 (defvar shell-command-switch "-c"
|
|
|
1154 "Switch used to have the shell execute its command line argument.")
|
|
|
1155
|
|
24419
|
1156 (defvar shell-command-default-error-buffer nil
|
|
|
1157 "*Buffer name for `shell-command' and `shell-command-on-region' error output.
|
|
|
1158 This buffer is used when `shell-command' or 'shell-command-on-region'
|
|
|
1159 is run interactively. A value of nil means that output to stderr and
|
|
|
1160 stdout will be intermixed in the output stream.")
|
|
|
1161
|
|
|
1162 (defun shell-command (command &optional output-buffer error-buffer)
|
|
475
|
1163 "Execute string COMMAND in inferior shell; display output, if any.
|
|
33876
|
1164 With prefix argument, insert the COMMAND's output at point.
|
|
11072
|
1165
|
|
475
|
1166 If COMMAND ends in ampersand, execute it asynchronously.
|
|
11072
|
1167 The output appears in the buffer `*Async Shell Command*'.
|
|
12565
|
1168 That buffer is in shell mode.
|
|
11072
|
1169
|
|
33312
|
1170 Otherwise, COMMAND is executed synchronously. The output appears in
|
|
|
1171 the buffer `*Shell Command Output*'. If the output is short enough to
|
|
|
1172 display in the echo area (which is determined by the variables
|
|
|
1173 `resize-mini-windows' and `max-mini-window-height'), it is shown
|
|
|
1174 there, but it is nonetheless available in buffer `*Shell Command
|
|
|
1175 Output*' even though that buffer is not automatically displayed. If
|
|
|
1176 there is no output, or if output is inserted in the current buffer,
|
|
|
1177 then `*Shell Command Output*' is deleted.
|
|
9539
|
1178
|
|
19109
|
1179 To specify a coding system for converting non-ASCII characters
|
|
|
1180 in the shell command output, use \\[universal-coding-system-argument]
|
|
|
1181 before this command.
|
|
|
1182
|
|
|
1183 Noninteractive callers can specify coding systems by binding
|
|
|
1184 `coding-system-for-read' and `coding-system-for-write'.
|
|
|
1185
|
|
9539
|
1186 The optional second argument OUTPUT-BUFFER, if non-nil,
|
|
|
1187 says to put the output in some other buffer.
|
|
|
1188 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
|
|
|
1189 If OUTPUT-BUFFER is not a buffer and not nil,
|
|
|
1190 insert output in current buffer. (This cannot be done asynchronously.)
|
|
24419
|
1191 In either case, the output is inserted after point (leaving mark after it).
|
|
|
1192
|
|
|
1193 If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
|
|
|
1194 or buffer name to which to direct the command's standard error output.
|
|
|
1195 If it is nil, error output is mingled with regular output.
|
|
|
1196 In an interactive call, the variable `shell-command-default-error-buffer'
|
|
|
1197 specifies the value of ERROR-BUFFER."
|
|
|
1198
|
|
4488
|
1199 (interactive (list (read-from-minibuffer "Shell command: "
|
|
|
1200 nil nil nil 'shell-command-history)
|
|
24419
|
1201 current-prefix-arg
|
|
|
1202 shell-command-default-error-buffer))
|
|
14627
|
1203 ;; Look for a handler in case default-directory is a remote file name.
|
|
|
1204 (let ((handler
|
|
|
1205 (find-file-name-handler (directory-file-name default-directory)
|
|
|
1206 'shell-command)))
|
|
|
1207 (if handler
|
|
24419
|
1208 (funcall handler 'shell-command command output-buffer error-buffer)
|
|
14627
|
1209 (if (and output-buffer
|
|
|
1210 (not (or (bufferp output-buffer) (stringp output-buffer))))
|
|
24419
|
1211 (let ((error-file
|
|
26457
|
1212 (if error-buffer
|
26003
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1213 (make-temp-file
|
|
25483
|
1214 (expand-file-name "scor"
|
|
|
1215 (or small-temporary-file-directory
|
|
|
1216 temporary-file-directory)))
|
|
24419
|
1217 nil)))
|
|
|
1218 (barf-if-buffer-read-only)
|
|
24825
|
1219 (push-mark nil t)
|
|
24419
|
1220 ;; We do not use -f for csh; we will not support broken use of
|
|
|
1221 ;; .cshrcs. Even the BSD csh manual says to use
|
|
|
1222 ;; "if ($?prompt) exit" before things which are not useful
|
|
|
1223 ;; non-interactively. Besides, if someone wants their other
|
|
|
1224 ;; aliases for shell commands then they can still have them.
|
|
26457
|
1225 (call-process shell-file-name nil
|
|
24419
|
1226 (if error-file
|
|
|
1227 (list t error-file)
|
|
|
1228 t)
|
|
|
1229 nil shell-command-switch command)
|
|
|
1230 (when (and error-file (file-exists-p error-file))
|
|
|
1231 (if (< 0 (nth 7 (file-attributes error-file)))
|
|
|
1232 (with-current-buffer (get-buffer-create error-buffer)
|
|
|
1233 (let ((pos-from-end (- (point-max) (point))))
|
|
|
1234 (or (bobp)
|
|
|
1235 (insert "\f\n"))
|
|
|
1236 ;; Do no formatting while reading error file,
|
|
|
1237 ;; because that can run a shell command, and we
|
|
|
1238 ;; don't want that to cause an infinite recursion.
|
|
|
1239 (format-insert-file error-file nil)
|
|
|
1240 ;; Put point after the inserted errors.
|
|
|
1241 (goto-char (- (point-max) pos-from-end)))
|
|
|
1242 (display-buffer (current-buffer))))
|
|
|
1243 (delete-file error-file))
|
|
|
1244 ;; This is like exchange-point-and-mark, but doesn't
|
|
|
1245 ;; activate the mark. It is cleaner to avoid activation,
|
|
|
1246 ;; even though the command loop would deactivate the mark
|
|
|
1247 ;; because we inserted text.
|
|
|
1248 (goto-char (prog1 (mark t)
|
|
|
1249 (set-marker (mark-marker) (point)
|
|
|
1250 (current-buffer)))))
|
|
14627
|
1251 ;; Preserve the match data in case called from a program.
|
|
|
1252 (save-match-data
|
|
|
1253 (if (string-match "[ \t]*&[ \t]*$" command)
|
|
|
1254 ;; Command ending with ampersand means asynchronous.
|
|
|
1255 (let ((buffer (get-buffer-create
|
|
|
1256 (or output-buffer "*Async Shell Command*")))
|
|
|
1257 (directory default-directory)
|
|
|
1258 proc)
|
|
|
1259 ;; Remove the ampersand.
|
|
|
1260 (setq command (substring command 0 (match-beginning 0)))
|
|
|
1261 ;; If will kill a process, query first.
|
|
|
1262 (setq proc (get-buffer-process buffer))
|
|
|
1263 (if proc
|
|
|
1264 (if (yes-or-no-p "A command is running. Kill it? ")
|
|
|
1265 (kill-process proc)
|
|
|
1266 (error "Shell command in progress")))
|
|
|
1267 (save-excursion
|
|
|
1268 (set-buffer buffer)
|
|
|
1269 (setq buffer-read-only nil)
|
|
|
1270 (erase-buffer)
|
|
|
1271 (display-buffer buffer)
|
|
|
1272 (setq default-directory directory)
|
|
26457
|
1273 (setq proc (start-process "Shell" buffer shell-file-name
|
|
14627
|
1274 shell-command-switch command))
|
|
|
1275 (setq mode-line-process '(":%s"))
|
|
|
1276 (require 'shell) (shell-mode)
|
|
|
1277 (set-process-sentinel proc 'shell-command-sentinel)
|
|
|
1278 ))
|
|
24419
|
1279 (shell-command-on-region (point) (point) command
|
|
|
1280 output-buffer nil error-buffer)))))))
|
|
33786
|
1281
|
|
32203
|
1282 (defun display-message-or-buffer (message
|
|
|
1283 &optional buffer-name not-this-window frame)
|
|
|
1284 "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
|
|
|
1285 MESSAGE may be either a string or a buffer.
|
|
|
1286
|
|
|
1287 A buffer is displayed using `display-buffer' if MESSAGE is too long for
|
|
33312
|
1288 the maximum height of the echo area, as defined by `max-mini-window-height'
|
|
|
1289 if `resize-mini-windows' is non-nil.
|
|
32203
|
1290
|
|
32260
|
1291 Returns either the string shown in the echo area, or when a pop-up
|
|
|
1292 buffer is used, the window used to display it.
|
|
|
1293
|
|
32203
|
1294 If MESSAGE is a string, then the optional argument BUFFER-NAME is the
|
|
|
1295 name of the buffer used to display it in the case where a pop-up buffer
|
|
|
1296 is used, defaulting to `*Message*'. In the case where MESSAGE is a
|
|
|
1297 string and it is displayed in the echo area, it is not specified whether
|
|
|
1298 the contents are inserted into the buffer anyway.
|
|
|
1299
|
|
|
1300 Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
|
|
|
1301 and only used if a buffer is displayed."
|
|
|
1302 (cond ((and (stringp message) (not (string-match "\n" message)))
|
|
|
1303 ;; Trivial case where we can use the echo area
|
|
|
1304 (message "%s" message))
|
|
|
1305 ((and (stringp message)
|
|
|
1306 (= (string-match "\n" message) (1- (length message))))
|
|
|
1307 ;; Trivial case where we can just remove single trailing newline
|
|
|
1308 (message "%s" (substring message 0 (1- (length message)))))
|
|
|
1309 (t
|
|
|
1310 ;; General case
|
|
|
1311 (with-current-buffer
|
|
|
1312 (if (bufferp message)
|
|
|
1313 message
|
|
|
1314 (get-buffer-create (or buffer-name "*Message*")))
|
|
|
1315
|
|
|
1316 (unless (bufferp message)
|
|
|
1317 (erase-buffer)
|
|
|
1318 (insert message))
|
|
|
1319
|
|
|
1320 (let ((lines
|
|
|
1321 (if (= (buffer-size) 0)
|
|
|
1322 0
|
|
|
1323 (count-lines (point-min) (point-max)))))
|
|
|
1324 (cond ((or (<= lines 1)
|
|
|
1325 (<= lines
|
|
33312
|
1326 (if resize-mini-windows
|
|
|
1327 (cond ((floatp max-mini-window-height)
|
|
|
1328 (* (frame-height)
|
|
|
1329 max-mini-window-height))
|
|
|
1330 ((integerp max-mini-window-height)
|
|
|
1331 max-mini-window-height)
|
|
|
1332 (t
|
|
|
1333 1))
|
|
|
1334 1)))
|
|
32203
|
1335 ;; Echo area
|
|
|
1336 (goto-char (point-max))
|
|
|
1337 (when (bolp)
|
|
|
1338 (backward-char 1))
|
|
|
1339 (message "%s" (buffer-substring (point-min) (point))))
|
|
|
1340 (t
|
|
|
1341 ;; Buffer
|
|
|
1342 (goto-char (point-min))
|
|
|
1343 (display-buffer message not-this-window frame))))))))
|
|
|
1344
|
|
|
1345
|
|
475
|
1346 ;; We have a sentinel to prevent insertion of a termination message
|
|
|
1347 ;; in the buffer itself.
|
|
|
1348 (defun shell-command-sentinel (process signal)
|
|
12565
|
1349 (if (memq (process-status process) '(exit signal))
|
|
26457
|
1350 (message "%s: %s."
|
|
12565
|
1351 (car (cdr (cdr (process-command process))))
|
|
|
1352 (substring signal 0 -1))))
|
|
475
|
1353
|
|
9539
|
1354 (defun shell-command-on-region (start end command
|
|
19362
|
1355 &optional output-buffer replace
|
|
|
1356 error-buffer)
|
|
475
|
1357 "Execute string COMMAND in inferior shell with region as input.
|
|
|
1358 Normally display output (if any) in temp buffer `*Shell Command Output*';
|
|
24155
|
1359 Prefix arg means replace the region with it. Return the exit code of
|
|
|
1360 COMMAND.
|
|
10852
|
1361
|
|
19109
|
1362 To specify a coding system for converting non-ASCII characters
|
|
|
1363 in the input and output to the shell command, use \\[universal-coding-system-argument]
|
|
|
1364 before this command. By default, the input (from the current buffer)
|
|
|
1365 is encoded in the same coding system that will be used to save the file,
|
|
|
1366 `buffer-file-coding-system'. If the output is going to replace the region,
|
|
|
1367 then it is decoded from that same coding system.
|
|
|
1368
|
|
23471
|
1369 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
|
|
|
1370 REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
|
|
|
1371 systems by binding `coding-system-for-read' and
|
|
|
1372 `coding-system-for-write'.
|
|
475
|
1373
|
32201
2d44e29be6fa
(shell-command-on-region): If the output is short enough to display in
Miles Bader <miles@gnu.org>
diff
changeset
|
1374 If the output is short enough to display in the echo area (which is
|
|
33312
|
1375 determined by the variable `max-mini-window-height' if
|
|
|
1376 `resize-mini-windows' is non-nil), it is shown there, but it is
|
|
|
1377 nonetheless available in buffer `*Shell Command Output*' even though
|
|
|
1378 that buffer is not automatically displayed. If there is no output, or
|
|
|
1379 if output is inserted in the current buffer, then `*Shell Command
|
|
|
1380 Output*' is deleted.
|
|
9539
|
1381
|
|
10852
|
1382 If the optional fourth argument OUTPUT-BUFFER is non-nil,
|
|
|
1383 that says to put the output in some other buffer.
|
|
9539
|
1384 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
|
|
|
1385 If OUTPUT-BUFFER is not a buffer and not nil,
|
|
|
1386 insert output in the current buffer.
|
|
19362
|
1387 In either case, the output is inserted after point (leaving mark after it).
|
|
|
1388
|
|
23471
|
1389 If REPLACE, the optional fifth argument, is non-nil, that means insert
|
|
|
1390 the output in place of text from START to END, putting point and mark
|
|
|
1391 around it.
|
|
|
1392
|
|
23588
|
1393 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
|
|
19362
|
1394 or buffer name to which to direct the command's standard error output.
|
|
24106
|
1395 If it is nil, error output is mingled with regular output.
|
|
24419
|
1396 In an interactive call, the variable `shell-command-default-error-buffer'
|
|
|
1397 specifies the value of ERROR-BUFFER."
|
|
10805
|
1398 (interactive (let ((string
|
|
|
1399 ;; Do this before calling region-beginning
|
|
|
1400 ;; and region-end, in case subprocess output
|
|
|
1401 ;; relocates them while we are in the minibuffer.
|
|
|
1402 (read-from-minibuffer "Shell command on region: "
|
|
|
1403 nil nil nil
|
|
|
1404 'shell-command-history)))
|
|
13482
|
1405 ;; call-interactively recognizes region-beginning and
|
|
|
1406 ;; region-end specially, leaving them in the history.
|
|
|
1407 (list (region-beginning) (region-end)
|
|
10805
|
1408 string
|
|
|
1409 current-prefix-arg
|
|
24106
|
1410 current-prefix-arg
|
|
24419
|
1411 shell-command-default-error-buffer)))
|
|
19362
|
1412 (let ((error-file
|
|
25483
|
1413 (if error-buffer
|
26003
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1414 (make-temp-file
|
|
25483
|
1415 (expand-file-name "scor"
|
|
|
1416 (or small-temporary-file-directory
|
|
|
1417 temporary-file-directory)))
|
|
24155
|
1418 nil))
|
|
|
1419 exit-status)
|
|
24106
|
1420 (if (or replace
|
|
|
1421 (and output-buffer
|
|
24400
|
1422 (not (or (bufferp output-buffer) (stringp output-buffer)))))
|
|
24106
|
1423 ;; Replace specified region with output from command.
|
|
|
1424 (let ((swap (and replace (< start end))))
|
|
|
1425 ;; Don't muck with mark unless REPLACE says we should.
|
|
|
1426 (goto-char start)
|
|
|
1427 (and replace (push-mark))
|
|
24155
|
1428 (setq exit-status
|
|
|
1429 (call-process-region start end shell-file-name t
|
|
|
1430 (if error-file
|
|
|
1431 (list t error-file)
|
|
|
1432 t)
|
|
|
1433 nil shell-command-switch command))
|
|
24106
|
1434 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
|
|
|
1435 (and shell-buffer (not (eq shell-buffer (current-buffer)))
|
|
|
1436 (kill-buffer shell-buffer)))
|
|
|
1437 ;; Don't muck with mark unless REPLACE says we should.
|
|
|
1438 (and replace swap (exchange-point-and-mark)))
|
|
|
1439 ;; No prefix argument: put the output in a temp buffer,
|
|
|
1440 ;; replacing its entire contents.
|
|
|
1441 (let ((buffer (get-buffer-create
|
|
|
1442 (or output-buffer "*Shell Command Output*")))
|
|
24155
|
1443 (success nil))
|
|
24106
|
1444 (unwind-protect
|
|
|
1445 (if (eq buffer (current-buffer))
|
|
|
1446 ;; If the input is the same buffer as the output,
|
|
|
1447 ;; delete everything but the specified region,
|
|
|
1448 ;; then replace that region with the output.
|
|
|
1449 (progn (setq buffer-read-only nil)
|
|
|
1450 (delete-region (max start end) (point-max))
|
|
|
1451 (delete-region (point-min) (min start end))
|
|
|
1452 (setq exit-status
|
|
|
1453 (call-process-region (point-min) (point-max)
|
|
26457
|
1454 shell-file-name t
|
|
24106
|
1455 (if error-file
|
|
|
1456 (list t error-file)
|
|
|
1457 t)
|
|
24155
|
1458 nil shell-command-switch
|
|
|
1459 command)))
|
|
|
1460 ;; Clear the output buffer, then run the command with
|
|
|
1461 ;; output there.
|
|
28703
|
1462 (let ((directory default-directory))
|
|
|
1463 (save-excursion
|
|
|
1464 (set-buffer buffer)
|
|
|
1465 (setq buffer-read-only nil)
|
|
|
1466 (if (not output-buffer)
|
|
|
1467 (setq default-directory directory))
|
|
|
1468 (erase-buffer)))
|
|
24106
|
1469 (setq exit-status
|
|
|
1470 (call-process-region start end shell-file-name nil
|
|
|
1471 (if error-file
|
|
|
1472 (list buffer error-file)
|
|
|
1473 buffer)
|
|
24155
|
1474 nil shell-command-switch command)))
|
|
25147
|
1475 (setq success (and exit-status (equal 0 exit-status)))
|
|
24106
|
1476 ;; Report the amount of output.
|
|
32203
|
1477 (if (with-current-buffer buffer (> (point-max) (point-min)))
|
|
|
1478 ;; There's some output, display it
|
|
|
1479 (display-message-or-buffer buffer)
|
|
|
1480 ;; No output; error?
|
|
|
1481 (message (if (and error-file
|
|
|
1482 (< 0 (nth 7 (file-attributes error-file))))
|
|
|
1483 "(Shell command %sed with some error output)"
|
|
|
1484 "(Shell command %sed with no output)")
|
|
|
1485 (if (equal 0 exit-status) "succeed" "fail"))
|
|
|
1486 (kill-buffer buffer)))))
|
|
|
1487
|
|
24419
|
1488 (when (and error-file (file-exists-p error-file))
|
|
|
1489 (if (< 0 (nth 7 (file-attributes error-file)))
|
|
|
1490 (with-current-buffer (get-buffer-create error-buffer)
|
|
|
1491 (let ((pos-from-end (- (point-max) (point))))
|
|
|
1492 (or (bobp)
|
|
|
1493 (insert "\f\n"))
|
|
|
1494 ;; Do no formatting while reading error file,
|
|
|
1495 ;; because that can run a shell command, and we
|
|
|
1496 ;; don't want that to cause an infinite recursion.
|
|
|
1497 (format-insert-file error-file nil)
|
|
|
1498 ;; Put point after the inserted errors.
|
|
|
1499 (goto-char (- (point-max) pos-from-end)))
|
|
|
1500 (display-buffer (current-buffer))))
|
|
|
1501 (delete-file error-file))
|
|
24155
|
1502 exit-status))
|
|
26457
|
1503
|
|
16312
|
1504 (defun shell-command-to-string (command)
|
|
|
1505 "Execute shell command COMMAND and return its output as a string."
|
|
|
1506 (with-output-to-string
|
|
16316
|
1507 (with-current-buffer
|
|
|
1508 standard-output
|
|
|
1509 (call-process shell-file-name nil t nil shell-command-switch command))))
|
|
33786
|
1510
|
|
16685
|
1511 (defvar universal-argument-map
|
|
12266
|
1512 (let ((map (make-sparse-keymap)))
|
|
|
1513 (define-key map [t] 'universal-argument-other-key)
|
|
12313
|
1514 (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
|
|
12266
|
1515 (define-key map [switch-frame] nil)
|
|
|
1516 (define-key map [?\C-u] 'universal-argument-more)
|
|
|
1517 (define-key map [?-] 'universal-argument-minus)
|
|
|
1518 (define-key map [?0] 'digit-argument)
|
|
|
1519 (define-key map [?1] 'digit-argument)
|
|
|
1520 (define-key map [?2] 'digit-argument)
|
|
|
1521 (define-key map [?3] 'digit-argument)
|
|
|
1522 (define-key map [?4] 'digit-argument)
|
|
|
1523 (define-key map [?5] 'digit-argument)
|
|
|
1524 (define-key map [?6] 'digit-argument)
|
|
|
1525 (define-key map [?7] 'digit-argument)
|
|
|
1526 (define-key map [?8] 'digit-argument)
|
|
|
1527 (define-key map [?9] 'digit-argument)
|
|
30347
|
1528 (define-key map [kp-0] 'digit-argument)
|
|
|
1529 (define-key map [kp-1] 'digit-argument)
|
|
|
1530 (define-key map [kp-2] 'digit-argument)
|
|
|
1531 (define-key map [kp-3] 'digit-argument)
|
|
|
1532 (define-key map [kp-4] 'digit-argument)
|
|
|
1533 (define-key map [kp-5] 'digit-argument)
|
|
|
1534 (define-key map [kp-6] 'digit-argument)
|
|
|
1535 (define-key map [kp-7] 'digit-argument)
|
|
|
1536 (define-key map [kp-8] 'digit-argument)
|
|
|
1537 (define-key map [kp-9] 'digit-argument)
|
|
|
1538 (define-key map [kp-subtract] 'universal-argument-minus)
|
|
12266
|
1539 map)
|
|
|
1540 "Keymap used while processing \\[universal-argument].")
|
|
|
1541
|
|
12334
|
1542 (defvar universal-argument-num-events nil
|
|
|
1543 "Number of argument-specifying events read by `universal-argument'.
|
|
|
1544 `universal-argument-other-key' uses this to discard those events
|
|
|
1545 from (this-command-keys), and reread only the final command.")
|
|
|
1546
|
|
12230
|
1547 (defun universal-argument ()
|
|
|
1548 "Begin a numeric argument for the following command.
|
|
|
1549 Digits or minus sign following \\[universal-argument] make up the numeric argument.
|
|
|
1550 \\[universal-argument] following the digits or minus sign ends the argument.
|
|
|
1551 \\[universal-argument] without digits or minus sign provides 4 as argument.
|
|
|
1552 Repeating \\[universal-argument] without digits or minus sign
|
|
16408
|
1553 multiplies the argument by 4 each time.
|
|
|
1554 For some commands, just \\[universal-argument] by itself serves as a flag
|
|
16445
|
1555 which is different in effect from any particular numeric argument.
|
|
|
1556 These commands include \\[set-mark-command] and \\[start-kbd-macro]."
|
|
12266
|
1557 (interactive)
|
|
|
1558 (setq prefix-arg (list 4))
|
|
12334
|
1559 (setq universal-argument-num-events (length (this-command-keys)))
|
|
12266
|
1560 (setq overriding-terminal-local-map universal-argument-map))
|
|
12230
|
1561
|
|
12266
|
1562 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
|
|
|
1563 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
|
|
|
1564 (defun universal-argument-more (arg)
|
|
|
1565 (interactive "P")
|
|
|
1566 (if (consp arg)
|
|
|
1567 (setq prefix-arg (list (* 4 (car arg))))
|
17214
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1568 (if (eq arg '-)
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1569 (setq prefix-arg (list -4))
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1570 (setq prefix-arg arg)
|
15e868121a15
(newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1571 (setq overriding-terminal-local-map nil)))
|
|
12334
|
1572 (setq universal-argument-num-events (length (this-command-keys))))
|
|
12230
|
1573
|
|
12266
|
1574 (defun negative-argument (arg)
|
|
|
1575 "Begin a negative numeric argument for the next command.
|
|
|
1576 \\[universal-argument] following digits or minus sign ends the argument."
|
|
|
1577 (interactive "P")
|
|
|
1578 (cond ((integerp arg)
|
|
|
1579 (setq prefix-arg (- arg)))
|
|
|
1580 ((eq arg '-)
|
|
|
1581 (setq prefix-arg nil))
|
|
|
1582 (t
|
|
12313
|
1583 (setq prefix-arg '-)))
|
|
12334
|
1584 (setq universal-argument-num-events (length (this-command-keys)))
|
|
12313
|
1585 (setq overriding-terminal-local-map universal-argument-map))
|
|
12230
|
1586
|
|
|
1587 (defun digit-argument (arg)
|
|
|
1588 "Part of the numeric argument for the next command.
|
|
|
1589 \\[universal-argument] following digits or minus sign ends the argument."
|
|
|
1590 (interactive "P")
|
|
30347
|
1591 (let* ((char (if (integerp last-command-char)
|
|
|
1592 last-command-char
|
|
|
1593 (get last-command-char 'ascii-character)))
|
|
|
1594 (digit (- (logand char ?\177) ?0)))
|
|
12266
|
1595 (cond ((integerp arg)
|
|
|
1596 (setq prefix-arg (+ (* arg 10)
|
|
|
1597 (if (< arg 0) (- digit) digit))))
|
|
|
1598 ((eq arg '-)
|
|
|
1599 ;; Treat -0 as just -, so that -01 will work.
|
|
|
1600 (setq prefix-arg (if (zerop digit) '- (- digit))))
|
|
|
1601 (t
|
|
12313
|
1602 (setq prefix-arg digit))))
|
|
12334
|
1603 (setq universal-argument-num-events (length (this-command-keys)))
|
|
12313
|
1604 (setq overriding-terminal-local-map universal-argument-map))
|
|
12230
|
1605
|
|
12266
|
1606 ;; For backward compatibility, minus with no modifiers is an ordinary
|
|
|
1607 ;; command if digits have already been entered.
|
|
|
1608 (defun universal-argument-minus (arg)
|
|
12230
|
1609 (interactive "P")
|
|
12266
|
1610 (if (integerp arg)
|
|
|
1611 (universal-argument-other-key arg)
|
|
|
1612 (negative-argument arg)))
|
|
|
1613
|
|
|
1614 ;; Anything else terminates the argument and is left in the queue to be
|
|
|
1615 ;; executed as a command.
|
|
|
1616 (defun universal-argument-other-key (arg)
|
|
|
1617 (interactive "P")
|
|
|
1618 (setq prefix-arg arg)
|
|
12334
|
1619 (let* ((key (this-command-keys))
|
|
|
1620 (keylist (listify-key-sequence key)))
|
|
|
1621 (setq unread-command-events
|
13525
de50b50309d1
(universal-argument-other-key): Add to existing unread-command-events value.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1622 (append (nthcdr universal-argument-num-events keylist)
|
de50b50309d1
(universal-argument-other-key): Add to existing unread-command-events value.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1623 unread-command-events)))
|
12320
979836b1a1a9
(universal-argument-other-key): Call reset-this-command-lengths.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1624 (reset-this-command-lengths)
|
|
12266
|
1625 (setq overriding-terminal-local-map nil))
|
|
33786
|
1626
|
|
715
|
1627 ;;;; Window system cut and paste hooks.
|
|
|
1628
|
|
|
1629 (defvar interprogram-cut-function nil
|
|
|
1630 "Function to call to make a killed region available to other programs.
|
|
|
1631
|
|
|
1632 Most window systems provide some sort of facility for cutting and
|
|
3034
|
1633 pasting text between the windows of different programs.
|
|
|
1634 This variable holds a function that Emacs calls whenever text
|
|
|
1635 is put in the kill ring, to make the new kill available to other
|
|
715
|
1636 programs.
|
|
|
1637
|
|
3034
|
1638 The function takes one or two arguments.
|
|
|
1639 The first argument, TEXT, is a string containing
|
|
|
1640 the text which should be made available.
|
|
|
1641 The second, PUSH, if non-nil means this is a \"new\" kill;
|
|
|
1642 nil means appending to an \"old\" kill.")
|
|
715
|
1643
|
|
|
1644 (defvar interprogram-paste-function nil
|
|
|
1645 "Function to call to get text cut from other programs.
|
|
|
1646
|
|
|
1647 Most window systems provide some sort of facility for cutting and
|
|
3034
|
1648 pasting text between the windows of different programs.
|
|
|
1649 This variable holds a function that Emacs calls to obtain
|
|
715
|
1650 text that other programs have provided for pasting.
|
|
|
1651
|
|
|
1652 The function should be called with no arguments. If the function
|
|
|
1653 returns nil, then no other program has provided such text, and the top
|
|
|
1654 of the Emacs kill ring should be used. If the function returns a
|
|
727
|
1655 string, that string should be put in the kill ring as the latest kill.
|
|
|
1656
|
|
|
1657 Note that the function should return a string only if a program other
|
|
|
1658 than Emacs has provided a string for pasting; if Emacs provided the
|
|
|
1659 most recent string, the function should return nil. If it is
|
|
|
1660 difficult to tell whether Emacs or some other program provided the
|
|
|
1661 current string, it is probably good enough to return nil if the string
|
|
|
1662 is equal (according to `string=') to the last text Emacs provided.")
|
|
715
|
1663
|
|
|
1664
|
|
33786
|
1665
|
|
715
|
1666 ;;;; The kill ring data structure.
|
|
475
|
1667
|
|
|
1668 (defvar kill-ring nil
|
|
715
|
1669 "List of killed text sequences.
|
|
|
1670 Since the kill ring is supposed to interact nicely with cut-and-paste
|
|
|
1671 facilities offered by window systems, use of this variable should
|
|
|
1672 interact nicely with `interprogram-cut-function' and
|
|
|
1673 `interprogram-paste-function'. The functions `kill-new',
|
|
|
1674 `kill-append', and `current-kill' are supposed to implement this
|
|
|
1675 interaction; you may want to use them instead of manipulating the kill
|
|
|
1676 ring directly.")
|
|
475
|
1677
|
|
23495
|
1678 (defcustom kill-ring-max 60
|
|
17663
|
1679 "*Maximum length of kill ring before oldest elements are thrown away."
|
|
|
1680 :type 'integer
|
|
|
1681 :group 'killing)
|
|
475
|
1682
|
|
|
1683 (defvar kill-ring-yank-pointer nil
|
|
|
1684 "The tail of the kill ring whose car is the last thing yanked.")
|
|
|
1685
|
|
8763
|
1686 (defun kill-new (string &optional replace)
|
|
715
|
1687 "Make STRING the latest kill in the kill ring.
|
|
|
1688 Set the kill-ring-yank pointer to point to it.
|
|
8763
|
1689 If `interprogram-cut-function' is non-nil, apply it to STRING.
|
|
|
1690 Optional second argument REPLACE non-nil means that STRING will replace
|
|
|
1691 the front of the kill ring, rather than being added to the list."
|
8768
e2073805b688
(kill-new): Call menu-bar-update-yank-menu only if that function is defined.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1692 (and (fboundp 'menu-bar-update-yank-menu)
|
e2073805b688
(kill-new): Call menu-bar-update-yank-menu only if that function is defined.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1693 (menu-bar-update-yank-menu string (and replace (car kill-ring))))
|
|
34443
|
1694 (if (and replace kill-ring)
|
|
8763
|
1695 (setcar kill-ring string)
|
|
|
1696 (setq kill-ring (cons string kill-ring))
|
|
|
1697 (if (> (length kill-ring) kill-ring-max)
|
|
|
1698 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
|
|
715
|
1699 (setq kill-ring-yank-pointer kill-ring)
|
|
|
1700 (if interprogram-cut-function
|
12975
9bad6a54e268
(kill-new): Compute 2nd arg to interprogram-cut-function based on REPLACE.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1701 (funcall interprogram-cut-function string (not replace))))
|
|
715
|
1702
|
|
475
|
1703 (defun kill-append (string before-p)
|
|
715
|
1704 "Append STRING to the end of the latest kill in the kill ring.
|
|
|
1705 If BEFORE-P is non-nil, prepend STRING to the kill.
|
|
1760
|
1706 If `interprogram-cut-function' is set, pass the resulting kill to
|
|
715
|
1707 it."
|
|
8763
|
1708 (kill-new (if before-p
|
|
|
1709 (concat string (car kill-ring))
|
|
|
1710 (concat (car kill-ring) string)) t))
|
|
658
|
1711
|
|
715
|
1712 (defun current-kill (n &optional do-not-move)
|
|
|
1713 "Rotate the yanking point by N places, and then return that kill.
|
|
|
1714 If N is zero, `interprogram-paste-function' is set, and calling it
|
|
|
1715 returns a string, then that string is added to the front of the
|
|
|
1716 kill ring and returned as the latest kill.
|
|
26457
|
1717 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
|
|
715
|
1718 yanking point; just return the Nth kill forward."
|
|
|
1719 (let ((interprogram-paste (and (= n 0)
|
|
|
1720 interprogram-paste-function
|
|
|
1721 (funcall interprogram-paste-function))))
|
|
|
1722 (if interprogram-paste
|
|
|
1723 (progn
|
|
|
1724 ;; Disable the interprogram cut function when we add the new
|
|
|
1725 ;; text to the kill ring, so Emacs doesn't try to own the
|
|
|
1726 ;; selection, with identical text.
|
|
|
1727 (let ((interprogram-cut-function nil))
|
|
|
1728 (kill-new interprogram-paste))
|
|
|
1729 interprogram-paste)
|
|
|
1730 (or kill-ring (error "Kill ring is empty"))
|
4511
db555f6edd6b
(current-kill): Replace (% (+ N (- L K)) L) with (mod (- N K) L),
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1731 (let ((ARGth-kill-element
|
db555f6edd6b
(current-kill): Replace (% (+ N (- L K)) L) with (mod (- N K) L),
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1732 (nthcdr (mod (- n (length kill-ring-yank-pointer))
|
db555f6edd6b
(current-kill): Replace (% (+ N (- L K)) L) with (mod (- N K) L),
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1733 (length kill-ring))
|
db555f6edd6b
(current-kill): Replace (% (+ N (- L K)) L) with (mod (- N K) L),
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
1734 kill-ring)))
|
|
715
|
1735 (or do-not-move
|
|
|
1736 (setq kill-ring-yank-pointer ARGth-kill-element))
|
|
|
1737 (car ARGth-kill-element)))))
|
|
658
|
1738
|
|
715
|
1739
|
|
33786
|
1740
|
|
715
|
1741 ;;;; Commands for manipulating the kill ring.
|
|
658
|
1742
|
|
17663
|
1743 (defcustom kill-read-only-ok nil
|
|
|
1744 "*Non-nil means don't signal an error for killing read-only text."
|
|
|
1745 :type 'boolean
|
|
|
1746 :group 'killing)
|
|
7063
|
1747
|
|
14507
|
1748 (put 'text-read-only 'error-conditions
|
|
|
1749 '(text-read-only buffer-read-only error))
|
|
|
1750 (put 'text-read-only 'error-message "Text is read-only")
|
|
|
1751
|
|
475
|
1752 (defun kill-region (beg end)
|
|
|
1753 "Kill between point and mark.
|
|
|
1754 The text is deleted but saved in the kill ring.
|
|
|
1755 The command \\[yank] can retrieve it from there.
|
|
36110
|
1756 \(If you want to kill and then yank immediately, use \\[kill-ring-save].)
|
|
|
1757
|
|
|
1758 If you want to append the killed region to the last killed text,
|
|
|
1759 use \\[append-next-kill] before \\[kill-region].
|
|
|
1760
|
|
1834
|
1761 If the buffer is read-only, Emacs will beep and refrain from deleting
|
|
|
1762 the text, but put the text in the kill ring anyway. This means that
|
|
|
1763 you can use the killing commands to copy text from a read-only buffer.
|
|
475
|
1764
|
|
|
1765 This is the primitive for programs to kill text (as opposed to deleting it).
|
|
|
1766 Supply two arguments, character numbers indicating the stretch of text
|
|
|
1767 to be killed.
|
|
|
1768 Any command that calls this function is a \"kill command\".
|
|
|
1769 If the previous command was also a kill command,
|
|
|
1770 the text killed this time appends to the text killed last time
|
|
|
1771 to make one entry in the kill ring."
|
|
27836
|
1772 (interactive "r")
|
|
20279
|
1773 (condition-case nil
|
|
26744
|
1774 (let ((string (delete-and-extract-region beg end)))
|
|
|
1775 (when string ;STRING is nil if BEG = END
|
|
|
1776 ;; Add that string to the kill ring, one way or another.
|
|
|
1777 (if (eq last-command 'kill-region)
|
|
|
1778 (kill-append string (< end beg))
|
|
|
1779 (kill-new string)))
|
|
20279
|
1780 (setq this-command 'kill-region))
|
|
|
1781 ((buffer-read-only text-read-only)
|
|
|
1782 ;; The code above failed because the buffer, or some of the characters
|
|
|
1783 ;; in the region, are read-only.
|
|
|
1784 ;; We should beep, in case the user just isn't aware of this.
|
|
|
1785 ;; However, there's no harm in putting
|
|
|
1786 ;; the region's text in the kill ring, anyway.
|
|
|
1787 (copy-region-as-kill beg end)
|
22144
632fc074e4d7
(kill-region): Set this-command unconditionally in a read-only buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1788 ;; Set this-command now, so it will be set even if we get an error.
|
632fc074e4d7
(kill-region): Set this-command unconditionally in a read-only buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1789 (setq this-command 'kill-region)
|
632fc074e4d7
(kill-region): Set this-command unconditionally in a read-only buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1790 ;; This should barf, if appropriate, and give us the correct error.
|
|
20279
|
1791 (if kill-read-only-ok
|
|
|
1792 (message "Read only text copied to kill ring")
|
|
|
1793 ;; Signal an error if the buffer is read-only.
|
|
|
1794 (barf-if-buffer-read-only)
|
|
|
1795 ;; If the buffer isn't read-only, the text is.
|
|
|
1796 (signal 'text-read-only (list (current-buffer)))))))
|
|
475
|
1797
|
|
9876
|
1798 ;; copy-region-as-kill no longer sets this-command, because it's confusing
|
|
|
1799 ;; to get two copies of the text when the user accidentally types M-w and
|
|
|
1800 ;; then corrects it with the intended C-w.
|
|
475
|
1801 (defun copy-region-as-kill (beg end)
|
|
|
1802 "Save the region as if killed, but don't kill it.
|
|
20484
|
1803 In Transient Mark mode, deactivate the mark.
|
|
617
|
1804 If `interprogram-cut-function' is non-nil, also save the text for a window
|
|
|
1805 system cut and paste."
|
|
475
|
1806 (interactive "r")
|
|
|
1807 (if (eq last-command 'kill-region)
|
|
|
1808 (kill-append (buffer-substring beg end) (< end beg))
|
|
715
|
1809 (kill-new (buffer-substring beg end)))
|
|
26457
|
1810 (if transient-mark-mode
|
|
21193
|
1811 (setq deactivate-mark t))
|
|
475
|
1812 nil)
|
|
|
1813
|
|
|
1814 (defun kill-ring-save (beg end)
|
|
2111
|
1815 "Save the region as if killed, but don't kill it.
|
|
20484
|
1816 In Transient Mark mode, deactivate the mark.
|
|
|
1817 If `interprogram-cut-function' is non-nil, also save the text for a window
|
|
|
1818 system cut and paste.
|
|
|
1819
|
|
36110
|
1820 If you want to append the killed line to the last killed text,
|
|
|
1821 use \\[append-next-kill] before \\[kill-ring-save].
|
|
|
1822
|
|
3467
|
1823 This command is similar to `copy-region-as-kill', except that it gives
|
|
20484
|
1824 visual feedback indicating the extent of the region being copied."
|
|
475
|
1825 (interactive "r")
|
|
|
1826 (copy-region-as-kill beg end)
|
|
846
|
1827 (if (interactive-p)
|
|
2850
|
1828 (let ((other-end (if (= (point) beg) end beg))
|
|
|
1829 (opoint (point))
|
|
|
1830 ;; Inhibit quitting so we can make a quit here
|
|
|
1831 ;; look like a C-g typed as a command.
|
|
|
1832 (inhibit-quit t))
|
|
|
1833 (if (pos-visible-in-window-p other-end (selected-window))
|
|
|
1834 (progn
|
|
|
1835 ;; Swap point and mark.
|
|
|
1836 (set-marker (mark-marker) (point) (current-buffer))
|
|
|
1837 (goto-char other-end)
|
|
|
1838 (sit-for 1)
|
|
|
1839 ;; Swap back.
|
|
|
1840 (set-marker (mark-marker) other-end (current-buffer))
|
|
|
1841 (goto-char opoint)
|
|
|
1842 ;; If user quit, deactivate the mark
|
|
|
1843 ;; as C-g would as a command.
|
4044
ad0643aa3ebf
(kill-ring-save): Call deactivate-mark regardless of transient-mark-mode.
Roland McGrath <roland@gnu.org>
diff
changeset
|
1844 (and quit-flag mark-active
|
|
4287
|
1845 (deactivate-mark)))
|
|
2850
|
1846 (let* ((killed-text (current-kill 0))
|
|
|
1847 (message-len (min (length killed-text) 40)))
|
|
|
1848 (if (= (point) beg)
|
|
|
1849 ;; Don't say "killed"; that is misleading.
|
|
|
1850 (message "Saved text until \"%s\""
|
|
|
1851 (substring killed-text (- message-len)))
|
|
|
1852 (message "Saved text from \"%s\""
|
|
|
1853 (substring killed-text 0 message-len))))))))
|
|
475
|
1854
|
|
24798
|
1855 (defun append-next-kill (&optional interactive)
|
|
|
1856 "Cause following command, if it kills, to append to previous kill.
|
|
|
1857 The argument is used for internal purposes; do not supply one."
|
|
|
1858 (interactive "p")
|
|
|
1859 ;; We don't use (interactive-p), since that breaks kbd macros.
|
|
|
1860 (if interactive
|
|
475
|
1861 (progn
|
|
|
1862 (setq this-command 'kill-region)
|
|
|
1863 (message "If the next command is a kill, it will append"))
|
|
|
1864 (setq last-command 'kill-region)))
|
|
33786
|
1865
|
|
25292
|
1866 ;; Yanking.
|
|
475
|
1867
|
|
|
1868 (defun yank-pop (arg)
|
|
1027
|
1869 "Replace just-yanked stretch of killed text with a different stretch.
|
|
|
1870 This command is allowed only immediately after a `yank' or a `yank-pop'.
|
|
475
|
1871 At such a time, the region contains a stretch of reinserted
|
|
1027
|
1872 previously-killed text. `yank-pop' deletes that text and inserts in its
|
|
475
|
1873 place a different stretch of killed text.
|
|
|
1874
|
|
|
1875 With no argument, the previous kill is inserted.
|
|
1027
|
1876 With argument N, insert the Nth previous kill.
|
|
|
1877 If N is negative, this is a more recent kill.
|
|
475
|
1878
|
|
|
1879 The sequence of kills wraps around, so that after the oldest one
|
|
|
1880 comes the newest one."
|
|
|
1881 (interactive "*p")
|
|
|
1882 (if (not (eq last-command 'yank))
|
|
|
1883 (error "Previous command was not a yank"))
|
|
|
1884 (setq this-command 'yank)
|
|
14507
|
1885 (let ((inhibit-read-only t)
|
|
|
1886 (before (< (point) (mark t))))
|
|
2805
|
1887 (delete-region (point) (mark t))
|
|
2824
|
1888 (set-marker (mark-marker) (point) (current-buffer))
|
|
18902
|
1889 (let ((opoint (point)))
|
|
18820
|
1890 (insert (current-kill arg))
|
|
18902
|
1891 (let ((inhibit-read-only t))
|
|
|
1892 (remove-text-properties opoint (point) '(read-only nil))))
|
|
2824
|
1893 (if before
|
|
|
1894 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
|
|
|
1895 ;; It is cleaner to avoid activation, even though the command
|
|
|
1896 ;; loop would deactivate the mark because we inserted text.
|
|
|
1897 (goto-char (prog1 (mark t)
|
|
|
1898 (set-marker (mark-marker) (point) (current-buffer))))))
|
|
2111
|
1899 nil)
|
|
475
|
1900
|
|
|
1901 (defun yank (&optional arg)
|
|
|
1902 "Reinsert the last stretch of killed text.
|
|
|
1903 More precisely, reinsert the stretch of killed text most recently
|
|
1027
|
1904 killed OR yanked. Put point at end, and set mark at beginning.
|
|
|
1905 With just C-u as argument, same but put point at beginning (and mark at end).
|
|
|
1906 With argument N, reinsert the Nth most recently killed stretch of killed
|
|
475
|
1907 text.
|
|
|
1908 See also the command \\[yank-pop]."
|
|
|
1909 (interactive "*P")
|
|
5935
|
1910 ;; If we don't get all the way thru, make last-command indicate that
|
|
|
1911 ;; for the following command.
|
|
|
1912 (setq this-command t)
|
|
475
|
1913 (push-mark (point))
|
|
18902
|
1914 (let ((opoint (point)))
|
|
18820
|
1915 (insert (current-kill (cond
|
|
|
1916 ((listp arg) 0)
|
|
|
1917 ((eq arg '-) -1)
|
|
|
1918 (t (1- arg)))))
|
|
18902
|
1919 (let ((inhibit-read-only t))
|
|
|
1920 (remove-text-properties opoint (point) '(read-only nil))))
|
|
475
|
1921 (if (consp arg)
|
|
2824
|
1922 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
|
|
|
1923 ;; It is cleaner to avoid activation, even though the command
|
|
|
1924 ;; loop would deactivate the mark because we inserted text.
|
|
|
1925 (goto-char (prog1 (mark t)
|
|
|
1926 (set-marker (mark-marker) (point) (current-buffer)))))
|
|
5935
|
1927 ;; If we do get all the way thru, make this-command indicate that.
|
|
|
1928 (setq this-command 'yank)
|
|
2111
|
1929 nil)
|
|
715
|
1930
|
|
|
1931 (defun rotate-yank-pointer (arg)
|
|
|
1932 "Rotate the yanking point in the kill ring.
|
|
|
1933 With argument, rotate that many kills forward (or backward, if negative)."
|
|
|
1934 (interactive "p")
|
|
|
1935 (current-kill arg))
|
|
33786
|
1936
|
|
25292
|
1937 ;; Some kill commands.
|
|
|
1938
|
|
|
1939 ;; Internal subroutine of delete-char
|
|
|
1940 (defun kill-forward-chars (arg)
|
|
|
1941 (if (listp arg) (setq arg (car arg)))
|
|
|
1942 (if (eq arg '-) (setq arg -1))
|
|
|
1943 (kill-region (point) (forward-point arg)))
|
|
|
1944
|
|
|
1945 ;; Internal subroutine of backward-delete-char
|
|
|
1946 (defun kill-backward-chars (arg)
|
|
|
1947 (if (listp arg) (setq arg (car arg)))
|
|
|
1948 (if (eq arg '-) (setq arg -1))
|
|
|
1949 (kill-region (point) (forward-point (- arg))))
|
|
|
1950
|
|
|
1951 (defcustom backward-delete-char-untabify-method 'untabify
|
|
|
1952 "*The method for untabifying when deleting backward.
|
|
26457
|
1953 Can be `untabify' -- turn a tab to many spaces, then delete one space;
|
|
|
1954 `hungry' -- delete all whitespace, both tabs and spaces;
|
|
|
1955 `all' -- delete all whitespace, including tabs, spaces and newlines;
|
|
25292
|
1956 nil -- just delete one character."
|
|
26457
|
1957 :type '(choice (const untabify) (const hungry) (const all) (const nil))
|
|
35327
|
1958 :version "20.3"
|
|
25292
|
1959 :group 'killing)
|
|
|
1960
|
|
|
1961 (defun backward-delete-char-untabify (arg &optional killp)
|
|
|
1962 "Delete characters backward, changing tabs into spaces.
|
|
|
1963 The exact behavior depends on `backward-delete-char-untabify-method'.
|
|
|
1964 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
|
|
|
1965 Interactively, ARG is the prefix arg (default 1)
|
|
|
1966 and KILLP is t if a prefix arg was specified."
|
|
|
1967 (interactive "*p\nP")
|
|
|
1968 (when (eq backward-delete-char-untabify-method 'untabify)
|
|
|
1969 (let ((count arg))
|
|
|
1970 (save-excursion
|
|
|
1971 (while (and (> count 0) (not (bobp)))
|
|
|
1972 (if (= (preceding-char) ?\t)
|
|
|
1973 (let ((col (current-column)))
|
|
|
1974 (forward-char -1)
|
|
|
1975 (setq col (- col (current-column)))
|
|
|
1976 (insert-char ?\ col)
|
|
|
1977 (delete-char 1)))
|
|
|
1978 (forward-char -1)
|
|
|
1979 (setq count (1- count))))))
|
|
|
1980 (delete-backward-char
|
|
26457
|
1981 (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
|
|
|
1982 ((eq backward-delete-char-untabify-method 'all)
|
|
|
1983 " \t\n\r"))))
|
|
|
1984 (if skip
|
|
|
1985 (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
|
|
25292
|
1986 (point)))))
|
|
|
1987 (+ arg (if (zerop wh) 0 (1- wh))))
|
|
26457
|
1988 arg))
|
|
25292
|
1989 killp))
|
|
|
1990
|
|
|
1991 (defun zap-to-char (arg char)
|
|
|
1992 "Kill up to and including ARG'th occurrence of CHAR.
|
|
|
1993 Case is ignored if `case-fold-search' is non-nil in the current buffer.
|
|
|
1994 Goes backward if ARG is negative; error if CHAR not found."
|
|
27836
|
1995 (interactive "p\ncZap to char: ")
|
|
25292
|
1996 (kill-region (point) (progn
|
|
|
1997 (search-forward (char-to-string char) nil nil arg)
|
|
|
1998 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
|
|
|
1999 (point))))
|
|
33786
|
2000
|
|
25292
|
2001 ;; kill-line and its subroutines.
|
|
|
2002
|
|
|
2003 (defcustom kill-whole-line nil
|
|
|
2004 "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
|
|
|
2005 :type 'boolean
|
|
|
2006 :group 'killing)
|
|
|
2007
|
|
|
2008 (defun kill-line (&optional arg)
|
|
|
2009 "Kill the rest of the current line; if no nonblanks there, kill thru newline.
|
|
|
2010 With prefix argument, kill that many lines from point.
|
|
|
2011 Negative arguments kill lines backward.
|
|
32267
|
2012 With zero argument, kills the text before point on the current line.
|
|
25292
|
2013
|
|
|
2014 When calling from a program, nil means \"no arg\",
|
|
|
2015 a number counts as a prefix arg.
|
|
|
2016
|
|
|
2017 To kill a whole line, when point is not at the beginning, type \
|
|
|
2018 \\[beginning-of-line] \\[kill-line] \\[kill-line].
|
|
|
2019
|
|
|
2020 If `kill-whole-line' is non-nil, then this command kills the whole line
|
|
|
2021 including its terminating newline, when used at the beginning of a line
|
|
|
2022 with no argument. As a consequence, you can always kill a whole line
|
|
35916
|
2023 by typing \\[beginning-of-line] \\[kill-line].
|
|
|
2024
|
|
36110
|
2025 If you want to append the killed line to the last killed text,
|
|
|
2026 use \\[append-next-kill] before \\[kill-line].
|
|
|
2027
|
|
35916
|
2028 If the buffer is read-only, Emacs will beep and refrain from deleting
|
|
|
2029 the line, but put the line in the kill ring anyway. This means that
|
|
|
2030 you can use this command to copy text from a read-only buffer."
|
|
27836
|
2031 (interactive "P")
|
|
25292
|
2032 (kill-region (point)
|
|
|
2033 ;; It is better to move point to the other end of the kill
|
|
|
2034 ;; before killing. That way, in a read-only buffer, point
|
|
|
2035 ;; moves across the text that is copied to the kill ring.
|
|
|
2036 ;; The choice has no effect on undo now that undo records
|
|
|
2037 ;; the value of point from before the command was run.
|
|
|
2038 (progn
|
|
|
2039 (if arg
|
|
|
2040 (forward-visible-line (prefix-numeric-value arg))
|
|
|
2041 (if (eobp)
|
|
|
2042 (signal 'end-of-buffer nil))
|
|
|
2043 (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
|
|
|
2044 (forward-visible-line 1)
|
|
|
2045 (end-of-visible-line)))
|
|
|
2046 (point))))
|
|
|
2047
|
|
|
2048 (defun forward-visible-line (arg)
|
|
|
2049 "Move forward by ARG lines, ignoring currently invisible newlines only.
|
|
|
2050 If ARG is negative, move backward -ARG lines.
|
|
|
2051 If ARG is zero, move to the beginning of the current line."
|
|
|
2052 (condition-case nil
|
|
|
2053 (if (> arg 0)
|
|
|
2054 (while (> arg 0)
|
|
|
2055 (or (zerop (forward-line 1))
|
|
|
2056 (signal 'end-of-buffer nil))
|
|
|
2057 ;; If the following character is currently invisible,
|
|
|
2058 ;; skip all characters with that same `invisible' property value,
|
|
|
2059 ;; then find the next newline.
|
|
|
2060 (while (and (not (eobp))
|
|
|
2061 (let ((prop
|
|
|
2062 (get-char-property (point) 'invisible)))
|
|
|
2063 (if (eq buffer-invisibility-spec t)
|
|
|
2064 prop
|
|
|
2065 (or (memq prop buffer-invisibility-spec)
|
|
|
2066 (assq prop buffer-invisibility-spec)))))
|
|
|
2067 (goto-char
|
|
|
2068 (if (get-text-property (point) 'invisible)
|
|
|
2069 (or (next-single-property-change (point) 'invisible)
|
|
|
2070 (point-max))
|
|
|
2071 (next-overlay-change (point))))
|
|
|
2072 (or (zerop (forward-line 1))
|
|
|
2073 (signal 'end-of-buffer nil)))
|
|
|
2074 (setq arg (1- arg)))
|
|
|
2075 (let ((first t))
|
|
|
2076 (while (or first (< arg 0))
|
|
|
2077 (if (zerop arg)
|
|
|
2078 (beginning-of-line)
|
|
|
2079 (or (zerop (forward-line -1))
|
|
|
2080 (signal 'beginning-of-buffer nil)))
|
|
|
2081 (while (and (not (bobp))
|
|
|
2082 (let ((prop
|
|
|
2083 (get-char-property (1- (point)) 'invisible)))
|
|
|
2084 (if (eq buffer-invisibility-spec t)
|
|
|
2085 prop
|
|
|
2086 (or (memq prop buffer-invisibility-spec)
|
|
|
2087 (assq prop buffer-invisibility-spec)))))
|
|
|
2088 (goto-char
|
|
|
2089 (if (get-text-property (1- (point)) 'invisible)
|
|
|
2090 (or (previous-single-property-change (point) 'invisible)
|
|
|
2091 (point-min))
|
|
|
2092 (previous-overlay-change (point))))
|
|
|
2093 (or (zerop (forward-line -1))
|
|
|
2094 (signal 'beginning-of-buffer nil)))
|
|
|
2095 (setq first nil)
|
|
|
2096 (setq arg (1+ arg)))))
|
|
|
2097 ((beginning-of-buffer end-of-buffer)
|
|
|
2098 nil)))
|
|
|
2099
|
|
|
2100 (defun end-of-visible-line ()
|
|
|
2101 "Move to end of current visible line."
|
|
|
2102 (end-of-line)
|
|
|
2103 ;; If the following character is currently invisible,
|
|
|
2104 ;; skip all characters with that same `invisible' property value,
|
|
|
2105 ;; then find the next newline.
|
|
|
2106 (while (and (not (eobp))
|
|
|
2107 (let ((prop
|
|
|
2108 (get-char-property (point) 'invisible)))
|
|
|
2109 (if (eq buffer-invisibility-spec t)
|
|
|
2110 prop
|
|
|
2111 (or (memq prop buffer-invisibility-spec)
|
|
|
2112 (assq prop buffer-invisibility-spec)))))
|
|
|
2113 (if (get-text-property (point) 'invisible)
|
|
|
2114 (goto-char (next-single-property-change (point) 'invisible))
|
|
|
2115 (goto-char (next-overlay-change (point))))
|
|
|
2116 (end-of-line)))
|
|
33786
|
2117
|
|
475
|
2118 (defun insert-buffer (buffer)
|
|
|
2119 "Insert after point the contents of BUFFER.
|
|
|
2120 Puts mark after the inserted text.
|
|
26723
|
2121 BUFFER may be a buffer or a buffer name.
|
|
|
2122
|
|
|
2123 This function is meant for the user to run interactively.
|
|
|
2124 Don't call it from programs!"
|
|
14835
|
2125 (interactive
|
14834
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2126 (list
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2127 (progn
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2128 (barf-if-buffer-read-only)
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2129 (read-buffer "Insert buffer: "
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2130 (if (eq (selected-window) (next-window (selected-window)))
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2131 (other-buffer (current-buffer))
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2132 (window-buffer (next-window (selected-window))))
|
5ae5d97727ce
* simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
diff
changeset
|
2133 t))))
|
|
475
|
2134 (or (bufferp buffer)
|
|
|
2135 (setq buffer (get-buffer buffer)))
|
|
|
2136 (let (start end newmark)
|
|
|
2137 (save-excursion
|
|
|
2138 (save-excursion
|
|
|
2139 (set-buffer buffer)
|
|
|
2140 (setq start (point-min) end (point-max)))
|
|
|
2141 (insert-buffer-substring buffer start end)
|
|
|
2142 (setq newmark (point)))
|
|
1982
|
2143 (push-mark newmark))
|
|
|
2144 nil)
|
|
475
|
2145
|
|
|
2146 (defun append-to-buffer (buffer start end)
|
|
|
2147 "Append to specified buffer the text of the region.
|
|
|
2148 It is inserted into that buffer before its point.
|
|
|
2149
|
|
|
2150 When calling from a program, give three arguments:
|
|
|
2151 BUFFER (or buffer name), START and END.
|
|
|
2152 START and END specify the portion of the current buffer to be copied."
|
|
715
|
2153 (interactive
|
|
10048
|
2154 (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
|
|
3629
|
2155 (region-beginning) (region-end)))
|
|
475
|
2156 (let ((oldbuf (current-buffer)))
|
|
|
2157 (save-excursion
|
|
28187
|
2158 (let* ((append-to (get-buffer-create buffer))
|
|
|
2159 (windows (get-buffer-window-list append-to t t))
|
|
|
2160 point)
|
|
|
2161 (set-buffer append-to)
|
|
|
2162 (setq point (point))
|
|
|
2163 (barf-if-buffer-read-only)
|
|
|
2164 (insert-buffer-substring oldbuf start end)
|
|
|
2165 (dolist (window windows)
|
|
|
2166 (when (= (window-point window) point)
|
|
|
2167 (set-window-point window (point))))))))
|
|
475
|
2168
|
|
|
2169 (defun prepend-to-buffer (buffer start end)
|
|
|
2170 "Prepend to specified buffer the text of the region.
|
|
|
2171 It is inserted into that buffer after its point.
|
|
|
2172
|
|
|
2173 When calling from a program, give three arguments:
|
|
|
2174 BUFFER (or buffer name), START and END.
|
|
|
2175 START and END specify the portion of the current buffer to be copied."
|
|
|
2176 (interactive "BPrepend to buffer: \nr")
|
|
|
2177 (let ((oldbuf (current-buffer)))
|
|
|
2178 (save-excursion
|
|
|
2179 (set-buffer (get-buffer-create buffer))
|
|
24973
|
2180 (barf-if-buffer-read-only)
|
|
475
|
2181 (save-excursion
|
|
|
2182 (insert-buffer-substring oldbuf start end)))))
|
|
|
2183
|
|
|
2184 (defun copy-to-buffer (buffer start end)
|
|
|
2185 "Copy to specified buffer the text of the region.
|
|
|
2186 It is inserted into that buffer, replacing existing text there.
|
|
|
2187
|
|
|
2188 When calling from a program, give three arguments:
|
|
|
2189 BUFFER (or buffer name), START and END.
|
|
|
2190 START and END specify the portion of the current buffer to be copied."
|
|
|
2191 (interactive "BCopy to buffer: \nr")
|
|
|
2192 (let ((oldbuf (current-buffer)))
|
|
|
2193 (save-excursion
|
|
|
2194 (set-buffer (get-buffer-create buffer))
|
|
24973
|
2195 (barf-if-buffer-read-only)
|
|
475
|
2196 (erase-buffer)
|
|
|
2197 (save-excursion
|
|
|
2198 (insert-buffer-substring oldbuf start end)))))
|
|
33786
|
2199
|
4040
d06d7295d3eb
Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
diff
changeset
|
2200 (put 'mark-inactive 'error-conditions '(mark-inactive error))
|
d06d7295d3eb
Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
diff
changeset
|
2201 (put 'mark-inactive 'error-message "The mark is not active now")
|
d06d7295d3eb
Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
diff
changeset
|
2202
|
|
2075
|
2203 (defun mark (&optional force)
|
|
3487
|
2204 "Return this buffer's mark value as integer; error if mark inactive.
|
|
2075
|
2205 If optional argument FORCE is non-nil, access the mark value
|
|
3487
|
2206 even if the mark is not currently active, and return nil
|
|
|
2207 if there is no mark at all.
|
|
2075
|
2208
|
|
475
|
2209 If you are using this in an editing command, you are most likely making
|
|
|
2210 a mistake; see the documentation of `set-mark'."
|
|
10525
|
2211 (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
|
|
2075
|
2212 (marker-position (mark-marker))
|
4040
d06d7295d3eb
Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
diff
changeset
|
2213 (signal 'mark-inactive nil)))
|
|
475
|
2214
|
|
4042
|
2215 ;; Many places set mark-active directly, and several of them failed to also
|
|
|
2216 ;; run deactivate-mark-hook. This shorthand should simplify.
|
|
|
2217 (defsubst deactivate-mark ()
|
|
|
2218 "Deactivate the mark by setting `mark-active' to nil.
|
|
4287
|
2219 \(That makes a difference only in Transient Mark mode.)
|
|
4042
|
2220 Also runs the hook `deactivate-mark-hook'."
|
|
7726
|
2221 (if transient-mark-mode
|
|
|
2222 (progn
|
|
|
2223 (setq mark-active nil)
|
|
|
2224 (run-hooks 'deactivate-mark-hook))))
|
|
4042
|
2225
|
|
475
|
2226 (defun set-mark (pos)
|
|
|
2227 "Set this buffer's mark to POS. Don't use this function!
|
|
|
2228 That is to say, don't use this function unless you want
|
|
|
2229 the user to see that the mark has moved, and you want the previous
|
|
|
2230 mark position to be lost.
|
|
|
2231
|
|
|
2232 Normally, when a new mark is set, the old one should go on the stack.
|
|
|
2233 This is why most applications should use push-mark, not set-mark.
|
|
|
2234
|
|
1027
|
2235 Novice Emacs Lisp programmers often try to use the mark for the wrong
|
|
475
|
2236 purposes. The mark saves a location for the user's convenience.
|
|
|
2237 Most editing commands should not alter the mark.
|
|
|
2238 To remember a location for internal use in the Lisp program,
|
|
|
2239 store it in a Lisp variable. Example:
|
|
|
2240
|
|
|
2241 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
|
|
|
2242
|
|
4287
|
2243 (if pos
|
|
|
2244 (progn
|
|
|
2245 (setq mark-active t)
|
|
|
2246 (run-hooks 'activate-mark-hook)
|
|
|
2247 (set-marker (mark-marker) pos (current-buffer)))
|
|
8660
|
2248 ;; Normally we never clear mark-active except in Transient Mark mode.
|
|
|
2249 ;; But when we actually clear out the mark value too,
|
|
|
2250 ;; we must clear mark-active in any mode.
|
|
|
2251 (setq mark-active nil)
|
|
|
2252 (run-hooks 'deactivate-mark-hook)
|
|
|
2253 (set-marker (mark-marker) nil)))
|
|
475
|
2254
|
|
|
2255 (defvar mark-ring nil
|
|
8695
|
2256 "The list of former marks of the current buffer, most recent first.")
|
|
475
|
2257 (make-variable-buffer-local 'mark-ring)
|
|
8695
|
2258 (put 'mark-ring 'permanent-local t)
|
|
475
|
2259
|
|
17663
|
2260 (defcustom mark-ring-max 16
|
|
|
2261 "*Maximum size of mark ring. Start discarding off end if gets this big."
|
|
|
2262 :type 'integer
|
|
|
2263 :group 'editing-basics)
|
|
475
|
2264
|
|
5811
|
2265 (defvar global-mark-ring nil
|
|
|
2266 "The list of saved global marks, most recent first.")
|
|
|
2267
|
|
17663
|
2268 (defcustom global-mark-ring-max 16
|
|
5811
|
2269 "*Maximum size of global mark ring. \
|
|
17663
|
2270 Start discarding off end if gets this big."
|
|
|
2271 :type 'integer
|
|
|
2272 :group 'editing-basics)
|
|
5811
|
2273
|
|
475
|
2274 (defun set-mark-command (arg)
|
|
|
2275 "Set mark at where point is, or jump to mark.
|
|
5811
|
2276 With no prefix argument, set mark, push old mark position on local mark
|
|
|
2277 ring, and push mark on global mark ring.
|
|
|
2278 With argument, jump to mark, and pop a new position for mark off the ring
|
|
|
2279 \(does not affect global mark ring\).
|
|
475
|
2280
|
|
1027
|
2281 Novice Emacs Lisp programmers often try to use the mark for the wrong
|
|
475
|
2282 purposes. See the documentation of `set-mark' for more information."
|
|
|
2283 (interactive "P")
|
|
|
2284 (if (null arg)
|
|
2805
|
2285 (progn
|
|
2824
|
2286 (push-mark nil nil t))
|
|
2075
|
2287 (if (null (mark t))
|
|
475
|
2288 (error "No mark set in this buffer")
|
|
2805
|
2289 (goto-char (mark t))
|
|
475
|
2290 (pop-mark))))
|
|
|
2291
|
|
2824
|
2292 (defun push-mark (&optional location nomsg activate)
|
|
475
|
2293 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
|
5812
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2294 If the last global mark pushed was not in the current buffer,
|
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2295 also push LOCATION on the global mark ring.
|
|
2824
|
2296 Display `Mark set' unless the optional second arg NOMSG is non-nil.
|
2844
086fda6b2041
(push-mark): Always activate the mark if not in Transient Mark mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2297 In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
|
|
475
|
2298
|
|
1027
|
2299 Novice Emacs Lisp programmers often try to use the mark for the wrong
|
|
2805
|
2300 purposes. See the documentation of `set-mark' for more information.
|
|
|
2301
|
|
|
2302 In Transient Mark mode, this does not activate the mark."
|
|
2075
|
2303 (if (null (mark t))
|
|
475
|
2304 nil
|
|
|
2305 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
|
|
|
2306 (if (> (length mark-ring) mark-ring-max)
|
|
|
2307 (progn
|
|
|
2308 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
|
|
|
2309 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
|
|
2805
|
2310 (set-marker (mark-marker) (or location (point)) (current-buffer))
|
|
5811
|
2311 ;; Now push the mark on the global mark ring.
|
5812
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2312 (if (and global-mark-ring
|
|
5826
|
2313 (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
|
5812
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2314 ;; The last global mark pushed was in this same buffer.
|
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2315 ;; Don't push another one.
|
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2316 nil
|
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2317 (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
|
|
5811
|
2318 (if (> (length global-mark-ring) global-mark-ring-max)
|
|
|
2319 (progn
|
|
|
2320 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
|
|
|
2321 nil)
|
5812
1959e5c4a563
(push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
diff
changeset
|
2322 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
|
|
15302
|
2323 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
|
|
475
|
2324 (message "Mark set"))
|
2844
086fda6b2041
(push-mark): Always activate the mark if not in Transient Mark mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2325 (if (or activate (not transient-mark-mode))
|
086fda6b2041
(push-mark): Always activate the mark if not in Transient Mark mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2326 (set-mark (mark t)))
|
|
475
|
2327 nil)
|
|
|
2328
|
|
|
2329 (defun pop-mark ()
|
|
|
2330 "Pop off mark ring into the buffer's actual mark.
|
|
|
2331 Does not set point. Does nothing if mark ring is empty."
|
|
|
2332 (if mark-ring
|
|
|
2333 (progn
|
|
|
2334 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
|
|
2805
|
2335 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
|
|
4042
|
2336 (deactivate-mark)
|
|
475
|
2337 (move-marker (car mark-ring) nil)
|
|
2805
|
2338 (if (null (mark t)) (ding))
|
|
475
|
2339 (setq mark-ring (cdr mark-ring)))))
|
|
|
2340
|
|
16436
|
2341 (defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
|
|
475
|
2342 (defun exchange-point-and-mark ()
|
|
2075
|
2343 "Put the mark where point is now, and point where the mark is now.
|
|
|
2344 This command works even when the mark is not active,
|
|
|
2345 and it reactivates the mark."
|
|
475
|
2346 (interactive nil)
|
|
2075
|
2347 (let ((omark (mark t)))
|
|
475
|
2348 (if (null omark)
|
|
|
2349 (error "No mark set in this buffer"))
|
|
|
2350 (set-mark (point))
|
|
|
2351 (goto-char omark)
|
|
|
2352 nil))
|
|
2796
|
2353
|
|
17514
|
2354 (defun transient-mark-mode (arg)
|
|
2796
|
2355 "Toggle Transient Mark mode.
|
|
2935
|
2356 With arg, turn Transient Mark mode on if arg is positive, off otherwise.
|
|
2796
|
2357
|
|
5372
|
2358 In Transient Mark mode, when the mark is active, the region is highlighted.
|
|
|
2359 Changing the buffer \"deactivates\" the mark.
|
|
|
2360 So do certain other operations that set the mark
|
|
|
2361 but whose main purpose is something else--for example,
|
|
35631
|
2362 incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
|
|
|
2363
|
|
|
2364 Many commands change their behavior when Transient Mark mode is in effect
|
|
|
2365 and the mark is active, by acting on the region instead of their usual
|
|
35652
|
2366 default part of the buffer's text. Examples of such commands include
|
|
35631
|
2367 \\[comment-dwim], \\[flush-lines], \\[ispell], \\[keep-lines],
|
|
|
2368 \\[query-replace], \\[query-replace-regexp], and \\[undo]. Invoke
|
|
35635
|
2369 \\[apropos-documentation] and type \"transient\" or \"mark.*active\" at
|
|
|
2370 the prompt, to see the documentation of commands which are sensitive to
|
|
|
2371 the Transient Mark mode."
|
|
17514
|
2372 (interactive "P")
|
|
2796
|
2373 (setq transient-mark-mode
|
|
|
2374 (if (null arg)
|
|
|
2375 (not transient-mark-mode)
|
|
17513
|
2376 (> (prefix-numeric-value arg) 0)))
|
|
17514
|
2377 (if (interactive-p)
|
|
|
2378 (if transient-mark-mode
|
|
|
2379 (message "Transient Mark mode enabled")
|
|
|
2380 (message "Transient Mark mode disabled"))))
|
|
5811
|
2381
|
|
|
2382 (defun pop-global-mark ()
|
|
|
2383 "Pop off global mark ring and jump to the top location."
|
|
|
2384 (interactive)
|
|
7881
|
2385 ;; Pop entries which refer to non-existent buffers.
|
|
|
2386 (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
|
|
|
2387 (setq global-mark-ring (cdr global-mark-ring)))
|
|
5811
|
2388 (or global-mark-ring
|
|
|
2389 (error "No global mark set"))
|
|
|
2390 (let* ((marker (car global-mark-ring))
|
|
|
2391 (buffer (marker-buffer marker))
|
|
|
2392 (position (marker-position marker)))
|
|
10351
|
2393 (setq global-mark-ring (nconc (cdr global-mark-ring)
|
|
|
2394 (list (car global-mark-ring))))
|
|
5811
|
2395 (set-buffer buffer)
|
|
|
2396 (or (and (>= position (point-min))
|
|
|
2397 (<= position (point-max)))
|
|
|
2398 (widen))
|
|
|
2399 (goto-char position)
|
|
|
2400 (switch-to-buffer buffer)))
|
|
33786
|
2401
|
|
34101
|
2402 (defcustom next-line-add-newlines nil
|
|
17663
|
2403 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
|
|
|
2404 :type 'boolean
|
|
35333
|
2405 :version "21.1"
|
|
17663
|
2406 :group 'editing-basics)
|
|
2568
|
2407
|
|
475
|
2408 (defun next-line (arg)
|
|
|
2409 "Move cursor vertically down ARG lines.
|
|
|
2410 If there is no character in the target line exactly under the current column,
|
|
|
2411 the cursor is positioned after the character in that line which spans this
|
|
|
2412 column, or at the end of the line if it is not long enough.
|
|
2568
|
2413 If there is no line in the buffer after this one, behavior depends on the
|
|
10226
|
2414 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
|
|
|
2415 to create a line, and moves the cursor to that line. Otherwise it moves the
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2416 cursor to the end of the buffer.
|
|
475
|
2417
|
|
|
2418 The command \\[set-goal-column] can be used to create
|
|
18593
|
2419 a semipermanent goal column for this command.
|
|
|
2420 Then instead of trying to move exactly vertically (or as close as possible),
|
|
|
2421 this command moves to the specified goal column (or as close as possible).
|
|
|
2422 The goal column is stored in the variable `goal-column', which is nil
|
|
|
2423 when there is no goal column.
|
|
475
|
2424
|
|
|
2425 If you are thinking of using this in a Lisp program, consider
|
|
|
2426 using `forward-line' instead. It is usually easier to use
|
|
|
2427 and more reliable (no dependence on goal column, etc.)."
|
|
|
2428 (interactive "p")
|
|
5675
|
2429 (if (and next-line-add-newlines (= arg 1))
|
|
35589
|
2430 (if (save-excursion (end-of-line) (eobp))
|
|
|
2431 ;; When adding a newline, don't expand an abbrev.
|
|
|
2432 (let ((abbrev-mode nil))
|
|
35886
|
2433 (end-of-line)
|
|
|
2434 (insert "\n"))
|
|
35589
|
2435 (line-move arg))
|
|
10226
|
2436 (if (interactive-p)
|
|
|
2437 (condition-case nil
|
|
|
2438 (line-move arg)
|
|
|
2439 ((beginning-of-buffer end-of-buffer) (ding)))
|
|
|
2440 (line-move arg)))
|
|
475
|
2441 nil)
|
|
|
2442
|
|
|
2443 (defun previous-line (arg)
|
|
|
2444 "Move cursor vertically up ARG lines.
|
|
|
2445 If there is no character in the target line exactly over the current column,
|
|
|
2446 the cursor is positioned after the character in that line which spans this
|
|
|
2447 column, or at the end of the line if it is not long enough.
|
|
|
2448
|
|
|
2449 The command \\[set-goal-column] can be used to create
|
|
18593
|
2450 a semipermanent goal column for this command.
|
|
|
2451 Then instead of trying to move exactly vertically (or as close as possible),
|
|
|
2452 this command moves to the specified goal column (or as close as possible).
|
|
|
2453 The goal column is stored in the variable `goal-column', which is nil
|
|
|
2454 when there is no goal column.
|
|
475
|
2455
|
|
|
2456 If you are thinking of using this in a Lisp program, consider using
|
|
1556
|
2457 `forward-line' with a negative argument instead. It is usually easier
|
|
475
|
2458 to use and more reliable (no dependence on goal column, etc.)."
|
|
|
2459 (interactive "p")
|
|
10226
|
2460 (if (interactive-p)
|
|
|
2461 (condition-case nil
|
|
|
2462 (line-move (- arg))
|
|
|
2463 ((beginning-of-buffer end-of-buffer) (ding)))
|
|
|
2464 (line-move (- arg)))
|
|
475
|
2465 nil)
|
|
33786
|
2466
|
|
17663
|
2467 (defcustom track-eol nil
|
|
475
|
2468 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
|
|
|
2469 This means moving to the end of each line moved onto.
|
|
17663
|
2470 The beginning of a blank line does not count as the end of a line."
|
|
|
2471 :type 'boolean
|
|
|
2472 :group 'editing-basics)
|
|
475
|
2473
|
|
17663
|
2474 (defcustom goal-column nil
|
|
|
2475 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
|
|
|
2476 :type '(choice integer
|
|
|
2477 (const :tag "None" nil))
|
|
|
2478 :group 'editing-basics)
|
1466
04b4499061fd
(goal-column): Don't put the defvar inside the make-variable-buffer-local.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2479 (make-variable-buffer-local 'goal-column)
|
|
475
|
2480
|
|
|
2481 (defvar temporary-goal-column 0
|
|
|
2482 "Current goal column for vertical motion.
|
|
|
2483 It is the column where point was
|
|
|
2484 at the start of current run of vertical motion commands.
|
|
513
|
2485 When the `track-eol' feature is doing its job, the value is 9999.")
|
|
475
|
2486
|
|
17663
|
2487 (defcustom line-move-ignore-invisible nil
|
|
10949
|
2488 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
|
|
17663
|
2489 Outline mode sets this."
|
|
|
2490 :type 'boolean
|
|
|
2491 :group 'editing-basics)
|
|
10949
|
2492
|
|
11326
|
2493 ;; This is the guts of next-line and previous-line.
|
|
|
2494 ;; Arg says how many lines to move.
|
|
475
|
2495 (defun line-move (arg)
|
|
11479
|
2496 ;; Don't run any point-motion hooks, and disregard intangibility,
|
|
|
2497 ;; for intermediate positions.
|
|
|
2498 (let ((inhibit-point-motion-hooks t)
|
|
|
2499 (opoint (point))
|
|
19003
|
2500 new line-end line-beg)
|
|
11479
|
2501 (unwind-protect
|
|
|
2502 (progn
|
|
|
2503 (if (not (or (eq last-command 'next-line)
|
|
|
2504 (eq last-command 'previous-line)))
|
|
|
2505 (setq temporary-goal-column
|
|
|
2506 (if (and track-eol (eolp)
|
|
|
2507 ;; Don't count beg of empty line as end of line
|
|
|
2508 ;; unless we just did explicit end-of-line.
|
|
|
2509 (or (not (bolp)) (eq last-command 'end-of-line)))
|
|
|
2510 9999
|
|
|
2511 (current-column))))
|
|
|
2512 (if (and (not (integerp selective-display))
|
|
|
2513 (not line-move-ignore-invisible))
|
|
|
2514 ;; Use just newline characters.
|
|
|
2515 (or (if (> arg 0)
|
|
|
2516 (progn (if (> arg 1) (forward-line (1- arg)))
|
|
|
2517 ;; This way of moving forward ARG lines
|
|
|
2518 ;; verifies that we have a newline after the last one.
|
|
|
2519 ;; It doesn't get confused by intangible text.
|
|
|
2520 (end-of-line)
|
|
|
2521 (zerop (forward-line 1)))
|
|
|
2522 (and (zerop (forward-line arg))
|
|
|
2523 (bolp)))
|
|
|
2524 (signal (if (< arg 0)
|
|
|
2525 'beginning-of-buffer
|
|
|
2526 'end-of-buffer)
|
|
|
2527 nil))
|
|
|
2528 ;; Move by arg lines, but ignore invisible ones.
|
|
|
2529 (while (> arg 0)
|
|
|
2530 (end-of-line)
|
|
|
2531 (and (zerop (vertical-motion 1))
|
|
|
2532 (signal 'end-of-buffer nil))
|
|
|
2533 ;; If the following character is currently invisible,
|
|
|
2534 ;; skip all characters with that same `invisible' property value.
|
|
|
2535 (while (and (not (eobp))
|
|
|
2536 (let ((prop
|
|
|
2537 (get-char-property (point) 'invisible)))
|
|
|
2538 (if (eq buffer-invisibility-spec t)
|
|
|
2539 prop
|
|
|
2540 (or (memq prop buffer-invisibility-spec)
|
|
|
2541 (assq prop buffer-invisibility-spec)))))
|
|
|
2542 (if (get-text-property (point) 'invisible)
|
|
|
2543 (goto-char (next-single-property-change (point) 'invisible))
|
|
|
2544 (goto-char (next-overlay-change (point)))))
|
|
|
2545 (setq arg (1- arg)))
|
|
|
2546 (while (< arg 0)
|
|
|
2547 (beginning-of-line)
|
|
|
2548 (and (zerop (vertical-motion -1))
|
|
|
2549 (signal 'beginning-of-buffer nil))
|
|
|
2550 (while (and (not (bobp))
|
|
|
2551 (let ((prop
|
|
|
2552 (get-char-property (1- (point)) 'invisible)))
|
|
|
2553 (if (eq buffer-invisibility-spec t)
|
|
|
2554 prop
|
|
|
2555 (or (memq prop buffer-invisibility-spec)
|
|
|
2556 (assq prop buffer-invisibility-spec)))))
|
|
|
2557 (if (get-text-property (1- (point)) 'invisible)
|
|
|
2558 (goto-char (previous-single-property-change (point) 'invisible))
|
|
|
2559 (goto-char (previous-overlay-change (point)))))
|
|
|
2560 (setq arg (1+ arg))))
|
|
16408
|
2561 (let ((buffer-invisibility-spec nil))
|
|
|
2562 (move-to-column (or goal-column temporary-goal-column))))
|
|
18034
|
2563 (setq new (point))
|
|
|
2564 ;; If we are moving into some intangible text,
|
|
|
2565 ;; look for following text on the same line which isn't intangible
|
|
|
2566 ;; and move there.
|
|
19003
|
2567 (setq line-end (save-excursion (end-of-line) (point)))
|
|
|
2568 (setq line-beg (save-excursion (beginning-of-line) (point)))
|
|
18034
|
2569 (let ((after (and (< new (point-max))
|
|
|
2570 (get-char-property new 'intangible)))
|
|
|
2571 (before (and (> new (point-min))
|
|
19003
|
2572 (get-char-property (1- new) 'intangible))))
|
|
|
2573 (when (and before (eq before after)
|
|
|
2574 (not (bolp)))
|
|
18034
|
2575 (goto-char (point-min))
|
|
|
2576 (let ((inhibit-point-motion-hooks nil))
|
|
|
2577 (goto-char new))
|
|
|
2578 (if (<= new line-end)
|
|
|
2579 (setq new (point)))))
|
|
19003
|
2580 ;; NEW is where we want to move to.
|
|
|
2581 ;; LINE-BEG and LINE-END are the beginning and end of the line.
|
|
|
2582 ;; Move there in just one step, from our starting position,
|
|
|
2583 ;; with intangibility and point-motion hooks enabled this time.
|
|
11479
|
2584 (goto-char opoint)
|
|
|
2585 (setq inhibit-point-motion-hooks nil)
|
|
30441
|
2586 (goto-char (constrain-to-field new opoint nil t
|
|
|
2587 'inhibit-line-move-field-capture))
|
|
19003
|
2588 ;; If intangibility processing moved us to a different line,
|
|
|
2589 ;; readjust the horizontal position within the line we ended up at.
|
|
|
2590 (when (or (< (point) line-beg) (> (point) line-end))
|
|
|
2591 (setq new (point))
|
|
|
2592 (setq inhibit-point-motion-hooks t)
|
|
|
2593 (setq line-end (save-excursion (end-of-line) (point)))
|
|
|
2594 (beginning-of-line)
|
|
|
2595 (setq line-beg (point))
|
|
|
2596 (let ((buffer-invisibility-spec nil))
|
|
|
2597 (move-to-column (or goal-column temporary-goal-column)))
|
|
|
2598 (if (<= (point) line-end)
|
|
|
2599 (setq new (point)))
|
|
|
2600 (goto-char (point-min))
|
|
|
2601 (setq inhibit-point-motion-hooks nil)
|
|
30441
|
2602 (goto-char (constrain-to-field new opoint nil t
|
|
|
2603 'inhibit-line-move-field-capture))
|
|
19003
|
2604 )))
|
|
11479
|
2605 nil)
|
|
475
|
2606
|
1771
3f0f18d4eb8c
* simple.el (set-goal-column): Make this command disabled by default.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2607 ;;; Many people have said they rarely use this feature, and often type
|
3f0f18d4eb8c
* simple.el (set-goal-column): Make this command disabled by default.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2608 ;;; it by accident. Maybe it shouldn't even be on a key.
|
3f0f18d4eb8c
* simple.el (set-goal-column): Make this command disabled by default.
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2609 (put 'set-goal-column 'disabled t)
|
|
475
|
2610
|
|
|
2611 (defun set-goal-column (arg)
|
|
|
2612 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
|
|
|
2613 Those commands will move to this position in the line moved to
|
|
|
2614 rather than trying to keep the same horizontal position.
|
|
|
2615 With a non-nil argument, clears out the goal column
|
1466
04b4499061fd
(goal-column): Don't put the defvar inside the make-variable-buffer-local.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2616 so that \\[next-line] and \\[previous-line] resume vertical motion.
|
04b4499061fd
(goal-column): Don't put the defvar inside the make-variable-buffer-local.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2617 The goal column is stored in the variable `goal-column'."
|
|
475
|
2618 (interactive "P")
|
|
|
2619 (if arg
|
|
|
2620 (progn
|
|
|
2621 (setq goal-column nil)
|
|
|
2622 (message "No goal column"))
|
|
|
2623 (setq goal-column (current-column))
|
|
|
2624 (message (substitute-command-keys
|
|
|
2625 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
|
|
|
2626 goal-column))
|
|
|
2627 nil)
|
|
33786
|
2628
|
|
8006
|
2629
|
|
|
2630 (defun scroll-other-window-down (lines)
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2631 "Scroll the \"other window\" down.
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2632 For more details, see the documentation for `scroll-other-window'."
|
|
8006
|
2633 (interactive "P")
|
|
|
2634 (scroll-other-window
|
|
|
2635 ;; Just invert the argument's meaning.
|
|
|
2636 ;; We can do that without knowing which window it will be.
|
|
|
2637 (if (eq lines '-) nil
|
|
|
2638 (if (null lines) '-
|
|
|
2639 (- (prefix-numeric-value lines))))))
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2640 (define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
|
|
8057
|
2641
|
|
|
2642 (defun beginning-of-buffer-other-window (arg)
|
|
|
2643 "Move point to the beginning of the buffer in the other window.
|
|
|
2644 Leave mark at previous position.
|
|
|
2645 With arg N, put point N/10 of the way from the true beginning."
|
|
|
2646 (interactive "P")
|
|
|
2647 (let ((orig-window (selected-window))
|
|
|
2648 (window (other-window-for-scrolling)))
|
|
|
2649 ;; We use unwind-protect rather than save-window-excursion
|
|
|
2650 ;; because the latter would preserve the things we want to change.
|
|
|
2651 (unwind-protect
|
|
|
2652 (progn
|
|
|
2653 (select-window window)
|
|
|
2654 ;; Set point and mark in that window's buffer.
|
|
|
2655 (beginning-of-buffer arg)
|
|
|
2656 ;; Set point accordingly.
|
|
|
2657 (recenter '(t)))
|
|
|
2658 (select-window orig-window))))
|
|
|
2659
|
|
|
2660 (defun end-of-buffer-other-window (arg)
|
|
|
2661 "Move point to the end of the buffer in the other window.
|
|
|
2662 Leave mark at previous position.
|
|
|
2663 With arg N, put point N/10 of the way from the true end."
|
|
|
2664 (interactive "P")
|
|
|
2665 ;; See beginning-of-buffer-other-window for comments.
|
|
|
2666 (let ((orig-window (selected-window))
|
|
|
2667 (window (other-window-for-scrolling)))
|
|
|
2668 (unwind-protect
|
|
|
2669 (progn
|
|
|
2670 (select-window window)
|
8442
05efaa4966e0
(end-of-buffer-other-window): Go to the end, not to the beginning.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2671 (end-of-buffer arg)
|
|
8057
|
2672 (recenter '(t)))
|
|
|
2673 (select-window orig-window))))
|
|
33786
|
2674
|
|
475
|
2675 (defun transpose-chars (arg)
|
|
|
2676 "Interchange characters around point, moving forward one character.
|
|
|
2677 With prefix arg ARG, effect is to take character before point
|
|
|
2678 and drag it forward past ARG other characters (backward if ARG negative).
|
|
|
2679 If no argument and at end of line, the previous two chars are exchanged."
|
|
|
2680 (interactive "*P")
|
|
|
2681 (and (null arg) (eolp) (forward-char -1))
|
|
|
2682 (transpose-subr 'forward-char (prefix-numeric-value arg)))
|
|
|
2683
|
|
|
2684 (defun transpose-words (arg)
|
|
|
2685 "Interchange words around point, leaving point at end of them.
|
|
|
2686 With prefix arg ARG, effect is to take word before or around point
|
|
|
2687 and drag it forward past ARG other words (backward if ARG negative).
|
|
|
2688 If ARG is zero, the words around or after point and around or after mark
|
|
|
2689 are interchanged."
|
|
|
2690 (interactive "*p")
|
|
|
2691 (transpose-subr 'forward-word arg))
|
|
|
2692
|
|
|
2693 (defun transpose-sexps (arg)
|
|
|
2694 "Like \\[transpose-words] but applies to sexps.
|
|
|
2695 Does not work on a sexp that point is in the middle of
|
|
|
2696 if it is a list or string."
|
|
|
2697 (interactive "*p")
|
|
|
2698 (transpose-subr 'forward-sexp arg))
|
|
|
2699
|
|
|
2700 (defun transpose-lines (arg)
|
|
|
2701 "Exchange current line and previous line, leaving point after both.
|
|
|
2702 With argument ARG, takes previous line and moves it past ARG lines.
|
|
|
2703 With argument 0, interchanges line point is in with line mark is in."
|
|
|
2704 (interactive "*p")
|
|
|
2705 (transpose-subr (function
|
|
|
2706 (lambda (arg)
|
|
20465
|
2707 (if (> arg 0)
|
|
475
|
2708 (progn
|
|
20465
|
2709 ;; Move forward over ARG lines,
|
|
|
2710 ;; but create newlines if necessary.
|
|
|
2711 (setq arg (forward-line arg))
|
|
|
2712 (if (/= (preceding-char) ?\n)
|
|
|
2713 (setq arg (1+ arg)))
|
|
|
2714 (if (> arg 0)
|
|
|
2715 (newline arg)))
|
|
475
|
2716 (forward-line arg))))
|
|
|
2717 arg))
|
|
|
2718
|
|
23775
|
2719 (defvar transpose-subr-start1)
|
|
|
2720 (defvar transpose-subr-start2)
|
|
|
2721 (defvar transpose-subr-end1)
|
|
|
2722 (defvar transpose-subr-end2)
|
|
|
2723
|
|
475
|
2724 (defun transpose-subr (mover arg)
|
|
23775
|
2725 (let (transpose-subr-start1
|
|
|
2726 transpose-subr-end1
|
|
|
2727 transpose-subr-start2
|
|
|
2728 transpose-subr-end2)
|
|
475
|
2729 (if (= arg 0)
|
|
|
2730 (progn
|
|
|
2731 (save-excursion
|
|
|
2732 (funcall mover 1)
|
|
23775
|
2733 (setq transpose-subr-end2 (point))
|
|
475
|
2734 (funcall mover -1)
|
|
23775
|
2735 (setq transpose-subr-start2 (point))
|
|
475
|
2736 (goto-char (mark))
|
|
|
2737 (funcall mover 1)
|
|
23775
|
2738 (setq transpose-subr-end1 (point))
|
|
475
|
2739 (funcall mover -1)
|
|
23775
|
2740 (setq transpose-subr-start1 (point))
|
|
475
|
2741 (transpose-subr-1))
|
|
20465
|
2742 (exchange-point-and-mark))
|
|
|
2743 (if (> arg 0)
|
|
|
2744 (progn
|
|
|
2745 (funcall mover -1)
|
|
23775
|
2746 (setq transpose-subr-start1 (point))
|
|
20465
|
2747 (funcall mover 1)
|
|
23775
|
2748 (setq transpose-subr-end1 (point))
|
|
20465
|
2749 (funcall mover arg)
|
|
23775
|
2750 (setq transpose-subr-end2 (point))
|
|
20465
|
2751 (funcall mover (- arg))
|
|
23775
|
2752 (setq transpose-subr-start2 (point))
|
|
20465
|
2753 (transpose-subr-1)
|
|
23775
|
2754 (goto-char transpose-subr-end2))
|
|
20465
|
2755 (funcall mover -1)
|
|
23775
|
2756 (setq transpose-subr-start2 (point))
|
|
20465
|
2757 (funcall mover 1)
|
|
23775
|
2758 (setq transpose-subr-end2 (point))
|
|
20465
|
2759 (funcall mover (1- arg))
|
|
23775
|
2760 (setq transpose-subr-start1 (point))
|
|
20465
|
2761 (funcall mover (- arg))
|
|
23775
|
2762 (setq transpose-subr-end1 (point))
|
|
20465
|
2763 (transpose-subr-1)))))
|
|
475
|
2764
|
|
|
2765 (defun transpose-subr-1 ()
|
|
23775
|
2766 (if (> (min transpose-subr-end1 transpose-subr-end2)
|
|
|
2767 (max transpose-subr-start1 transpose-subr-start2))
|
|
475
|
2768 (error "Don't have two things to transpose"))
|
|
23775
|
2769 (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
|
|
16999
|
2770 (len1 (length word1))
|
|
23775
|
2771 (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
|
|
16999
|
2772 (len2 (length word2)))
|
|
23775
|
2773 (delete-region transpose-subr-start2 transpose-subr-end2)
|
|
|
2774 (goto-char transpose-subr-start2)
|
|
475
|
2775 (insert word1)
|
|
23775
|
2776 (goto-char (if (< transpose-subr-start1 transpose-subr-start2)
|
|
|
2777 transpose-subr-start1
|
|
|
2778 (+ transpose-subr-start1 (- len1 len2))))
|
|
16999
|
2779 (delete-region (point) (+ (point) len1))
|
|
475
|
2780 (insert word2)))
|
|
33786
|
2781
|
|
475
|
2782 (defun backward-word (arg)
|
|
|
2783 "Move backward until encountering the end of a word.
|
|
32222
|
2784 With argument, do this that many times."
|
|
5764
|
2785 (interactive "p")
|
|
475
|
2786 (forward-word (- arg)))
|
|
|
2787
|
|
|
2788 (defun mark-word (arg)
|
|
|
2789 "Set mark arg words away from point."
|
|
|
2790 (interactive "p")
|
|
|
2791 (push-mark
|
|
|
2792 (save-excursion
|
|
|
2793 (forward-word arg)
|
|
2824
|
2794 (point))
|
|
|
2795 nil t))
|
|
475
|
2796
|
|
|
2797 (defun kill-word (arg)
|
|
|
2798 "Kill characters forward until encountering the end of a word.
|
|
|
2799 With argument, do this that many times."
|
|
27836
|
2800 (interactive "p")
|
|
25400
|
2801 (kill-region (point) (progn (forward-word arg) (point))))
|
|
475
|
2802
|
|
|
2803 (defun backward-kill-word (arg)
|
|
|
2804 "Kill characters backward until encountering the end of a word.
|
|
|
2805 With argument, do this that many times."
|
|
27836
|
2806 (interactive "p")
|
|
475
|
2807 (kill-word (- arg)))
|
|
2416
|
2808
|
6174
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2809 (defun current-word (&optional strict)
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2810 "Return the word point is on (or a nearby word) as a string.
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2811 If optional arg STRICT is non-nil, return nil unless point is within
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2812 or adjacent to a word."
|
|
2416
|
2813 (save-excursion
|
|
|
2814 (let ((oldpoint (point)) (start (point)) (end (point)))
|
|
|
2815 (skip-syntax-backward "w_") (setq start (point))
|
|
|
2816 (goto-char oldpoint)
|
|
|
2817 (skip-syntax-forward "w_") (setq end (point))
|
|
|
2818 (if (and (eq start oldpoint) (eq end oldpoint))
|
6174
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2819 ;; Point is neither within nor adjacent to a word.
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2820 (and (not strict)
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2821 (progn
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2822 ;; Look for preceding word in same line.
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2823 (skip-syntax-backward "^w_"
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2824 (save-excursion (beginning-of-line)
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2825 (point)))
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2826 (if (bolp)
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2827 ;; No preceding word in same line.
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2828 ;; Look for following word in same line.
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2829 (progn
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2830 (skip-syntax-forward "^w_"
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2831 (save-excursion (end-of-line)
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2832 (point)))
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2833 (setq start (point))
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2834 (skip-syntax-forward "w_")
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2835 (setq end (point)))
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2836 (setq end (point))
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2837 (skip-syntax-backward "w_")
|
3902f1241d1c
(current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2838 (setq start (point)))
|
|
18379
|
2839 (buffer-substring-no-properties start end)))
|
|
|
2840 (buffer-substring-no-properties start end)))))
|
|
33786
|
2841
|
|
17663
|
2842 (defcustom fill-prefix nil
|
|
475
|
2843 "*String for filling to insert at front of new line, or nil for none.
|
|
17663
|
2844 Setting this variable automatically makes it local to the current buffer."
|
|
|
2845 :type '(choice (const :tag "None" nil)
|
|
|
2846 string)
|
|
|
2847 :group 'fill)
|
|
475
|
2848 (make-variable-buffer-local 'fill-prefix)
|
|
|
2849
|
|
17663
|
2850 (defcustom auto-fill-inhibit-regexp nil
|
|
|
2851 "*Regexp to match lines which should not be auto-filled."
|
|
|
2852 :type '(choice (const :tag "None" nil)
|
|
|
2853 regexp)
|
|
|
2854 :group 'fill)
|
|
475
|
2855
|
|
33781
|
2856 (defvar comment-line-break-function 'comment-indent-new-line
|
|
19160
|
2857 "*Mode-specific function which line breaks and continues a comment.
|
|
|
2858
|
|
|
2859 This function is only called during auto-filling of a comment section.
|
|
|
2860 The function should take a single optional argument, which is a flag
|
|
|
2861 indicating whether it should use soft newlines.
|
|
|
2862
|
|
|
2863 Setting this variable automatically makes it local to the current buffer.")
|
|
|
2864
|
|
21122
|
2865 ;; This function is used as the auto-fill-function of a buffer
|
|
15263
|
2866 ;; when Auto-Fill mode is enabled.
|
|
|
2867 ;; It returns t if it really did any work.
|
|
21122
|
2868 ;; (Actually some major modes use a different auto-fill function,
|
|
|
2869 ;; but this one is the default one.)
|
|
475
|
2870 (defun do-auto-fill ()
|
|
12708
|
2871 (let (fc justify bol give-up
|
|
|
2872 (fill-prefix fill-prefix))
|
10471
3eb77f03f53e
(do-auto-fill): justification renamed to current-justification.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2873 (if (or (not (setq justify (current-justification)))
|
|
12428
|
2874 (null (setq fc (current-fill-column)))
|
|
|
2875 (and (eq justify 'left)
|
|
|
2876 (<= (current-column) fc))
|
|
26457
|
2877 (save-excursion (beginning-of-line)
|
|
10469
|
2878 (setq bol (point))
|
|
|
2879 (and auto-fill-inhibit-regexp
|
|
|
2880 (looking-at auto-fill-inhibit-regexp))))
|
|
|
2881 nil ;; Auto-filling not required
|
|
10813
|
2882 (if (memq justify '(full center right))
|
|
|
2883 (save-excursion (unjustify-current-line)))
|
|
12708
|
2884
|
|
|
2885 ;; Choose a fill-prefix automatically.
|
|
|
2886 (if (and adaptive-fill-mode
|
|
|
2887 (or (null fill-prefix) (string= fill-prefix "")))
|
|
13587
|
2888 (let ((prefix
|
|
|
2889 (fill-context-prefix
|
|
|
2890 (save-excursion (backward-paragraph 1) (point))
|
|
18034
|
2891 (save-excursion (forward-paragraph 1) (point)))))
|
|
13587
|
2892 (and prefix (not (equal prefix ""))
|
|
|
2893 (setq fill-prefix prefix))))
|
|
12708
|
2894
|
|
10469
|
2895 (while (and (not give-up) (> (current-column) fc))
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2896 ;; Determine where to split the line.
|
|
19343
|
2897 (let* (after-prefix
|
|
|
2898 (fill-point
|
|
|
2899 (let ((opoint (point))
|
|
|
2900 bounce
|
|
|
2901 (first t))
|
|
|
2902 (save-excursion
|
|
|
2903 (beginning-of-line)
|
|
|
2904 (setq after-prefix (point))
|
|
|
2905 (and fill-prefix
|
|
|
2906 (looking-at (regexp-quote fill-prefix))
|
|
|
2907 (setq after-prefix (match-end 0)))
|
|
|
2908 (move-to-column (1+ fc))
|
|
21122
|
2909 ;; Move back to the point where we can break the line.
|
|
|
2910 ;; We break the line between word or
|
|
19343
|
2911 ;; after/before the character which has character
|
|
|
2912 ;; category `|'. We search space, \c| followed by
|
|
21122
|
2913 ;; a character, or \c| following a character. If
|
|
19343
|
2914 ;; not found, place the point at beginning of line.
|
|
|
2915 (while (or first
|
|
|
2916 ;; If this is after period and a single space,
|
|
|
2917 ;; move back once more--we don't want to break
|
|
|
2918 ;; the line there and make it look like a
|
|
|
2919 ;; sentence end.
|
|
|
2920 (and (not (bobp))
|
|
|
2921 (not bounce)
|
|
|
2922 sentence-end-double-space
|
|
|
2923 (save-excursion (forward-char -1)
|
|
|
2924 (and (looking-at "\\. ")
|
|
21122
|
2925 (not (looking-at "\\. ")))))
|
|
|
2926 (and (not (bobp))
|
|
|
2927 (not bounce)
|
|
|
2928 fill-nobreak-predicate
|
|
|
2929 (funcall fill-nobreak-predicate)))
|
|
19343
|
2930 (setq first nil)
|
|
|
2931 (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
|
|
|
2932 ;; If we find nowhere on the line to break it,
|
|
|
2933 ;; break after one word. Set bounce to t
|
|
|
2934 ;; so we will not keep going in this while loop.
|
|
|
2935 (if (<= (point) after-prefix)
|
|
|
2936 (progn
|
|
|
2937 (goto-char after-prefix)
|
|
|
2938 (re-search-forward "[ \t]" opoint t)
|
|
|
2939 (setq bounce t))
|
|
|
2940 (if (looking-at "[ \t]")
|
|
|
2941 ;; Break the line at word boundary.
|
|
|
2942 (skip-chars-backward " \t")
|
|
|
2943 ;; Break the line after/before \c|.
|
|
|
2944 (forward-char 1))))
|
|
23491
|
2945 (if enable-multibyte-characters
|
|
23520
|
2946 ;; If we are going to break the line after or
|
|
|
2947 ;; before a non-ascii character, we may have
|
|
|
2948 ;; to run a special function for the charset
|
|
|
2949 ;; of the character to find the correct break
|
|
|
2950 ;; point.
|
|
|
2951 (if (not (and (eq (charset-after (1- (point))) 'ascii)
|
|
|
2952 (eq (charset-after (point)) 'ascii)))
|
|
|
2953 (fill-find-break-point after-prefix)))
|
|
|
2954
|
|
19343
|
2955 ;; Let fill-point be set to the place where we end up.
|
|
22754
|
2956 ;; But move back before any whitespace here.
|
|
|
2957 (skip-chars-backward " \t")
|
|
19343
|
2958 (point)))))
|
|
|
2959
|
|
|
2960 ;; See whether the place we found is any good.
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2961 (if (save-excursion
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2962 (goto-char fill-point)
|
|
19109
|
2963 (and (not (bolp))
|
|
19343
|
2964 ;; There is no use breaking at end of line.
|
|
|
2965 (not (save-excursion (skip-chars-forward " ") (eolp)))
|
|
|
2966 ;; It is futile to split at the end of the prefix
|
|
|
2967 ;; since we would just insert the prefix again.
|
|
|
2968 (not (and after-prefix (<= (point) after-prefix)))
|
|
19109
|
2969 ;; Don't split right after a comment starter
|
|
|
2970 ;; since we would just make another comment starter.
|
|
|
2971 (not (and comment-start-skip
|
|
|
2972 (let ((limit (point)))
|
|
|
2973 (beginning-of-line)
|
|
|
2974 (and (re-search-forward comment-start-skip
|
|
|
2975 limit t)
|
|
|
2976 (eq (point) limit)))))))
|
|
19343
|
2977 ;; Ok, we have a useful place to break the line. Do it.
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2978 (let ((prev-column (current-column)))
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2979 ;; If point is at the fill-point, do not `save-excursion'.
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2980 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2981 ;; point will end up before it rather than after it.
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2982 (if (save-excursion
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2983 (skip-chars-backward " \t")
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2984 (= (point) fill-point))
|
|
19160
|
2985 (funcall comment-line-break-function t)
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2986 (save-excursion
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2987 (goto-char fill-point)
|
|
19160
|
2988 (funcall comment-line-break-function t)))
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2989 ;; Now do justification, if required
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2990 (if (not (eq justify 'left))
|
|
26457
|
2991 (save-excursion
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2992 (end-of-line 0)
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2993 (justify-current-line justify nil t)))
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2994 ;; If making the new line didn't reduce the hpos of
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2995 ;; the end of the line, then give up now;
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2996 ;; trying again will not help.
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2997 (if (>= (current-column) prev-column)
|
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2998 (setq give-up t)))
|
|
19343
|
2999 ;; No good place to break => stop trying.
|
12718
0a8b4f086ffc
(do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3000 (setq give-up t))))
|
|
15836
|
3001 ;; Justify last line.
|
|
15263
|
3002 (justify-current-line justify t t)
|
|
26457
|
3003 t)))
|
|
475
|
3004
|
|
15836
|
3005 (defvar normal-auto-fill-function 'do-auto-fill
|
|
|
3006 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
|
|
|
3007 Some major modes set this.")
|
|
|
3008
|
|
6907
|
3009 (defun auto-fill-mode (&optional arg)
|
|
15836
|
3010 "Toggle Auto Fill mode.
|
|
|
3011 With arg, turn Auto Fill mode on if and only if arg is positive.
|
|
|
3012 In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
|
|
|
3013 automatically breaks the line at a previous space.
|
|
|
3014
|
|
|
3015 The value of `normal-auto-fill-function' specifies the function to use
|
|
|
3016 for `auto-fill-function' when turning Auto Fill mode on."
|
|
6907
|
3017 (interactive "P")
|
|
|
3018 (prog1 (setq auto-fill-function
|
|
|
3019 (if (if (null arg)
|
|
|
3020 (not auto-fill-function)
|
|
|
3021 (> (prefix-numeric-value arg) 0))
|
|
15836
|
3022 normal-auto-fill-function
|
|
6907
|
3023 nil))
|
|
11572
|
3024 (force-mode-line-update)))
|
|
6907
|
3025
|
|
|
3026 ;; This holds a document string used to document auto-fill-mode.
|
|
|
3027 (defun auto-fill-function ()
|
|
|
3028 "Automatically break line at a previous space, in insertion of text."
|
|
|
3029 nil)
|
|
|
3030
|
|
|
3031 (defun turn-on-auto-fill ()
|
|
|
3032 "Unconditionally turn on Auto Fill mode."
|
|
|
3033 (auto-fill-mode 1))
|
|
29808
|
3034
|
|
|
3035 (defun turn-off-auto-fill ()
|
|
|
3036 "Unconditionally turn off Auto Fill mode."
|
|
|
3037 (auto-fill-mode -1))
|
|
|
3038
|
24343
d00b069a7d17
(turn-on-auto-fill): Mark it as an option for `text-mode-hook'.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3039 (custom-add-option 'text-mode-hook 'turn-on-auto-fill)
|
|
6907
|
3040
|
|
|
3041 (defun set-fill-column (arg)
|
|
15431
|
3042 "Set `fill-column' to specified argument.
|
|
23447
|
3043 Use \\[universal-argument] followed by a number to specify a column.
|
|
15431
|
3044 Just \\[universal-argument] as argument means to use the current column."
|
|
6907
|
3045 (interactive "P")
|
|
17874
|
3046 (if (consp arg)
|
|
|
3047 (setq arg (current-column)))
|
|
|
3048 (if (not (integerp arg))
|
|
|
3049 ;; Disallow missing argument; it's probably a typo for C-x C-f.
|
|
|
3050 (error "set-fill-column requires an explicit argument")
|
|
|
3051 (message "Fill column set to %d (was %d)" arg fill-column)
|
|
|
3052 (setq fill-column arg)))
|
|
33786
|
3053
|
|
475
|
3054 (defun set-selective-display (arg)
|
|
1027
|
3055 "Set `selective-display' to ARG; clear it if no arg.
|
|
|
3056 When the value of `selective-display' is a number > 0,
|
|
|
3057 lines whose indentation is >= that value are not displayed.
|
|
|
3058 The variable `selective-display' has a separate value for each buffer."
|
|
475
|
3059 (interactive "P")
|
|
|
3060 (if (eq selective-display t)
|
|
|
3061 (error "selective-display already in use for marked lines"))
|
|
658
|
3062 (let ((current-vpos
|
|
|
3063 (save-restriction
|
|
|
3064 (narrow-to-region (point-min) (point))
|
|
|
3065 (goto-char (window-start))
|
|
|
3066 (vertical-motion (window-height)))))
|
|
|
3067 (setq selective-display
|
|
|
3068 (and arg (prefix-numeric-value arg)))
|
|
|
3069 (recenter current-vpos))
|
|
475
|
3070 (set-window-start (selected-window) (window-start (selected-window)))
|
|
|
3071 (princ "selective-display set to " t)
|
|
|
3072 (prin1 selective-display t)
|
|
|
3073 (princ "." t))
|
|
|
3074
|
|
17471
|
3075 (defvar overwrite-mode-textual " Ovwrt"
|
2215
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3076 "The string displayed in the mode line when in overwrite mode.")
|
|
17471
|
3077 (defvar overwrite-mode-binary " Bin Ovwrt"
|
2215
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3078 "The string displayed in the mode line when in binary overwrite mode.")
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3079
|
|
475
|
3080 (defun overwrite-mode (arg)
|
|
|
3081 "Toggle overwrite mode.
|
|
|
3082 With arg, turn overwrite mode on iff arg is positive.
|
|
|
3083 In overwrite mode, printing characters typed in replace existing text
|
2215
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3084 on a one-for-one basis, rather than pushing it to the right. At the
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3085 end of a line, such characters extend the line. Before a tab,
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3086 such characters insert until the tab is filled in.
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3087 \\[quoted-insert] still inserts characters in overwrite mode; this
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3088 is supposed to make it easier to insert characters when necessary."
|
|
475
|
3089 (interactive "P")
|
|
|
3090 (setq overwrite-mode
|
2215
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3091 (if (if (null arg) (not overwrite-mode)
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3092 (> (prefix-numeric-value arg) 0))
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3093 'overwrite-mode-textual))
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3094 (force-mode-line-update))
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3095
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3096 (defun binary-overwrite-mode (arg)
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3097 "Toggle binary overwrite mode.
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3098 With arg, turn binary overwrite mode on iff arg is positive.
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3099 In binary overwrite mode, printing characters typed in replace
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3100 existing text. Newlines are not treated specially, so typing at the
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3101 end of a line joins the line to the next, with the typed character
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3102 between them. Typing before a tab character simply replaces the tab
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3103 with the character typed.
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3104 \\[quoted-insert] replaces the text at the cursor, just as ordinary
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3105 typing characters do.
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3106
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3107 Note that binary overwrite mode is not its own minor mode; it is a
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3108 specialization of overwrite-mode, entered by setting the
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3109 `overwrite-mode' variable to `overwrite-mode-binary'."
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3110 (interactive "P")
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3111 (setq overwrite-mode
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3112 (if (if (null arg)
|
|
2301
|
3113 (not (eq overwrite-mode 'overwrite-mode-binary))
|
2215
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3114 (> (prefix-numeric-value arg) 0))
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3115 'overwrite-mode-binary))
|
a7d915ce7676
src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
diff
changeset
|
3116 (force-mode-line-update))
|
|
33786
|
3117
|
|
17663
|
3118 (defcustom line-number-mode t
|
|
|
3119 "*Non-nil means display line number in mode line."
|
|
|
3120 :type 'boolean
|
|
|
3121 :group 'editing-basics)
|
|
2301
|
3122
|
|
|
3123 (defun line-number-mode (arg)
|
|
|
3124 "Toggle Line Number mode.
|
|
|
3125 With arg, turn Line Number mode on iff arg is positive.
|
|
|
3126 When Line Number mode is enabled, the line number appears
|
|
23660
|
3127 in the mode line.
|
|
|
3128
|
|
|
3129 Line numbers do not appear for very large buffers, see variable
|
|
|
3130 `line-number-display-limit'."
|
|
2301
|
3131 (interactive "P")
|
|
|
3132 (setq line-number-mode
|
|
|
3133 (if (null arg) (not line-number-mode)
|
|
|
3134 (> (prefix-numeric-value arg) 0)))
|
|
|
3135 (force-mode-line-update))
|
|
|
3136
|
|
17663
|
3137 (defcustom column-number-mode nil
|
|
|
3138 "*Non-nil means display column number in mode line."
|
|
|
3139 :type 'boolean
|
|
|
3140 :group 'editing-basics)
|
|
12565
|
3141
|
|
|
3142 (defun column-number-mode (arg)
|
|
|
3143 "Toggle Column Number mode.
|
|
|
3144 With arg, turn Column Number mode on iff arg is positive.
|
|
|
3145 When Column Number mode is enabled, the column number appears
|
|
|
3146 in the mode line."
|
|
|
3147 (interactive "P")
|
|
|
3148 (setq column-number-mode
|
|
|
3149 (if (null arg) (not column-number-mode)
|
|
|
3150 (> (prefix-numeric-value arg) 0)))
|
|
|
3151 (force-mode-line-update))
|
|
|
3152
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3153 (defgroup paren-blinking nil
|
|
18379
|
3154 "Blinking matching of parens and expressions."
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3155 :prefix "blink-matching-"
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3156 :group 'paren-matching)
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3157
|
|
17663
|
3158 (defcustom blink-matching-paren t
|
|
|
3159 "*Non-nil means show matching open-paren when close-paren is inserted."
|
|
|
3160 :type 'boolean
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3161 :group 'paren-blinking)
|
|
475
|
3162
|
|
17663
|
3163 (defcustom blink-matching-paren-on-screen t
|
|
13810
|
3164 "*Non-nil means show matching open-paren when it is on screen.
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3165 If nil, means don't show it (but the open-paren can still be shown
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3166 when it is off screen)."
|
|
17663
|
3167 :type 'boolean
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3168 :group 'paren-blinking)
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3169
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3170 (defcustom blink-matching-paren-distance (* 25 1024)
|
|
17663
|
3171 "*If non-nil, is maximum distance to search for matching open-paren."
|
|
|
3172 :type 'integer
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3173 :group 'paren-blinking)
|
|
475
|
3174
|
|
17663
|
3175 (defcustom blink-matching-delay 1
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3176 "*Time in seconds to delay after showing a matching paren."
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3177 :type 'number
|
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3178 :group 'paren-blinking)
|
|
9771
|
3179
|
|
17663
|
3180 (defcustom blink-matching-paren-dont-ignore-comments nil
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3181 "*Non-nil means `blink-matching-paren' will not ignore comments."
|
|
17663
|
3182 :type 'boolean
|
18334
d03c1b315e76
Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
diff
changeset
|
3183 :group 'paren-blinking)
|
|
12893
|
3184
|
|
475
|
3185 (defun blink-matching-open ()
|
|
|
3186 "Move cursor momentarily to the beginning of the sexp before point."
|
|
|
3187 (interactive)
|
|
|
3188 (and (> (point) (1+ (point-min)))
|
|
|
3189 blink-matching-paren
|
|
9749
|
3190 ;; Verify an even number of quoting characters precede the close.
|
|
|
3191 (= 1 (logand 1 (- (point)
|
|
|
3192 (save-excursion
|
|
|
3193 (forward-char -1)
|
|
|
3194 (skip-syntax-backward "/\\")
|
|
|
3195 (point)))))
|
|
475
|
3196 (let* ((oldpos (point))
|
|
|
3197 (blinkpos)
|
|
|
3198 (mismatch))
|
|
|
3199 (save-excursion
|
|
|
3200 (save-restriction
|
|
|
3201 (if blink-matching-paren-distance
|
|
|
3202 (narrow-to-region (max (point-min)
|
|
|
3203 (- (point) blink-matching-paren-distance))
|
|
|
3204 oldpos))
|
|
|
3205 (condition-case ()
|
|
12893
|
3206 (let ((parse-sexp-ignore-comments
|
|
|
3207 (and parse-sexp-ignore-comments
|
|
|
3208 (not blink-matching-paren-dont-ignore-comments))))
|
|
|
3209 (setq blinkpos (scan-sexps oldpos -1)))
|
|
475
|
3210 (error nil)))
|
|
12893
|
3211 (and blinkpos
|
|
|
3212 (/= (char-syntax (char-after blinkpos))
|
|
|
3213 ?\$)
|
|
475
|
3214 (setq mismatch
|
|
12893
|
3215 (or (null (matching-paren (char-after blinkpos)))
|
|
|
3216 (/= (char-after (1- oldpos))
|
|
|
3217 (matching-paren (char-after blinkpos))))))
|
|
475
|
3218 (if mismatch (setq blinkpos nil))
|
|
|
3219 (if blinkpos
|
|
23251
|
3220 ;; Don't log messages about paren matching.
|
|
|
3221 (let (message-log-max)
|
|
475
|
3222 (goto-char blinkpos)
|
|
|
3223 (if (pos-visible-in-window-p)
|
|
13810
|
3224 (and blink-matching-paren-on-screen
|
|
|
3225 (sit-for blink-matching-delay))
|
|
475
|
3226 (goto-char blinkpos)
|
|
|
3227 (message
|
|
|
3228 "Matches %s"
|
|
6539
|
3229 ;; Show what precedes the open in its line, if anything.
|
|
475
|
3230 (if (save-excursion
|
|
|
3231 (skip-chars-backward " \t")
|
|
|
3232 (not (bolp)))
|
|
|
3233 (buffer-substring (progn (beginning-of-line) (point))
|
|
|
3234 (1+ blinkpos))
|
|
6539
|
3235 ;; Show what follows the open in its line, if anything.
|
|
|
3236 (if (save-excursion
|
|
|
3237 (forward-char 1)
|
|
|
3238 (skip-chars-forward " \t")
|
|
|
3239 (not (eolp)))
|
|
|
3240 (buffer-substring blinkpos
|
|
|
3241 (progn (end-of-line) (point)))
|
|
9434
|
3242 ;; Otherwise show the previous nonblank line,
|
|
|
3243 ;; if there is one.
|
|
|
3244 (if (save-excursion
|
|
|
3245 (skip-chars-backward "\n \t")
|
|
|
3246 (not (bobp)))
|
|
|
3247 (concat
|
|
|
3248 (buffer-substring (progn
|
|
|
3249 (skip-chars-backward "\n \t")
|
|
|
3250 (beginning-of-line)
|
|
|
3251 (point))
|
|
|
3252 (progn (end-of-line)
|
|
|
3253 (skip-chars-backward " \t")
|
|
|
3254 (point)))
|
|
|
3255 ;; Replace the newline and other whitespace with `...'.
|
|
|
3256 "..."
|
|
|
3257 (buffer-substring blinkpos (1+ blinkpos)))
|
|
|
3258 ;; There is nothing to show except the char itself.
|
|
|
3259 (buffer-substring blinkpos (1+ blinkpos))))))))
|
|
475
|
3260 (cond (mismatch
|
|
|
3261 (message "Mismatched parentheses"))
|
|
|
3262 ((not blink-matching-paren-distance)
|
|
|
3263 (message "Unmatched parenthesis"))))))))
|
|
|
3264
|
|
|
3265 ;Turned off because it makes dbx bomb out.
|
|
|
3266 (setq blink-paren-function 'blink-matching-open)
|
|
|
3267
|
|
2805
|
3268 ;; This executes C-g typed while Emacs is waiting for a command.
|
|
|
3269 ;; Quitting out of a program does not go through here;
|
|
|
3270 ;; that happens in the QUIT macro at the C code level.
|
|
475
|
3271 (defun keyboard-quit ()
|
|
22304
|
3272 "Signal a `quit' condition.
|
|
2075
|
3273 During execution of Lisp code, this character causes a quit directly.
|
|
|
3274 At top-level, as an editor command, this simply beeps."
|
|
475
|
3275 (interactive)
|
|
4042
|
3276 (deactivate-mark)
|
|
475
|
3277 (signal 'quit nil))
|
|
|
3278
|
|
|
3279 (define-key global-map "\C-g" 'keyboard-quit)
|
|
10085
|
3280
|
|
10165
|
3281 (defvar buffer-quit-function nil
|
|
|
3282 "Function to call to \"quit\" the current buffer, or nil if none.
|
|
|
3283 \\[keyboard-escape-quit] calls this function when its more local actions
|
|
|
3284 \(such as cancelling a prefix argument, minibuffer or region) do not apply.")
|
|
|
3285
|
|
10085
|
3286 (defun keyboard-escape-quit ()
|
|
|
3287 "Exit the current \"mode\" (in a generalized sense of the word).
|
|
|
3288 This command can exit an interactive command such as `query-replace',
|
|
|
3289 can clear out a prefix argument or a region,
|
|
|
3290 can get out of the minibuffer or other recursive edit,
|
|
10165
|
3291 cancel the use of the current buffer (for special-purpose buffers),
|
|
|
3292 or go back to just one window (by deleting all but the selected window)."
|
|
10085
|
3293 (interactive)
|
|
|
3294 (cond ((eq last-command 'mode-exited) nil)
|
|
|
3295 ((> (minibuffer-depth) 0)
|
|
|
3296 (abort-recursive-edit))
|
|
|
3297 (current-prefix-arg
|
|
|
3298 nil)
|
|
|
3299 ((and transient-mark-mode
|
|
|
3300 mark-active)
|
|
|
3301 (deactivate-mark))
|
|
17355
|
3302 ((> (recursion-depth) 0)
|
|
|
3303 (exit-recursive-edit))
|
|
10165
|
3304 (buffer-quit-function
|
|
|
3305 (funcall buffer-quit-function))
|
|
10085
|
3306 ((not (one-window-p t))
|
|
17355
|
3307 (delete-other-windows))
|
|
|
3308 ((string-match "^ \\*" (buffer-name (current-buffer)))
|
|
|
3309 (bury-buffer))))
|
|
10085
|
3310
|
|
10165
|
3311 (define-key global-map "\e\e\e" 'keyboard-escape-quit)
|
|
26201
|
3312
|
|
27234
|
3313 (defcustom read-mail-command 'rmail
|
|
|
3314 "*Your preference for a mail reading package.
|
|
31573
|
3315 This is used by some keybindings which support reading mail.
|
|
|
3316 See also `mail-user-agent' concerning sending mail."
|
|
27234
|
3317 :type '(choice (function-item rmail)
|
|
|
3318 (function-item gnus)
|
|
|
3319 (function-item mh-rmail)
|
|
|
3320 (function :tag "Other"))
|
|
|
3321 :version "21.1"
|
|
|
3322 :group 'mail)
|
|
|
3323
|
|
17663
|
3324 (defcustom mail-user-agent 'sendmail-user-agent
|
|
15988
|
3325 "*Your preference for a mail composition package.
|
|
31573
|
3326 Various Emacs Lisp packages (e.g. Reporter) require you to compose an
|
|
15988
|
3327 outgoing email message. This variable lets you specify which
|
|
|
3328 mail-sending package you prefer.
|
|
|
3329
|
|
|
3330 Valid values include:
|
|
|
3331
|
|
31573
|
3332 `sendmail-user-agent' -- use the default Emacs Mail package.
|
|
|
3333 See Info node `(emacs)Sending Mail'.
|
|
|
3334 `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
|
|
|
3335 See Info node `(mh-e)'.
|
|
|
3336 `message-user-agent' -- use the Gnus Message package.
|
|
|
3337 See Info node `(message)'.
|
|
|
3338 `gnus-user-agent' -- like `message-user-agent', but with Gnus
|
|
|
3339 paraphernalia, particularly the Gcc: header for
|
|
|
3340 archiving.
|
|
15988
|
3341
|
|
|
3342 Additional valid symbols may be available; check with the author of
|
|
34687
|
3343 your package for details. The function should return non-nil if it
|
|
|
3344 succeeds.
|
|
31573
|
3345
|
|
|
3346 See also `read-mail-command' concerning reading mail."
|
|
17663
|
3347 :type '(radio (function-item :tag "Default Emacs mail"
|
|
|
3348 :format "%t\n"
|
|
|
3349 sendmail-user-agent)
|
|
|
3350 (function-item :tag "Emacs interface to MH"
|
|
|
3351 :format "%t\n"
|
|
|
3352 mh-e-user-agent)
|
|
31573
|
3353 (function-item :tag "Gnus Message package"
|
|
17663
|
3354 :format "%t\n"
|
|
|
3355 message-user-agent)
|
|
31573
|
3356 (function-item :tag "Gnus Message with full Gnus features"
|
|
|
3357 :format "%t\n"
|
|
|
3358 gnus-user-agent)
|
|
17663
|
3359 (function :tag "Other"))
|
|
|
3360 :group 'mail)
|
|
15988
|
3361
|
|
|
3362 (defun define-mail-user-agent (symbol composefunc sendfunc
|
|
|
3363 &optional abortfunc hookvar)
|
|
|
3364 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
|
|
|
3365
|
|
|
3366 SYMBOL can be any Lisp symbol. Its function definition and/or
|
|
|
3367 value as a variable do not matter for this usage; we use only certain
|
|
|
3368 properties on its property list, to encode the rest of the arguments.
|
|
|
3369
|
|
|
3370 COMPOSEFUNC is program callable function that composes an outgoing
|
|
|
3371 mail message buffer. This function should set up the basics of the
|
|
|
3372 buffer without requiring user interaction. It should populate the
|
|
16624
|
3373 standard mail headers, leaving the `to:' and `subject:' headers blank
|
|
|
3374 by default.
|
|
15988
|
3375
|
|
16632
|
3376 COMPOSEFUNC should accept several optional arguments--the same
|
|
|
3377 arguments that `compose-mail' takes. See that function's documentation.
|
|
15988
|
3378
|
|
16624
|
3379 SENDFUNC is the command a user would run to send the message.
|
|
|
3380
|
|
|
3381 Optional ABORTFUNC is the command a user would run to abort the
|
|
15988
|
3382 message. For mail packages that don't have a separate abort function,
|
|
|
3383 this can be `kill-buffer' (the equivalent of omitting this argument).
|
|
|
3384
|
|
|
3385 Optional HOOKVAR is a hook variable that gets run before the message
|
|
16624
|
3386 is actually sent. Callers that use the `mail-user-agent' may
|
|
|
3387 install a hook function temporarily on this hook variable.
|
|
|
3388 If HOOKVAR is nil, `mail-send-hook' is used.
|
|
15988
|
3389
|
|
|
3390 The properties used on SYMBOL are `composefunc', `sendfunc',
|
|
|
3391 `abortfunc', and `hookvar'."
|
|
|
3392 (put symbol 'composefunc composefunc)
|
|
|
3393 (put symbol 'sendfunc sendfunc)
|
|
|
3394 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
|
|
|
3395 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
|
|
|
3396
|
|
|
3397 (define-mail-user-agent 'sendmail-user-agent
|
|
18629
|
3398 'sendmail-user-agent-compose
|
|
15988
|
3399 'mail-send-and-exit)
|
|
|
3400
|
|
21906
|
3401 (defun rfc822-goto-eoh ()
|
|
|
3402 ;; Go to header delimiter line in a mail message, following RFC822 rules
|
|
|
3403 (goto-char (point-min))
|
|
|
3404 (while (looking-at "^[^: \n]+:\\|^[ \t]")
|
|
|
3405 (forward-line 1))
|
|
|
3406 (point))
|
|
|
3407
|
|
18629
|
3408 (defun sendmail-user-agent-compose (&optional to subject other-headers continue
|
|
|
3409 switch-function yank-action
|
|
|
3410 send-actions)
|
|
|
3411 (if switch-function
|
|
|
3412 (let ((special-display-buffer-names nil)
|
|
|
3413 (special-display-regexps nil)
|
|
|
3414 (same-window-buffer-names nil)
|
|
|
3415 (same-window-regexps nil))
|
|
|
3416 (funcall switch-function "*mail*")))
|
|
|
3417 (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
|
|
28491
|
3418 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
|
|
|
3419 (body (cdr (assoc-ignore-case "body" other-headers))))
|
|
18629
|
3420 (or (mail continue to subject in-reply-to cc yank-action send-actions)
|
|
|
3421 continue
|
|
|
3422 (error "Message aborted"))
|
|
|
3423 (save-excursion
|
|
21906
|
3424 (rfc822-goto-eoh)
|
|
18629
|
3425 (while other-headers
|
|
28491
|
3426 (unless (member-ignore-case (car (car other-headers))
|
|
|
3427 '("in-reply-to" "cc" "body"))
|
|
18629
|
3428 (insert (car (car other-headers)) ": "
|
|
|
3429 (cdr (car other-headers)) "\n"))
|
|
|
3430 (setq other-headers (cdr other-headers)))
|
|
28491
|
3431 (when body
|
|
|
3432 (forward-line 1)
|
|
|
3433 (insert body))
|
|
18629
|
3434 t)))
|
|
|
3435
|
|
15988
|
3436 (define-mail-user-agent 'mh-e-user-agent
|
|
|
3437 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
|
|
|
3438 'mh-before-send-letter-hook)
|
|
16632
|
3439
|
|
|
3440 (defun compose-mail (&optional to subject other-headers continue
|
|
|
3441 switch-function yank-action send-actions)
|
|
|
3442 "Start composing a mail message to send.
|
|
|
3443 This uses the user's chosen mail composition package
|
|
|
3444 as selected with the variable `mail-user-agent'.
|
|
|
3445 The optional arguments TO and SUBJECT specify recipients
|
|
|
3446 and the initial Subject field, respectively.
|
|
|
3447
|
|
|
3448 OTHER-HEADERS is an alist specifying additional
|
|
|
3449 header fields. Elements look like (HEADER . VALUE) where both
|
|
|
3450 HEADER and VALUE are strings.
|
|
|
3451
|
|
|
3452 CONTINUE, if non-nil, says to continue editing a message already
|
|
|
3453 being composed.
|
|
|
3454
|
|
|
3455 SWITCH-FUNCTION, if non-nil, is a function to use to
|
|
|
3456 switch to and display the buffer used for mail composition.
|
|
|
3457
|
|
|
3458 YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
|
|
16717
|
3459 to insert the raw text of the message being replied to.
|
|
|
3460 It has the form (FUNCTION . ARGS). The user agent will apply
|
|
|
3461 FUNCTION to ARGS, to insert the raw text of the original message.
|
|
|
3462 \(The user agent will also run `mail-citation-hook', *after* the
|
|
|
3463 original text has been inserted in this way.)
|
|
16632
|
3464
|
|
|
3465 SEND-ACTIONS is a list of actions to call when the message is sent.
|
|
|
3466 Each action has the form (FUNCTION . ARGS)."
|
|
17594
|
3467 (interactive
|
|
|
3468 (list nil nil nil current-prefix-arg))
|
|
16632
|
3469 (let ((function (get mail-user-agent 'composefunc)))
|
|
|
3470 (funcall function to subject other-headers continue
|
|
|
3471 switch-function yank-action send-actions)))
|
|
17594
|
3472
|
|
|
3473 (defun compose-mail-other-window (&optional to subject other-headers continue
|
|
|
3474 yank-action send-actions)
|
|
|
3475 "Like \\[compose-mail], but edit the outgoing message in another window."
|
|
|
3476 (interactive
|
|
|
3477 (list nil nil nil current-prefix-arg))
|
|
|
3478 (compose-mail to subject other-headers continue
|
|
|
3479 'switch-to-buffer-other-window yank-action send-actions))
|
|
|
3480
|
|
|
3481
|
|
|
3482 (defun compose-mail-other-frame (&optional to subject other-headers continue
|
|
|
3483 yank-action send-actions)
|
|
|
3484 "Like \\[compose-mail], but edit the outgoing message in another frame."
|
|
|
3485 (interactive
|
|
|
3486 (list nil nil nil current-prefix-arg))
|
|
|
3487 (compose-mail to subject other-headers continue
|
|
|
3488 'switch-to-buffer-other-frame yank-action send-actions))
|
|
33786
|
3489
|
|
17606
|
3490 (defvar set-variable-value-history nil
|
|
|
3491 "History of values entered with `set-variable'.")
|
|
|
3492
|
|
|
3493 (defun set-variable (var val)
|
|
|
3494 "Set VARIABLE to VALUE. VALUE is a Lisp object.
|
|
|
3495 When using this interactively, enter a Lisp object for VALUE.
|
|
|
3496 If you want VALUE to be a string, you must surround it with doublequotes.
|
|
|
3497 VALUE is used literally, not evaluated.
|
|
|
3498
|
|
|
3499 If VARIABLE has a `variable-interactive' property, that is used as if
|
|
|
3500 it were the arg to `interactive' (which see) to interactively read VALUE.
|
|
|
3501
|
|
|
3502 If VARIABLE has been defined with `defcustom', then the type information
|
|
|
3503 in the definition is used to check that VALUE is valid."
|
|
22157
|
3504 (interactive
|
|
|
3505 (let* ((default-var (variable-at-point))
|
|
|
3506 (var (if (symbolp default-var)
|
|
|
3507 (read-variable (format "Set variable (default %s): " default-var)
|
|
|
3508 default-var)
|
|
|
3509 (read-variable "Set variable: ")))
|
|
17606
|
3510 (minibuffer-help-form '(describe-variable var))
|
|
|
3511 (prop (get var 'variable-interactive))
|
|
|
3512 (prompt (format "Set %s to value: " var))
|
|
|
3513 (val (if prop
|
|
|
3514 ;; Use VAR's `variable-interactive' property
|
|
|
3515 ;; as an interactive spec for prompting.
|
|
|
3516 (call-interactively `(lambda (arg)
|
|
|
3517 (interactive ,prop)
|
|
|
3518 arg))
|
|
|
3519 (read
|
|
|
3520 (read-string prompt nil
|
|
|
3521 'set-variable-value-history)))))
|
|
|
3522 (list var val)))
|
|
|
3523
|
|
17613
|
3524 (let ((type (get var 'custom-type)))
|
|
17606
|
3525 (when type
|
|
|
3526 ;; Match with custom type.
|
|
|
3527 (require 'wid-edit)
|
|
|
3528 (setq type (widget-convert type))
|
|
|
3529 (unless (widget-apply type :match val)
|
|
26457
|
3530 (error "Value `%S' does not match type %S of %S"
|
|
17606
|
3531 val (car type) var))))
|
|
35203
|
3532 (set var val)
|
|
|
3533
|
|
|
3534 ;; Force a thorough redisplay for the case that the variable
|
|
|
3535 ;; has an effect on the display, like `tab-width' has.
|
|
|
3536 (force-mode-line-update))
|
|
33786
|
3537
|
|
4082
|
3538 ;; Define the major mode for lists of completions.
|
|
658
|
3539
|
|
11313
|
3540 (defvar completion-list-mode-map nil
|
|
|
3541 "Local map for completion list buffers.")
|
|
4217
|
3542 (or completion-list-mode-map
|
|
4082
|
3543 (let ((map (make-sparse-keymap)))
|
|
|
3544 (define-key map [mouse-2] 'mouse-choose-completion)
|
|
7762
|
3545 (define-key map [down-mouse-2] nil)
|
|
6549
|
3546 (define-key map "\C-m" 'choose-completion)
|
|
10165
|
3547 (define-key map "\e\e\e" 'delete-completion-window)
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3548 (define-key map [left] 'previous-completion)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3549 (define-key map [right] 'next-completion)
|
|
4217
|
3550 (setq completion-list-mode-map map)))
|
|
4082
|
3551
|
|
|
3552 ;; Completion mode is suitable only for specially formatted data.
|
|
4217
|
3553 (put 'completion-list-mode 'mode-class 'special)
|
|
4082
|
3554
|
|
11313
|
3555 (defvar completion-reference-buffer nil
|
|
|
3556 "Record the buffer that was current when the completion list was requested.
|
|
|
3557 This is a local variable in the completion list buffer.
|
|
11318
|
3558 Initial value is nil to avoid some compiler warnings.")
|
|
6160
|
3559
|
|
16924
|
3560 (defvar completion-no-auto-exit nil
|
|
|
3561 "Non-nil means `choose-completion-string' should never exit the minibuffer.
|
|
|
3562 This also applies to other functions such as `choose-completion'
|
|
|
3563 and `mouse-choose-completion'.")
|
|
|
3564
|
|
11313
|
3565 (defvar completion-base-size nil
|
|
|
3566 "Number of chars at beginning of minibuffer not involved in completion.
|
|
|
3567 This is a local variable in the completion list buffer
|
|
|
3568 but it talks about the buffer in `completion-reference-buffer'.
|
|
|
3569 If this is nil, it means to compare text to determine which part
|
|
|
3570 of the tail end of the buffer's text is involved in completion.")
|
|
8479
|
3571
|
|
10165
|
3572 (defun delete-completion-window ()
|
|
|
3573 "Delete the completion list window.
|
|
|
3574 Go to the window from which completion was requested."
|
|
|
3575 (interactive)
|
|
|
3576 (let ((buf completion-reference-buffer))
|
|
16851
|
3577 (if (one-window-p t)
|
|
|
3578 (if (window-dedicated-p (selected-window))
|
|
|
3579 (delete-frame (selected-frame)))
|
|
|
3580 (delete-window (selected-window))
|
|
|
3581 (if (get-buffer-window buf)
|
|
|
3582 (select-window (get-buffer-window buf))))))
|
|
10165
|
3583
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3584 (defun previous-completion (n)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3585 "Move to the previous item in the completion list."
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3586 (interactive "p")
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3587 (next-completion (- n)))
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3588
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3589 (defun next-completion (n)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3590 "Move to the next item in the completion list.
|
|
13960
|
3591 With prefix argument N, move N items (negative N means move backward)."
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3592 (interactive "p")
|
|
33781
|
3593 (let ((beg (point-min)) (end (point-max)))
|
|
|
3594 (while (and (> n 0) (not (eobp)))
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3595 ;; If in a completion, move to the end of it.
|
|
33781
|
3596 (when (get-text-property (point) 'mouse-face)
|
|
|
3597 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3598 ;; Move to start of next one.
|
|
33781
|
3599 (unless (get-text-property (point) 'mouse-face)
|
|
|
3600 (goto-char (next-single-property-change (point) 'mouse-face nil end)))
|
|
|
3601 (setq n (1- n)))
|
|
|
3602 (while (and (< n 0) (not (bobp)))
|
|
|
3603 (let ((prop (get-text-property (1- (point)) 'mouse-face)))
|
|
|
3604 ;; If in a completion, move to the start of it.
|
|
|
3605 (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
|
13171
ed9465203ed6
(next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3606 (goto-char (previous-single-property-change
|
|
33781
|
3607 (point) 'mouse-face nil beg)))
|
|
|
3608 ;; Move to end of the previous completion.
|
|
|
3609 (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
|
|
|
3610 (goto-char (previous-single-property-change
|
|
|
3611 (point) 'mouse-face nil beg)))
|
|
|
3612 ;; Move to the start of that one.
|
|
|
3613 (goto-char (previous-single-property-change
|
|
|
3614 (point) 'mouse-face nil beg))
|
|
|
3615 (setq n (1+ n))))))
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3616
|
|
6549
|
3617 (defun choose-completion ()
|
|
|
3618 "Choose the completion that point is in or next to."
|
|
|
3619 (interactive)
|
|
8479
|
3620 (let (beg end completion (buffer completion-reference-buffer)
|
|
|
3621 (base-size completion-base-size))
|
|
8203
|
3622 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
|
|
|
3623 (setq end (point) beg (1+ (point))))
|
|
|
3624 (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
|
|
10959
|
3625 (setq end (1- (point)) beg (point)))
|
|
8203
|
3626 (if (null beg)
|
|
|
3627 (error "No completion here"))
|
|
|
3628 (setq beg (previous-single-property-change beg 'mouse-face))
|
8380
40ab7df62402
(choose-completion): Check for next-single-property-change returning nil.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3629 (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
|
|
8468
|
3630 (setq completion (buffer-substring beg end))
|
|
|
3631 (let ((owindow (selected-window)))
|
|
|
3632 (if (and (one-window-p t 'selected-frame)
|
|
|
3633 (window-dedicated-p (selected-window)))
|
|
|
3634 ;; This is a special buffer's frame
|
|
|
3635 (iconify-frame (selected-frame))
|
|
|
3636 (or (window-dedicated-p (selected-window))
|
|
|
3637 (bury-buffer)))
|
|
|
3638 (select-window owindow))
|
|
8479
|
3639 (choose-completion-string completion buffer base-size)))
|
|
6549
|
3640
|
|
|
3641 ;; Delete the longest partial match for STRING
|
|
|
3642 ;; that can be found before POINT.
|
|
|
3643 (defun choose-completion-delete-max-match (string)
|
|
|
3644 (let ((opoint (point))
|
|
|
3645 (len (min (length string)
|
|
|
3646 (- (point) (point-min)))))
|
|
|
3647 (goto-char (- (point) (length string)))
|
7574
040547adfab2
(completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3648 (if completion-ignore-case
|
040547adfab2
(completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3649 (setq string (downcase string)))
|
|
6549
|
3650 (while (and (> len 0)
|
|
|
3651 (let ((tail (buffer-substring (point)
|
|
|
3652 (+ (point) len))))
|
7574
040547adfab2
(completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3653 (if completion-ignore-case
|
040547adfab2
(completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3654 (setq tail (downcase tail)))
|
|
6549
|
3655 (not (string= tail (substring string 0 len)))))
|
|
|
3656 (setq len (1- len))
|
|
|
3657 (forward-char 1))
|
|
|
3658 (delete-char len)))
|
|
|
3659
|
|
11313
|
3660 ;; Switch to BUFFER and insert the completion choice CHOICE.
|
|
|
3661 ;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
|
|
|
3662 ;; to keep. If it is nil, use choose-completion-delete-max-match instead.
|
|
15484
|
3663
|
|
|
3664 ;; If BUFFER is the minibuffer, exit the minibuffer
|
|
16924
|
3665 ;; unless it is reading a file name and CHOICE is a directory,
|
|
|
3666 ;; or completion-no-auto-exit is non-nil.
|
|
8479
|
3667 (defun choose-completion-string (choice &optional buffer base-size)
|
|
27050
|
3668 (let ((buffer (or buffer completion-reference-buffer))
|
|
|
3669 (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
|
|
7333
|
3670 ;; If BUFFER is a minibuffer, barf unless it's the currently
|
|
|
3671 ;; active minibuffer.
|
|
27050
|
3672 (if (and mini-p
|
|
11159
|
3673 (or (not (active-minibuffer-window))
|
|
|
3674 (not (equal buffer
|
|
|
3675 (window-buffer (active-minibuffer-window))))))
|
|
7333
|
3676 (error "Minibuffer is not active for completion")
|
|
|
3677 ;; Insert the completion into the buffer where completion was requested.
|
|
|
3678 (set-buffer buffer)
|
|
8479
|
3679 (if base-size
|
|
27050
|
3680 (delete-region (+ base-size (if mini-p
|
|
|
3681 (minibuffer-prompt-end)
|
|
|
3682 (point-min)))
|
|
|
3683 (point))
|
|
8479
|
3684 (choose-completion-delete-max-match choice))
|
|
7333
|
3685 (insert choice)
|
|
7697
|
3686 (remove-text-properties (- (point) (length choice)) (point)
|
|
|
3687 '(mouse-face nil))
|
|
7333
|
3688 ;; Update point in the window that BUFFER is showing in.
|
|
|
3689 (let ((window (get-buffer-window buffer t)))
|
|
|
3690 (set-window-point window (point)))
|
|
|
3691 ;; If completing for the minibuffer, exit it with this choice.
|
|
16924
|
3692 (and (not completion-no-auto-exit)
|
|
|
3693 (equal buffer (window-buffer (minibuffer-window)))
|
|
8559
|
3694 minibuffer-completion-table
|
|
15484
|
3695 ;; If this is reading a file name, and the file name chosen
|
|
|
3696 ;; is a directory, don't exit the minibuffer.
|
|
|
3697 (if (and (eq minibuffer-completion-table 'read-file-name-internal)
|
|
26054
|
3698 (file-directory-p (field-string (point-max))))
|
|
15484
|
3699 (select-window (active-minibuffer-window))
|
|
|
3700 (exit-minibuffer))))))
|
|
6549
|
3701
|
|
4217
|
3702 (defun completion-list-mode ()
|
|
4082
|
3703 "Major mode for buffers showing lists of possible completions.
|
|
6549
|
3704 Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
|
|
|
3705 to select the completion near point.
|
|
|
3706 Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
|
|
|
3707 with the mouse."
|
|
4082
|
3708 (interactive)
|
|
|
3709 (kill-all-local-variables)
|
|
4217
|
3710 (use-local-map completion-list-mode-map)
|
|
|
3711 (setq mode-name "Completion List")
|
|
|
3712 (setq major-mode 'completion-list-mode)
|
|
8479
|
3713 (make-local-variable 'completion-base-size)
|
|
|
3714 (setq completion-base-size nil)
|
|
4217
|
3715 (run-hooks 'completion-list-mode-hook))
|
|
4082
|
3716
|
|
20482
|
3717 (defvar completion-setup-hook nil
|
|
|
3718 "Normal hook run at the end of setting up a completion list buffer.
|
|
|
3719 When this hook is run, the current buffer is the one in which the
|
|
|
3720 command to display the completion list buffer was run.
|
|
|
3721 The completion list buffer is available as the value of `standard-output'.")
|
|
|
3722
|
|
11313
|
3723 ;; This function goes in completion-setup-hook, so that it is called
|
|
|
3724 ;; after the text of the completion list buffer is written.
|
|
8203
|
3725
|
|
4082
|
3726 (defun completion-setup-function ()
|
|
|
3727 (save-excursion
|
|
11313
|
3728 (let ((mainbuf (current-buffer)))
|
|
6160
|
3729 (set-buffer standard-output)
|
|
|
3730 (completion-list-mode)
|
|
|
3731 (make-local-variable 'completion-reference-buffer)
|
|
|
3732 (setq completion-reference-buffer mainbuf)
|
|
18034
|
3733 (if (eq minibuffer-completion-table 'read-file-name-internal)
|
|
|
3734 ;; For file name completion,
|
|
|
3735 ;; use the number of chars before the start of the
|
|
|
3736 ;; last file name component.
|
|
|
3737 (setq completion-base-size
|
|
|
3738 (save-excursion
|
|
|
3739 (set-buffer mainbuf)
|
|
|
3740 (goto-char (point-max))
|
|
|
3741 (skip-chars-backward (format "^%c" directory-sep-char))
|
|
27096
|
3742 (- (point) (minibuffer-prompt-end))))
|
|
19227
|
3743 ;; Otherwise, in minibuffer, the whole input is being completed.
|
|
|
3744 (save-match-data
|
|
|
3745 (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
|
|
|
3746 (buffer-name mainbuf))
|
|
|
3747 (setq completion-base-size 0))))
|
|
6160
|
3748 (goto-char (point-min))
|
|
28113
|
3749 (if (display-mouse-p)
|
|
6160
|
3750 (insert (substitute-command-keys
|
|
6549
|
3751 "Click \\[mouse-choose-completion] on a completion to select it.\n")))
|
|
|
3752 (insert (substitute-command-keys
|
|
|
3753 "In this buffer, type \\[choose-completion] to \
|
|
23450
|
3754 select the completion near point.\n\n")))))
|
|
4082
|
3755
|
|
|
3756 (add-hook 'completion-setup-hook 'completion-setup-function)
|
10284
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3757
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3758 (define-key minibuffer-local-completion-map [prior]
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3759 'switch-to-completions)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3760 (define-key minibuffer-local-must-match-map [prior]
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3761 'switch-to-completions)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3762 (define-key minibuffer-local-completion-map "\M-v"
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3763 'switch-to-completions)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3764 (define-key minibuffer-local-must-match-map "\M-v"
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3765 'switch-to-completions)
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3766
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3767 (defun switch-to-completions ()
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3768 "Select the completion list window."
|
832491972c95
(switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3769 (interactive)
|
|
12483
|
3770 ;; Make sure we have a completions window.
|
|
|
3771 (or (get-buffer-window "*Completions*")
|
|
|
3772 (minibuffer-completion-help))
|
|
20663
|
3773 (let ((window (get-buffer-window "*Completions*")))
|
|
|
3774 (when window
|
|
|
3775 (select-window window)
|
|
|
3776 (goto-char (point-min))
|
|
|
3777 (search-forward "\n\n")
|
|
|
3778 (forward-line 1))))
|
|
33786
|
3779
|
|
11140
|
3780 ;; Support keyboard commands to turn on various modifiers.
|
|
|
3781
|
|
|
3782 ;; These functions -- which are not commands -- each add one modifier
|
|
|
3783 ;; to the following event.
|
|
|
3784
|
|
|
3785 (defun event-apply-alt-modifier (ignore-prompt)
|
|
22324
|
3786 "Add the Alt modifier to the following event.
|
|
|
3787 For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
|
|
11140
|
3788 (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
|
|
|
3789 (defun event-apply-super-modifier (ignore-prompt)
|
|
22324
|
3790 "Add the Super modifier to the following event.
|
|
|
3791 For example, type \\[event-apply-super-modifier] & to enter Super-&."
|
|
11140
|
3792 (vector (event-apply-modifier (read-event) 'super 23 "s-")))
|
|
|
3793 (defun event-apply-hyper-modifier (ignore-prompt)
|
|
22324
|
3794 "Add the Hyper modifier to the following event.
|
|
|
3795 For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
|
|
11140
|
3796 (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
|
|
|
3797 (defun event-apply-shift-modifier (ignore-prompt)
|
|
22324
|
3798 "Add the Shift modifier to the following event.
|
|
|
3799 For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
|
|
11140
|
3800 (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
|
|
|
3801 (defun event-apply-control-modifier (ignore-prompt)
|
|
22324
|
3802 "Add the Ctrl modifier to the following event.
|
|
|
3803 For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
|
|
11140
|
3804 (vector (event-apply-modifier (read-event) 'control 26 "C-")))
|
|
|
3805 (defun event-apply-meta-modifier (ignore-prompt)
|
|
22324
|
3806 "Add the Meta modifier to the following event.
|
|
|
3807 For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
|
|
11140
|
3808 (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
|
|
|
3809
|
|
|
3810 (defun event-apply-modifier (event symbol lshiftby prefix)
|
|
|
3811 "Apply a modifier flag to event EVENT.
|
|
|
3812 SYMBOL is the name of this modifier, as a symbol.
|
|
|
3813 LSHIFTBY is the numeric value of this modifier, in keyboard events.
|
|
|
3814 PREFIX is the string that represents this modifier in an event type symbol."
|
|
|
3815 (if (numberp event)
|
|
|
3816 (cond ((eq symbol 'control)
|
|
11201
|
3817 (if (and (<= (downcase event) ?z)
|
|
|
3818 (>= (downcase event) ?a))
|
|
11140
|
3819 (- (downcase event) ?a -1)
|
|
11201
|
3820 (if (and (<= (downcase event) ?Z)
|
|
|
3821 (>= (downcase event) ?A))
|
|
11140
|
3822 (- (downcase event) ?A -1)
|
|
|
3823 (logior (lsh 1 lshiftby) event))))
|
|
|
3824 ((eq symbol 'shift)
|
|
|
3825 (if (and (<= (downcase event) ?z)
|
|
|
3826 (>= (downcase event) ?a))
|
|
|
3827 (upcase event)
|
|
|
3828 (logior (lsh 1 lshiftby) event)))
|
|
|
3829 (t
|
|
|
3830 (logior (lsh 1 lshiftby) event)))
|
|
|
3831 (if (memq symbol (event-modifiers event))
|
|
|
3832 event
|
|
|
3833 (let ((event-type (if (symbolp event) event (car event))))
|
|
|
3834 (setq event-type (intern (concat prefix (symbol-name event-type))))
|
|
|
3835 (if (symbolp event)
|
|
|
3836 event-type
|
|
|
3837 (cons event-type (cdr event)))))))
|
|
|
3838
|
|
11206
|
3839 (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
|
|
|
3840 (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
|
|
|
3841 (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
|
|
|
3842 (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
|
|
|
3843 (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
|
|
|
3844 (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
|
|
33786
|
3845
|
|
3947
|
3846 ;;;; Keypad support.
|
|
|
3847
|
|
|
3848 ;;; Make the keypad keys act like ordinary typing keys. If people add
|
|
|
3849 ;;; bindings for the function key symbols, then those bindings will
|
|
|
3850 ;;; override these, so this shouldn't interfere with any existing
|
|
|
3851 ;;; bindings.
|
|
|
3852
|
|
5342
|
3853 ;; Also tell read-char how to handle these keys.
|
|
3947
|
3854 (mapcar
|
|
|
3855 (lambda (keypad-normal)
|
|
|
3856 (let ((keypad (nth 0 keypad-normal))
|
|
|
3857 (normal (nth 1 keypad-normal)))
|
|
5342
|
3858 (put keypad 'ascii-character normal)
|
|
3947
|
3859 (define-key function-key-map (vector keypad) (vector normal))))
|
|
|
3860 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
|
|
|
3861 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
|
|
|
3862 (kp-space ?\ )
|
|
|
3863 (kp-tab ?\t)
|
|
|
3864 (kp-enter ?\r)
|
|
|
3865 (kp-multiply ?*)
|
|
|
3866 (kp-add ?+)
|
|
|
3867 (kp-separator ?,)
|
|
|
3868 (kp-subtract ?-)
|
|
|
3869 (kp-decimal ?.)
|
|
|
3870 (kp-divide ?/)
|
|
|
3871 (kp-equal ?=)))
|
|
|
3872
|
|
26457
|
3873 ;;;;
|
26003
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3874 ;;;; forking a twin copy of a buffer.
|
|
26457
|
3875 ;;;;
|
26003
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3876
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3877 (defvar clone-buffer-hook nil
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3878 "Normal hook to run in the new buffer at the end of `clone-buffer'.")
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3879
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3880 (defun clone-process (process &optional newname)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3881 "Create a twin copy of PROCESS.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3882 If NEWNAME is nil, it defaults to PROCESS' name;
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3883 NEWNAME is modified by adding or incrementing <N> at the end as necessary.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3884 If PROCESS is associated with a buffer, the new process will be associated
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3885 with the current buffer instead.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3886 Returns nil if PROCESS has already terminated."
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3887 (setq newname (or newname (process-name process)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3888 (if (string-match "<[0-9]+>\\'" newname)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3889 (setq newname (substring newname 0 (match-beginning 0))))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3890 (when (memq (process-status process) '(run stop open))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3891 (let* ((process-connection-type (process-tty-name process))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3892 (old-kwoq (process-kill-without-query process nil))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3893 (new-process
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3894 (if (memq (process-status process) '(open))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3895 (apply 'open-network-stream newname
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3896 (if (process-buffer process) (current-buffer))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3897 (process-contact process))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3898 (apply 'start-process newname
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3899 (if (process-buffer process) (current-buffer))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3900 (process-command process)))))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3901 (process-kill-without-query new-process old-kwoq)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3902 (process-kill-without-query process old-kwoq)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3903 (set-process-inherit-coding-system-flag
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3904 new-process (process-inherit-coding-system-flag process))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3905 (set-process-filter new-process (process-filter process))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3906 (set-process-sentinel new-process (process-sentinel process))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3907 new-process)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3908
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3909 ;; things to maybe add (currently partly covered by `funcall mode':
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3910 ;; - syntax-table
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3911 ;; - overlays
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3912 (defun clone-buffer (&optional newname display-flag)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3913 "Create a twin copy of the current buffer.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3914 If NEWNAME is nil, it defaults to the current buffer's name;
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3915 NEWNAME is modified by adding or incrementing <N> at the end as necessary.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3916
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3917 If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3918 This runs the normal hook `clone-buffer-hook' in the new buffer
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3919 after it has been set up properly in other respects."
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3920 (interactive (list (if current-prefix-arg (read-string "Name: "))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3921 t))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3922 (if buffer-file-name
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3923 (error "Cannot clone a file-visiting buffer"))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3924 (if (get major-mode 'no-clone)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3925 (error "Cannot clone a buffer in %s mode" mode-name))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3926 (setq newname (or newname (buffer-name)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3927 (if (string-match "<[0-9]+>\\'" newname)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3928 (setq newname (substring newname 0 (match-beginning 0))))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3929 (let ((buf (current-buffer))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3930 (ptmin (point-min))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3931 (ptmax (point-max))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3932 (pt (point))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3933 (mk (if mark-active (mark t)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3934 (modified (buffer-modified-p))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3935 (mode major-mode)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3936 (lvars (buffer-local-variables))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3937 (process (get-buffer-process (current-buffer)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3938 (new (generate-new-buffer (or newname (buffer-name)))))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3939 (save-restriction
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3940 (widen)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3941 (with-current-buffer new
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3942 (insert-buffer-substring buf)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3943 (with-current-buffer new
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3944 (narrow-to-region ptmin ptmax)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3945 (goto-char pt)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3946 (if mk (set-mark mk))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3947 (set-buffer-modified-p modified)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3948
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3949 ;; Clone the old buffer's process, if any.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3950 (when process (clone-process process))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3951
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3952 ;; Now set up the major mode.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3953 (funcall mode)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3954
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3955 ;; Set up other local variables.
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3956 (mapcar (lambda (v)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3957 (condition-case () ;in case var is read-only
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3958 (if (symbolp v)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3959 (makunbound v)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3960 (set (make-local-variable (car v)) (cdr v)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3961 (error nil)))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3962 lvars)
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3963
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3964 ;; Run any hooks (typically set up by the major mode
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3965 ;; for cloning to work properly).
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3966 (run-hooks 'clone-buffer-hook))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3967 (if display-flag (pop-to-buffer new))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3968 new))
|
f6c190ef2f45
(shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3969
|
|
28624
|
3970
|
|
28659
|
3971 (defun clone-indirect-buffer (newname display-flag &optional norecord)
|
|
28624
|
3972 "Create an indirect buffer that is a twin copy of the current buffer.
|
|
|
3973
|
|
|
3974 Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME
|
|
|
3975 from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
|
|
|
3976 or if not called with a prefix arg, NEWNAME defaults to the current
|
|
|
3977 buffer's name. The name is modified by adding a `<N>' suffix to it
|
|
|
3978 or by incrementing the N in an existing suffix.
|
|
|
3979
|
|
|
3980 DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
|
|
28659
|
3981 This is always done when called interactively.
|
|
|
3982
|
|
|
3983 Optional last arg NORECORD non-nil means do not put this buffer at the
|
|
|
3984 front of the list of recently selected ones."
|
|
28624
|
3985 (interactive (list (if current-prefix-arg
|
|
|
3986 (read-string "BName of indirect buffer: "))
|
|
|
3987 t))
|
|
|
3988 (setq newname (or newname (buffer-name)))
|
|
|
3989 (if (string-match "<[0-9]+>\\'" newname)
|
|
|
3990 (setq newname (substring newname 0 (match-beginning 0))))
|
|
|
3991 (let* ((name (generate-new-buffer-name newname))
|
|
|
3992 (buffer (make-indirect-buffer (current-buffer) name t)))
|
|
|
3993 (when display-flag
|
|
33781
|
3994 (pop-to-buffer buffer norecord))
|
|
28624
|
3995 buffer))
|
|
|
3996
|
|
|
3997
|
|
28659
|
3998 (defun clone-indirect-buffer-other-window (buffer &optional norecord)
|
|
|
3999 "Create an indirect buffer that is a twin copy of BUFFER.
|
|
|
4000 Select the new buffer in another window.
|
|
|
4001 Optional second arg NORECORD non-nil means do not put this buffer at
|
|
|
4002 the front of the list of recently selected ones."
|
|
|
4003 (interactive "bClone buffer in other window: ")
|
|
|
4004 (let ((popup-windows t))
|
|
|
4005 (set-buffer buffer)
|
|
|
4006 (clone-indirect-buffer nil t norecord)))
|
|
|
4007
|
|
28661
|
4008 (define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
|
|
28659
|
4009
|
|
33786
|
4010
|
|
28193
|
4011 ;;; Syntax stuff.
|
|
|
4012
|
|
|
4013 (defconst syntax-code-table
|
|
28896
|
4014 '((?\ 0 "whitespace")
|
|
|
4015 (?- 0 "whitespace")
|
|
|
4016 (?. 1 "punctuation")
|
|
|
4017 (?w 2 "word")
|
|
|
4018 (?_ 3 "symbol")
|
|
|
4019 (?\( 4 "open parenthesis")
|
|
|
4020 (?\) 5 "close parenthesis")
|
|
|
4021 (?\' 6 "expression prefix")
|
|
|
4022 (?\" 7 "string quote")
|
|
|
4023 (?$ 8 "paired delimiter")
|
|
|
4024 (?\\ 9 "escape")
|
|
|
4025 (?/ 10 "character quote")
|
|
|
4026 (?< 11 "comment start")
|
|
|
4027 (?> 12 "comment end")
|
|
|
4028 (?@ 13 "inherit")
|
|
|
4029 (nil 14 "comment fence")
|
|
|
4030 (nil 15 "string fence"))
|
|
|
4031 "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
|
|
28193
|
4032 CHAR is a character that is allowed as first char in the string
|
|
|
4033 specifying the syntax when calling `modify-syntax-entry'. CODE is the
|
|
|
4034 corresponing syntax code as it is stored in a syntax cell, and
|
|
28896
|
4035 can be used as value of a `syntax-table' property.
|
|
|
4036 DESCRIPTION is the descriptive string for the syntax.")
|
|
28193
|
4037
|
|
33786
|
4038
|
|
34553
|
4039 ;;; Handling of Backspace and Delete keys.
|
|
|
4040
|
|
|
4041 (defcustom delete-key-deletes-forward nil
|
|
|
4042 "Whether the Delete key should delete forward or not.
|
|
|
4043
|
|
|
4044 On window systems, the default value of this option is chosen
|
|
|
4045 according to the keyboard used. If the keyboard has both a Backspace
|
|
|
4046 key and a Delete key, and both are mapped to their usual meanings, the
|
|
|
4047 option's default value is set to t, so that Backspace can be used to
|
|
|
4048 delete backward, and Delete can be used used to delete forward
|
|
|
4049
|
|
|
4050 If not running under a window system, setting this option accomplishes
|
|
|
4051 a similar effect by mapping C-h, which is usually generated by the
|
|
|
4052 Backspace key, to DEL, and by mapping DEL to C-d via
|
|
|
4053 `keyboard-translate'. The former functionality of C-h is available on
|
|
|
4054 the F1 key. You should probably not use this setting if you don't
|
|
34827
|
4055 have both Backspace, Delete and F1 keys.
|
|
|
4056
|
|
|
4057 Setting this variable with setq doesn't take effect. Programmatically,
|
|
|
4058 call `delete-key-deleted-forward-mode' instead."
|
|
34553
|
4059 :type 'boolean
|
|
|
4060 :group 'editing-basics
|
|
|
4061 :version "21.1"
|
|
|
4062 :set (lambda (symbol value)
|
|
|
4063 ;; The fboundp is because of a problem with :set when
|
|
|
4064 ;; dumping Emacs. It doesn't really matter.
|
|
|
4065 (if (fboundp 'delete-key-deletes-forward-mode)
|
|
|
4066 (delete-key-deletes-forward-mode (or value 0))
|
|
|
4067 (set-default symbol value))))
|
|
|
4068
|
|
|
4069
|
|
|
4070 (defun delete-key-deletes-forward-mode (&optional arg)
|
|
|
4071 "Toggle Delete key deleting forward or backward.
|
|
|
4072 With numeric arg, turn the mode on if and only iff ARG is positive.
|
|
34713
|
4073 For more details, see `delete-key-deletes-forward'."
|
|
34553
|
4074 (interactive "P")
|
|
|
4075 (setq delete-key-deletes-forward
|
|
|
4076 (if arg
|
|
|
4077 (> (prefix-numeric-value arg) 0)
|
|
|
4078 (not delete-key-deletes-forward)))
|
|
|
4079
|
|
34570
|
4080 (cond ((or (memq window-system '(x w32 mac pc))
|
|
|
4081 (memq system-type '(ms-dos windows-nt)))
|
|
34829
|
4082 (let ((bindings
|
|
36030
|
4083 `(([C-delete] [C-backspace])
|
|
|
4084 ([M-delete] [M-backspace])
|
|
|
4085 ([C-M-delete] [C-M-backspace])
|
|
35346
|
4086 (,esc-map
|
|
36030
|
4087 [C-delete] [C-backspace])))
|
|
|
4088 (old-state (lookup-key function-key-map [delete])))
|
|
35346
|
4089
|
|
|
4090 (if delete-key-deletes-forward
|
|
|
4091 (progn
|
|
|
4092 (define-key function-key-map [delete] [?\C-d])
|
|
35776
|
4093 (define-key function-key-map [kp-delete] [?\C-d])
|
|
35346
|
4094 (define-key function-key-map [backspace] [?\C-?]))
|
|
|
4095 (define-key function-key-map [delete] [?\C-?])
|
|
35776
|
4096 (define-key function-key-map [kp-delete] [?\C-?])
|
|
35346
|
4097 (define-key function-key-map [backspace] [?\C-?]))
|
|
|
4098
|
|
36030
|
4099 ;; Maybe swap bindings of C-delete and C-backspace, etc.
|
|
|
4100 (unless (equal old-state (lookup-key function-key-map [delete]))
|
|
|
4101 (dolist (binding bindings)
|
|
|
4102 (let ((map global-map))
|
|
|
4103 (when (keymapp (car binding))
|
|
|
4104 (setq map (car binding) binding (cdr binding)))
|
|
|
4105 (let* ((key1 (nth 0 binding))
|
|
|
4106 (key2 (nth 1 binding))
|
|
|
4107 (binding1 (lookup-key map key1))
|
|
|
4108 (binding2 (lookup-key map key2)))
|
|
|
4109 (define-key map key1 binding2)
|
|
|
4110 (define-key map key2 binding1)))))))
|
|
34553
|
4111 (t
|
|
|
4112 (if delete-key-deletes-forward
|
|
|
4113 (progn
|
|
|
4114 (keyboard-translate ?\C-h ?\C-?)
|
|
|
4115 (keyboard-translate ?\C-? ?\C-d))
|
|
|
4116 (keyboard-translate ?\C-h ?\C-h)
|
|
|
4117 (keyboard-translate ?\C-? ?\C-?))))
|
|
|
4118
|
|
|
4119 (run-hooks 'delete-key-deletes-forward-hook)
|
|
|
4120 (if (interactive-p)
|
|
|
4121 (message "Delete key deletes %s"
|
|
|
4122 (if delete-key-deletes-forward "forward" "backward"))))
|
|
|
4123
|
|
|
4124
|
|
33352
|
4125 ;;; Misc
|
|
|
4126
|
|
|
4127 (defun byte-compiling-files-p ()
|
|
|
4128 "Return t if currently byte-compiling files."
|
|
|
4129 (and (boundp 'byte-compile-current-file)
|
|
|
4130 (stringp byte-compile-current-file)))
|
|
33786
|
4131
|
|
658
|
4132 ;;; simple.el ends here
|
