annotate lisp/simple.el @ 28553:56d5ca61cfd8

(NUM_MOUSE_BUTTONS): Define. (IT_frame_up_to_date): Support the buffer local value of cursor-type, if defined.
author Eli Zaretskii <eliz@gnu.org>
date Wed, 12 Apr 2000 15:44:16 +0000
parents 3e21859cd0e7
children aef61acb21de
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1 ;;; simple.el --- basic editing commands for Emacs
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2
27234
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
4 ;; Free Software Foundation, Inc.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 ;; This file is part of GNU Emacs.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 ;; it under the terms of the GNU General Public License as published by
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
10 ;; the Free Software Foundation; either version 2, or (at your option)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 ;; any later version.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 ;; GNU Emacs is distributed in the hope that it will be useful,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 ;; GNU General Public License for more details.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13960
diff changeset
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13960
diff changeset
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13960
diff changeset
21 ;; Boston, MA 02111-1307, USA.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22
2315
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
23 ;;; Commentary:
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
24
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
25 ;; A grab-bag of basic Emacs commands not specifically related to some
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
26 ;; major mode or to file-handling.
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
27
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
28 ;;; Code:
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29
26466
b32572666174 (with-syntax-table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26457
diff changeset
30 (eval-when-compile
b32572666174 (with-syntax-table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26457
diff changeset
31 (require 'cl))
b32572666174 (with-syntax-table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26457
diff changeset
32
b32572666174 (with-syntax-table): New.
Gerd Moellmann <gerd@gnu.org>
parents: 26457
diff changeset
33
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
34 (defgroup killing nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
35 "Killing and yanking commands"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
36 :group 'editing)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
37
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
38 (defgroup fill-comments nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
39 "Indenting and filling of comments."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
40 :prefix "comment-"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
41 :group 'fill)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
42
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
43 (defgroup paren-matching nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
44 "Highlight (un)matching of parens and expressions."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
45 :group 'matching)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
46
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
47
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
48 (defun fundamental-mode ()
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
49 "Major mode not specialized for anything in particular.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
50 Other major modes are defined by comparison with this one."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
51 (interactive)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
52 (kill-all-local-variables))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
53
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
54 ;; Making and deleting lines.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
55
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
56 (defun newline (&optional arg)
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
57 "Insert a newline, and move to left margin of the new line if it's blank.
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
58 The newline is marked with the text-property `hard'.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
59 With arg, insert that many newlines.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
60 In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
61 (interactive "*P")
13137
a83a1515fd9b (newline): Call barf-if-buffer-read-only.
Richard M. Stallman <rms@gnu.org>
parents: 12975
diff changeset
62 (barf-if-buffer-read-only)
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
63 ;; Inserting a newline at the end of a line produces better redisplay in
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
64 ;; try_window_id than inserting at the beginning of a line, and the textual
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
65 ;; result is the same. So, if we're at beginning of line, pretend to be at
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
66 ;; the end of the previous line.
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
67 (let ((flag (and (not (bobp))
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
68 (bolp)
17214
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
69 ;; 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>
parents: 17133
diff changeset
70 ;; the range of the changes.
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
71 (not after-change-function)
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
72 (not before-change-function)
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
73 (not after-change-functions)
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
74 (not before-change-functions)
16417
fb6785d0c256 (newline): Use buffer-has-markers-at.
Richard M. Stallman <rms@gnu.org>
parents: 16408
diff changeset
75 ;; Make sure there are no markers here.
fb6785d0c256 (newline): Use buffer-has-markers-at.
Richard M. Stallman <rms@gnu.org>
parents: 16408
diff changeset
76 (not (buffer-has-markers-at (1- (point))))
21459
b787b88cc575 (newline): Mark as hard the newline that was just
Karl Heuer <kwzh@gnu.org>
parents: 21222
diff changeset
77 (not (buffer-has-markers-at (point)))
17214
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
78 ;; 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>
parents: 17133
diff changeset
79 ;; where the change was.
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
80 (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>
parents: 17133
diff changeset
81 (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>
parents: 17133
diff changeset
82 (or (eobp)
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
83 (not (get-char-property (point) 'insert-in-front-hooks)))
15605
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
84 ;; Make sure the newline before point isn't intangible.
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
85 (not (get-char-property (1- (point)) 'intangible))
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
86 ;; Make sure the newline before point isn't read-only.
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
87 (not (get-char-property (1- (point)) 'read-only))
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
88 ;; Make sure the newline before point isn't invisible.
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
89 (not (get-char-property (1- (point)) 'invisible))
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
90 ;; Make sure the newline before point has the same
8b2f2d10c40a (newline): Don't do the optimization if the newline before point is
Miles Bader <miles@gnu.org>
parents: 15484
diff changeset
91 ;; properties as the char before it (if any).
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
92 (< (or (previous-property-change (point)) -2)
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
93 (- (point) 2))))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
94 (was-page-start (and (bolp)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
95 (looking-at page-delimiter)))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
96 (beforepos (point)))
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
97 (if flag (backward-char 1))
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
98 ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
99 ;; Set last-command-char to tell self-insert what to insert.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
100 (let ((last-command-char ?\n)
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
101 ;; 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>
parents: 11326
diff changeset
102 ;; 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>
parents: 11326
diff changeset
103 ;; 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>
parents: 11326
diff changeset
104 (auto-fill-function (if (or arg flag) nil auto-fill-function)))
12400
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
105 (unwind-protect
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
106 (self-insert-command (prefix-numeric-value arg))
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
107 ;; If we get an error in self-insert-command, put point at right place.
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
108 (if flag (forward-char 1))))
21459
b787b88cc575 (newline): Mark as hard the newline that was just
Karl Heuer <kwzh@gnu.org>
parents: 21222
diff changeset
109 ;; Even if we did *not* get an error, keep that forward-char;
b787b88cc575 (newline): Mark as hard the newline that was just
Karl Heuer <kwzh@gnu.org>
parents: 21222
diff changeset
110 ;; all further processing should apply to the newline that the user
b787b88cc575 (newline): Mark as hard the newline that was just
Karl Heuer <kwzh@gnu.org>
parents: 21222
diff changeset
111 ;; thinks he inserted.
b787b88cc575 (newline): Mark as hard the newline that was just
Karl Heuer <kwzh@gnu.org>
parents: 21222
diff changeset
112
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
113 ;; Mark the newline(s) `hard'.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
114 (if use-hard-newlines
21459
b787b88cc575 (newline): Mark as hard the newline that was just
Karl Heuer <kwzh@gnu.org>
parents: 21222
diff changeset
115 (set-hard-newline-properties
16018
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
116 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
117 ;; If the newline leaves the previous line blank,
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
118 ;; and we have a left margin, delete that from the blank line.
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
119 (or flag
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
120 (save-excursion
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
121 (goto-char beforepos)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
122 (beginning-of-line)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
123 (and (looking-at "[ \t]$")
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
124 (> (current-left-margin) 0)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
125 (delete-region (point) (progn (end-of-line) (point))))))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
126 ;; Indent the line after the newline, except in one case:
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
127 ;; when we added the newline at the beginning of a line
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
128 ;; which starts a page.
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
129 (or was-page-start
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
130 (move-to-left-margin nil t)))
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
131 nil)
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
132
16018
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
133 (defun set-hard-newline-properties (from to)
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
134 (let ((sticky (get-text-property from 'rear-nonsticky)))
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
135 (put-text-property from to 'hard 't)
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
136 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
137 (if (and (listp sticky) (not (memq 'hard sticky)))
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
138 (put-text-property from (point) 'rear-nonsticky
9a12ac7707c9 (set-hard-newline-properties): New fn.
Richard M. Stallman <rms@gnu.org>
parents: 15988
diff changeset
139 (cons 'hard sticky)))))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
140
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 (defun open-line (arg)
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
142 "Insert a newline and leave point before it.
10813
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
143 If there is a fill prefix and/or a left-margin, insert them on the new line
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
144 if the line would have been blank.
1063
25b929c06f83 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
145 With arg N, insert N newlines."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 (interactive "*p")
1063
25b929c06f83 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
147 (let* ((do-fill-prefix (and fill-prefix (bolp)))
10813
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
148 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
149 (loc (point)))
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
150 (newline arg)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
151 (goto-char loc)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
152 (while (> arg 0)
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
153 (cond ((bolp)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
154 (if do-left-margin (indent-to (current-left-margin)))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
155 (if do-fill-prefix (insert-and-inherit fill-prefix))))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
156 (forward-line 1)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
157 (setq arg (1- arg)))
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
158 (goto-char loc)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
159 (end-of-line)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 (defun split-line ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162 "Split current line, moving portion beyond point vertically down."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164 (skip-chars-forward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 (let ((col (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166 (pos (point)))
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
167 (newline 1)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 (indent-to col 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169 (goto-char pos)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 (defun delete-indentation (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 "Join this line to previous and fix up whitespace at join.
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
173 If there is a fill prefix, delete it from the beginning of this line.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 With argument, join this line to following line."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 (interactive "*P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177 (if arg (forward-line 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 (if (eq (preceding-char) ?\n)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 (delete-region (point) (1- (point)))
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
181 ;; If the second line started with the fill prefix,
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
182 ;; delete the prefix.
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
183 (if (and fill-prefix
1276
6b63876aea1c (kill-word): Don't change point before calling kill-region.
Richard M. Stallman <rms@gnu.org>
parents: 1145
diff changeset
184 (<= (+ (point) (length fill-prefix)) (point-max))
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
185 (string= fill-prefix
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
186 (buffer-substring (point)
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
187 (+ (point) (length fill-prefix)))))
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
188 (delete-region (point) (+ (point) (length fill-prefix))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 (fixup-whitespace))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190
24078
4de23887487f (join-line): New alias.
Dave Love <fx@gnu.org>
parents: 24028
diff changeset
191 (defalias 'join-line #'delete-indentation) ; easier to find
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
192
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 (defun delete-blank-lines ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 "On blank line, delete all surrounding blank lines, leaving just one.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 On isolated blank line, delete that one.
7817
d729f75fff04 (delete-blank-lines): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7762
diff changeset
196 On nonblank line, delete any immediately following blank lines."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 (let (thisblank singleblank)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
199 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
200 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
201 (setq thisblank (looking-at "[ \t]*$"))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
202 ;; Set singleblank if there is just one blank line here.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
203 (setq singleblank
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
204 (and thisblank
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
205 (not (looking-at "[ \t]*\n[ \t]*$"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
206 (or (bobp)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207 (progn (forward-line -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
208 (not (looking-at "[ \t]*$")))))))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
209 ;; Delete preceding blank lines, and this one too if it's the only one.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210 (if thisblank
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
212 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
213 (if singleblank (forward-line 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 (delete-region (point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 (if (re-search-backward "[^ \t\n]" nil t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 (progn (forward-line 1) (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 (point-min)))))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
218 ;; Delete following blank lines, unless the current line is blank
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
219 ;; and there are no following blank lines.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 (if (not (and thisblank singleblank))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 (forward-line 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224 (delete-region (point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
225 (if (re-search-forward "[^ \t\n]" nil t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226 (progn (beginning-of-line) (point))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
227 (point-max)))))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
228 ;; Handle the special case where point is followed by newline and eob.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
229 ;; Delete the line, leaving point at eob.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
230 (if (looking-at "^[ \t]*\n\\'")
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
231 (delete-region (point) (point-max)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 (defun newline-and-indent ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234 "Insert a newline, then indent according to major mode.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
235 Indentation is done using the value of `indent-line-function'.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236 In programming language modes, this is the same as TAB.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
237 In some text modes, where TAB inserts a tab, this command indents to the
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
238 column specified by the function `current-left-margin'."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 582
diff changeset
241 (newline)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
242 (indent-according-to-mode))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
243
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
244 (defun reindent-then-newline-and-indent ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
245 "Reindent current line, insert newline, then indent the new line.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
246 Indentation of both lines is done according to the current major mode,
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
247 which means calling the current value of `indent-line-function'.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
248 In programming language modes, this is the same as TAB.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
249 In some text modes, where TAB inserts a tab, this indents to the
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
250 column specified by the function `current-left-margin'."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
251 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
252 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
253 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
254 (indent-according-to-mode))
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 582
diff changeset
255 (newline)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
256 (indent-according-to-mode))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
257
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
258 (defun quoted-insert (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
259 "Read next input character and insert it.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
260 This is useful for inserting control characters.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
261
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
262 If the first character you type after this command is an octal digit,
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
263 you should type a sequence of octal digits which specify a character code.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
264 Any nondigit terminates the sequence. If the terminator is a RET,
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
265 it is discarded; any other terminator is used itself as input.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
266 The variable `read-quoted-char-radix' specifies the radix for this feature;
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
267 set it to 10 or 16 to use decimal or hex instead of octal.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
268
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
269 In overwrite mode, this function inserts the character anyway, and
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
270 does not handle octal digits specially. This means that if you use
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
271 overwrite as your normal editing mode, you can use this function to
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
272 insert characters when necessary.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
273
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
274 In binary overwrite mode, this function does overwrite, and octal
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
275 digits are interpreted as a character code. This is intended to be
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
276 useful for editing binary files."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
277 (interactive "*p")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
278 (let ((char (if (or (not overwrite-mode)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
279 (eq overwrite-mode 'overwrite-mode-binary))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
280 (read-quoted-char)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
281 (read-char))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
282 ;; Assume character codes 0240 - 0377 stand for characters in some
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
283 ;; single-byte character set, and convert them to Emacs
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
284 ;; characters.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
285 (if (and enable-multibyte-characters
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
286 (>= char ?\240)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
287 (<= char ?\377))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
288 (setq char (unibyte-char-to-multibyte char)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
289 (if (> arg 0)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
290 (if (eq overwrite-mode 'overwrite-mode-binary)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
291 (delete-char arg)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
292 (while (> arg 0)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
293 (insert-and-inherit char)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
294 (setq arg (1- arg)))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
295
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
296 (defun forward-to-indentation (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
297 "Move forward ARG lines and position at first nonblank character."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
298 (interactive "p")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
299 (forward-line arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
300 (skip-chars-forward " \t"))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
301
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
302 (defun backward-to-indentation (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
303 "Move backward ARG lines and position at first nonblank character."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
304 (interactive "p")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
305 (forward-line (- arg))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
306 (skip-chars-forward " \t"))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
307
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
308 (defun back-to-indentation ()
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
309 "Move point to the first non-whitespace character on this line."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
310 (interactive)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
311 (beginning-of-line 1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
312 (skip-chars-forward " \t"))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
313
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
314 (defun fixup-whitespace ()
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
315 "Fixup white space between objects around point.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
316 Leave one space or none, according to the context."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
317 (interactive "*")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
318 (save-excursion
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
319 (delete-horizontal-space)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
320 (if (or (looking-at "^\\|\\s)")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
321 (save-excursion (forward-char -1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
322 (looking-at "$\\|\\s(\\|\\s'")))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
323 nil
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
324 (insert ?\ ))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
325
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
326 (defun delete-horizontal-space ()
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
327 "Delete all spaces and tabs around point."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
328 (interactive "*")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
329 (skip-chars-backward " \t")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
330 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
331
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
332 (defun just-one-space ()
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
333 "Delete all spaces and tabs around point, leaving one space."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
334 (interactive "*")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
335 (skip-chars-backward " \t")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
336 (if (= (following-char) ? )
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
337 (forward-char 1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
338 (insert ? ))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
339 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
340
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
341
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
342 (defun beginning-of-buffer (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343 "Move point to the beginning of the buffer; leave mark at previous position.
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
344 With arg N, put point N/10 of the way from the beginning.
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
345
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
346 If the buffer is narrowed, this command uses the beginning and size
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
347 of the accessible part of the buffer.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
348
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
349 Don't use this command in Lisp programs!
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
350 \(goto-char (point-min)) is faster and avoids clobbering the mark."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352 (push-mark)
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
353 (let ((size (- (point-max) (point-min))))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
354 (goto-char (if arg
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
355 (+ (point-min)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
356 (if (> size 10000)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
357 ;; Avoid overflow for large buffer sizes!
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
358 (* (prefix-numeric-value arg)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
359 (/ size 10))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
360 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
361 (point-min))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
362 (if arg (forward-line 1)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 (defun end-of-buffer (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
365 "Move point to the end of the buffer; leave mark at previous position.
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
366 With arg N, put point N/10 of the way from the end.
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
367
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
368 If the buffer is narrowed, this command uses the beginning and size
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
369 of the accessible part of the buffer.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
370
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
371 Don't use this command in Lisp programs!
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 \(goto-char (point-max)) is faster and avoids clobbering the mark."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 (push-mark)
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
375 (let ((size (- (point-max) (point-min))))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
376 (goto-char (if arg
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
377 (- (point-max)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
378 (if (> size 10000)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
379 ;; Avoid overflow for large buffer sizes!
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
380 (* (prefix-numeric-value arg)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
381 (/ size 10))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
382 (/ (* size (prefix-numeric-value arg)) 10)))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
383 (point-max))))
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
384 ;; If we went to a place in the middle of the buffer,
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
385 ;; adjust it to the beginning of a line.
26265
bcd25953e4cf (end-of-buffer): Use window-end to find the window end
Gerd Moellmann <gerd@gnu.org>
parents: 26201
diff changeset
386 (cond (arg (forward-line 1))
bcd25953e4cf (end-of-buffer): Use window-end to find the window end
Gerd Moellmann <gerd@gnu.org>
parents: 26201
diff changeset
387 ((< (point) (window-end nil t))
bcd25953e4cf (end-of-buffer): Use window-end to find the window end
Gerd Moellmann <gerd@gnu.org>
parents: 26201
diff changeset
388 ;; If the end of the buffer is not already on the screen,
bcd25953e4cf (end-of-buffer): Use window-end to find the window end
Gerd Moellmann <gerd@gnu.org>
parents: 26201
diff changeset
389 ;; then scroll specially to put it near, but not at, the bottom.
bcd25953e4cf (end-of-buffer): Use window-end to find the window end
Gerd Moellmann <gerd@gnu.org>
parents: 26201
diff changeset
390 (overlay-recenter (point))
bcd25953e4cf (end-of-buffer): Use window-end to find the window end
Gerd Moellmann <gerd@gnu.org>
parents: 26201
diff changeset
391 (recenter -3))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
392
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
393 (defun mark-whole-buffer ()
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
394 "Put point at beginning and mark at end of buffer.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
395 You probably should not use this function in Lisp programs;
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
396 it is usually a mistake for a Lisp function to use any subroutine
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
397 that uses or sets the mark."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
399 (push-mark (point))
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
400 (push-mark (point-max) nil t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
401 (goto-char (point-min)))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
402
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
403 ;; Counting lines, one way or another.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
404
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
405 (defun goto-line (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
406 "Goto line ARG, counting from line 1 at beginning of buffer."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
407 (interactive "NGoto line: ")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
408 (setq arg (prefix-numeric-value arg))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
409 (save-restriction
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
410 (widen)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
411 (goto-char 1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
412 (if (eq selective-display t)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
413 (re-search-forward "[\n\C-m]" nil 'end (1- arg))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
414 (forward-line (1- arg)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416 (defun count-lines-region (start end)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3487
diff changeset
417 "Print number of lines and characters in the region."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 (interactive "r")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 (message "Region has %d lines, %d characters"
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 (count-lines start end) (- end start)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 (defun what-line ()
12939
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
423 "Print the current buffer line number and narrowed line number of point."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 (interactive)
12939
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
425 (let ((opoint (point)) start)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 (save-excursion
12939
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
427 (save-restriction
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
428 (goto-char (point-min))
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
429 (widen)
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
430 (beginning-of-line)
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
431 (setq start (point))
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
432 (goto-char opoint)
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
433 (beginning-of-line)
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
434 (if (/= start 1)
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
435 (message "line %d (narrowed line %d)"
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
436 (1+ (count-lines 1 (point)))
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
437 (1+ (count-lines start (point))))
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
438 (message "Line %d" (1+ (count-lines 1 (point)))))))))
1fc5a2981547 (what-line): Print narrowed linenum with full buffer num.
Richard M. Stallman <rms@gnu.org>
parents: 12893
diff changeset
439
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 (defun count-lines (start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 "Return number of lines between START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 This is usually the number of newlines between them,
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
443 but can be one more if START is not equal to END
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
444 and the greater of them is not at the start of a line."
9554
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
445 (save-excursion
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
446 (save-restriction
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
447 (narrow-to-region start end)
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
448 (goto-char (point-min))
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
449 (if (eq selective-display t)
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
450 (save-match-data
2421
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
451 (let ((done 0))
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
452 (while (re-search-forward "[\n\C-m]" nil t 40)
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
453 (setq done (+ 40 done)))
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
454 (while (re-search-forward "[\n\C-m]" nil t 1)
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
455 (setq done (+ 1 done)))
5151
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
456 (goto-char (point-max))
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
457 (if (and (/= start end)
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
458 (not (bolp)))
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
459 (1+ done)
9554
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
460 done)))
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
461 (- (buffer-size) (forward-line (buffer-size)))))))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
462
16999
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
463 (defun what-cursor-position (&optional detail)
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
464 "Print info on cursor position (on screen and within buffer).
23963
c242e2dc93a9 (what-cursor-position): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 23944
diff changeset
465 Also describe the character after point, and give its character code
24398
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
466 in octal, decimal and hex.
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
467
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
468 For a non-ASCII multibyte character, also give its encoding in the
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
469 buffer's selected coding system if the coding system encodes the
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
470 character safely. If the character is encoded into one byte, that
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
471 code is shown in hex. If the character is encoded into more than one
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
472 byte, just \"...\" is shown.
23963
c242e2dc93a9 (what-cursor-position): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 23944
diff changeset
473
c242e2dc93a9 (what-cursor-position): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 23944
diff changeset
474 With prefix argument, print additional details about that character,
c242e2dc93a9 (what-cursor-position): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 23944
diff changeset
475 instead of the cursor position. This includes the character set name,
24398
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
476 the codes that identify the character within that character set. In
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
477 addition, the encoding is fully shown."
16999
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
478 (interactive "P")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479 (let* ((char (following-char))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
480 (beg (point-min))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
481 (end (point-max))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
482 (pos (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
483 (total (buffer-size))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
484 (percent (if (> total 50000)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
485 ;; Avoid overflow from multiplying by 100!
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
486 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
487 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
488 (hscroll (if (= (window-hscroll) 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
489 ""
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
490 (format " Hscroll=%d" (window-hscroll))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
491 (col (current-column)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
492 (if (= pos end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
493 (if (or (/= beg 1) (/= end (1+ total)))
27477
8a7e3bcab064 (what-cursor-position): Change formatting of
Gerd Moellmann <gerd@gnu.org>
parents: 27302
diff changeset
494 (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
495 pos total percent beg end col hscroll)
27477
8a7e3bcab064 (what-cursor-position): Change formatting of
Gerd Moellmann <gerd@gnu.org>
parents: 27302
diff changeset
496 (message "point=%d of %d (%d%%) column %d %s"
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
497 pos total percent col hscroll))
24398
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
498 (let ((coding buffer-file-coding-system)
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
499 encoded encoding-msg)
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
500 (if (or (not coding)
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
501 (eq (coding-system-type coding) t))
0f92ac490b66 * simple.el (what-cursor-position): To show the character's
Kenichi Handa <handa@m17n.org>
parents: 24372
diff changeset
502 (setq coding default-buffer-file-coding-system))
24508
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
503 (if (not (char-valid-p char))
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
504 (setq encoding-msg
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
505 (format "(0%o, %d, 0x%x, invalid)" char char char))
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
506 (setq encoded (and (>= char 128) (encode-coding-char char coding)))
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
507 (setq encoding-msg
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
508 (if encoded
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
509 (format "(0%o, %d, 0x%x, ext %s)"
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
510 char char char
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
511 (if (and (not detail)
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
512 (> (length encoded) 1))
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
513 "..."
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
514 (concat
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
515 (encoded-string-description encoded coding)
26884
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
516 (if (nth 2 (find-composition (point)))
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
517 " (composed)" ""))))
24508
f9e613360d62 (what-cursor-position): Don't cause error when point
Kenichi Handa <handa@m17n.org>
parents: 24419
diff changeset
518 (format "(0%o, %d, 0x%x)" char char char))))
23944
b5617ede97a8 (what-cursor-position): Print character encoding also.
Richard M. Stallman <rms@gnu.org>
parents: 23864
diff changeset
519 (if detail
24301
b09b949b5433 (what-cursor-position): Don't use the variable
Kenichi Handa <handa@m17n.org>
parents: 24155
diff changeset
520 ;; We show the detailed information of CHAR.
26884
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
521 (message "Char: %s %s %s"
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
522 (if (< char 256)
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
523 (single-key-description char)
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
524 (buffer-substring-no-properties (point) (1+ (point))))
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
525 encoding-msg (split-char char))
23944
b5617ede97a8 (what-cursor-position): Print character encoding also.
Richard M. Stallman <rms@gnu.org>
parents: 23864
diff changeset
526 (if (or (/= beg 1) (/= end (1+ total)))
27477
8a7e3bcab064 (what-cursor-position): Change formatting of
Gerd Moellmann <gerd@gnu.org>
parents: 27302
diff changeset
527 (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
23944
b5617ede97a8 (what-cursor-position): Print character encoding also.
Richard M. Stallman <rms@gnu.org>
parents: 23864
diff changeset
528 (if (< char 256)
b5617ede97a8 (what-cursor-position): Print character encoding also.
Richard M. Stallman <rms@gnu.org>
parents: 23864
diff changeset
529 (single-key-description char)
26884
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
530 (buffer-substring-no-properties (point) (1+ (point))))
23944
b5617ede97a8 (what-cursor-position): Print character encoding also.
Richard M. Stallman <rms@gnu.org>
parents: 23864
diff changeset
531 encoding-msg pos total percent beg end col hscroll)
27477
8a7e3bcab064 (what-cursor-position): Change formatting of
Gerd Moellmann <gerd@gnu.org>
parents: 27302
diff changeset
532 (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
16999
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
533 (if (< char 256)
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
534 (single-key-description char)
26884
8063bfbd8b08 (what-cursor-position): Show "(composed)" if the
Kenichi Handa <handa@m17n.org>
parents: 26744
diff changeset
535 (buffer-substring-no-properties (point) (1+ (point))))
23944
b5617ede97a8 (what-cursor-position): Print character encoding also.
Richard M. Stallman <rms@gnu.org>
parents: 23864
diff changeset
536 encoding-msg pos total percent col hscroll)))))))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
537
4894
1574c6c6561f (eval-expression): Fix typo: missing paren.
Roland McGrath <roland@gnu.org>
parents: 4886
diff changeset
538 (defvar read-expression-map (cons 'keymap minibuffer-local-map)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
539 "Minibuffer keymap used for reading Lisp expressions.")
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
540 (define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
541
4289
4d0c57f01eed (read-expression-history): New defvar.
Roland McGrath <roland@gnu.org>
parents: 4287
diff changeset
542 (defvar read-expression-history nil)
4d0c57f01eed (read-expression-history): New defvar.
Roland McGrath <roland@gnu.org>
parents: 4287
diff changeset
543
25702
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
544 (defcustom eval-expression-print-level 4
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
545 "*Value to use for `print-level' when printing value in `eval-expression'."
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
546 :group 'lisp
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
547 :type 'integer
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
548 :version "21.1")
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
549
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
550 (defcustom eval-expression-print-length 12
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
551 "*Value to use for `print-length' when printing value in `eval-expression'."
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
552 :group 'lisp
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
553 :type 'integer
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
554 :version "21.1")
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
555
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
556 (defcustom eval-expression-debug-on-error t
27302
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
557 "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
558 If nil, don't change the value of `debug-on-error'."
25702
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
559 :group 'lisp
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
560 :type 'boolean
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
561 :version "21.1")
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
562
4289
4d0c57f01eed (read-expression-history): New defvar.
Roland McGrath <roland@gnu.org>
parents: 4287
diff changeset
563 ;; We define this, rather than making `eval' interactive,
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
564 ;; 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>
parents: 19362
diff changeset
565 (defun eval-expression (eval-expression-arg
9f6b375ce842 (eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
parents: 19362
diff changeset
566 &optional eval-expression-insert-value)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
567 "Evaluate EXPRESSION and print value in minibuffer.
954
9e51bb887797 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 921
diff changeset
568 Value is also consed on to front of the variable `values'."
4886
20e345c97e28 (eval-expression, edit-and-eval-command): Let
Brian Fox <bfox@gnu.org>
parents: 4869
diff changeset
569 (interactive
5068
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
570 (list (read-from-minibuffer "Eval: "
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
571 nil read-expression-map t
19514
9f6b375ce842 (eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
parents: 19362
diff changeset
572 'read-expression-history)
9f6b375ce842 (eval-expression): Prefix arg means insert value in current buffer.
Richard M. Stallman <rms@gnu.org>
parents: 19362
diff changeset
573 current-prefix-arg))
27302
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
574
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
575 (if (null eval-expression-debug-on-error)
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
576 (setq values (cons (eval eval-expression-arg) values))
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
577 (let ((old-value (make-symbol "t")) new-value)
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
578 ;; Bind debug-on-error to something unique so that we can
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
579 ;; detect when evaled code changes it.
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
580 (let ((debug-on-error old-value))
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
581 (setq values (cons (eval eval-expression-arg) values))
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
582 (setq new-value debug-on-error))
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
583 ;; If evaled code has changed the value of debug-on-error,
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
584 ;; propagate that change to the global binding.
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
585 (unless (eq old-value new-value)
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
586 (setq debug-on-error new-value))))
1cb6c18c3163 (eval-expression): Don't bind debug-on-error if
Gerd Moellmann <gerd@gnu.org>
parents: 27298
diff changeset
587
25702
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
588 (let ((print-length eval-expression-print-length)
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
589 (print-level eval-expression-print-level))
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
590 (prin1 (car values)
2b96c6e05f23 (eval-expression-print-level): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 25490
diff changeset
591 (if eval-expression-insert-value (current-buffer) t))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
592
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
593 (defun edit-and-eval-command (prompt command)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
594 "Prompting with PROMPT, let user edit COMMAND and eval result.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
595 COMMAND is a Lisp expression. Let user edit that expression in
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
596 the minibuffer, then read and evaluate the result."
5068
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
597 (let ((command (read-from-minibuffer prompt
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
598 (prin1-to-string command)
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
599 read-expression-map t
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
600 '(command-history . 1))))
9629
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
601 ;; If command was added to command-history as a string,
13960
5f1ba0200a33 (shell-command): Fix message spelling.
Karl Heuer <kwzh@gnu.org>
parents: 13810
diff changeset
602 ;; 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>
parents: 9554
diff changeset
603 (if (stringp (car command-history))
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
604 (setq command-history (cdr command-history)))
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
605
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
606 ;; 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>
parents: 9554
diff changeset
607 ;; add it to the history.
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
608 (or (equal command (car command-history))
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
609 (setq command-history (cons command command-history)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
610 (eval command)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
611
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
612 (defun repeat-complex-command (arg)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
613 "Edit and re-evaluate last complex command, or ARGth from last.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
614 A complex command is one which used the minibuffer.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
615 The command is placed in the minibuffer as a Lisp form for editing.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
616 The result is executed, repeating the command as changed.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
617 If the command has been changed or is not the most recent previous command
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
618 it is added to the front of the command history.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
619 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
620 to get different commands to edit and resubmit."
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
621 (interactive "p")
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
622 (let ((elt (nth (1- arg) command-history))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
623 newcmd)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
624 (if elt
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
625 (progn
4821
2c16f99ef5dc (edit-and-eval-command): Let `read-from-minibuffer' manipulate the
Brian Fox <bfox@gnu.org>
parents: 4765
diff changeset
626 (setq newcmd
16803
3d4a27ecfba9 (repeat-complex-command): Bind
Richard M. Stallman <rms@gnu.org>
parents: 16723
diff changeset
627 (let ((print-level nil)
3d4a27ecfba9 (repeat-complex-command): Bind
Richard M. Stallman <rms@gnu.org>
parents: 16723
diff changeset
628 (minibuffer-history-position arg)
20022
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
629 (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
8734
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
630 (read-from-minibuffer
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
631 "Redo: " (prin1-to-string elt) read-expression-map t
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
632 (cons 'command-history arg))))
4821
2c16f99ef5dc (edit-and-eval-command): Let `read-from-minibuffer' manipulate the
Brian Fox <bfox@gnu.org>
parents: 4765
diff changeset
633
5135
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
634 ;; If command was added to command-history as a string,
13960
5f1ba0200a33 (shell-command): Fix message spelling.
Karl Heuer <kwzh@gnu.org>
parents: 13810
diff changeset
635 ;; get rid of that. We want only evaluable expressions there.
5135
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
636 (if (stringp (car command-history))
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
637 (setq command-history (cdr command-history)))
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
638
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
639 ;; If command to be redone does not match front of history,
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
640 ;; add it to the history.
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
641 (or (equal newcmd (car command-history))
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
642 (setq command-history (cons newcmd command-history)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
643 (eval newcmd))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
644 (ding))))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
645
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
646 (defvar minibuffer-history nil
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
647 "Default minibuffer history list.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
648 This is used for all minibuffer input
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
649 except when an alternate history list is specified.")
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
650 (defvar minibuffer-history-sexp-flag nil
7373
451602bf12e4 (minibuffer-history-sexp-flag): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 7333
diff changeset
651 "Non-nil when doing history operations on `command-history'.
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
652 More generally, indicates that the history list being acted on
20022
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
653 contains expressions rather than strings.
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
654 It is only valid if its value equals the current minibuffer depth,
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
655 to handle recursive uses of the minibuffer.")
862
46630543d659 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 859
diff changeset
656 (setq minibuffer-history-variable 'minibuffer-history)
46630543d659 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 859
diff changeset
657 (setq minibuffer-history-position nil)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
658 (defvar minibuffer-history-search-history nil)
858
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
659
921
c5c4c2ee8f26 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 892
diff changeset
660 (mapcar
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
661 (lambda (key-and-command)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
662 (mapcar
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
663 (lambda (keymap-and-completionp)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
664 ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
665 ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
666 ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
667 (define-key (symbol-value (car keymap-and-completionp))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
668 (car key-and-command)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
669 (let ((command (cdr key-and-command)))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
670 (if (consp command)
1826
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
671 ;; (and ... nil) => ... turns back on the completion-oriented
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
672 ;; 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>
parents: 1824
diff changeset
673 ;; do things he doesn't like.
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
674 (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
1838
34da3c151be4 Restore nuked information in minibuffer history bindings.
Roland McGrath <roland@gnu.org>
parents: 1837
diff changeset
675 (progn (error "EMACS BUG!") (cdr command))
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
676 (car command))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
677 command))))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
678 '((minibuffer-local-map . nil)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
679 (minibuffer-local-ns-map . nil)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
680 (minibuffer-local-completion-map . t)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
681 (minibuffer-local-must-match-map . t)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
682 (read-expression-map . nil))))
1838
34da3c151be4 Restore nuked information in minibuffer history bindings.
Roland McGrath <roland@gnu.org>
parents: 1837
diff changeset
683 '(("\en" . (next-history-element . next-complete-history-element))
34da3c151be4 Restore nuked information in minibuffer history bindings.
Roland McGrath <roland@gnu.org>
parents: 1837
diff changeset
684 ([next] . (next-history-element . next-complete-history-element))
34da3c151be4 Restore nuked information in minibuffer history bindings.
Roland McGrath <roland@gnu.org>
parents: 1837
diff changeset
685 ("\ep" . (previous-history-element . previous-complete-history-element))
34da3c151be4 Restore nuked information in minibuffer history bindings.
Roland McGrath <roland@gnu.org>
parents: 1837
diff changeset
686 ([prior] . (previous-history-element . previous-complete-history-element))
921
c5c4c2ee8f26 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 892
diff changeset
687 ("\er" . previous-matching-history-element)
c5c4c2ee8f26 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 892
diff changeset
688 ("\es" . next-matching-history-element)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
689
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
690 (defvar minibuffer-text-before-history nil
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
691 "Text that was in this minibuffer before any history commands.
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
692 This is nil if there have not yet been any history commands
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
693 in this use of the minibuffer.")
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
694
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
695 (add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
696
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
697 (defun minibuffer-history-initialize ()
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
698 (setq minibuffer-text-before-history nil))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
699
22257
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
700 (defcustom minibuffer-history-case-insensitive-variables nil
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
701 "*Minibuffer history variables for which matching should ignore case.
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
702 If a history variable is a member of this list, then the
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
703 \\[previous-matching-history-element] and \\[next-matching-history-element]\
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
704 commands ignore case when searching it, regardless of `case-fold-search'."
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
705 :type '(repeat variable)
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
706 :group 'minibuffer)
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
707
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
708 (defun previous-matching-history-element (regexp n)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
709 "Find the previous history element that matches REGEXP.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
710 \(Previous history elements refer to earlier actions.)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
711 With prefix argument N, search for Nth previous match.
20510
d175ee25287e (previous-matching-history-element): Bind
Richard M. Stallman <rms@gnu.org>
parents: 20484
diff changeset
712 If N is negative, find the next or Nth next match.
22257
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
713 An uppercase letter in REGEXP makes the search case-sensitive.
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
714 See also `minibuffer-history-case-insensitive-variables'."
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
715 (interactive
2681
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
716 (let* ((enable-recursive-minibuffers t)
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
717 (regexp (read-from-minibuffer "Previous element matching (regexp): "
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
718 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
719 minibuffer-local-map
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
720 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
721 'minibuffer-history-search-history)))
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
722 ;; Use the last regexp specified, by default, if input is empty.
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
723 (list (if (string= regexp "")
11961
b5efbe330c86 (previous-matching-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 11572
diff changeset
724 (if minibuffer-history-search-history
b5efbe330c86 (previous-matching-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 11572
diff changeset
725 (car minibuffer-history-search-history)
b5efbe330c86 (previous-matching-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 11572
diff changeset
726 (error "No previous history search regexp"))
2681
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
727 regexp)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
728 (prefix-numeric-value current-prefix-arg))))
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
729 (if (and (zerop minibuffer-history-position)
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
730 (null minibuffer-text-before-history))
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
731 (setq minibuffer-text-before-history (field-string (point-max))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
732 (let ((history (symbol-value minibuffer-history-variable))
20510
d175ee25287e (previous-matching-history-element): Bind
Richard M. Stallman <rms@gnu.org>
parents: 20484
diff changeset
733 (case-fold-search
d175ee25287e (previous-matching-history-element): Bind
Richard M. Stallman <rms@gnu.org>
parents: 20484
diff changeset
734 (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
22257
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
735 ;; On some systems, ignore case for file names.
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
736 (if (memq minibuffer-history-variable
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
737 minibuffer-history-case-insensitive-variables)
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
738 t
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
739 ;; Respect the user's setting for case-fold-search:
23e2e03f2bf6 (minibuffer-history-case-insensitive-variables): New var.
Richard M. Stallman <rms@gnu.org>
parents: 22157
diff changeset
740 case-fold-search)
20510
d175ee25287e (previous-matching-history-element): Bind
Richard M. Stallman <rms@gnu.org>
parents: 20484
diff changeset
741 nil))
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
742 prevpos
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
743 (pos minibuffer-history-position))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
744 (while (/= n 0)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
745 (setq prevpos pos)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
746 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
747 (if (= pos prevpos)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
748 (error (if (= pos 1)
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
749 "No later matching history item"
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
750 "No earlier matching history item")))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
751 (if (string-match regexp
20022
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
752 (if (eq minibuffer-history-sexp-flag
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
753 (minibuffer-depth))
8734
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
754 (let ((print-level nil))
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
755 (prin1-to-string (nth (1- pos) history)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
756 (nth (1- pos) history)))
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
757 (setq n (+ n (if (< n 0) 1 -1)))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
758 (setq minibuffer-history-position pos)
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
759 (goto-char (point-max))
26349
e3e54e862d5f (previous-matching-history-element)
Gerd Moellmann <gerd@gnu.org>
parents: 26265
diff changeset
760 (delete-field)
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
761 (let ((elt (nth (1- pos) history)))
20022
c9ed682ff86f (previous-matching-history-element): No need to bind
Karl Heuer <kwzh@gnu.org>
parents: 19888
diff changeset
762 (insert (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
8734
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
763 (let ((print-level nil))
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
764 (prin1-to-string elt))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
765 elt)))
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
766 (goto-char (field-beginning)))
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
767 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
768 (eq (car (car command-history)) 'next-matching-history-element))
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
769 (setq command-history (cdr command-history))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
770
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
771 (defun next-matching-history-element (regexp n)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
772 "Find the next history element that matches REGEXP.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
773 \(The next history element refers to a more recent action.)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
774 With prefix argument N, search for Nth next match.
20510
d175ee25287e (previous-matching-history-element): Bind
Richard M. Stallman <rms@gnu.org>
parents: 20484
diff changeset
775 If N is negative, find the previous or Nth previous match.
d175ee25287e (previous-matching-history-element): Bind
Richard M. Stallman <rms@gnu.org>
parents: 20484
diff changeset
776 An uppercase letter in REGEXP makes the search case-sensitive."
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
777 (interactive
2681
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
778 (let* ((enable-recursive-minibuffers t)
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
779 (regexp (read-from-minibuffer "Next element matching (regexp): "
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
780 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
781 minibuffer-local-map
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
782 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
783 'minibuffer-history-search-history)))
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
784 ;; Use the last regexp specified, by default, if input is empty.
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
785 (list (if (string= regexp "")
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
786 (setcar minibuffer-history-search-history
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
787 (nth 1 minibuffer-history-search-history))
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
788 regexp)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
789 (prefix-numeric-value current-prefix-arg))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
790 (previous-matching-history-element regexp (- n)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
791
858
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
792 (defun next-history-element (n)
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
793 "Insert the next element of the minibuffer history into the minibuffer."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
794 (interactive "p")
10722
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
795 (or (zerop n)
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
796 (let ((narg (- minibuffer-history-position n))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
797 (minimum (if minibuffer-default -1 0))
24814
4c57b458fa9b (next-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 24798
diff changeset
798 elt minibuffer-returned-to-present)
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
799 (if (and (zerop minibuffer-history-position)
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
800 (null minibuffer-text-before-history))
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
801 (setq minibuffer-text-before-history (field-string (point-max))))
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
802 (if (< narg minimum)
23472
d75fa19c5fc0 (next-history-element): Special error message if no default.
Richard M. Stallman <rms@gnu.org>
parents: 23471
diff changeset
803 (if minibuffer-default
d75fa19c5fc0 (next-history-element): Special error message if no default.
Richard M. Stallman <rms@gnu.org>
parents: 23471
diff changeset
804 (error "End of history; no next item")
d75fa19c5fc0 (next-history-element): Special error message if no default.
Richard M. Stallman <rms@gnu.org>
parents: 23471
diff changeset
805 (error "End of history; no default available")))
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
806 (if (> narg (length (symbol-value minibuffer-history-variable)))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
807 (error "Beginning of history; no preceding item"))
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
808 (goto-char (point-max))
26349
e3e54e862d5f (previous-matching-history-element)
Gerd Moellmann <gerd@gnu.org>
parents: 26265
diff changeset
809 (delete-field)
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
810 (setq minibuffer-history-position narg)
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
811 (cond ((= narg -1)
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
812 (setq elt minibuffer-default))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
813 ((= narg 0)
19888
45a077538366 (next-history-element):
Richard M. Stallman <rms@gnu.org>
parents: 19514
diff changeset
814 (setq elt (or minibuffer-text-before-history ""))
24814
4c57b458fa9b (next-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 24798
diff changeset
815 (setq minibuffer-returned-to-present t)
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
816 (setq minibuffer-text-before-history nil))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
817 (t (setq elt (nth (1- minibuffer-history-position)
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
818 (symbol-value minibuffer-history-variable)))))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
819 (insert
24814
4c57b458fa9b (next-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 24798
diff changeset
820 (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
4c57b458fa9b (next-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 24798
diff changeset
821 (not minibuffer-returned-to-present))
17662
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
822 (let ((print-level nil))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
823 (prin1-to-string elt))
9b1b6974b36f (minibuffer-text-before-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 17613
diff changeset
824 elt))
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
825 (goto-char (field-beginning)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
826
858
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
827 (defun previous-history-element (n)
1145
e6cefcaba564 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1135
diff changeset
828 "Inserts the previous element of the minibuffer history into the minibuffer."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 (interactive "p")
859
5f325fbc093d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 858
diff changeset
830 (next-history-element (- n)))
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
831
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
832 (defun next-complete-history-element (n)
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
833 "Get next history element which completes the minibuffer before the point.
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
834 The contents of the minibuffer after the point are deleted, and replaced
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
835 by the new completion."
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
836 (interactive "p")
1826
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
837 (let ((point-at-start (point)))
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
838 (next-matching-history-element
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
839 (concat
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
840 "^" (regexp-quote (buffer-substring (field-beginning) (point))))
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
841 n)
1826
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
842 ;; 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>
parents: 1824
diff changeset
843 ;; 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>
parents: 1824
diff changeset
844 ;; 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>
parents: 1824
diff changeset
845 (goto-char point-at-start)))
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
846
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
847 (defun previous-complete-history-element (n)
5324
f091cdec77e2 (next-complete-history-element): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5151
diff changeset
848 "\
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
849 Get previous history element which completes the minibuffer before the point.
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
850 The contents of the minibuffer after the point are deleted, and replaced
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
851 by the new completion."
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
852 (interactive "p")
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
853 (next-complete-history-element (- n)))
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
854
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
855 ;; These two functions are for compatibility with the old subrs of the
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
856 ;; same name.
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
857
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
858 (defun minibuffer-prompt-width ()
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
859 "Return the display width of the minibuffer prompt.
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
860 Return 0 if current buffer is not a mini-buffer."
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
861 ;; Return the width of everything before the field at the end of
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
862 ;; the buffer; this should be 0 for normal buffers.
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
863 (1- (field-beginning (point-max))))
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
864
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
865 (defun minibuffer-prompt-end ()
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
866 "Return the buffer position of the end of the minibuffer prompt.
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
867 Return 0 if current buffer is not a mini-buffer."
26063
aa272f550e17 (minibuffer-prompt-end): Return the position
Gerd Moellmann <gerd@gnu.org>
parents: 26054
diff changeset
868 (field-beginning (point-max)))
aa272f550e17 (minibuffer-prompt-end): Return the position
Gerd Moellmann <gerd@gnu.org>
parents: 26054
diff changeset
869
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
870
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
871 ;Put this on C-x u, so we can force that rather than C-_ into startup msg
16436
d2acc84badf4 Use defalias not define-function.
Richard M. Stallman <rms@gnu.org>
parents: 16417
diff changeset
872 (defalias 'advertised-undo 'undo)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
873
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
874 (defun undo (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
875 "Undo some previous changes.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
876 Repeat this command to undo more changes.
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
877 A numeric argument serves as a repeat count.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
878
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
879 Just C-u as argument requests selective undo,
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
880 limited to changes within the current region.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
881 Likewise in Transient Mark mode when the mark is active."
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
882 (interactive "*P")
5935
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
883 ;; If we don't get all the way thru, make last-command indicate that
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
884 ;; for the following command.
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
885 (setq this-command t)
3408
8ffb00332c5f (undo): Pass proper arg to delete-auto-save-file-if-necessary.
Richard M. Stallman <rms@gnu.org>
parents: 3034
diff changeset
886 (let ((modified (buffer-modified-p))
8ffb00332c5f (undo): Pass proper arg to delete-auto-save-file-if-necessary.
Richard M. Stallman <rms@gnu.org>
parents: 3034
diff changeset
887 (recent-save (recent-auto-save-p)))
582
a9c4bc19b2aa *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 513
diff changeset
888 (or (eq (selected-window) (minibuffer-window))
a9c4bc19b2aa *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 513
diff changeset
889 (message "Undo!"))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
890 (or (eq last-command 'undo)
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
891 (progn (if (or arg (and transient-mark-mode mark-active))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
892 (undo-start (region-beginning) (region-end))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
893 (undo-start))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
894 (undo-more 1)))
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
895 (undo-more (if arg (prefix-numeric-value arg) 1))
6386
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
896 ;; Don't specify a position in the undo record for the undo command.
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
897 ;; Instead, undoing this should move point to where the change is.
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
898 (let ((tail buffer-undo-list)
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
899 done)
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
900 (while (and tail (not done) (not (null (car tail))))
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
901 (if (integerp (car tail))
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
902 (progn
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
903 (setq done t)
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
904 (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
905 (setq tail (cdr tail))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
906 (and modified (not (buffer-modified-p))
5935
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
907 (delete-auto-save-file-if-necessary recent-save)))
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
908 ;; If we do get all the way thru, make this-command indicate that.
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
909 (setq this-command 'undo))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
910
2947
518509536741 (pending-undo-list): Var declared.
Richard M. Stallman <rms@gnu.org>
parents: 2935
diff changeset
911 (defvar pending-undo-list nil
518509536741 (pending-undo-list): Var declared.
Richard M. Stallman <rms@gnu.org>
parents: 2935
diff changeset
912 "Within a run of consecutive undo commands, list remaining to be undone.")
518509536741 (pending-undo-list): Var declared.
Richard M. Stallman <rms@gnu.org>
parents: 2935
diff changeset
913
22725
6d0f7798f157 (undo-in-progress): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 22375
diff changeset
914 (defvar undo-in-progress nil
6d0f7798f157 (undo-in-progress): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 22375
diff changeset
915 "Non-nil while performing an undo.
6d0f7798f157 (undo-in-progress): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 22375
diff changeset
916 Some change-hooks test this variable to do something different.")
6d0f7798f157 (undo-in-progress): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 22375
diff changeset
917
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
918 (defun undo-more (count)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
919 "Undo back N undo-boundaries beyond what was already undone recently.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
920 Call `undo-start' to get ready to undo recent changes,
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
921 then call `undo-more' one or more times to undo them."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
922 (or pending-undo-list
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
923 (error "No further undo information"))
22725
6d0f7798f157 (undo-in-progress): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 22375
diff changeset
924 (let ((undo-in-progress t))
6d0f7798f157 (undo-in-progress): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 22375
diff changeset
925 (setq pending-undo-list (primitive-undo count pending-undo-list))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
926
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
927 ;; Deep copy of a list
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
928 (defun undo-copy-list (list)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
929 "Make a copy of undo list LIST."
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
930 (mapcar 'undo-copy-list-1 list))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
931
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
932 (defun undo-copy-list-1 (elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
933 (if (consp elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
934 (cons (car elt) (undo-copy-list-1 (cdr elt)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
935 elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
936
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
937 (defun undo-start (&optional beg end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
938 "Set `pending-undo-list' to the front of the undo list.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
939 The next call to `undo-more' will undo the most recently made change.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
940 If BEG and END are specified, then only undo elements
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
941 that apply to text between BEG and END are used; other undo elements
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
942 are ignored. If BEG and END are nil, all undo elements are used."
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
943 (if (eq buffer-undo-list t)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
944 (error "No undo information in this buffer"))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
945 (setq pending-undo-list
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
946 (if (and beg end (not (= beg end)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
947 (undo-make-selective-list (min beg end) (max beg end))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
948 buffer-undo-list)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
949
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
950 (defvar undo-adjusted-markers)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
951
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
952 (defun undo-make-selective-list (start end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
953 "Return a list of undo elements for the region START to END.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
954 The elements come from `buffer-undo-list', but we keep only
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
955 the elements inside this region, and discard those outside this region.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
956 If we find an element that crosses an edge of this region,
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
957 we stop and ignore all further elements."
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
958 (let ((undo-list-copy (undo-copy-list buffer-undo-list))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
959 (undo-list (list nil))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
960 undo-adjusted-markers
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
961 some-rejected
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
962 undo-elt undo-elt temp-undo-list delta)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
963 (while undo-list-copy
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
964 (setq undo-elt (car undo-list-copy))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
965 (let ((keep-this
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
966 (cond ((and (consp undo-elt) (eq (car undo-elt) t))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
967 ;; This is a "was unmodified" element.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
968 ;; Keep it if we have kept everything thus far.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
969 (not some-rejected))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
970 (t
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
971 (undo-elt-in-region undo-elt start end)))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
972 (if keep-this
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
973 (progn
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
974 (setq end (+ end (cdr (undo-delta undo-elt))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
975 ;; Don't put two nils together in the list
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
976 (if (not (and (eq (car undo-list) nil)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
977 (eq undo-elt nil)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
978 (setq undo-list (cons undo-elt undo-list))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
979 (if (undo-elt-crosses-region undo-elt start end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
980 (setq undo-list-copy nil)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
981 (setq some-rejected t)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
982 (setq temp-undo-list (cdr undo-list-copy))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
983 (setq delta (undo-delta undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
984
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
985 (when (/= (cdr delta) 0)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
986 (let ((position (car delta))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
987 (offset (cdr delta)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
988
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
989 ;; Loop down the earlier events adjusting their buffer positions
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
990 ;; to reflect the fact that a change to the buffer isn't being
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
991 ;; undone. We only need to process those element types which
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
992 ;; undo-elt-in-region will return as being in the region since
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
993 ;; only those types can ever get into the output
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
994
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
995 (while temp-undo-list
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
996 (setq undo-elt (car temp-undo-list))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
997 (cond ((integerp undo-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
998 (if (>= undo-elt position)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
999 (setcar temp-undo-list (- undo-elt offset))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1000 ((atom undo-elt) nil)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1001 ((stringp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1002 ;; (TEXT . POSITION)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1003 (let ((text-pos (abs (cdr undo-elt)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1004 (point-at-end (< (cdr undo-elt) 0 )))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1005 (if (>= text-pos position)
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1006 (setcdr undo-elt (* (if point-at-end -1 1)
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1007 (- text-pos offset))))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1008 ((integerp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1009 ;; (BEGIN . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1010 (when (>= (car undo-elt) position)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1011 (setcar undo-elt (- (car undo-elt) offset))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1012 (setcdr undo-elt (- (cdr undo-elt) offset))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1013 ((null (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1014 ;; (nil PROPERTY VALUE BEG . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1015 (let ((tail (nthcdr 3 undo-elt)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1016 (when (>= (car tail) position)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1017 (setcar tail (- (car tail) offset))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1018 (setcdr tail (- (cdr tail) offset))))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1019 (setq temp-undo-list (cdr temp-undo-list))))))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1020 (setq undo-list-copy (cdr undo-list-copy)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1021 (nreverse undo-list)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1022
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1023 (defun undo-elt-in-region (undo-elt start end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1024 "Determine whether UNDO-ELT falls inside the region START ... END.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1025 If it crosses the edge, we return nil."
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1026 (cond ((integerp undo-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1027 (and (>= undo-elt start)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1028 (< undo-elt end)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1029 ((eq undo-elt nil)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1030 t)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1031 ((atom undo-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1032 nil)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1033 ((stringp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1034 ;; (TEXT . POSITION)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1035 (and (>= (abs (cdr undo-elt)) start)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1036 (< (abs (cdr undo-elt)) end)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1037 ((and (consp undo-elt) (markerp (car undo-elt)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1038 ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1039 ;; See if MARKER is inside the region.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1040 (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1041 (unless alist-elt
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1042 (setq alist-elt (cons (car undo-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1043 (marker-position (car undo-elt))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1044 (setq undo-adjusted-markers
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1045 (cons alist-elt undo-adjusted-markers)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1046 (and (cdr alist-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1047 (>= (cdr alist-elt) start)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1048 (< (cdr alist-elt) end))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1049 ((null (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1050 ;; (nil PROPERTY VALUE BEG . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1051 (let ((tail (nthcdr 3 undo-elt)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1052 (and (>= (car tail) start)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1053 (< (cdr tail) end))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1054 ((integerp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1055 ;; (BEGIN . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1056 (and (>= (car undo-elt) start)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1057 (< (cdr undo-elt) end)))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1058
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1059 (defun undo-elt-crosses-region (undo-elt start end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1060 "Test whether UNDO-ELT crosses one edge of that region START ... END.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1061 This assumes we have already decided that UNDO-ELT
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1062 is not *inside* the region START...END."
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1063 (cond ((atom undo-elt) nil)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1064 ((null (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1065 ;; (nil PROPERTY VALUE BEG . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1066 (let ((tail (nthcdr 3 undo-elt)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1067 (not (or (< (car tail) end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1068 (> (cdr tail) start)))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1069 ((integerp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1070 ;; (BEGIN . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1071 (not (or (< (car undo-elt) end)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1072 (> (cdr undo-elt) start))))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1073
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1074 ;; Return the first affected buffer position and the delta for an undo element
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1075 ;; delta is defined as the change in subsequent buffer positions if we *did*
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1076 ;; the undo.
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1077 (defun undo-delta (undo-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1078 (if (consp undo-elt)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1079 (cond ((stringp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1080 ;; (TEXT . POSITION)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1081 (cons (abs (cdr undo-elt)) (length (car undo-elt))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1082 ((integerp (car undo-elt))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1083 ;; (BEGIN . END)
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1084 (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1085 (t
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1086 '(0 . 0)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1087 '(0 . 0)))
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1088
4374
1a64d641cea4 (shell-command-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 4289
diff changeset
1089 (defvar shell-command-history nil
1a64d641cea4 (shell-command-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 4289
diff changeset
1090 "History list for some commands that read shell commands.")
1a64d641cea4 (shell-command-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 4289
diff changeset
1091
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
1092 (defvar shell-command-switch "-c"
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
1093 "Switch used to have the shell execute its command line argument.")
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
1094
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1095 (defvar shell-command-default-error-buffer nil
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1096 "*Buffer name for `shell-command' and `shell-command-on-region' error output.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1097 This buffer is used when `shell-command' or 'shell-command-on-region'
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1098 is run interactively. A value of nil means that output to stderr and
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1099 stdout will be intermixed in the output stream.")
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1100
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1101 (defun shell-command (command &optional output-buffer error-buffer)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1102 "Execute string COMMAND in inferior shell; display output, if any.
11072
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1103
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1104 If COMMAND ends in ampersand, execute it asynchronously.
11072
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1105 The output appears in the buffer `*Async Shell Command*'.
12565
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
1106 That buffer is in shell mode.
11072
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1107
12565
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
1108 Otherwise, COMMAND is executed synchronously. The output appears in the
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
1109 buffer `*Shell Command Output*'.
11072
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1110 If the output is one line, it is displayed in the echo area *as well*,
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1111 but it is nonetheless available in buffer `*Shell Command Output*',
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1112 even though that buffer is not automatically displayed.
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1113 If there is no output, or if output is inserted in the current buffer,
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
1114 then `*Shell Command Output*' is deleted.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1115
19109
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1116 To specify a coding system for converting non-ASCII characters
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1117 in the shell command output, use \\[universal-coding-system-argument]
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1118 before this command.
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1119
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1120 Noninteractive callers can specify coding systems by binding
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1121 `coding-system-for-read' and `coding-system-for-write'.
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1122
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1123 The optional second argument OUTPUT-BUFFER, if non-nil,
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1124 says to put the output in some other buffer.
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1125 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1126 If OUTPUT-BUFFER is not a buffer and not nil,
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1127 insert output in current buffer. (This cannot be done asynchronously.)
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1128 In either case, the output is inserted after point (leaving mark after it).
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1129
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1130 If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1131 or buffer name to which to direct the command's standard error output.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1132 If it is nil, error output is mingled with regular output.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1133 In an interactive call, the variable `shell-command-default-error-buffer'
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1134 specifies the value of ERROR-BUFFER."
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1135
4488
b0a70d8d9af4 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 4477
diff changeset
1136 (interactive (list (read-from-minibuffer "Shell command: "
b0a70d8d9af4 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 4477
diff changeset
1137 nil nil nil 'shell-command-history)
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1138 current-prefix-arg
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1139 shell-command-default-error-buffer))
14627
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1140 ;; Look for a handler in case default-directory is a remote file name.
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1141 (let ((handler
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1142 (find-file-name-handler (directory-file-name default-directory)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1143 'shell-command)))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1144 (if handler
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1145 (funcall handler 'shell-command command output-buffer error-buffer)
14627
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1146 (if (and output-buffer
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1147 (not (or (bufferp output-buffer) (stringp output-buffer))))
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1148 (let ((error-file
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1149 (if error-buffer
26003
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
1150 (make-temp-file
25483
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1151 (expand-file-name "scor"
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1152 (or small-temporary-file-directory
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1153 temporary-file-directory)))
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1154 nil)))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1155 (barf-if-buffer-read-only)
24825
f88179cfae99 (shell-command): Avoid printing "mark set" message.
Karl Heuer <kwzh@gnu.org>
parents: 24814
diff changeset
1156 (push-mark nil t)
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1157 ;; We do not use -f for csh; we will not support broken use of
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1158 ;; .cshrcs. Even the BSD csh manual says to use
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1159 ;; "if ($?prompt) exit" before things which are not useful
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1160 ;; non-interactively. Besides, if someone wants their other
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1161 ;; aliases for shell commands then they can still have them.
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1162 (call-process shell-file-name nil
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1163 (if error-file
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1164 (list t error-file)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1165 t)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1166 nil shell-command-switch command)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1167 (when (and error-file (file-exists-p error-file))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1168 (if (< 0 (nth 7 (file-attributes error-file)))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1169 (with-current-buffer (get-buffer-create error-buffer)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1170 (let ((pos-from-end (- (point-max) (point))))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1171 (or (bobp)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1172 (insert "\f\n"))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1173 ;; Do no formatting while reading error file,
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1174 ;; because that can run a shell command, and we
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1175 ;; don't want that to cause an infinite recursion.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1176 (format-insert-file error-file nil)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1177 ;; Put point after the inserted errors.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1178 (goto-char (- (point-max) pos-from-end)))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1179 (display-buffer (current-buffer))))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1180 (delete-file error-file))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1181 ;; This is like exchange-point-and-mark, but doesn't
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1182 ;; activate the mark. It is cleaner to avoid activation,
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1183 ;; even though the command loop would deactivate the mark
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1184 ;; because we inserted text.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1185 (goto-char (prog1 (mark t)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1186 (set-marker (mark-marker) (point)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1187 (current-buffer)))))
14627
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1188 ;; Preserve the match data in case called from a program.
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1189 (save-match-data
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1190 (if (string-match "[ \t]*&[ \t]*$" command)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1191 ;; Command ending with ampersand means asynchronous.
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1192 (let ((buffer (get-buffer-create
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1193 (or output-buffer "*Async Shell Command*")))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1194 (directory default-directory)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1195 proc)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1196 ;; Remove the ampersand.
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1197 (setq command (substring command 0 (match-beginning 0)))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1198 ;; If will kill a process, query first.
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1199 (setq proc (get-buffer-process buffer))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1200 (if proc
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1201 (if (yes-or-no-p "A command is running. Kill it? ")
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1202 (kill-process proc)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1203 (error "Shell command in progress")))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1204 (save-excursion
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1205 (set-buffer buffer)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1206 (setq buffer-read-only nil)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1207 (erase-buffer)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1208 (display-buffer buffer)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1209 (setq default-directory directory)
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1210 (setq proc (start-process "Shell" buffer shell-file-name
14627
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1211 shell-command-switch command))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1212 (setq mode-line-process '(":%s"))
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1213 (require 'shell) (shell-mode)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1214 (set-process-sentinel proc 'shell-command-sentinel)
670173a3653b (shell-command): Call file name handler.
Karl Heuer <kwzh@gnu.org>
parents: 14507
diff changeset
1215 ))
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1216 (shell-command-on-region (point) (point) command
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1217 output-buffer nil error-buffer)))))))
21175
e260c4389363 Implement selective undo (by Paul Flinders).
Richard M. Stallman <rms@gnu.org>
parents: 21122
diff changeset
1218
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1219 ;; We have a sentinel to prevent insertion of a termination message
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1220 ;; in the buffer itself.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1221 (defun shell-command-sentinel (process signal)
12565
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
1222 (if (memq (process-status process) '(exit signal))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1223 (message "%s: %s."
12565
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
1224 (car (cdr (cdr (process-command process))))
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
1225 (substring signal 0 -1))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1226
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1227 (defun shell-command-on-region (start end command
19362
fddeff2c6697 (shell-command-on-region): New argument ERROR-BUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 19343
diff changeset
1228 &optional output-buffer replace
fddeff2c6697 (shell-command-on-region): New argument ERROR-BUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 19343
diff changeset
1229 error-buffer)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1230 "Execute string COMMAND in inferior shell with region as input.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1231 Normally display output (if any) in temp buffer `*Shell Command Output*';
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1232 Prefix arg means replace the region with it. Return the exit code of
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1233 COMMAND.
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
1234
19109
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1235 To specify a coding system for converting non-ASCII characters
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1236 in the input and output to the shell command, use \\[universal-coding-system-argument]
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1237 before this command. By default, the input (from the current buffer)
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1238 is encoded in the same coding system that will be used to save the file,
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1239 `buffer-file-coding-system'. If the output is going to replace the region,
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1240 then it is decoded from that same coding system.
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
1241
23471
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1242 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER,
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1243 REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1244 systems by binding `coding-system-for-read' and
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1245 `coding-system-for-write'.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1246
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1247 If the output is one line, it is displayed in the echo area,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1248 but it is nonetheless available in buffer `*Shell Command Output*'
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
1249 even though that buffer is not automatically displayed.
10854
cd64b7e04e23 (shell-command-on-region): Fix typos in doc string.
Karl Heuer <kwzh@gnu.org>
parents: 10852
diff changeset
1250 If there is no output, or if output is inserted in the current buffer,
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
1251 then `*Shell Command Output*' is deleted.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1252
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
1253 If the optional fourth argument OUTPUT-BUFFER is non-nil,
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
1254 that says to put the output in some other buffer.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1255 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1256 If OUTPUT-BUFFER is not a buffer and not nil,
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
1257 insert output in the current buffer.
19362
fddeff2c6697 (shell-command-on-region): New argument ERROR-BUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 19343
diff changeset
1258 In either case, the output is inserted after point (leaving mark after it).
fddeff2c6697 (shell-command-on-region): New argument ERROR-BUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 19343
diff changeset
1259
23471
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1260 If REPLACE, the optional fifth argument, is non-nil, that means insert
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1261 the output in place of text from START to END, putting point and mark
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1262 around it.
b6dbbd2cc3ac (shell-command-on-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23450
diff changeset
1263
23588
cec6b3f8f355 (shell-command-on-region): Doc fix.
Andreas Schwab <schwab@suse.de>
parents: 23520
diff changeset
1264 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
19362
fddeff2c6697 (shell-command-on-region): New argument ERROR-BUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 19343
diff changeset
1265 or buffer name to which to direct the command's standard error output.
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1266 If it is nil, error output is mingled with regular output.
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1267 In an interactive call, the variable `shell-command-default-error-buffer'
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1268 specifies the value of ERROR-BUFFER."
10805
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1269 (interactive (let ((string
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1270 ;; Do this before calling region-beginning
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1271 ;; and region-end, in case subprocess output
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1272 ;; relocates them while we are in the minibuffer.
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1273 (read-from-minibuffer "Shell command on region: "
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1274 nil nil nil
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1275 'shell-command-history)))
13482
e49cd471ced7 (do-auto-fill): Use fill-context-prefix.
Richard M. Stallman <rms@gnu.org>
parents: 13328
diff changeset
1276 ;; call-interactively recognizes region-beginning and
e49cd471ced7 (do-auto-fill): Use fill-context-prefix.
Richard M. Stallman <rms@gnu.org>
parents: 13328
diff changeset
1277 ;; region-end specially, leaving them in the history.
e49cd471ced7 (do-auto-fill): Use fill-context-prefix.
Richard M. Stallman <rms@gnu.org>
parents: 13328
diff changeset
1278 (list (region-beginning) (region-end)
10805
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1279 string
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
1280 current-prefix-arg
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1281 current-prefix-arg
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1282 shell-command-default-error-buffer)))
19362
fddeff2c6697 (shell-command-on-region): New argument ERROR-BUFFER.
Richard M. Stallman <rms@gnu.org>
parents: 19343
diff changeset
1283 (let ((error-file
25483
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1284 (if error-buffer
26003
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
1285 (make-temp-file
25483
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1286 (expand-file-name "scor"
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1287 (or small-temporary-file-directory
cd1649a27c08 (shell-command, shell-command-on-region): Use
Eli Zaretskii <eliz@gnu.org>
parents: 25400
diff changeset
1288 temporary-file-directory)))
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1289 nil))
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1290 exit-status)
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1291 (if (or replace
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1292 (and output-buffer
24400
a4a1ad877482 (shell-command-on-region): Don't go into the REPLACE = t
Richard M. Stallman <rms@gnu.org>
parents: 24398
diff changeset
1293 (not (or (bufferp output-buffer) (stringp output-buffer)))))
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1294 ;; Replace specified region with output from command.
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1295 (let ((swap (and replace (< start end))))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1296 ;; Don't muck with mark unless REPLACE says we should.
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1297 (goto-char start)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1298 (and replace (push-mark))
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1299 (setq exit-status
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1300 (call-process-region start end shell-file-name t
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1301 (if error-file
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1302 (list t error-file)
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1303 t)
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1304 nil shell-command-switch command))
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1305 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1306 (and shell-buffer (not (eq shell-buffer (current-buffer)))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1307 (kill-buffer shell-buffer)))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1308 ;; Don't muck with mark unless REPLACE says we should.
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1309 (and replace swap (exchange-point-and-mark)))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1310 ;; No prefix argument: put the output in a temp buffer,
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1311 ;; replacing its entire contents.
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1312 (let ((buffer (get-buffer-create
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1313 (or output-buffer "*Shell Command Output*")))
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1314 (success nil))
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1315 (unwind-protect
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1316 (if (eq buffer (current-buffer))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1317 ;; If the input is the same buffer as the output,
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1318 ;; delete everything but the specified region,
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1319 ;; then replace that region with the output.
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1320 (progn (setq buffer-read-only nil)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1321 (delete-region (max start end) (point-max))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1322 (delete-region (point-min) (min start end))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1323 (setq exit-status
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1324 (call-process-region (point-min) (point-max)
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1325 shell-file-name t
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1326 (if error-file
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1327 (list t error-file)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1328 t)
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1329 nil shell-command-switch
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1330 command)))
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1331 ;; Clear the output buffer, then run the command with
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1332 ;; output there.
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1333 (save-excursion
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1334 (set-buffer buffer)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1335 (setq buffer-read-only nil)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1336 (erase-buffer))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1337 (setq exit-status
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1338 (call-process-region start end shell-file-name nil
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1339 (if error-file
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1340 (list buffer error-file)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1341 buffer)
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1342 nil shell-command-switch command)))
25147
820b95325cb5 (shell-command-on-region): EXIT-STATUS can be a string.
Richard M. Stallman <rms@gnu.org>
parents: 25046
diff changeset
1343 (setq success (and exit-status (equal 0 exit-status)))
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1344 ;; Report the amount of output.
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1345 (let ((lines (save-excursion
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1346 (set-buffer buffer)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1347 (if (= (buffer-size) 0)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1348 0
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1349 (count-lines (point-min) (point-max))))))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1350 (cond ((= lines 0)
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1351 (if (and error-file
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1352 (< 0 (nth 7 (file-attributes error-file))))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1353 (message "(Shell command %sed with some error output)"
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1354 (if (equal 0 exit-status)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1355 "succeed"
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1356 "fail"))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1357 (message "(Shell command %sed with no output)"
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1358 (if (equal 0 exit-status)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1359 "succeed"
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1360 "fail")))
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1361 (kill-buffer buffer))
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1362 ((= lines 1)
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1363 (message "%s"
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1364 (save-excursion
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1365 (set-buffer buffer)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1366 (goto-char (point-min))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1367 (buffer-substring (point)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1368 (progn (end-of-line) (point))))))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1369 (t
24106
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1370 (save-excursion
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1371 (set-buffer buffer)
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1372 (goto-char (point-min)))
ea58bb66d0e3 (shell-command-on-region-default-error-buffer): New var.
Richard M. Stallman <rms@gnu.org>
parents: 24078
diff changeset
1373 (display-buffer buffer)))))))
24419
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1374 (when (and error-file (file-exists-p error-file))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1375 (if (< 0 (nth 7 (file-attributes error-file)))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1376 (with-current-buffer (get-buffer-create error-buffer)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1377 (let ((pos-from-end (- (point-max) (point))))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1378 (or (bobp)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1379 (insert "\f\n"))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1380 ;; Do no formatting while reading error file,
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1381 ;; because that can run a shell command, and we
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1382 ;; don't want that to cause an infinite recursion.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1383 (format-insert-file error-file nil)
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1384 ;; Put point after the inserted errors.
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1385 (goto-char (- (point-max) pos-from-end)))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1386 (display-buffer (current-buffer))))
30e478cd167e (shell-command-default-error-buffer): Renamed from
Karl Heuer <kwzh@gnu.org>
parents: 24400
diff changeset
1387 (delete-file error-file))
24155
62548105541c (shell-command-on-region): Return command's exit
Dave Love <fx@gnu.org>
parents: 24106
diff changeset
1388 exit-status))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1389
16312
20690a1ec100 (shell-command-to-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16018
diff changeset
1390 (defun shell-command-to-string (command)
20690a1ec100 (shell-command-to-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16018
diff changeset
1391 "Execute shell command COMMAND and return its output as a string."
20690a1ec100 (shell-command-to-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16018
diff changeset
1392 (with-output-to-string
16316
50be5f6cb5e6 (shell-command-to-string): Make the buffer current
Richard M. Stallman <rms@gnu.org>
parents: 16312
diff changeset
1393 (with-current-buffer
50be5f6cb5e6 (shell-command-to-string): Make the buffer current
Richard M. Stallman <rms@gnu.org>
parents: 16312
diff changeset
1394 standard-output
50be5f6cb5e6 (shell-command-to-string): Make the buffer current
Richard M. Stallman <rms@gnu.org>
parents: 16312
diff changeset
1395 (call-process shell-file-name nil t nil shell-command-switch command))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1396
16685
26919ad3a4ad Change most defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16632
diff changeset
1397 (defvar universal-argument-map
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1398 (let ((map (make-sparse-keymap)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1399 (define-key map [t] 'universal-argument-other-key)
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
1400 (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1401 (define-key map [switch-frame] nil)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1402 (define-key map [?\C-u] 'universal-argument-more)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1403 (define-key map [?-] 'universal-argument-minus)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1404 (define-key map [?0] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1405 (define-key map [?1] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1406 (define-key map [?2] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1407 (define-key map [?3] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1408 (define-key map [?4] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1409 (define-key map [?5] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1410 (define-key map [?6] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1411 (define-key map [?7] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1412 (define-key map [?8] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1413 (define-key map [?9] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1414 map)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1415 "Keymap used while processing \\[universal-argument].")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1416
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1417 (defvar universal-argument-num-events nil
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1418 "Number of argument-specifying events read by `universal-argument'.
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1419 `universal-argument-other-key' uses this to discard those events
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1420 from (this-command-keys), and reread only the final command.")
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1421
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1422 (defun universal-argument ()
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1423 "Begin a numeric argument for the following command.
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1424 Digits or minus sign following \\[universal-argument] make up the numeric argument.
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1425 \\[universal-argument] following the digits or minus sign ends the argument.
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1426 \\[universal-argument] without digits or minus sign provides 4 as argument.
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1427 Repeating \\[universal-argument] without digits or minus sign
16408
87f15c601f5a (line-move): Ignore invisibility in `move-to-column'.
Richard M. Stallman <rms@gnu.org>
parents: 16316
diff changeset
1428 multiplies the argument by 4 each time.
87f15c601f5a (line-move): Ignore invisibility in `move-to-column'.
Richard M. Stallman <rms@gnu.org>
parents: 16316
diff changeset
1429 For some commands, just \\[universal-argument] by itself serves as a flag
16445
c5ec4ef6203c (universal-argument): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16436
diff changeset
1430 which is different in effect from any particular numeric argument.
c5ec4ef6203c (universal-argument): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16436
diff changeset
1431 These commands include \\[set-mark-command] and \\[start-kbd-macro]."
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1432 (interactive)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1433 (setq prefix-arg (list 4))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1434 (setq universal-argument-num-events (length (this-command-keys)))
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1435 (setq overriding-terminal-local-map universal-argument-map))
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1436
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1437 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1438 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1439 (defun universal-argument-more (arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1440 (interactive "P")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1441 (if (consp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1442 (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>
parents: 17133
diff changeset
1443 (if (eq arg '-)
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
1444 (setq prefix-arg (list -4))
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
1445 (setq prefix-arg arg)
15e868121a15 (newline): Be more conservative about when to use the optimization.
Richard M. Stallman <rms@gnu.org>
parents: 17133
diff changeset
1446 (setq overriding-terminal-local-map nil)))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1447 (setq universal-argument-num-events (length (this-command-keys))))
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1448
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1449 (defun negative-argument (arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1450 "Begin a negative numeric argument for the next command.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1451 \\[universal-argument] following digits or minus sign ends the argument."
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1452 (interactive "P")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1453 (cond ((integerp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1454 (setq prefix-arg (- arg)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1455 ((eq arg '-)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1456 (setq prefix-arg nil))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1457 (t
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
1458 (setq prefix-arg '-)))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1459 (setq universal-argument-num-events (length (this-command-keys)))
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
1460 (setq overriding-terminal-local-map universal-argument-map))
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1461
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1462 (defun digit-argument (arg)
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1463 "Part of the numeric argument for the next command.
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1464 \\[universal-argument] following digits or minus sign ends the argument."
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1465 (interactive "P")
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1466 (let ((digit (- (logand last-command-char ?\177) ?0)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1467 (cond ((integerp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1468 (setq prefix-arg (+ (* arg 10)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1469 (if (< arg 0) (- digit) digit))))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1470 ((eq arg '-)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1471 ;; Treat -0 as just -, so that -01 will work.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1472 (setq prefix-arg (if (zerop digit) '- (- digit))))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1473 (t
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
1474 (setq prefix-arg digit))))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1475 (setq universal-argument-num-events (length (this-command-keys)))
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
1476 (setq overriding-terminal-local-map universal-argument-map))
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1477
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1478 ;; For backward compatibility, minus with no modifiers is an ordinary
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1479 ;; command if digits have already been entered.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1480 (defun universal-argument-minus (arg)
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1481 (interactive "P")
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1482 (if (integerp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1483 (universal-argument-other-key arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1484 (negative-argument arg)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1485
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1486 ;; Anything else terminates the argument and is left in the queue to be
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1487 ;; executed as a command.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1488 (defun universal-argument-other-key (arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1489 (interactive "P")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1490 (setq prefix-arg arg)
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1491 (let* ((key (this-command-keys))
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1492 (keylist (listify-key-sequence key)))
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1493 (setq unread-command-events
13525
de50b50309d1 (universal-argument-other-key): Add to existing unread-command-events value.
Richard M. Stallman <rms@gnu.org>
parents: 13482
diff changeset
1494 (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>
parents: 13482
diff changeset
1495 unread-command-events)))
12320
979836b1a1a9 (universal-argument-other-key): Call reset-this-command-lengths.
Richard M. Stallman <rms@gnu.org>
parents: 12313
diff changeset
1496 (reset-this-command-lengths)
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1497 (setq overriding-terminal-local-map nil))
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1498
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1499 ;;;; Window system cut and paste hooks.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1500
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1501 (defvar interprogram-cut-function nil
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1502 "Function to call to make a killed region available to other programs.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1503
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1504 Most window systems provide some sort of facility for cutting and
3034
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1505 pasting text between the windows of different programs.
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1506 This variable holds a function that Emacs calls whenever text
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1507 is put in the kill ring, to make the new kill available to other
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1508 programs.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1509
3034
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1510 The function takes one or two arguments.
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1511 The first argument, TEXT, is a string containing
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1512 the text which should be made available.
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1513 The second, PUSH, if non-nil means this is a \"new\" kill;
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1514 nil means appending to an \"old\" kill.")
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1515
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1516 (defvar interprogram-paste-function nil
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1517 "Function to call to get text cut from other programs.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1518
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1519 Most window systems provide some sort of facility for cutting and
3034
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1520 pasting text between the windows of different programs.
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1521 This variable holds a function that Emacs calls to obtain
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1522 text that other programs have provided for pasting.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1523
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1524 The function should be called with no arguments. If the function
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1525 returns nil, then no other program has provided such text, and the top
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1526 of the Emacs kill ring should be used. If the function returns a
727
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1527 string, that string should be put in the kill ring as the latest kill.
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1528
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1529 Note that the function should return a string only if a program other
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1530 than Emacs has provided a string for pasting; if Emacs provided the
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1531 most recent string, the function should return nil. If it is
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1532 difficult to tell whether Emacs or some other program provided the
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1533 current string, it is probably good enough to return nil if the string
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1534 is equal (according to `string=') to the last text Emacs provided.")
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1535
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1536
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1537
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1538 ;;;; The kill ring data structure.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1539
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1540 (defvar kill-ring nil
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1541 "List of killed text sequences.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1542 Since the kill ring is supposed to interact nicely with cut-and-paste
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1543 facilities offered by window systems, use of this variable should
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1544 interact nicely with `interprogram-cut-function' and
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1545 `interprogram-paste-function'. The functions `kill-new',
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1546 `kill-append', and `current-kill' are supposed to implement this
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1547 interaction; you may want to use them instead of manipulating the kill
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1548 ring directly.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1549
23495
d5f08ad9a40b (kill-ring-max): Increased to 60.
Richard M. Stallman <rms@gnu.org>
parents: 23491
diff changeset
1550 (defcustom kill-ring-max 60
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1551 "*Maximum length of kill ring before oldest elements are thrown away."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1552 :type 'integer
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1553 :group 'killing)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1554
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1555 (defvar kill-ring-yank-pointer nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1556 "The tail of the kill ring whose car is the last thing yanked.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1557
8763
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1558 (defun kill-new (string &optional replace)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1559 "Make STRING the latest kill in the kill ring.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1560 Set the kill-ring-yank pointer to point to it.
8763
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1561 If `interprogram-cut-function' is non-nil, apply it to STRING.
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1562 Optional second argument REPLACE non-nil means that STRING will replace
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1563 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>
parents: 8763
diff changeset
1564 (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>
parents: 8763
diff changeset
1565 (menu-bar-update-yank-menu string (and replace (car kill-ring))))
8763
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1566 (if replace
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1567 (setcar kill-ring string)
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1568 (setq kill-ring (cons string kill-ring))
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1569 (if (> (length kill-ring) kill-ring-max)
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1570 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1571 (setq kill-ring-yank-pointer kill-ring)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1572 (if interprogram-cut-function
12975
9bad6a54e268 (kill-new): Compute 2nd arg to interprogram-cut-function based on REPLACE.
Richard M. Stallman <rms@gnu.org>
parents: 12939
diff changeset
1573 (funcall interprogram-cut-function string (not replace))))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1574
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1575 (defun kill-append (string before-p)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1576 "Append STRING to the end of the latest kill in the kill ring.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1577 If BEFORE-P is non-nil, prepend STRING to the kill.
1760
05492c456293 (kill-append): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1740
diff changeset
1578 If `interprogram-cut-function' is set, pass the resulting kill to
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1579 it."
8763
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1580 (kill-new (if before-p
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1581 (concat string (car kill-ring))
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1582 (concat (car kill-ring) string)) t))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1583
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1584 (defun current-kill (n &optional do-not-move)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1585 "Rotate the yanking point by N places, and then return that kill.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1586 If N is zero, `interprogram-paste-function' is set, and calling it
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1587 returns a string, then that string is added to the front of the
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1588 kill ring and returned as the latest kill.
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1589 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1590 yanking point; just return the Nth kill forward."
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1591 (let ((interprogram-paste (and (= n 0)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1592 interprogram-paste-function
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1593 (funcall interprogram-paste-function))))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1594 (if interprogram-paste
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1595 (progn
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1596 ;; Disable the interprogram cut function when we add the new
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1597 ;; text to the kill ring, so Emacs doesn't try to own the
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1598 ;; selection, with identical text.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1599 (let ((interprogram-cut-function nil))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1600 (kill-new interprogram-paste))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1601 interprogram-paste)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1602 (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>
parents: 4488
diff changeset
1603 (let ((ARGth-kill-element
db555f6edd6b (current-kill): Replace (% (+ N (- L K)) L) with (mod (- N K) L),
Paul Eggert <eggert@twinsun.com>
parents: 4488
diff changeset
1604 (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>
parents: 4488
diff changeset
1605 (length kill-ring))
db555f6edd6b (current-kill): Replace (% (+ N (- L K)) L) with (mod (- N K) L),
Paul Eggert <eggert@twinsun.com>
parents: 4488
diff changeset
1606 kill-ring)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1607 (or do-not-move
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1608 (setq kill-ring-yank-pointer ARGth-kill-element))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1609 (car ARGth-kill-element)))))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1610
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1611
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1612
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1613 ;;;; Commands for manipulating the kill ring.
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1614
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1615 (defcustom kill-read-only-ok nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1616 "*Non-nil means don't signal an error for killing read-only text."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1617 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
1618 :group 'killing)
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1619
14507
ec4424facc98 (text-read-only): New error symbol.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1620 (put 'text-read-only 'error-conditions
ec4424facc98 (text-read-only): New error symbol.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1621 '(text-read-only buffer-read-only error))
ec4424facc98 (text-read-only): New error symbol.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1622 (put 'text-read-only 'error-message "Text is read-only")
ec4424facc98 (text-read-only): New error symbol.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1623
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1624 (defun kill-region (beg end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1625 "Kill between point and mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1626 The text is deleted but saved in the kill ring.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627 The command \\[yank] can retrieve it from there.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1628 \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
1834
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1629 If the buffer is read-only, Emacs will beep and refrain from deleting
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1630 the text, but put the text in the kill ring anyway. This means that
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1631 you can use the killing commands to copy text from a read-only buffer.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1632
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1633 This is the primitive for programs to kill text (as opposed to deleting it).
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1634 Supply two arguments, character numbers indicating the stretch of text
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1635 to be killed.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1636 Any command that calls this function is a \"kill command\".
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637 If the previous command was also a kill command,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638 the text killed this time appends to the text killed last time
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 to make one entry in the kill ring."
27836
132294fa754e (zap-to-char, kill-line, kill-region, kill-word)
Dave Love <fx@gnu.org>
parents: 27477
diff changeset
1640 (interactive "r")
20279
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1641 (condition-case nil
26744
f14026cd9767 (kill-region): Use the new `delete-and-extract-region'
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 26723
diff changeset
1642 (let ((string (delete-and-extract-region beg end)))
f14026cd9767 (kill-region): Use the new `delete-and-extract-region'
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 26723
diff changeset
1643 (when string ;STRING is nil if BEG = END
f14026cd9767 (kill-region): Use the new `delete-and-extract-region'
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 26723
diff changeset
1644 ;; Add that string to the kill ring, one way or another.
f14026cd9767 (kill-region): Use the new `delete-and-extract-region'
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 26723
diff changeset
1645 (if (eq last-command 'kill-region)
f14026cd9767 (kill-region): Use the new `delete-and-extract-region'
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 26723
diff changeset
1646 (kill-append string (< end beg))
f14026cd9767 (kill-region): Use the new `delete-and-extract-region'
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 26723
diff changeset
1647 (kill-new string)))
20279
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1648 (setq this-command 'kill-region))
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1649 ((buffer-read-only text-read-only)
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1650 ;; The code above failed because the buffer, or some of the characters
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1651 ;; in the region, are read-only.
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1652 ;; We should beep, in case the user just isn't aware of this.
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1653 ;; However, there's no harm in putting
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1654 ;; the region's text in the kill ring, anyway.
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1655 (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>
parents: 21906
diff changeset
1656 ;; 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>
parents: 21906
diff changeset
1657 (setq this-command 'kill-region)
632fc074e4d7 (kill-region): Set this-command unconditionally in a read-only buffer.
Richard M. Stallman <rms@gnu.org>
parents: 21906
diff changeset
1658 ;; This should barf, if appropriate, and give us the correct error.
20279
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1659 (if kill-read-only-ok
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1660 (message "Read only text copied to kill ring")
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1661 ;; Signal an error if the buffer is read-only.
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1662 (barf-if-buffer-read-only)
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1663 ;; If the buffer isn't read-only, the text is.
69a6030e443a (kill-region): Detect read-only text
Karl Heuer <kwzh@gnu.org>
parents: 20265
diff changeset
1664 (signal 'text-read-only (list (current-buffer)))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1665
9876
75ecf866cfb8 Comment reason for preceding change.
Karl Heuer <kwzh@gnu.org>
parents: 9870
diff changeset
1666 ;; copy-region-as-kill no longer sets this-command, because it's confusing
75ecf866cfb8 Comment reason for preceding change.
Karl Heuer <kwzh@gnu.org>
parents: 9870
diff changeset
1667 ;; to get two copies of the text when the user accidentally types M-w and
75ecf866cfb8 Comment reason for preceding change.
Karl Heuer <kwzh@gnu.org>
parents: 9870
diff changeset
1668 ;; then corrects it with the intended C-w.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669 (defun copy-region-as-kill (beg end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670 "Save the region as if killed, but don't kill it.
20484
089c85c48eab (copy-region-as-kill): Deactivate mark in transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 20482
diff changeset
1671 In Transient Mark mode, deactivate the mark.
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 582
diff changeset
1672 If `interprogram-cut-function' is non-nil, also save the text for a window
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 582
diff changeset
1673 system cut and paste."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1674 (interactive "r")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1675 (if (eq last-command 'kill-region)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1676 (kill-append (buffer-substring beg end) (< end beg))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1677 (kill-new (buffer-substring beg end)))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1678 (if transient-mark-mode
21193
20bba919ec72 (copy-region-as-kill): Set deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21175
diff changeset
1679 (setq deactivate-mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1680 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1681
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1682 (defun kill-ring-save (beg end)
2111
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1683 "Save the region as if killed, but don't kill it.
20484
089c85c48eab (copy-region-as-kill): Deactivate mark in transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 20482
diff changeset
1684 In Transient Mark mode, deactivate the mark.
089c85c48eab (copy-region-as-kill): Deactivate mark in transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 20482
diff changeset
1685 If `interprogram-cut-function' is non-nil, also save the text for a window
089c85c48eab (copy-region-as-kill): Deactivate mark in transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 20482
diff changeset
1686 system cut and paste.
089c85c48eab (copy-region-as-kill): Deactivate mark in transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 20482
diff changeset
1687
3467
002945794814 (kill-ring-save): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3408
diff changeset
1688 This command is similar to `copy-region-as-kill', except that it gives
20484
089c85c48eab (copy-region-as-kill): Deactivate mark in transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 20482
diff changeset
1689 visual feedback indicating the extent of the region being copied."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690 (interactive "r")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 (copy-region-as-kill beg end)
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
1692 (if (interactive-p)
2850
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1693 (let ((other-end (if (= (point) beg) end beg))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1694 (opoint (point))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1695 ;; Inhibit quitting so we can make a quit here
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1696 ;; look like a C-g typed as a command.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1697 (inhibit-quit t))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1698 (if (pos-visible-in-window-p other-end (selected-window))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1699 (progn
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1700 ;; Swap point and mark.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1701 (set-marker (mark-marker) (point) (current-buffer))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1702 (goto-char other-end)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1703 (sit-for 1)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1704 ;; Swap back.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1705 (set-marker (mark-marker) other-end (current-buffer))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1706 (goto-char opoint)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1707 ;; If user quit, deactivate the mark
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1708 ;; 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>
parents: 4042
diff changeset
1709 (and quit-flag mark-active
4287
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1710 (deactivate-mark)))
2850
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1711 (let* ((killed-text (current-kill 0))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1712 (message-len (min (length killed-text) 40)))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1713 (if (= (point) beg)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1714 ;; Don't say "killed"; that is misleading.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1715 (message "Saved text until \"%s\""
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1716 (substring killed-text (- message-len)))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1717 (message "Saved text from \"%s\""
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1718 (substring killed-text 0 message-len))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719
24798
6fe40d35360e (append-next-kill): Use an arg to distinguish
Karl Heuer <kwzh@gnu.org>
parents: 24789
diff changeset
1720 (defun append-next-kill (&optional interactive)
6fe40d35360e (append-next-kill): Use an arg to distinguish
Karl Heuer <kwzh@gnu.org>
parents: 24789
diff changeset
1721 "Cause following command, if it kills, to append to previous kill.
6fe40d35360e (append-next-kill): Use an arg to distinguish
Karl Heuer <kwzh@gnu.org>
parents: 24789
diff changeset
1722 The argument is used for internal purposes; do not supply one."
6fe40d35360e (append-next-kill): Use an arg to distinguish
Karl Heuer <kwzh@gnu.org>
parents: 24789
diff changeset
1723 (interactive "p")
6fe40d35360e (append-next-kill): Use an arg to distinguish
Karl Heuer <kwzh@gnu.org>
parents: 24789
diff changeset
1724 ;; We don't use (interactive-p), since that breaks kbd macros.
6fe40d35360e (append-next-kill): Use an arg to distinguish
Karl Heuer <kwzh@gnu.org>
parents: 24789
diff changeset
1725 (if interactive
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1726 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1727 (setq this-command 'kill-region)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1728 (message "If the next command is a kill, it will append"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1729 (setq last-command 'kill-region)))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1730
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1731 ;; Yanking.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1732
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1733 (defun yank-pop (arg)
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1734 "Replace just-yanked stretch of killed text with a different stretch.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1735 This command is allowed only immediately after a `yank' or a `yank-pop'.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1736 At such a time, the region contains a stretch of reinserted
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1737 previously-killed text. `yank-pop' deletes that text and inserts in its
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1738 place a different stretch of killed text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1739
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1740 With no argument, the previous kill is inserted.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1741 With argument N, insert the Nth previous kill.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1742 If N is negative, this is a more recent kill.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1743
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1744 The sequence of kills wraps around, so that after the oldest one
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1745 comes the newest one."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1746 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1747 (if (not (eq last-command 'yank))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 (error "Previous command was not a yank"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1749 (setq this-command 'yank)
14507
ec4424facc98 (text-read-only): New error symbol.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1750 (let ((inhibit-read-only t)
ec4424facc98 (text-read-only): New error symbol.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1751 (before (< (point) (mark t))))
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
1752 (delete-region (point) (mark t))
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1753 (set-marker (mark-marker) (point) (current-buffer))
18902
7ce2d04d5561 (yank, yank-pop): Bind inhibit-read-only
Richard M. Stallman <rms@gnu.org>
parents: 18825
diff changeset
1754 (let ((opoint (point)))
18820
ac2b130c513a (yank, yank-pop): Clear out read-only prop.
Richard M. Stallman <rms@gnu.org>
parents: 18731
diff changeset
1755 (insert (current-kill arg))
18902
7ce2d04d5561 (yank, yank-pop): Bind inhibit-read-only
Richard M. Stallman <rms@gnu.org>
parents: 18825
diff changeset
1756 (let ((inhibit-read-only t))
7ce2d04d5561 (yank, yank-pop): Bind inhibit-read-only
Richard M. Stallman <rms@gnu.org>
parents: 18825
diff changeset
1757 (remove-text-properties opoint (point) '(read-only nil))))
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1758 (if before
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1759 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1760 ;; It is cleaner to avoid activation, even though the command
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1761 ;; loop would deactivate the mark because we inserted text.
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1762 (goto-char (prog1 (mark t)
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1763 (set-marker (mark-marker) (point) (current-buffer))))))
2111
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1764 nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1766 (defun yank (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767 "Reinsert the last stretch of killed text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1768 More precisely, reinsert the stretch of killed text most recently
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1769 killed OR yanked. Put point at end, and set mark at beginning.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1770 With just C-u as argument, same but put point at beginning (and mark at end).
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1771 With argument N, reinsert the Nth most recently killed stretch of killed
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1772 text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1773 See also the command \\[yank-pop]."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1774 (interactive "*P")
5935
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1775 ;; If we don't get all the way thru, make last-command indicate that
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1776 ;; for the following command.
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1777 (setq this-command t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1778 (push-mark (point))
18902
7ce2d04d5561 (yank, yank-pop): Bind inhibit-read-only
Richard M. Stallman <rms@gnu.org>
parents: 18825
diff changeset
1779 (let ((opoint (point)))
18820
ac2b130c513a (yank, yank-pop): Clear out read-only prop.
Richard M. Stallman <rms@gnu.org>
parents: 18731
diff changeset
1780 (insert (current-kill (cond
ac2b130c513a (yank, yank-pop): Clear out read-only prop.
Richard M. Stallman <rms@gnu.org>
parents: 18731
diff changeset
1781 ((listp arg) 0)
ac2b130c513a (yank, yank-pop): Clear out read-only prop.
Richard M. Stallman <rms@gnu.org>
parents: 18731
diff changeset
1782 ((eq arg '-) -1)
ac2b130c513a (yank, yank-pop): Clear out read-only prop.
Richard M. Stallman <rms@gnu.org>
parents: 18731
diff changeset
1783 (t (1- arg)))))
18902
7ce2d04d5561 (yank, yank-pop): Bind inhibit-read-only
Richard M. Stallman <rms@gnu.org>
parents: 18825
diff changeset
1784 (let ((inhibit-read-only t))
7ce2d04d5561 (yank, yank-pop): Bind inhibit-read-only
Richard M. Stallman <rms@gnu.org>
parents: 18825
diff changeset
1785 (remove-text-properties opoint (point) '(read-only nil))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1786 (if (consp arg)
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1787 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1788 ;; It is cleaner to avoid activation, even though the command
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1789 ;; loop would deactivate the mark because we inserted text.
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1790 (goto-char (prog1 (mark t)
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1791 (set-marker (mark-marker) (point) (current-buffer)))))
5935
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1792 ;; If we do get all the way thru, make this-command indicate that.
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1793 (setq this-command 'yank)
2111
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1794 nil)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1795
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1796 (defun rotate-yank-pointer (arg)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1797 "Rotate the yanking point in the kill ring.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1798 With argument, rotate that many kills forward (or backward, if negative)."
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1799 (interactive "p")
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1800 (current-kill arg))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1801
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1802 ;; Some kill commands.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1803
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1804 ;; Internal subroutine of delete-char
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1805 (defun kill-forward-chars (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1806 (if (listp arg) (setq arg (car arg)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1807 (if (eq arg '-) (setq arg -1))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1808 (kill-region (point) (forward-point arg)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1809
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1810 ;; Internal subroutine of backward-delete-char
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1811 (defun kill-backward-chars (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1812 (if (listp arg) (setq arg (car arg)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1813 (if (eq arg '-) (setq arg -1))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1814 (kill-region (point) (forward-point (- arg))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1815
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1816 (defcustom backward-delete-char-untabify-method 'untabify
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1817 "*The method for untabifying when deleting backward.
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1818 Can be `untabify' -- turn a tab to many spaces, then delete one space;
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1819 `hungry' -- delete all whitespace, both tabs and spaces;
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1820 `all' -- delete all whitespace, including tabs, spaces and newlines;
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1821 nil -- just delete one character."
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1822 :type '(choice (const untabify) (const hungry) (const all) (const nil))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1823 :group 'killing)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1824
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1825 (defun backward-delete-char-untabify (arg &optional killp)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1826 "Delete characters backward, changing tabs into spaces.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1827 The exact behavior depends on `backward-delete-char-untabify-method'.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1828 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1829 Interactively, ARG is the prefix arg (default 1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1830 and KILLP is t if a prefix arg was specified."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1831 (interactive "*p\nP")
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1832 (when (eq backward-delete-char-untabify-method 'untabify)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1833 (let ((count arg))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1834 (save-excursion
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1835 (while (and (> count 0) (not (bobp)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1836 (if (= (preceding-char) ?\t)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1837 (let ((col (current-column)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1838 (forward-char -1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1839 (setq col (- col (current-column)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1840 (insert-char ?\ col)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1841 (delete-char 1)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1842 (forward-char -1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1843 (setq count (1- count))))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1844 (delete-backward-char
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1845 (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1846 ((eq backward-delete-char-untabify-method 'all)
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1847 " \t\n\r"))))
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1848 (if skip
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1849 (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1850 (point)))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1851 (+ arg (if (zerop wh) 0 (1- wh))))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
1852 arg))
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1853 killp))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1854
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1855 (defun zap-to-char (arg char)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1856 "Kill up to and including ARG'th occurrence of CHAR.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1857 Case is ignored if `case-fold-search' is non-nil in the current buffer.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1858 Goes backward if ARG is negative; error if CHAR not found."
27836
132294fa754e (zap-to-char, kill-line, kill-region, kill-word)
Dave Love <fx@gnu.org>
parents: 27477
diff changeset
1859 (interactive "p\ncZap to char: ")
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1860 (kill-region (point) (progn
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1861 (search-forward (char-to-string char) nil nil arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1862 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1863 (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1864
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1865 ;; kill-line and its subroutines.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1866
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1867 (defcustom kill-whole-line nil
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1868 "*If non-nil, `kill-line' with no arg at beg of line kills the whole line."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1869 :type 'boolean
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1870 :group 'killing)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1871
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1872 (defun kill-line (&optional arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1873 "Kill the rest of the current line; if no nonblanks there, kill thru newline.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1874 With prefix argument, kill that many lines from point.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1875 Negative arguments kill lines backward.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1876
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1877 When calling from a program, nil means \"no arg\",
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1878 a number counts as a prefix arg.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1879
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1880 To kill a whole line, when point is not at the beginning, type \
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1881 \\[beginning-of-line] \\[kill-line] \\[kill-line].
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1882
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1883 If `kill-whole-line' is non-nil, then this command kills the whole line
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1884 including its terminating newline, when used at the beginning of a line
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1885 with no argument. As a consequence, you can always kill a whole line
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1886 by typing \\[beginning-of-line] \\[kill-line]."
27836
132294fa754e (zap-to-char, kill-line, kill-region, kill-word)
Dave Love <fx@gnu.org>
parents: 27477
diff changeset
1887 (interactive "P")
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1888 (kill-region (point)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1889 ;; It is better to move point to the other end of the kill
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1890 ;; before killing. That way, in a read-only buffer, point
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1891 ;; moves across the text that is copied to the kill ring.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1892 ;; The choice has no effect on undo now that undo records
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1893 ;; the value of point from before the command was run.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1894 (progn
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1895 (if arg
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1896 (forward-visible-line (prefix-numeric-value arg))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1897 (if (eobp)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1898 (signal 'end-of-buffer nil))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1899 (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1900 (forward-visible-line 1)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1901 (end-of-visible-line)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1902 (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1903
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1904 (defun forward-visible-line (arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1905 "Move forward by ARG lines, ignoring currently invisible newlines only.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1906 If ARG is negative, move backward -ARG lines.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1907 If ARG is zero, move to the beginning of the current line."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1908 (condition-case nil
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1909 (if (> arg 0)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1910 (while (> arg 0)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1911 (or (zerop (forward-line 1))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1912 (signal 'end-of-buffer nil))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1913 ;; If the following character is currently invisible,
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1914 ;; skip all characters with that same `invisible' property value,
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1915 ;; then find the next newline.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1916 (while (and (not (eobp))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1917 (let ((prop
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1918 (get-char-property (point) 'invisible)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1919 (if (eq buffer-invisibility-spec t)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1920 prop
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1921 (or (memq prop buffer-invisibility-spec)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1922 (assq prop buffer-invisibility-spec)))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1923 (goto-char
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1924 (if (get-text-property (point) 'invisible)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1925 (or (next-single-property-change (point) 'invisible)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1926 (point-max))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1927 (next-overlay-change (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1928 (or (zerop (forward-line 1))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1929 (signal 'end-of-buffer nil)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1930 (setq arg (1- arg)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1931 (let ((first t))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1932 (while (or first (< arg 0))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1933 (if (zerop arg)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1934 (beginning-of-line)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1935 (or (zerop (forward-line -1))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1936 (signal 'beginning-of-buffer nil)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1937 (while (and (not (bobp))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1938 (let ((prop
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1939 (get-char-property (1- (point)) 'invisible)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1940 (if (eq buffer-invisibility-spec t)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1941 prop
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1942 (or (memq prop buffer-invisibility-spec)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1943 (assq prop buffer-invisibility-spec)))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1944 (goto-char
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1945 (if (get-text-property (1- (point)) 'invisible)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1946 (or (previous-single-property-change (point) 'invisible)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1947 (point-min))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1948 (previous-overlay-change (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1949 (or (zerop (forward-line -1))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1950 (signal 'beginning-of-buffer nil)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1951 (setq first nil)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1952 (setq arg (1+ arg)))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1953 ((beginning-of-buffer end-of-buffer)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1954 nil)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1955
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1956 (defun end-of-visible-line ()
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1957 "Move to end of current visible line."
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1958 (end-of-line)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1959 ;; If the following character is currently invisible,
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1960 ;; skip all characters with that same `invisible' property value,
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1961 ;; then find the next newline.
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1962 (while (and (not (eobp))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1963 (let ((prop
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1964 (get-char-property (point) 'invisible)))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1965 (if (eq buffer-invisibility-spec t)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1966 prop
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1967 (or (memq prop buffer-invisibility-spec)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1968 (assq prop buffer-invisibility-spec)))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1969 (if (get-text-property (point) 'invisible)
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1970 (goto-char (next-single-property-change (point) 'invisible))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1971 (goto-char (next-overlay-change (point))))
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
1972 (end-of-line)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1974 (defun insert-buffer (buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 "Insert after point the contents of BUFFER.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1976 Puts mark after the inserted text.
26723
b4f7c98850f0 (insert-buffer): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 26521
diff changeset
1977 BUFFER may be a buffer or a buffer name.
b4f7c98850f0 (insert-buffer): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 26521
diff changeset
1978
b4f7c98850f0 (insert-buffer): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 26521
diff changeset
1979 This function is meant for the user to run interactively.
b4f7c98850f0 (insert-buffer): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 26521
diff changeset
1980 Don't call it from programs!"
14835
eb78ddcff331 (insert-buffer): Fix typo in previous change.
Erik Naggum <erik@naggum.no>
parents: 14834
diff changeset
1981 (interactive
14834
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1982 (list
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1983 (progn
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1984 (barf-if-buffer-read-only)
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1985 (read-buffer "Insert buffer: "
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1986 (if (eq (selected-window) (next-window (selected-window)))
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1987 (other-buffer (current-buffer))
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1988 (window-buffer (next-window (selected-window))))
5ae5d97727ce * simple.el (insert-buffer): Interactive default changed to a more
Francesco Potortì <pot@gnu.org>
parents: 14721
diff changeset
1989 t))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1990 (or (bufferp buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1991 (setq buffer (get-buffer buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1992 (let (start end newmark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1993 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1994 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1995 (set-buffer buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1996 (setq start (point-min) end (point-max)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1997 (insert-buffer-substring buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1998 (setq newmark (point)))
1982
d65c1fefc636 * simple.el (kill-region): If the buffer is read-only, call
Jim Blandy <jimb@redhat.com>
parents: 1838
diff changeset
1999 (push-mark newmark))
d65c1fefc636 * simple.el (kill-region): If the buffer is read-only, call
Jim Blandy <jimb@redhat.com>
parents: 1838
diff changeset
2000 nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2001
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2002 (defun append-to-buffer (buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2003 "Append to specified buffer the text of the region.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2004 It is inserted into that buffer before its point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2005
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2006 When calling from a program, give three arguments:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2007 BUFFER (or buffer name), START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2008 START and END specify the portion of the current buffer to be copied."
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
2009 (interactive
10048
db01a04d2afb (append-to-buffer): Don't use current buffer as default.
Richard M. Stallman <rms@gnu.org>
parents: 10034
diff changeset
2010 (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
3629
58add805382e (append-to-buffer): Interactively, supply all 3 args.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
2011 (region-beginning) (region-end)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 (let ((oldbuf (current-buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 (save-excursion
28187
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2014 (let* ((append-to (get-buffer-create buffer))
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2015 (windows (get-buffer-window-list append-to t t))
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2016 point)
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2017 (set-buffer append-to)
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2018 (setq point (point))
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2019 (barf-if-buffer-read-only)
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2020 (insert-buffer-substring oldbuf start end)
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2021 (dolist (window windows)
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2022 (when (= (window-point window) point)
507041681c73 (append-to-buffer): Update point of windows after
Gerd Moellmann <gerd@gnu.org>
parents: 28113
diff changeset
2023 (set-window-point window (point))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2024
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2025 (defun prepend-to-buffer (buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2026 "Prepend to specified buffer the text of the region.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2027 It is inserted into that buffer after its point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2028
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2029 When calling from a program, give three arguments:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2030 BUFFER (or buffer name), START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2031 START and END specify the portion of the current buffer to be copied."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2032 (interactive "BPrepend to buffer: \nr")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2033 (let ((oldbuf (current-buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2034 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2035 (set-buffer (get-buffer-create buffer))
24973
57d2a2f294cb (append-to-buffer, prepend-to-buffer, copy-to-buffer): Check for
Dave Love <fx@gnu.org>
parents: 24831
diff changeset
2036 (barf-if-buffer-read-only)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2037 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2038 (insert-buffer-substring oldbuf start end)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2039
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2040 (defun copy-to-buffer (buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2041 "Copy to specified buffer the text of the region.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2042 It is inserted into that buffer, replacing existing text there.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2043
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2044 When calling from a program, give three arguments:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2045 BUFFER (or buffer name), START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2046 START and END specify the portion of the current buffer to be copied."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2047 (interactive "BCopy to buffer: \nr")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2048 (let ((oldbuf (current-buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2049 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2050 (set-buffer (get-buffer-create buffer))
24973
57d2a2f294cb (append-to-buffer, prepend-to-buffer, copy-to-buffer): Check for
Dave Love <fx@gnu.org>
parents: 24831
diff changeset
2051 (barf-if-buffer-read-only)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2052 (erase-buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2053 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2054 (insert-buffer-substring oldbuf start end)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2055
4040
d06d7295d3eb Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
parents: 3967
diff changeset
2056 (put 'mark-inactive 'error-conditions '(mark-inactive error))
d06d7295d3eb Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
parents: 3967
diff changeset
2057 (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>
parents: 3967
diff changeset
2058
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2059 (defun mark (&optional force)
3487
8c151ebeff9c (mark): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3467
diff changeset
2060 "Return this buffer's mark value as integer; error if mark inactive.
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2061 If optional argument FORCE is non-nil, access the mark value
3487
8c151ebeff9c (mark): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3467
diff changeset
2062 even if the mark is not currently active, and return nil
8c151ebeff9c (mark): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3467
diff changeset
2063 if there is no mark at all.
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2064
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2065 If you are using this in an editing command, you are most likely making
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2066 a mistake; see the documentation of `set-mark'."
10525
8c7043925702 (mark): If transient-mark-mode is nil, mark is active.
Karl Heuer <kwzh@gnu.org>
parents: 10471
diff changeset
2067 (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2068 (marker-position (mark-marker))
4040
d06d7295d3eb Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
parents: 3967
diff changeset
2069 (signal 'mark-inactive nil)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2070
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2071 ;; Many places set mark-active directly, and several of them failed to also
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2072 ;; run deactivate-mark-hook. This shorthand should simplify.
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2073 (defsubst deactivate-mark ()
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2074 "Deactivate the mark by setting `mark-active' to nil.
4287
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
2075 \(That makes a difference only in Transient Mark mode.)
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2076 Also runs the hook `deactivate-mark-hook'."
7726
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
2077 (if transient-mark-mode
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
2078 (progn
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
2079 (setq mark-active nil)
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
2080 (run-hooks 'deactivate-mark-hook))))
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2081
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2082 (defun set-mark (pos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2083 "Set this buffer's mark to POS. Don't use this function!
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2084 That is to say, don't use this function unless you want
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2085 the user to see that the mark has moved, and you want the previous
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2086 mark position to be lost.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2087
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2088 Normally, when a new mark is set, the old one should go on the stack.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2089 This is why most applications should use push-mark, not set-mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2090
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2091 Novice Emacs Lisp programmers often try to use the mark for the wrong
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2092 purposes. The mark saves a location for the user's convenience.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2093 Most editing commands should not alter the mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2094 To remember a location for internal use in the Lisp program,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2095 store it in a Lisp variable. Example:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2096
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2097 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2098
4287
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
2099 (if pos
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
2100 (progn
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
2101 (setq mark-active t)
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
2102 (run-hooks 'activate-mark-hook)
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
2103 (set-marker (mark-marker) pos (current-buffer)))
8660
bb7bd2b068bf (set-mark): When POS is nil, always clear mark-active.
Richard M. Stallman <rms@gnu.org>
parents: 8604
diff changeset
2104 ;; Normally we never clear mark-active except in Transient Mark mode.
bb7bd2b068bf (set-mark): When POS is nil, always clear mark-active.
Richard M. Stallman <rms@gnu.org>
parents: 8604
diff changeset
2105 ;; But when we actually clear out the mark value too,
bb7bd2b068bf (set-mark): When POS is nil, always clear mark-active.
Richard M. Stallman <rms@gnu.org>
parents: 8604
diff changeset
2106 ;; we must clear mark-active in any mode.
bb7bd2b068bf (set-mark): When POS is nil, always clear mark-active.
Richard M. Stallman <rms@gnu.org>
parents: 8604
diff changeset
2107 (setq mark-active nil)
bb7bd2b068bf (set-mark): When POS is nil, always clear mark-active.
Richard M. Stallman <rms@gnu.org>
parents: 8604
diff changeset
2108 (run-hooks 'deactivate-mark-hook)
bb7bd2b068bf (set-mark): When POS is nil, always clear mark-active.
Richard M. Stallman <rms@gnu.org>
parents: 8604
diff changeset
2109 (set-marker (mark-marker) nil)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2110
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2111 (defvar mark-ring nil
8695
0f702e9ab06d (mark-ring): Add permanent-local prop. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8660
diff changeset
2112 "The list of former marks of the current buffer, most recent first.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2113 (make-variable-buffer-local 'mark-ring)
8695
0f702e9ab06d (mark-ring): Add permanent-local prop. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8660
diff changeset
2114 (put 'mark-ring 'permanent-local t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2115
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2116 (defcustom mark-ring-max 16
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2117 "*Maximum size of mark ring. Start discarding off end if gets this big."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2118 :type 'integer
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2119 :group 'editing-basics)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2120
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2121 (defvar global-mark-ring nil
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2122 "The list of saved global marks, most recent first.")
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2123
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2124 (defcustom global-mark-ring-max 16
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2125 "*Maximum size of global mark ring. \
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2126 Start discarding off end if gets this big."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2127 :type 'integer
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2128 :group 'editing-basics)
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2129
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2130 (defun set-mark-command (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2131 "Set mark at where point is, or jump to mark.
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2132 With no prefix argument, set mark, push old mark position on local mark
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2133 ring, and push mark on global mark ring.
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2134 With argument, jump to mark, and pop a new position for mark off the ring
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2135 \(does not affect global mark ring\).
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2136
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2137 Novice Emacs Lisp programmers often try to use the mark for the wrong
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2138 purposes. See the documentation of `set-mark' for more information."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2139 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2140 (if (null arg)
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2141 (progn
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2142 (push-mark nil nil t))
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2143 (if (null (mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2144 (error "No mark set in this buffer")
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2145 (goto-char (mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2146 (pop-mark))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2148 (defun push-mark (&optional location nomsg activate)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2149 "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>
parents: 5811
diff changeset
2150 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>
parents: 5811
diff changeset
2151 also push LOCATION on the global mark ring.
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2152 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>
parents: 2824
diff changeset
2153 In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2154
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2155 Novice Emacs Lisp programmers often try to use the mark for the wrong
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2156 purposes. See the documentation of `set-mark' for more information.
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2157
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2158 In Transient Mark mode, this does not activate the mark."
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2159 (if (null (mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2160 nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2161 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2162 (if (> (length mark-ring) mark-ring-max)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2163 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2164 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2165 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2166 (set-marker (mark-marker) (or location (point)) (current-buffer))
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2167 ;; 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>
parents: 5811
diff changeset
2168 (if (and global-mark-ring
5826
2de9426a38bf Fix Roland's misplaced paren around call to marker-buffer.
Michael I. Bushnell <mib@gnu.org>
parents: 5812
diff changeset
2169 (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>
parents: 5811
diff changeset
2170 ;; 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>
parents: 5811
diff changeset
2171 ;; 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>
parents: 5811
diff changeset
2172 nil
1959e5c4a563 (push-mark): Don't push on global-mark-ring if its car is a marker in the
Roland McGrath <roland@gnu.org>
parents: 5811
diff changeset
2173 (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2174 (if (> (length global-mark-ring) global-mark-ring-max)
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2175 (progn
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2176 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2177 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>
parents: 5811
diff changeset
2178 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
15302
c23c9712ef5c Use executing-kbd-macro, not executing-macro.
Karl Heuer <kwzh@gnu.org>
parents: 15263
diff changeset
2179 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2180 (message "Mark set"))
2844
086fda6b2041 (push-mark): Always activate the mark if not in Transient Mark mode.
Richard M. Stallman <rms@gnu.org>
parents: 2824
diff changeset
2181 (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>
parents: 2824
diff changeset
2182 (set-mark (mark t)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2183 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2184
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2185 (defun pop-mark ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2186 "Pop off mark ring into the buffer's actual mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2187 Does not set point. Does nothing if mark ring is empty."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2188 (if mark-ring
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2189 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2190 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2191 (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2192 (deactivate-mark)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2193 (move-marker (car mark-ring) nil)
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2194 (if (null (mark t)) (ding))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2195 (setq mark-ring (cdr mark-ring)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2196
16436
d2acc84badf4 Use defalias not define-function.
Richard M. Stallman <rms@gnu.org>
parents: 16417
diff changeset
2197 (defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2198 (defun exchange-point-and-mark ()
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2199 "Put the mark where point is now, and point where the mark is now.
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2200 This command works even when the mark is not active,
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2201 and it reactivates the mark."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2202 (interactive nil)
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2203 (let ((omark (mark t)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2204 (if (null omark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2205 (error "No mark set in this buffer"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2206 (set-mark (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2207 (goto-char omark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2208 nil))
2796
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
2209
17514
335bd3dea3ea Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17513
diff changeset
2210 (defun transient-mark-mode (arg)
2796
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
2211 "Toggle Transient Mark mode.
2935
653e14f61220 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 2850
diff changeset
2212 With arg, turn Transient Mark mode on if arg is positive, off otherwise.
2796
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
2213
5372
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
2214 In Transient Mark mode, when the mark is active, the region is highlighted.
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
2215 Changing the buffer \"deactivates\" the mark.
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
2216 So do certain other operations that set the mark
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
2217 but whose main purpose is something else--for example,
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
2218 incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
17514
335bd3dea3ea Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17513
diff changeset
2219 (interactive "P")
2796
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
2220 (setq transient-mark-mode
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
2221 (if (null arg)
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
2222 (not transient-mark-mode)
17513
ea3acb6b992a (transient-mark-mode): Print message if used interactively.
Richard M. Stallman <rms@gnu.org>
parents: 17471
diff changeset
2223 (> (prefix-numeric-value arg) 0)))
17514
335bd3dea3ea Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17513
diff changeset
2224 (if (interactive-p)
335bd3dea3ea Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17513
diff changeset
2225 (if transient-mark-mode
335bd3dea3ea Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17513
diff changeset
2226 (message "Transient Mark mode enabled")
335bd3dea3ea Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17513
diff changeset
2227 (message "Transient Mark mode disabled"))))
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2228
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2229 (defun pop-global-mark ()
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2230 "Pop off global mark ring and jump to the top location."
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2231 (interactive)
7881
4ab8723cd491 (pop-global-mark): Discard entries for nonexistent buffers.
Richard M. Stallman <rms@gnu.org>
parents: 7877
diff changeset
2232 ;; Pop entries which refer to non-existent buffers.
4ab8723cd491 (pop-global-mark): Discard entries for nonexistent buffers.
Richard M. Stallman <rms@gnu.org>
parents: 7877
diff changeset
2233 (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
4ab8723cd491 (pop-global-mark): Discard entries for nonexistent buffers.
Richard M. Stallman <rms@gnu.org>
parents: 7877
diff changeset
2234 (setq global-mark-ring (cdr global-mark-ring)))
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2235 (or global-mark-ring
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2236 (error "No global mark set"))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2237 (let* ((marker (car global-mark-ring))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2238 (buffer (marker-buffer marker))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2239 (position (marker-position marker)))
10351
e34cbd5276bd (pop-global-mark): Make pop-global-mark treat
Richard M. Stallman <rms@gnu.org>
parents: 10284
diff changeset
2240 (setq global-mark-ring (nconc (cdr global-mark-ring)
e34cbd5276bd (pop-global-mark): Make pop-global-mark treat
Richard M. Stallman <rms@gnu.org>
parents: 10284
diff changeset
2241 (list (car global-mark-ring))))
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2242 (set-buffer buffer)
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2243 (or (and (>= position (point-min))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2244 (<= position (point-max)))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2245 (widen))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2246 (goto-char position)
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
2247 (switch-to-buffer buffer)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2248
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2249 (defcustom next-line-add-newlines t
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2250 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2251 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2252 :group 'editing-basics)
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
2253
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254 (defun next-line (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2255 "Move cursor vertically down ARG lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2256 If there is no character in the target line exactly under the current column,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2257 the cursor is positioned after the character in that line which spans this
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2258 column, or at the end of the line if it is not long enough.
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
2259 If there is no line in the buffer after this one, behavior depends on the
10226
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2260 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2261 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>
parents: 12708
diff changeset
2262 cursor to the end of the buffer.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2263
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2264 The command \\[set-goal-column] can be used to create
18593
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2265 a semipermanent goal column for this command.
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2266 Then instead of trying to move exactly vertically (or as close as possible),
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2267 this command moves to the specified goal column (or as close as possible).
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2268 The goal column is stored in the variable `goal-column', which is nil
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2269 when there is no goal column.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2270
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2271 If you are thinking of using this in a Lisp program, consider
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2272 using `forward-line' instead. It is usually easier to use
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2273 and more reliable (no dependence on goal column, etc.)."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2274 (interactive "p")
5675
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
2275 (if (and next-line-add-newlines (= arg 1))
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
2276 (let ((opoint (point)))
8309
a4dbf8e6c78f (line-move, next-line): Check last line moved over
Richard M. Stallman <rms@gnu.org>
parents: 8203
diff changeset
2277 (end-of-line)
a4dbf8e6c78f (line-move, next-line): Check last line moved over
Richard M. Stallman <rms@gnu.org>
parents: 8203
diff changeset
2278 (if (eobp)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
2279 (newline 1)
5675
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
2280 (goto-char opoint)
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
2281 (line-move arg)))
10226
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2282 (if (interactive-p)
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2283 (condition-case nil
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2284 (line-move arg)
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2285 ((beginning-of-buffer end-of-buffer) (ding)))
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2286 (line-move arg)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2288
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2289 (defun previous-line (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2290 "Move cursor vertically up ARG lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2291 If there is no character in the target line exactly over the current column,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2292 the cursor is positioned after the character in that line which spans this
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2293 column, or at the end of the line if it is not long enough.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2294
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2295 The command \\[set-goal-column] can be used to create
18593
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2296 a semipermanent goal column for this command.
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2297 Then instead of trying to move exactly vertically (or as close as possible),
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2298 this command moves to the specified goal column (or as close as possible).
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2299 The goal column is stored in the variable `goal-column', which is nil
3c958a136c4a (next-line, previous-line): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 18498
diff changeset
2300 when there is no goal column.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2301
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2302 If you are thinking of using this in a Lisp program, consider using
1556
fce86d06a758 * simple.el (previous-line): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1481
diff changeset
2303 `forward-line' with a negative argument instead. It is usually easier
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2304 to use and more reliable (no dependence on goal column, etc.)."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2305 (interactive "p")
10226
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2306 (if (interactive-p)
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2307 (condition-case nil
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2308 (line-move (- arg))
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2309 ((beginning-of-buffer end-of-buffer) (ding)))
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
2310 (line-move (- arg)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2311 nil)
25292
0a9e93f020a3 Functions reordered.
Karl Heuer <kwzh@gnu.org>
parents: 25237
diff changeset
2312
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2313 (defcustom track-eol nil
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2314 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2315 This means moving to the end of each line moved onto.
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2316 The beginning of a blank line does not count as the end of a line."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2317 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2318 :group 'editing-basics)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2319
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2320 (defcustom goal-column nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2321 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2322 :type '(choice integer
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2323 (const :tag "None" nil))
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2324 :group 'editing-basics)
1466
04b4499061fd (goal-column): Don't put the defvar inside the make-variable-buffer-local.
Richard M. Stallman <rms@gnu.org>
parents: 1459
diff changeset
2325 (make-variable-buffer-local 'goal-column)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2326
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2327 (defvar temporary-goal-column 0
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2328 "Current goal column for vertical motion.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2329 It is the column where point was
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2330 at the start of current run of vertical motion commands.
513
12facf6e03ed *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 475
diff changeset
2331 When the `track-eol' feature is doing its job, the value is 9999.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2332
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2333 (defcustom line-move-ignore-invisible nil
10949
99c9f475a355 (line-move-ignore-invisible): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10943
diff changeset
2334 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2335 Outline mode sets this."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2336 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2337 :group 'editing-basics)
10949
99c9f475a355 (line-move-ignore-invisible): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10943
diff changeset
2338
11326
0d5ebc078c51 (line-move): Turn off intangibility for intermediate stops.
Richard M. Stallman <rms@gnu.org>
parents: 11324
diff changeset
2339 ;; This is the guts of next-line and previous-line.
0d5ebc078c51 (line-move): Turn off intangibility for intermediate stops.
Richard M. Stallman <rms@gnu.org>
parents: 11324
diff changeset
2340 ;; Arg says how many lines to move.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341 (defun line-move (arg)
11479
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2342 ;; Don't run any point-motion hooks, and disregard intangibility,
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2343 ;; for intermediate positions.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2344 (let ((inhibit-point-motion-hooks t)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2345 (opoint (point))
19003
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2346 new line-end line-beg)
11479
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2347 (unwind-protect
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2348 (progn
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2349 (if (not (or (eq last-command 'next-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2350 (eq last-command 'previous-line)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2351 (setq temporary-goal-column
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2352 (if (and track-eol (eolp)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2353 ;; Don't count beg of empty line as end of line
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2354 ;; unless we just did explicit end-of-line.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2355 (or (not (bolp)) (eq last-command 'end-of-line)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2356 9999
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2357 (current-column))))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2358 (if (and (not (integerp selective-display))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2359 (not line-move-ignore-invisible))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2360 ;; Use just newline characters.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2361 (or (if (> arg 0)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2362 (progn (if (> arg 1) (forward-line (1- arg)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2363 ;; This way of moving forward ARG lines
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2364 ;; verifies that we have a newline after the last one.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2365 ;; It doesn't get confused by intangible text.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2366 (end-of-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2367 (zerop (forward-line 1)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2368 (and (zerop (forward-line arg))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2369 (bolp)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2370 (signal (if (< arg 0)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2371 'beginning-of-buffer
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2372 'end-of-buffer)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2373 nil))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2374 ;; Move by arg lines, but ignore invisible ones.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2375 (while (> arg 0)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2376 (end-of-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2377 (and (zerop (vertical-motion 1))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2378 (signal 'end-of-buffer nil))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2379 ;; If the following character is currently invisible,
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2380 ;; skip all characters with that same `invisible' property value.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2381 (while (and (not (eobp))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2382 (let ((prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2383 (get-char-property (point) 'invisible)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2384 (if (eq buffer-invisibility-spec t)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2385 prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2386 (or (memq prop buffer-invisibility-spec)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2387 (assq prop buffer-invisibility-spec)))))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2388 (if (get-text-property (point) 'invisible)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2389 (goto-char (next-single-property-change (point) 'invisible))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2390 (goto-char (next-overlay-change (point)))))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2391 (setq arg (1- arg)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2392 (while (< arg 0)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2393 (beginning-of-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2394 (and (zerop (vertical-motion -1))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2395 (signal 'beginning-of-buffer nil))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2396 (while (and (not (bobp))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2397 (let ((prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2398 (get-char-property (1- (point)) 'invisible)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2399 (if (eq buffer-invisibility-spec t)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2400 prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2401 (or (memq prop buffer-invisibility-spec)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2402 (assq prop buffer-invisibility-spec)))))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2403 (if (get-text-property (1- (point)) 'invisible)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2404 (goto-char (previous-single-property-change (point) 'invisible))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2405 (goto-char (previous-overlay-change (point)))))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2406 (setq arg (1+ arg))))
16408
87f15c601f5a (line-move): Ignore invisibility in `move-to-column'.
Richard M. Stallman <rms@gnu.org>
parents: 16316
diff changeset
2407 (let ((buffer-invisibility-spec nil))
87f15c601f5a (line-move): Ignore invisibility in `move-to-column'.
Richard M. Stallman <rms@gnu.org>
parents: 16316
diff changeset
2408 (move-to-column (or goal-column temporary-goal-column))))
18034
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2409 (setq new (point))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2410 ;; If we are moving into some intangible text,
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2411 ;; look for following text on the same line which isn't intangible
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2412 ;; and move there.
19003
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2413 (setq line-end (save-excursion (end-of-line) (point)))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2414 (setq line-beg (save-excursion (beginning-of-line) (point)))
18034
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2415 (let ((after (and (< new (point-max))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2416 (get-char-property new 'intangible)))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2417 (before (and (> new (point-min))
19003
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2418 (get-char-property (1- new) 'intangible))))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2419 (when (and before (eq before after)
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2420 (not (bolp)))
18034
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2421 (goto-char (point-min))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2422 (let ((inhibit-point-motion-hooks nil))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2423 (goto-char new))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2424 (if (<= new line-end)
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2425 (setq new (point)))))
19003
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2426 ;; NEW is where we want to move to.
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2427 ;; LINE-BEG and LINE-END are the beginning and end of the line.
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2428 ;; Move there in just one step, from our starting position,
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2429 ;; with intangibility and point-motion hooks enabled this time.
11479
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2430 (goto-char opoint)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2431 (setq inhibit-point-motion-hooks nil)
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
2432 (goto-char (constrain-to-field new opoint t t))
19003
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2433 ;; If intangibility processing moved us to a different line,
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2434 ;; readjust the horizontal position within the line we ended up at.
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2435 (when (or (< (point) line-beg) (> (point) line-end))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2436 (setq new (point))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2437 (setq inhibit-point-motion-hooks t)
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2438 (setq line-end (save-excursion (end-of-line) (point)))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2439 (beginning-of-line)
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2440 (setq line-beg (point))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2441 (let ((buffer-invisibility-spec nil))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2442 (move-to-column (or goal-column temporary-goal-column)))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2443 (if (<= (point) line-end)
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2444 (setq new (point)))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2445 (goto-char (point-min))
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2446 (setq inhibit-point-motion-hooks nil)
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
2447 (goto-char (constrain-to-field new opoint t t))
19003
9d24caacda44 (line-move): If intangibility moves us to a different line,
Richard M. Stallman <rms@gnu.org>
parents: 18902
diff changeset
2448 )))
11479
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
2449 nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2450
1771
3f0f18d4eb8c * simple.el (set-goal-column): Make this command disabled by default.
Jim Blandy <jimb@redhat.com>
parents: 1760
diff changeset
2451 ;;; 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>
parents: 1760
diff changeset
2452 ;;; 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>
parents: 1760
diff changeset
2453 (put 'set-goal-column 'disabled t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2454
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2455 (defun set-goal-column (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2456 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2457 Those commands will move to this position in the line moved to
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2458 rather than trying to keep the same horizontal position.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2459 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>
parents: 1459
diff changeset
2460 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>
parents: 1459
diff changeset
2461 The goal column is stored in the variable `goal-column'."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2462 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2463 (if arg
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2464 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2465 (setq goal-column nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2466 (message "No goal column"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2467 (setq goal-column (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2468 (message (substitute-command-keys
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2469 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2470 goal-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2471 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2472
8006
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2473
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2474 (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>
parents: 12708
diff changeset
2475 "Scroll the \"other window\" down.
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
2476 For more details, see the documentation for `scroll-other-window'."
8006
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2477 (interactive "P")
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2478 (scroll-other-window
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2479 ;; Just invert the argument's meaning.
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2480 ;; We can do that without knowing which window it will be.
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2481 (if (eq lines '-) nil
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2482 (if (null lines) '-
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2483 (- (prefix-numeric-value lines))))))
12718
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
2484 (define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
8057
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2485
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2486 (defun beginning-of-buffer-other-window (arg)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2487 "Move point to the beginning of the buffer in the other window.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2488 Leave mark at previous position.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2489 With arg N, put point N/10 of the way from the true beginning."
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2490 (interactive "P")
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2491 (let ((orig-window (selected-window))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2492 (window (other-window-for-scrolling)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2493 ;; We use unwind-protect rather than save-window-excursion
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2494 ;; because the latter would preserve the things we want to change.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2495 (unwind-protect
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2496 (progn
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2497 (select-window window)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2498 ;; Set point and mark in that window's buffer.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2499 (beginning-of-buffer arg)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2500 ;; Set point accordingly.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2501 (recenter '(t)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2502 (select-window orig-window))))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2503
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2504 (defun end-of-buffer-other-window (arg)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2505 "Move point to the end of the buffer in the other window.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2506 Leave mark at previous position.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2507 With arg N, put point N/10 of the way from the true end."
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2508 (interactive "P")
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2509 ;; See beginning-of-buffer-other-window for comments.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2510 (let ((orig-window (selected-window))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2511 (window (other-window-for-scrolling)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2512 (unwind-protect
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2513 (progn
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2514 (select-window window)
8442
05efaa4966e0 (end-of-buffer-other-window): Go to the end, not to the beginning.
Richard M. Stallman <rms@gnu.org>
parents: 8380
diff changeset
2515 (end-of-buffer arg)
8057
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2516 (recenter '(t)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
2517 (select-window orig-window))))
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
2518
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2519 (defun transpose-chars (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2520 "Interchange characters around point, moving forward one character.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2521 With prefix arg ARG, effect is to take character before point
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2522 and drag it forward past ARG other characters (backward if ARG negative).
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2523 If no argument and at end of line, the previous two chars are exchanged."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2524 (interactive "*P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2525 (and (null arg) (eolp) (forward-char -1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2526 (transpose-subr 'forward-char (prefix-numeric-value arg)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2527
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2528 (defun transpose-words (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2529 "Interchange words around point, leaving point at end of them.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2530 With prefix arg ARG, effect is to take word before or around point
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2531 and drag it forward past ARG other words (backward if ARG negative).
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2532 If ARG is zero, the words around or after point and around or after mark
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2533 are interchanged."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2534 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 (transpose-subr 'forward-word arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2537 (defun transpose-sexps (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2538 "Like \\[transpose-words] but applies to sexps.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2539 Does not work on a sexp that point is in the middle of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540 if it is a list or string."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2541 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2542 (transpose-subr 'forward-sexp arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2543
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2544 (defun transpose-lines (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2545 "Exchange current line and previous line, leaving point after both.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2546 With argument ARG, takes previous line and moves it past ARG lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2547 With argument 0, interchanges line point is in with line mark is in."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2548 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2549 (transpose-subr (function
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2550 (lambda (arg)
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2551 (if (> arg 0)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2552 (progn
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2553 ;; Move forward over ARG lines,
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2554 ;; but create newlines if necessary.
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2555 (setq arg (forward-line arg))
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2556 (if (/= (preceding-char) ?\n)
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2557 (setq arg (1+ arg)))
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2558 (if (> arg 0)
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2559 (newline arg)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2560 (forward-line arg))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2561 arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2562
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2563 (defvar transpose-subr-start1)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2564 (defvar transpose-subr-start2)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2565 (defvar transpose-subr-end1)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2566 (defvar transpose-subr-end2)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2567
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2568 (defun transpose-subr (mover arg)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2569 (let (transpose-subr-start1
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2570 transpose-subr-end1
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2571 transpose-subr-start2
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2572 transpose-subr-end2)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2573 (if (= arg 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2574 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2575 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2576 (funcall mover 1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2577 (setq transpose-subr-end2 (point))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578 (funcall mover -1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2579 (setq transpose-subr-start2 (point))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580 (goto-char (mark))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2581 (funcall mover 1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2582 (setq transpose-subr-end1 (point))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2583 (funcall mover -1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2584 (setq transpose-subr-start1 (point))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2585 (transpose-subr-1))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2586 (exchange-point-and-mark))
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2587 (if (> arg 0)
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2588 (progn
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2589 (funcall mover -1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2590 (setq transpose-subr-start1 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2591 (funcall mover 1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2592 (setq transpose-subr-end1 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2593 (funcall mover arg)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2594 (setq transpose-subr-end2 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2595 (funcall mover (- arg))
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2596 (setq transpose-subr-start2 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2597 (transpose-subr-1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2598 (goto-char transpose-subr-end2))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2599 (funcall mover -1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2600 (setq transpose-subr-start2 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2601 (funcall mover 1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2602 (setq transpose-subr-end2 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2603 (funcall mover (1- arg))
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2604 (setq transpose-subr-start1 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2605 (funcall mover (- arg))
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2606 (setq transpose-subr-end1 (point))
20465
de641c2459a6 (transpose-subr): Rewrite to make faster with big move
Andreas Schwab <schwab@suse.de>
parents: 20384
diff changeset
2607 (transpose-subr-1)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2608
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2609 (defun transpose-subr-1 ()
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2610 (if (> (min transpose-subr-end1 transpose-subr-end2)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2611 (max transpose-subr-start1 transpose-subr-start2))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2612 (error "Don't have two things to transpose"))
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2613 (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
16999
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
2614 (len1 (length word1))
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2615 (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
16999
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
2616 (len2 (length word2)))
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2617 (delete-region transpose-subr-start2 transpose-subr-end2)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2618 (goto-char transpose-subr-start2)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2619 (insert word1)
23775
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2620 (goto-char (if (< transpose-subr-start1 transpose-subr-start2)
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2621 transpose-subr-start1
e2b39708c646 (transpose-subr, transpose-subr-1): Rename variables
Richard M. Stallman <rms@gnu.org>
parents: 23660
diff changeset
2622 (+ transpose-subr-start1 (- len1 len2))))
16999
b22c4cee0207 (kill-forward-chars, kill-backward-chars): Pay
Karl Heuer <kwzh@gnu.org>
parents: 16957
diff changeset
2623 (delete-region (point) (+ (point) len1))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2624 (insert word2)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2625
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2626 (defcustom comment-column 32
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2627 "*Column to indent right-margin comments to.
1581
9de0900ca56a * simple.el (comment-column): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1556
diff changeset
2628 Setting this variable automatically makes it local to the current buffer.
9de0900ca56a * simple.el (comment-column): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1556
diff changeset
2629 Each mode establishes a different default value for this variable; you
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2630 can set the value for a particular mode using that mode's hook."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2631 :type 'integer
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2632 :group 'fill-comments)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2633 (make-variable-buffer-local 'comment-column)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2634
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2635 (defcustom comment-start nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2636 "*String to insert to start a new comment, or nil if no comment syntax."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2637 :type '(choice (const :tag "None" nil)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2638 string)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2639 :group 'fill-comments)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2640
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2641 (defcustom comment-start-skip nil
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2642 "*Regexp to match the start of a comment plus everything up to its body.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2643 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2644 at the place matched by the close of the first pair."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2645 :type '(choice (const :tag "None" nil)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2646 regexp)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2647 :group 'fill-comments)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2648
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2649 (defcustom comment-end ""
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2650 "*String to insert to end a new comment.
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2651 Should be an empty string if comments are terminated by end-of-line."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2652 :type 'string
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2653 :group 'fill-comments)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2654
16685
26919ad3a4ad Change most defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16632
diff changeset
2655 (defvar comment-indent-hook nil
2299
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2656 "Obsolete variable for function to compute desired indentation for a comment.
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2657 This function is called with no args with point at the beginning of
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2658 the comment's starting delimiter.")
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2659
16685
26919ad3a4ad Change most defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16632
diff changeset
2660 (defvar comment-indent-function
27234
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
2661 (lambda () comment-column)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2662 "Function to compute desired indentation for a comment.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2663 This function is called with no args with point at the beginning of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2664 the comment's starting delimiter.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2665
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2666 (defcustom block-comment-start nil
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2667 "*String to insert to start a new comment on a line by itself.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2668 If nil, use `comment-start' instead.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2669 Note that the regular expression `comment-start-skip' should skip this string
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2670 as well as the `comment-start' string."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2671 :type '(choice (const :tag "Use comment-start" nil)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2672 string)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2673 :group 'fill-comments)
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2674
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2675 (defcustom block-comment-end nil
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2676 "*String to insert to end a new comment on a line by itself.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2677 Should be an empty string if comments are terminated by end-of-line.
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2678 If nil, use `comment-end' instead."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2679 :type '(choice (const :tag "Use comment-end" nil)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2680 string)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2681 :group 'fill-comments)
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2682
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683 (defun indent-for-comment ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2684 "Indent this line's comment to comment column, or insert an empty comment."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2685 (interactive "*")
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2686 (let* ((empty (save-excursion (beginning-of-line)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2687 (looking-at "[ \t]*$")))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2688 (starter (or (and empty block-comment-start) comment-start))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2689 (ender (or (and empty block-comment-end) comment-end)))
20384
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2690 (cond
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2691 ((null starter)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2692 (error "No comment syntax defined"))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2693 ((null comment-start-skip)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2694 (error "This mode doesn't define `comment-start-skip'"))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2695 (t (let* ((eolpos (save-excursion (end-of-line) (point)))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2696 cpos indent begpos)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2697 (beginning-of-line)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2698 (if (re-search-forward comment-start-skip eolpos 'move)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2699 (progn (setq cpos (point-marker))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2700 ;; Find the start of the comment delimiter.
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2701 ;; If there were paren-pairs in comment-start-skip,
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2702 ;; position at the end of the first pair.
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2703 (if (match-end 1)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2704 (goto-char (match-end 1))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2705 ;; If comment-start-skip matched a string with
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2706 ;; internal whitespace (not final whitespace) then
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2707 ;; the delimiter start at the end of that
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2708 ;; whitespace. Otherwise, it starts at the
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2709 ;; beginning of what was matched.
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2710 (skip-syntax-backward " " (match-beginning 0))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2711 (skip-syntax-backward "^ " (match-beginning 0)))))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2712 (setq begpos (point))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2713 ;; Compute desired indent.
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2714 (if (= (current-column)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2715 (setq indent (if comment-indent-hook
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2716 (funcall comment-indent-hook)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2717 (funcall comment-indent-function))))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2718 (goto-char begpos)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2719 ;; If that's different from current, change it.
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2720 (skip-chars-backward " \t")
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2721 (delete-region (point) begpos)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2722 (indent-to indent))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2723 ;; An existing comment?
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
2724 (if cpos
20384
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2725 (progn (goto-char cpos)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2726 (set-marker cpos nil))
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2727 ;; No, insert one.
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2728 (insert starter)
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2729 (save-excursion
931b472be076 (indent-for-comment): Check for null `comment-start-skip'.
Dave Love <fx@gnu.org>
parents: 20279
diff changeset
2730 (insert ender))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2731
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2732 (defun set-comment-column (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2733 "Set the comment column based on point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 With no arg, set the comment column to the current column.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2735 With just minus as arg, kill any comment on this line.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2736 With any other arg, set comment column to indentation of the previous comment
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 and then align or create a comment on this line at that column."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2738 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2739 (if (eq arg '-)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2740 (kill-comment nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2741 (if arg
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2742 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2745 (re-search-backward comment-start-skip)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2746 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2747 (re-search-forward comment-start-skip)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2748 (goto-char (match-beginning 0))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2749 (setq comment-column (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2750 (message "Comment column set to %d" comment-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2751 (indent-for-comment))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2752 (setq comment-column (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 (message "Comment column set to %d" comment-column))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2754
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2755 (defun kill-comment (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2756 "Kill the comment on this line, if any.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2757 With argument, kill comments on that many lines starting with this one."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2758 ;; this function loses in a lot of situations. it incorrectly recognises
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2759 ;; comment delimiters sometimes (ergo, inside a string), doesn't work
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2760 ;; with multi-line comments, can kill extra whitespace if comment wasn't
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2761 ;; through end-of-line, et cetera.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2762 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2763 (or comment-start-skip (error "No comment syntax defined"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2764 (let ((count (prefix-numeric-value arg)) endc)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2765 (while (> count 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2766 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2767 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2768 (setq endc (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2769 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2770 (and (string< "" comment-end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2771 (setq endc
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2772 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2773 (re-search-forward (regexp-quote comment-end) endc 'move)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2774 (skip-chars-forward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2775 (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2776 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2777 (if (re-search-forward comment-start-skip endc t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2778 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2779 (goto-char (match-beginning 0))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2780 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2781 (kill-region (point) endc)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2782 ;; to catch comments a line beginnings
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2783 (indent-according-to-mode))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2784 (if arg (forward-line 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2785 (setq count (1- count)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2786
20265
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2787 (defvar comment-padding 1
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2788 "Number of spaces `comment-region' puts between comment chars and text.
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2789
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2790 Extra spacing between the comment characters and the comment text
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2791 makes the comment easier to read. Default is 1. Nil means 0 and is
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2792 more efficient.")
37a6af24de93 (comment-padding): New var.
Karl Heuer <kwzh@gnu.org>
parents: 20054
diff changeset
2793
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2794 (defun comment-region (beg end &optional arg)
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2795 "Comment or uncomment each line in the region.
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2796 With just C-u prefix arg, uncomment each line in region.
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2797 Numeric prefix arg ARG means use ARG comment characters.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2798 If ARG is negative, delete that many comment characters instead.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2799 Comments are terminated on each line, even for syntax in which newline does
26356
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2800 not end the comment. Blank lines do not get comments.
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2801
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2802 The strings used as comment starts are build from
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2803 `comment-start' without trailing spaces and `comment-padding'."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2804 ;; if someone wants it to only put a comment-start at the beginning and
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2805 ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2806 ;; is easy enough. No option is made here for other than commenting
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2807 ;; every line.
24973
57d2a2f294cb (append-to-buffer, prepend-to-buffer, copy-to-buffer): Check for
Dave Love <fx@gnu.org>
parents: 24831
diff changeset
2808 (interactive "*r\nP")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2809 (or comment-start (error "No comment syntax is defined"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2810 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2811 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2812 (save-restriction
26356
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2813 (let* ((comment-start
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2814 (substring comment-start 0
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2815 (string-match "[ \t]*$" comment-start)))
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2816 (cs comment-start) (ce comment-end)
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2817 (cp (when comment-padding
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2818 (make-string comment-padding ? )))
533da0020196 (comment-region): Strip off white space at end of
Gerd Moellmann <gerd@gnu.org>
parents: 26349
diff changeset
2819 numarg)
23864
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2820 (if (consp arg) (setq numarg t)
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2821 (setq numarg (prefix-numeric-value arg))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2822 ;; For positive arg > 1, replicate the comment delims now,
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2823 ;; then insert the replicated strings just once.
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2824 (while (> numarg 1)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2825 (setq cs (concat cs comment-start)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2826 ce (concat ce comment-end))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2827 (setq numarg (1- numarg))))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2828 ;; Loop over all lines from BEG to END.
23864
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2829 (narrow-to-region beg end)
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2830 (goto-char beg)
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2831 (if (or (eq numarg t) (< numarg 0))
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2832 (while (not (eobp))
24028
7ffc86429459 (comment-region): Delete spaces only if we
Richard M. Stallman <rms@gnu.org>
parents: 23963
diff changeset
2833 (let (found-comment)
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2834 ;; Delete comment start from beginning of line.
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2835 (if (eq numarg t)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2836 (while (looking-at (regexp-quote cs))
24028
7ffc86429459 (comment-region): Delete spaces only if we
Richard M. Stallman <rms@gnu.org>
parents: 23963
diff changeset
2837 (setq found-comment t)
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2838 (delete-char (length cs)))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2839 (let ((count numarg))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2840 (while (and (> 1 (setq count (1+ count)))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2841 (looking-at (regexp-quote cs)))
24028
7ffc86429459 (comment-region): Delete spaces only if we
Richard M. Stallman <rms@gnu.org>
parents: 23963
diff changeset
2842 (setq found-comment t)
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2843 (delete-char (length cs)))))
23864
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2844 ;; Delete comment padding from beginning of line
24028
7ffc86429459 (comment-region): Delete spaces only if we
Richard M. Stallman <rms@gnu.org>
parents: 23963
diff changeset
2845 (when (and found-comment comment-padding
7ffc86429459 (comment-region): Delete spaces only if we
Richard M. Stallman <rms@gnu.org>
parents: 23963
diff changeset
2846 (looking-at (regexp-quote cp)))
7ffc86429459 (comment-region): Delete spaces only if we
Richard M. Stallman <rms@gnu.org>
parents: 23963
diff changeset
2847 (delete-char comment-padding))
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2848 ;; Delete comment end from end of line.
23864
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2849 (if (string= "" ce)
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2850 nil
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2851 (if (eq numarg t)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2852 (progn
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2853 (end-of-line)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2854 ;; This is questionable if comment-end ends in
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2855 ;; whitespace. That is pretty brain-damaged,
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2856 ;; though.
16508
fd19350c1405 (comment-region): With just C-u as arg,
Richard M. Stallman <rms@gnu.org>
parents: 16445
diff changeset
2857 (while (progn (skip-chars-backward " \t")
fd19350c1405 (comment-region): With just C-u as arg,
Richard M. Stallman <rms@gnu.org>
parents: 16445
diff changeset
2858 (and (>= (- (point) (point-min)) (length ce))
fd19350c1405 (comment-region): With just C-u as arg,
Richard M. Stallman <rms@gnu.org>
parents: 16445
diff changeset
2859 (save-excursion
fd19350c1405 (comment-region): With just C-u as arg,
Richard M. Stallman <rms@gnu.org>
parents: 16445
diff changeset
2860 (backward-char (length ce))
fd19350c1405 (comment-region): With just C-u as arg,
Richard M. Stallman <rms@gnu.org>
parents: 16445
diff changeset
2861 (looking-at (regexp-quote ce)))))
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2862 (delete-char (- (length ce)))))
5767
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2863 (let ((count numarg))
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2864 (while (> 1 (setq count (1+ count)))
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2865 (end-of-line)
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2866 ;; this is questionable if comment-end ends in whitespace
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2867 ;; that is pretty brain-damaged though
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2868 (skip-chars-backward " \t")
22375
b64e8aaad74e (comment-region): Check for enough chars to delete
Richard M. Stallman <rms@gnu.org>
parents: 22324
diff changeset
2869 (if (>= (- (point) (point-min)) (length ce))
b64e8aaad74e (comment-region): Check for enough chars to delete
Richard M. Stallman <rms@gnu.org>
parents: 22324
diff changeset
2870 (save-excursion
b64e8aaad74e (comment-region): Check for enough chars to delete
Richard M. Stallman <rms@gnu.org>
parents: 22324
diff changeset
2871 (backward-char (length ce))
b64e8aaad74e (comment-region): Check for enough chars to delete
Richard M. Stallman <rms@gnu.org>
parents: 22324
diff changeset
2872 (if (looking-at (regexp-quote ce))
b64e8aaad74e (comment-region): Check for enough chars to delete
Richard M. Stallman <rms@gnu.org>
parents: 22324
diff changeset
2873 (delete-char (length ce)))))))))
23864
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2874 (forward-line 1)))
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2875
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2876 (when comment-padding
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2877 (setq cs (concat cs cp)))
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2878 (while (not (eobp))
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2879 ;; Insert at beginning and at end.
23864
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2880 (if (looking-at "[ \t]*$") ()
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2881 (insert cs)
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2882 (if (string= "" ce) ()
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2883 (end-of-line)
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2884 (insert ce)))
62965fadf048 (comment-region): Handle comment-padding
Karl Heuer <kwzh@gnu.org>
parents: 23775
diff changeset
2885 (search-forward "\n" nil 'move)))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2886
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2887 (defun backward-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2888 "Move backward until encountering the end of a word.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2889 With argument, do this that many times.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2890 In programs, it is faster to call `forward-word' with negative arg."
5764
5726c18895e3 Rms (in his change to comment-region on Feb 1) decided to make
Michael I. Bushnell <mib@gnu.org>
parents: 5730
diff changeset
2891 (interactive "p")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2892 (forward-word (- arg)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2893
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2894 (defun mark-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2895 "Set mark arg words away from point."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2896 (interactive "p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2897 (push-mark
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2898 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2899 (forward-word arg)
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2900 (point))
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2901 nil t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2902
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2903 (defun kill-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2904 "Kill characters forward until encountering the end of a word.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2905 With argument, do this that many times."
27836
132294fa754e (zap-to-char, kill-line, kill-region, kill-word)
Dave Love <fx@gnu.org>
parents: 27477
diff changeset
2906 (interactive "p")
25400
c75839c09c84 (kill-word): Undo previous change.
Gerd Moellmann <gerd@gnu.org>
parents: 25342
diff changeset
2907 (kill-region (point) (progn (forward-word arg) (point))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2908
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2909 (defun backward-kill-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2910 "Kill characters backward until encountering the end of a word.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2911 With argument, do this that many times."
27836
132294fa754e (zap-to-char, kill-line, kill-region, kill-word)
Dave Love <fx@gnu.org>
parents: 27477
diff changeset
2912 (interactive "p")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2913 (kill-word (- arg)))
2416
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2914
6174
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2915 (defun current-word (&optional strict)
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2916 "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>
parents: 6160
diff changeset
2917 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>
parents: 6160
diff changeset
2918 or adjacent to a word."
2416
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2919 (save-excursion
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2920 (let ((oldpoint (point)) (start (point)) (end (point)))
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2921 (skip-syntax-backward "w_") (setq start (point))
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2922 (goto-char oldpoint)
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2923 (skip-syntax-forward "w_") (setq end (point))
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2924 (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>
parents: 6160
diff changeset
2925 ;; 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>
parents: 6160
diff changeset
2926 (and (not strict)
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2927 (progn
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2928 ;; 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>
parents: 6160
diff changeset
2929 (skip-syntax-backward "^w_"
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2930 (save-excursion (beginning-of-line)
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2931 (point)))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2932 (if (bolp)
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2933 ;; 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>
parents: 6160
diff changeset
2934 ;; 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>
parents: 6160
diff changeset
2935 (progn
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2936 (skip-syntax-forward "^w_"
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2937 (save-excursion (end-of-line)
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2938 (point)))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2939 (setq start (point))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2940 (skip-syntax-forward "w_")
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2941 (setq end (point)))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2942 (setq end (point))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2943 (skip-syntax-backward "w_")
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2944 (setq start (point)))
18379
1dd6f63f0ea3 (paren-blinking group): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 18334
diff changeset
2945 (buffer-substring-no-properties start end)))
1dd6f63f0ea3 (paren-blinking group): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 18334
diff changeset
2946 (buffer-substring-no-properties start end)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2947
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2948 (defcustom fill-prefix nil
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2949 "*String for filling to insert at front of new line, or nil for none.
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2950 Setting this variable automatically makes it local to the current buffer."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2951 :type '(choice (const :tag "None" nil)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2952 string)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2953 :group 'fill)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2954 (make-variable-buffer-local 'fill-prefix)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2955
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2956 (defcustom auto-fill-inhibit-regexp nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2957 "*Regexp to match lines which should not be auto-filled."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2958 :type '(choice (const :tag "None" nil)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2959 regexp)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
2960 :group 'fill)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2961
19160
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2962 (defvar comment-line-break-function 'indent-new-comment-line
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2963 "*Mode-specific function which line breaks and continues a comment.
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2964
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2965 This function is only called during auto-filling of a comment section.
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2966 The function should take a single optional argument, which is a flag
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2967 indicating whether it should use soft newlines.
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2968
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2969 Setting this variable automatically makes it local to the current buffer.")
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
2970
21122
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
2971 ;; This function is used as the auto-fill-function of a buffer
15263
0d7899c372ed (do-auto-fill): Return t if real work was done.
Karl Heuer <kwzh@gnu.org>
parents: 15115
diff changeset
2972 ;; when Auto-Fill mode is enabled.
0d7899c372ed (do-auto-fill): Return t if real work was done.
Karl Heuer <kwzh@gnu.org>
parents: 15115
diff changeset
2973 ;; It returns t if it really did any work.
21122
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
2974 ;; (Actually some major modes use a different auto-fill function,
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
2975 ;; but this one is the default one.)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2976 (defun do-auto-fill ()
12708
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
2977 (let (fc justify bol give-up
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
2978 (fill-prefix fill-prefix))
10471
3eb77f03f53e (do-auto-fill): justification renamed to current-justification.
Richard M. Stallman <rms@gnu.org>
parents: 10469
diff changeset
2979 (if (or (not (setq justify (current-justification)))
12428
e4c0623f4a2e (do-auto-fill): No-op if (current-fill-column) is nil.
Richard M. Stallman <rms@gnu.org>
parents: 12400
diff changeset
2980 (null (setq fc (current-fill-column)))
e4c0623f4a2e (do-auto-fill): No-op if (current-fill-column) is nil.
Richard M. Stallman <rms@gnu.org>
parents: 12400
diff changeset
2981 (and (eq justify 'left)
e4c0623f4a2e (do-auto-fill): No-op if (current-fill-column) is nil.
Richard M. Stallman <rms@gnu.org>
parents: 12400
diff changeset
2982 (<= (current-column) fc))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
2983 (save-excursion (beginning-of-line)
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2984 (setq bol (point))
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2985 (and auto-fill-inhibit-regexp
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2986 (looking-at auto-fill-inhibit-regexp))))
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2987 nil ;; Auto-filling not required
10813
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2988 (if (memq justify '(full center right))
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2989 (save-excursion (unjustify-current-line)))
12708
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
2990
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
2991 ;; Choose a fill-prefix automatically.
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
2992 (if (and adaptive-fill-mode
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
2993 (or (null fill-prefix) (string= fill-prefix "")))
13587
a0c1c62e2c4a (do-auto-fill): Look at 2nd line for fill prefix
Richard M. Stallman <rms@gnu.org>
parents: 13525
diff changeset
2994 (let ((prefix
a0c1c62e2c4a (do-auto-fill): Look at 2nd line for fill prefix
Richard M. Stallman <rms@gnu.org>
parents: 13525
diff changeset
2995 (fill-context-prefix
a0c1c62e2c4a (do-auto-fill): Look at 2nd line for fill prefix
Richard M. Stallman <rms@gnu.org>
parents: 13525
diff changeset
2996 (save-excursion (backward-paragraph 1) (point))
18034
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
2997 (save-excursion (forward-paragraph 1) (point)))))
13587
a0c1c62e2c4a (do-auto-fill): Look at 2nd line for fill prefix
Richard M. Stallman <rms@gnu.org>
parents: 13525
diff changeset
2998 (and prefix (not (equal prefix ""))
a0c1c62e2c4a (do-auto-fill): Look at 2nd line for fill prefix
Richard M. Stallman <rms@gnu.org>
parents: 13525
diff changeset
2999 (setq fill-prefix prefix))))
12708
1a81e79198c6 (do-auto-fill): Handle adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12624
diff changeset
3000
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
3001 (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>
parents: 12708
diff changeset
3002 ;; Determine where to split the line.
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3003 (let* (after-prefix
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3004 (fill-point
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3005 (let ((opoint (point))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3006 bounce
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3007 (first t))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3008 (save-excursion
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3009 (beginning-of-line)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3010 (setq after-prefix (point))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3011 (and fill-prefix
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3012 (looking-at (regexp-quote fill-prefix))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3013 (setq after-prefix (match-end 0)))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3014 (move-to-column (1+ fc))
21122
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3015 ;; Move back to the point where we can break the line.
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3016 ;; We break the line between word or
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3017 ;; after/before the character which has character
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3018 ;; category `|'. We search space, \c| followed by
21122
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3019 ;; a character, or \c| following a character. If
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3020 ;; not found, place the point at beginning of line.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3021 (while (or first
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3022 ;; If this is after period and a single space,
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3023 ;; move back once more--we don't want to break
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3024 ;; the line there and make it look like a
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3025 ;; sentence end.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3026 (and (not (bobp))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3027 (not bounce)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3028 sentence-end-double-space
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3029 (save-excursion (forward-char -1)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3030 (and (looking-at "\\. ")
21122
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3031 (not (looking-at "\\. ")))))
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3032 (and (not (bobp))
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3033 (not bounce)
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3034 fill-nobreak-predicate
912cc3491589 (do-auto-fill): Obey fill-nobreak-predicate.
Richard M. Stallman <rms@gnu.org>
parents: 21074
diff changeset
3035 (funcall fill-nobreak-predicate)))
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3036 (setq first nil)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3037 (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3038 ;; If we find nowhere on the line to break it,
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3039 ;; break after one word. Set bounce to t
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3040 ;; so we will not keep going in this while loop.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3041 (if (<= (point) after-prefix)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3042 (progn
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3043 (goto-char after-prefix)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3044 (re-search-forward "[ \t]" opoint t)
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3045 (setq bounce t))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3046 (if (looking-at "[ \t]")
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3047 ;; Break the line at word boundary.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3048 (skip-chars-backward " \t")
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3049 ;; Break the line after/before \c|.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3050 (forward-char 1))))
23491
608e86fcce73 (do-auto-fill): Don't check kinsoku-enable here.
Kenichi Handa <handa@m17n.org>
parents: 23472
diff changeset
3051 (if enable-multibyte-characters
23520
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3052 ;; If we are going to break the line after or
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3053 ;; before a non-ascii character, we may have
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3054 ;; to run a special function for the charset
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3055 ;; of the character to find the correct break
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3056 ;; point.
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3057 (if (not (and (eq (charset-after (1- (point))) 'ascii)
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3058 (eq (charset-after (point)) 'ascii)))
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3059 (fill-find-break-point after-prefix)))
b697f796a473 (do-auto-fill): Adjust argument for fill-find-break-point.
Kenichi Handa <handa@m17n.org>
parents: 23495
diff changeset
3060
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3061 ;; Let fill-point be set to the place where we end up.
22754
5102cb480cae (do-auto-fill): Always break before any whitespace
Richard M. Stallman <rms@gnu.org>
parents: 22725
diff changeset
3062 ;; But move back before any whitespace here.
5102cb480cae (do-auto-fill): Always break before any whitespace
Richard M. Stallman <rms@gnu.org>
parents: 22725
diff changeset
3063 (skip-chars-backward " \t")
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3064 (point)))))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3065
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3066 ;; 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>
parents: 12708
diff changeset
3067 (if (save-excursion
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3068 (goto-char fill-point)
19109
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3069 (and (not (bolp))
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3070 ;; There is no use breaking at end of line.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3071 (not (save-excursion (skip-chars-forward " ") (eolp)))
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3072 ;; It is futile to split at the end of the prefix
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3073 ;; since we would just insert the prefix again.
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3074 (not (and after-prefix (<= (point) after-prefix)))
19109
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3075 ;; Don't split right after a comment starter
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3076 ;; since we would just make another comment starter.
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3077 (not (and comment-start-skip
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3078 (let ((limit (point)))
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3079 (beginning-of-line)
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3080 (and (re-search-forward comment-start-skip
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3081 limit t)
98515e50136d (shell-command-on-region, shell-command): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents: 19003
diff changeset
3082 (eq (point) limit)))))))
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3083 ;; 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>
parents: 12708
diff changeset
3084 (let ((prev-column (current-column)))
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3085 ;; 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>
parents: 12708
diff changeset
3086 ;; 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>
parents: 12708
diff changeset
3087 ;; 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>
parents: 12708
diff changeset
3088 (if (save-excursion
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3089 (skip-chars-backward " \t")
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3090 (= (point) fill-point))
19160
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
3091 (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>
parents: 12708
diff changeset
3092 (save-excursion
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3093 (goto-char fill-point)
19160
6fc804ec9434 (comment-line-break-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 19109
diff changeset
3094 (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>
parents: 12708
diff changeset
3095 ;; Now do justification, if required
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3096 (if (not (eq justify 'left))
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
3097 (save-excursion
12718
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3098 (end-of-line 0)
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3099 (justify-current-line justify nil t)))
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3100 ;; 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>
parents: 12708
diff changeset
3101 ;; 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>
parents: 12708
diff changeset
3102 ;; trying again will not help.
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3103 (if (>= (current-column) prev-column)
0a8b4f086ffc (do-auto-fill): Handle adaptive-fill-function and adaptive-fill-regexp.
Richard M. Stallman <rms@gnu.org>
parents: 12708
diff changeset
3104 (setq give-up t)))
19343
9427b0fcd9c1 (do-auto-fill): Better handling of a very long word
Richard M. Stallman <rms@gnu.org>
parents: 19326
diff changeset
3105 ;; 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>
parents: 12708
diff changeset
3106 (setq give-up t))))
15836
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3107 ;; Justify last line.
15263
0d7899c372ed (do-auto-fill): Return t if real work was done.
Karl Heuer <kwzh@gnu.org>
parents: 15115
diff changeset
3108 (justify-current-line justify t t)
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
3109 t)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3110
15836
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3111 (defvar normal-auto-fill-function 'do-auto-fill
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3112 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3113 Some major modes set this.")
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3114
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3115 (defun auto-fill-mode (&optional arg)
15836
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3116 "Toggle Auto Fill mode.
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3117 With arg, turn Auto Fill mode on if and only if arg is positive.
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3118 In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3119 automatically breaks the line at a previous space.
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3120
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3121 The value of `normal-auto-fill-function' specifies the function to use
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3122 for `auto-fill-function' when turning Auto Fill mode on."
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3123 (interactive "P")
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3124 (prog1 (setq auto-fill-function
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3125 (if (if (null arg)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3126 (not auto-fill-function)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3127 (> (prefix-numeric-value arg) 0))
15836
aa83fbda6971 (normal-auto-fill-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15605
diff changeset
3128 normal-auto-fill-function
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3129 nil))
11572
09d49f6e0af9 (auto-fill-mode): Use force-mode-line-update.
Karl Heuer <kwzh@gnu.org>
parents: 11479
diff changeset
3130 (force-mode-line-update)))
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3131
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3132 ;; This holds a document string used to document auto-fill-mode.
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3133 (defun auto-fill-function ()
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3134 "Automatically break line at a previous space, in insertion of text."
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3135 nil)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3136
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3137 (defun turn-on-auto-fill ()
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3138 "Unconditionally turn on Auto Fill mode."
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3139 (auto-fill-mode 1))
24343
d00b069a7d17 (turn-on-auto-fill): Mark it as an option for `text-mode-hook'.
Richard M. Stallman <rms@gnu.org>
parents: 24301
diff changeset
3140 (custom-add-option 'text-mode-hook 'turn-on-auto-fill)
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3141
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3142 (defun set-fill-column (arg)
15431
68cca71d69bd (set-fill-column): Error if no argument.
Richard M. Stallman <rms@gnu.org>
parents: 15305
diff changeset
3143 "Set `fill-column' to specified argument.
23447
7ccd43d053fd (set-fill-column): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 23251
diff changeset
3144 Use \\[universal-argument] followed by a number to specify a column.
15431
68cca71d69bd (set-fill-column): Error if no argument.
Richard M. Stallman <rms@gnu.org>
parents: 15305
diff changeset
3145 Just \\[universal-argument] as argument means to use the current column."
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3146 (interactive "P")
17874
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3147 (if (consp arg)
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3148 (setq arg (current-column)))
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3149 (if (not (integerp arg))
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3150 ;; Disallow missing argument; it's probably a typo for C-x C-f.
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3151 (error "set-fill-column requires an explicit argument")
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3152 (message "Fill column set to %d (was %d)" arg fill-column)
86e95716af6d (set-fill-column): Make the C-u case work.
Richard M. Stallman <rms@gnu.org>
parents: 17855
diff changeset
3153 (setq fill-column arg)))
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3154
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3155 (defcustom comment-multi-line nil
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3156 "*Non-nil means \\[indent-new-comment-line] should continue same comment
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3157 on new line, with no new terminator or starter.
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3158 This is obsolete because you might as well use \\[newline-and-indent]."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3159 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3160 :group 'fill-comments)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3161
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
3162 (defun indent-new-comment-line (&optional soft)
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3163 "Break line at point and indent, continuing comment if within one.
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3164 This indents the body of the continued comment
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
3165 under the previous comment line.
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3166
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3167 This command is intended for styles where you write a comment per line,
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3168 starting a new comment (and terminating it if necessary) on each line.
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
3169 If you want to continue one comment across several lines, use \\[newline-and-indent].
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
3170
12624
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3171 If a fill column is specified, it overrides the use of the comment column
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3172 or comment indentation.
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3173
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
3174 The inserted newline is marked hard if `use-hard-newlines' is true,
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
3175 unless optional argument SOFT is non-nil."
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
3176 (interactive)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3177 (let (comcol comstart)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3178 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3179 (delete-region (point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3180 (progn (skip-chars-forward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3181 (point)))
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
3182 (if soft (insert-and-inherit ?\n) (newline 1))
12624
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3183 (if fill-prefix
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3184 (progn
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3185 (indent-to-left-margin)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3186 (insert-and-inherit fill-prefix))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3187 (if (not comment-multi-line)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3188 (save-excursion
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3189 (if (and comment-start-skip
24626
37dec422bd7c (indent-new-comment-line): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 24525
diff changeset
3190 (let ((opoint (1- (point)))
24522
3147a1a92eeb (indent-new-comment-line): Handle use at a point
Karl Heuer <kwzh@gnu.org>
parents: 24508
diff changeset
3191 inside)
12624
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3192 (forward-line -1)
24522
3147a1a92eeb (indent-new-comment-line): Handle use at a point
Karl Heuer <kwzh@gnu.org>
parents: 24508
diff changeset
3193 ;; Determine (more or less) whether
3147a1a92eeb (indent-new-comment-line): Handle use at a point
Karl Heuer <kwzh@gnu.org>
parents: 24508
diff changeset
3194 ;; target position is inside a comment.
24626
37dec422bd7c (indent-new-comment-line): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 24525
diff changeset
3195 (while (and (re-search-forward comment-start-skip opoint t)
37dec422bd7c (indent-new-comment-line): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 24525
diff changeset
3196 (not (setq inside (or (equal comment-end "")
37dec422bd7c (indent-new-comment-line): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 24525
diff changeset
3197 (not (search-forward comment-end opoint t)))))))
37dec422bd7c (indent-new-comment-line): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 24525
diff changeset
3198 inside))
37dec422bd7c (indent-new-comment-line): Fix previous change.
Karl Heuer <kwzh@gnu.org>
parents: 24525
diff changeset
3199 ;; The old line has a comment and point was inside the comment.
12624
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3200 ;; Set WIN to the pos of the comment-start.
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3201 ;; But if the comment is empty, look at preceding lines
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3202 ;; to find one that has a nonempty comment.
10943
6a2af2832a42 (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip.
Richard M. Stallman <rms@gnu.org>
parents: 10912
diff changeset
3203
12624
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3204 ;; If comment-start-skip contains a \(...\) pair,
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3205 ;; the real comment delimiter starts at the end of that pair.
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3206 (let ((win (or (match-end 1) (match-beginning 0))))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3207 (while (and (eolp) (not (bobp))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3208 (let (opoint)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3209 (beginning-of-line)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3210 (setq opoint (point))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3211 (forward-line -1)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3212 (re-search-forward comment-start-skip opoint t)))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3213 (setq win (or (match-end 1) (match-beginning 0))))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3214 ;; Indent this line like what we found.
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3215 (goto-char win)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3216 (setq comcol (current-column))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3217 (setq comstart
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3218 (buffer-substring (point) (match-end 0)))))))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3219 (if comcol
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3220 (let ((comment-column comcol)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3221 (comment-start comstart)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3222 (comment-end comment-end))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3223 (and comment-end (not (equal comment-end ""))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3224 ; (if (not comment-multi-line)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3225 (progn
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3226 (forward-char -1)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3227 (insert comment-end)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3228 (forward-char 1))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3229 ; (setq comment-column (+ comment-column (length comment-start))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3230 ; comment-start "")
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3231 ; )
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3232 )
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3233 (if (not (eolp))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3234 (setq comment-end ""))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3235 (insert-and-inherit ?\n)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3236 (forward-char -1)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3237 (indent-for-comment)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3238 (save-excursion
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3239 ;; Make sure we delete the newline inserted above.
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3240 (end-of-line)
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3241 (delete-char 1)))
8ba65cbc8abe (indent-new-comment-line): fill-prefix overrides comment indentation.
Richard M. Stallman <rms@gnu.org>
parents: 12565
diff changeset
3242 (indent-according-to-mode)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3243
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3244 (defun set-selective-display (arg)
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
3245 "Set `selective-display' to ARG; clear it if no arg.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
3246 When the value of `selective-display' is a number > 0,
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
3247 lines whose indentation is >= that value are not displayed.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
3248 The variable `selective-display' has a separate value for each buffer."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3249 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3250 (if (eq selective-display t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3251 (error "selective-display already in use for marked lines"))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3252 (let ((current-vpos
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3253 (save-restriction
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3254 (narrow-to-region (point-min) (point))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3255 (goto-char (window-start))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3256 (vertical-motion (window-height)))))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3257 (setq selective-display
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3258 (and arg (prefix-numeric-value arg)))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3259 (recenter current-vpos))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3260 (set-window-start (selected-window) (window-start (selected-window)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3261 (princ "selective-display set to " t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3262 (prin1 selective-display t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3263 (princ "." t))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3264
17471
f383bfae3202 (overwrite-mode-binary, overwrite-mode-textual): Use defvar.
Richard M. Stallman <rms@gnu.org>
parents: 17355
diff changeset
3265 (defvar overwrite-mode-textual " Ovwrt"
2215
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3266 "The string displayed in the mode line when in overwrite mode.")
17471
f383bfae3202 (overwrite-mode-binary, overwrite-mode-textual): Use defvar.
Richard M. Stallman <rms@gnu.org>
parents: 17355
diff changeset
3267 (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>
parents: 2111
diff changeset
3268 "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>
parents: 2111
diff changeset
3269
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3270 (defun overwrite-mode (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3271 "Toggle overwrite mode.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3272 With arg, turn overwrite mode on iff arg is positive.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3273 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>
parents: 2111
diff changeset
3274 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>
parents: 2111
diff changeset
3275 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>
parents: 2111
diff changeset
3276 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>
parents: 2111
diff changeset
3277 \\[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>
parents: 2111
diff changeset
3278 is supposed to make it easier to insert characters when necessary."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3279 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3280 (setq overwrite-mode
2215
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3281 (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>
parents: 2111
diff changeset
3282 (> (prefix-numeric-value arg) 0))
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3283 'overwrite-mode-textual))
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3284 (force-mode-line-update))
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3285
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3286 (defun binary-overwrite-mode (arg)
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3287 "Toggle binary overwrite mode.
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3288 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>
parents: 2111
diff changeset
3289 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>
parents: 2111
diff changeset
3290 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>
parents: 2111
diff changeset
3291 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>
parents: 2111
diff changeset
3292 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>
parents: 2111
diff changeset
3293 with the character typed.
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3294 \\[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>
parents: 2111
diff changeset
3295 typing characters do.
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3296
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3297 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>
parents: 2111
diff changeset
3298 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>
parents: 2111
diff changeset
3299 `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>
parents: 2111
diff changeset
3300 (interactive "P")
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3301 (setq overwrite-mode
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3302 (if (if (null arg)
2301
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3303 (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>
parents: 2111
diff changeset
3304 (> (prefix-numeric-value arg) 0))
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3305 'overwrite-mode-binary))
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
3306 (force-mode-line-update))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3307
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3308 (defcustom line-number-mode t
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3309 "*Non-nil means display line number in mode line."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3310 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3311 :group 'editing-basics)
2301
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3312
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3313 (defun line-number-mode (arg)
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3314 "Toggle Line Number mode.
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3315 With arg, turn Line Number mode on iff arg is positive.
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3316 When Line Number mode is enabled, the line number appears
23660
68edff9e7389 (line-number-mode): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 23588
diff changeset
3317 in the mode line.
68edff9e7389 (line-number-mode): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 23588
diff changeset
3318
68edff9e7389 (line-number-mode): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 23588
diff changeset
3319 Line numbers do not appear for very large buffers, see variable
68edff9e7389 (line-number-mode): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 23588
diff changeset
3320 `line-number-display-limit'."
2301
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3321 (interactive "P")
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3322 (setq line-number-mode
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3323 (if (null arg) (not line-number-mode)
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3324 (> (prefix-numeric-value arg) 0)))
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3325 (force-mode-line-update))
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
3326
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3327 (defcustom column-number-mode nil
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3328 "*Non-nil means display column number in mode line."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3329 :type 'boolean
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3330 :group 'editing-basics)
12565
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3331
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3332 (defun column-number-mode (arg)
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3333 "Toggle Column Number mode.
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3334 With arg, turn Column Number mode on iff arg is positive.
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3335 When Column Number mode is enabled, the column number appears
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3336 in the mode line."
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3337 (interactive "P")
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3338 (setq column-number-mode
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3339 (if (null arg) (not column-number-mode)
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3340 (> (prefix-numeric-value arg) 0)))
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3341 (force-mode-line-update))
c0a5d0d00c18 (shell-command): Use save-match-data.
Karl Heuer <kwzh@gnu.org>
parents: 12483
diff changeset
3342
18334
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3343 (defgroup paren-blinking nil
18379
1dd6f63f0ea3 (paren-blinking group): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 18334
diff changeset
3344 "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>
parents: 18189
diff changeset
3345 :prefix "blink-matching-"
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3346 :group 'paren-matching)
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3347
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3348 (defcustom blink-matching-paren t
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3349 "*Non-nil means show matching open-paren when close-paren is inserted."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3350 :type 'boolean
18334
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3351 :group 'paren-blinking)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3352
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3353 (defcustom blink-matching-paren-on-screen t
13810
64679d67fde9 (blink-matching-paren-on-screen): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 13587
diff changeset
3354 "*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>
parents: 18189
diff changeset
3355 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>
parents: 18189
diff changeset
3356 when it is off screen)."
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3357 :type 'boolean
18334
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3358 :group 'paren-blinking)
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3359
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3360 (defcustom blink-matching-paren-distance (* 25 1024)
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3361 "*If non-nil, is maximum distance to search for matching open-paren."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3362 :type 'integer
18334
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3363 :group 'paren-blinking)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3364
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3365 (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>
parents: 18189
diff changeset
3366 "*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>
parents: 18189
diff changeset
3367 :type 'number
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3368 :group 'paren-blinking)
9771
3a51735d4a55 (blink-matching-delay): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9750
diff changeset
3369
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3370 (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>
parents: 18189
diff changeset
3371 "*Non-nil means `blink-matching-paren' will not ignore comments."
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3372 :type 'boolean
18334
d03c1b315e76 Create paren-blinking custom group and put all blink-matching-paren variables in it.
Simon Marshall <simon@gnu.org>
parents: 18189
diff changeset
3373 :group 'paren-blinking)
12893
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3374
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3375 (defun blink-matching-open ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3376 "Move cursor momentarily to the beginning of the sexp before point."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3377 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3378 (and (> (point) (1+ (point-min)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3379 blink-matching-paren
9749
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
3380 ;; Verify an even number of quoting characters precede the close.
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
3381 (= 1 (logand 1 (- (point)
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
3382 (save-excursion
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
3383 (forward-char -1)
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
3384 (skip-syntax-backward "/\\")
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
3385 (point)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3386 (let* ((oldpos (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3387 (blinkpos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3388 (mismatch))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3389 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3390 (save-restriction
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3391 (if blink-matching-paren-distance
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3392 (narrow-to-region (max (point-min)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3393 (- (point) blink-matching-paren-distance))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3394 oldpos))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3395 (condition-case ()
12893
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3396 (let ((parse-sexp-ignore-comments
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3397 (and parse-sexp-ignore-comments
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3398 (not blink-matching-paren-dont-ignore-comments))))
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3399 (setq blinkpos (scan-sexps oldpos -1)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3400 (error nil)))
12893
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3401 (and blinkpos
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3402 (/= (char-syntax (char-after blinkpos))
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3403 ?\$)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3404 (setq mismatch
12893
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3405 (or (null (matching-paren (char-after blinkpos)))
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3406 (/= (char-after (1- oldpos))
3ae9326907aa (blink-matching-paren-dont-ignore-comments): New var.
Richard M. Stallman <rms@gnu.org>
parents: 12838
diff changeset
3407 (matching-paren (char-after blinkpos))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3408 (if mismatch (setq blinkpos nil))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3409 (if blinkpos
23251
f19f44b54f00 (blink-matching-open): Don't log paren matching
Karl Heuer <kwzh@gnu.org>
parents: 22877
diff changeset
3410 ;; Don't log messages about paren matching.
f19f44b54f00 (blink-matching-open): Don't log paren matching
Karl Heuer <kwzh@gnu.org>
parents: 22877
diff changeset
3411 (let (message-log-max)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3412 (goto-char blinkpos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3413 (if (pos-visible-in-window-p)
13810
64679d67fde9 (blink-matching-paren-on-screen): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 13587
diff changeset
3414 (and blink-matching-paren-on-screen
64679d67fde9 (blink-matching-paren-on-screen): New variable.
Karl Heuer <kwzh@gnu.org>
parents: 13587
diff changeset
3415 (sit-for blink-matching-delay))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3416 (goto-char blinkpos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3417 (message
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3418 "Matches %s"
6539
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3419 ;; Show what precedes the open in its line, if anything.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3420 (if (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3421 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3422 (not (bolp)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3423 (buffer-substring (progn (beginning-of-line) (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3424 (1+ blinkpos))
6539
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3425 ;; Show what follows the open in its line, if anything.
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3426 (if (save-excursion
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3427 (forward-char 1)
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3428 (skip-chars-forward " \t")
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3429 (not (eolp)))
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3430 (buffer-substring blinkpos
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
3431 (progn (end-of-line) (point)))
9434
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3432 ;; Otherwise show the previous nonblank line,
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3433 ;; if there is one.
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3434 (if (save-excursion
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3435 (skip-chars-backward "\n \t")
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3436 (not (bobp)))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3437 (concat
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3438 (buffer-substring (progn
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3439 (skip-chars-backward "\n \t")
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3440 (beginning-of-line)
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3441 (point))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3442 (progn (end-of-line)
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3443 (skip-chars-backward " \t")
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3444 (point)))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3445 ;; Replace the newline and other whitespace with `...'.
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3446 "..."
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3447 (buffer-substring blinkpos (1+ blinkpos)))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3448 ;; There is nothing to show except the char itself.
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
3449 (buffer-substring blinkpos (1+ blinkpos))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3450 (cond (mismatch
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3451 (message "Mismatched parentheses"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3452 ((not blink-matching-paren-distance)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3453 (message "Unmatched parenthesis"))))))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3454
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3455 ;Turned off because it makes dbx bomb out.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3456 (setq blink-paren-function 'blink-matching-open)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3457
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
3458 ;; This executes C-g typed while Emacs is waiting for a command.
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
3459 ;; Quitting out of a program does not go through here;
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
3460 ;; that happens in the QUIT macro at the C code level.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3461 (defun keyboard-quit ()
22304
f322afba9154 (keyboard-quit): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 22257
diff changeset
3462 "Signal a `quit' condition.
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
3463 During execution of Lisp code, this character causes a quit directly.
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
3464 At top-level, as an editor command, this simply beeps."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3465 (interactive)
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
3466 (deactivate-mark)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3467 (signal 'quit nil))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3468
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3469 (define-key global-map "\C-g" 'keyboard-quit)
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3470
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3471 (defvar buffer-quit-function nil
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3472 "Function to call to \"quit\" the current buffer, or nil if none.
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3473 \\[keyboard-escape-quit] calls this function when its more local actions
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3474 \(such as cancelling a prefix argument, minibuffer or region) do not apply.")
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3475
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3476 (defun keyboard-escape-quit ()
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3477 "Exit the current \"mode\" (in a generalized sense of the word).
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3478 This command can exit an interactive command such as `query-replace',
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3479 can clear out a prefix argument or a region,
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3480 can get out of the minibuffer or other recursive edit,
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3481 cancel the use of the current buffer (for special-purpose buffers),
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3482 or go back to just one window (by deleting all but the selected window)."
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3483 (interactive)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3484 (cond ((eq last-command 'mode-exited) nil)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3485 ((> (minibuffer-depth) 0)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3486 (abort-recursive-edit))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3487 (current-prefix-arg
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3488 nil)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3489 ((and transient-mark-mode
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3490 mark-active)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3491 (deactivate-mark))
17355
dc683d40dde5 (keyboard-escape-quit): Exit recursive edits,
Richard M. Stallman <rms@gnu.org>
parents: 17276
diff changeset
3492 ((> (recursion-depth) 0)
dc683d40dde5 (keyboard-escape-quit): Exit recursive edits,
Richard M. Stallman <rms@gnu.org>
parents: 17276
diff changeset
3493 (exit-recursive-edit))
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3494 (buffer-quit-function
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3495 (funcall buffer-quit-function))
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3496 ((not (one-window-p t))
17355
dc683d40dde5 (keyboard-escape-quit): Exit recursive edits,
Richard M. Stallman <rms@gnu.org>
parents: 17276
diff changeset
3497 (delete-other-windows))
dc683d40dde5 (keyboard-escape-quit): Exit recursive edits,
Richard M. Stallman <rms@gnu.org>
parents: 17276
diff changeset
3498 ((string-match "^ \\*" (buffer-name (current-buffer)))
dc683d40dde5 (keyboard-escape-quit): Exit recursive edits,
Richard M. Stallman <rms@gnu.org>
parents: 17276
diff changeset
3499 (bury-buffer))))
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
3500
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3501 (define-key global-map "\e\e\e" 'keyboard-escape-quit)
26201
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3502
26504
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3503 (defcustom input-mode-8-bit t
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3504 "Control acceptance of 8-bit keyboard input.
26201
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3505 This may be useful for inputting non-ASCII characters if your keyboard
26504
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3506 can generate them. It is not necessary to change this under a window
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3507 system which can distinguish 8-bit characters and Meta keys.
26201
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3508 Setting this variable directly does not take effect;
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3509 use either M-x customize or the function `set-input-mode'."
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3510 :set (lambda (symbol value)
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3511 (let ((mode (current-input-mode)))
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3512 (set-input-mode (nth 0 mode) (nth 1 mode) value)))
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3513 :initialize 'custom-initialize-default
26504
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3514 :type '(choice (const :tag "8-bit input for a Meta key" t)
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3515 (const :tag "Direct 8-bit character input" 0)
0044d20f41ae (input-mode-8-bit): Fix the customization.
Dave Love <fx@gnu.org>
parents: 26476
diff changeset
3516 (const :tag "Assume top bit is parity and ignore" nil))
26201
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3517 :version "21.1"
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3518 :link '(custom-manual "Single-Byte European Support")
097072728e80 (input-mode-8-bit): New defcustom.
Dave Love <fx@gnu.org>
parents: 26063
diff changeset
3519 :group 'keyboard)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3520
27234
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3521 (defcustom read-mail-command 'rmail
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3522 "*Your preference for a mail reading package.
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3523 This is used by some keybindings which support reading mail."
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3524 :type '(choice (function-item rmail)
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3525 (function-item gnus)
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3526 (function-item mh-rmail)
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3527 (function :tag "Other"))
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3528 :version "21.1"
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3529 :group 'mail)
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3530
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3531 (defcustom mail-user-agent 'sendmail-user-agent
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3532 "*Your preference for a mail composition package.
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3533 Various Emacs Lisp packages (e.g. reporter) require you to compose an
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3534 outgoing email message. This variable lets you specify which
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3535 mail-sending package you prefer.
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3536
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3537 Valid values include:
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3538
27234
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3539 `sendmail-user-agent' -- use the default Emacs Mail package
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3540 `mh-e-user-agent' -- use the Emacs interface to the MH mail system
bf32d38f9721 (with-syntax-table): Fix backquoting.
Dave Love <fx@gnu.org>
parents: 27096
diff changeset
3541 `message-user-agent' -- use the GNUS mail sending package
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3542
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3543 Additional valid symbols may be available; check with the author of
17663
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3544 your package for details."
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3545 :type '(radio (function-item :tag "Default Emacs mail"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3546 :format "%t\n"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3547 sendmail-user-agent)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3548 (function-item :tag "Emacs interface to MH"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3549 :format "%t\n"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3550 mh-e-user-agent)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3551 (function-item :tag "Gnus mail sending package"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3552 :format "%t\n"
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3553 message-user-agent)
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3554 (function :tag "Other"))
d2c64a1563f7 Use defgroup and defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17662
diff changeset
3555 :group 'mail)
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3556
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3557 (defun define-mail-user-agent (symbol composefunc sendfunc
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3558 &optional abortfunc hookvar)
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3559 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3560
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3561 SYMBOL can be any Lisp symbol. Its function definition and/or
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3562 value as a variable do not matter for this usage; we use only certain
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3563 properties on its property list, to encode the rest of the arguments.
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3564
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3565 COMPOSEFUNC is program callable function that composes an outgoing
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3566 mail message buffer. This function should set up the basics of the
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3567 buffer without requiring user interaction. It should populate the
16624
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3568 standard mail headers, leaving the `to:' and `subject:' headers blank
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3569 by default.
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3570
16632
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3571 COMPOSEFUNC should accept several optional arguments--the same
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3572 arguments that `compose-mail' takes. See that function's documentation.
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3573
16624
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3574 SENDFUNC is the command a user would run to send the message.
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3575
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3576 Optional ABORTFUNC is the command a user would run to abort the
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3577 message. For mail packages that don't have a separate abort function,
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3578 this can be `kill-buffer' (the equivalent of omitting this argument).
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3579
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3580 Optional HOOKVAR is a hook variable that gets run before the message
16624
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3581 is actually sent. Callers that use the `mail-user-agent' may
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3582 install a hook function temporarily on this hook variable.
cd1a0e1e6975 (sendmail-user-agent): Support 2 optional args.
Richard M. Stallman <rms@gnu.org>
parents: 16508
diff changeset
3583 If HOOKVAR is nil, `mail-send-hook' is used.
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3584
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3585 The properties used on SYMBOL are `composefunc', `sendfunc',
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3586 `abortfunc', and `hookvar'."
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3587 (put symbol 'composefunc composefunc)
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3588 (put symbol 'sendfunc sendfunc)
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3589 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3590 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3591
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3592 (define-mail-user-agent 'sendmail-user-agent
18629
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3593 'sendmail-user-agent-compose
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3594 'mail-send-and-exit)
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3595
21906
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3596 (defun rfc822-goto-eoh ()
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3597 ;; Go to header delimiter line in a mail message, following RFC822 rules
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3598 (goto-char (point-min))
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3599 (while (looking-at "^[^: \n]+:\\|^[ \t]")
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3600 (forward-line 1))
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3601 (point))
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3602
18629
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3603 (defun sendmail-user-agent-compose (&optional to subject other-headers continue
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3604 switch-function yank-action
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3605 send-actions)
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3606 (if switch-function
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3607 (let ((special-display-buffer-names nil)
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3608 (special-display-regexps nil)
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3609 (same-window-buffer-names nil)
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3610 (same-window-regexps nil))
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3611 (funcall switch-function "*mail*")))
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3612 (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
28491
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3613 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3614 (body (cdr (assoc-ignore-case "body" other-headers))))
18629
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3615 (or (mail continue to subject in-reply-to cc yank-action send-actions)
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3616 continue
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3617 (error "Message aborted"))
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3618 (save-excursion
21906
2ee50035ee1b (rfc822-goto-eoh): Stop at a blank line, too.
Richard M. Stallman <rms@gnu.org>
parents: 21847
diff changeset
3619 (rfc822-goto-eoh)
18629
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3620 (while other-headers
28491
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3621 (unless (member-ignore-case (car (car other-headers))
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3622 '("in-reply-to" "cc" "body"))
18629
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3623 (insert (car (car other-headers)) ": "
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3624 (cdr (car other-headers)) "\n"))
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3625 (setq other-headers (cdr other-headers)))
28491
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3626 (when body
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3627 (forward-line 1)
3e21859cd0e7 (sendmail-user-agent-compose): Recognize a `body'
Gerd Moellmann <gerd@gnu.org>
parents: 28193
diff changeset
3628 (insert body))
18629
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3629 t)))
fbb38f6bf8dc (sendmail-user-agent-compose): New function;
Richard M. Stallman <rms@gnu.org>
parents: 18618
diff changeset
3630
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3631 (define-mail-user-agent 'mh-e-user-agent
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3632 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3633 'mh-before-send-letter-hook)
16632
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3634
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3635 (defun compose-mail (&optional to subject other-headers continue
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3636 switch-function yank-action send-actions)
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3637 "Start composing a mail message to send.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3638 This uses the user's chosen mail composition package
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3639 as selected with the variable `mail-user-agent'.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3640 The optional arguments TO and SUBJECT specify recipients
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3641 and the initial Subject field, respectively.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3642
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3643 OTHER-HEADERS is an alist specifying additional
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3644 header fields. Elements look like (HEADER . VALUE) where both
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3645 HEADER and VALUE are strings.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3646
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3647 CONTINUE, if non-nil, says to continue editing a message already
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3648 being composed.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3649
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3650 SWITCH-FUNCTION, if non-nil, is a function to use to
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3651 switch to and display the buffer used for mail composition.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3652
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3653 YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
16717
18d451689307 (compose-mail): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16685
diff changeset
3654 to insert the raw text of the message being replied to.
18d451689307 (compose-mail): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16685
diff changeset
3655 It has the form (FUNCTION . ARGS). The user agent will apply
18d451689307 (compose-mail): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16685
diff changeset
3656 FUNCTION to ARGS, to insert the raw text of the original message.
18d451689307 (compose-mail): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16685
diff changeset
3657 \(The user agent will also run `mail-citation-hook', *after* the
18d451689307 (compose-mail): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 16685
diff changeset
3658 original text has been inserted in this way.)
16632
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3659
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3660 SEND-ACTIONS is a list of actions to call when the message is sent.
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3661 Each action has the form (FUNCTION . ARGS)."
17594
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3662 (interactive
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3663 (list nil nil nil current-prefix-arg))
16632
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3664 (let ((function (get mail-user-agent 'composefunc)))
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3665 (funcall function to subject other-headers continue
5dd86f31843a (compose-mail): Handle several more args:
Richard M. Stallman <rms@gnu.org>
parents: 16624
diff changeset
3666 switch-function yank-action send-actions)))
17594
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3667
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3668 (defun compose-mail-other-window (&optional to subject other-headers continue
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3669 yank-action send-actions)
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3670 "Like \\[compose-mail], but edit the outgoing message in another window."
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3671 (interactive
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3672 (list nil nil nil current-prefix-arg))
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3673 (compose-mail to subject other-headers continue
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3674 'switch-to-buffer-other-window yank-action send-actions))
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3675
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3676
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3677 (defun compose-mail-other-frame (&optional to subject other-headers continue
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3678 yank-action send-actions)
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3679 "Like \\[compose-mail], but edit the outgoing message in another frame."
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3680 (interactive
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3681 (list nil nil nil current-prefix-arg))
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3682 (compose-mail to subject other-headers continue
1a6a798242d6 (compose-mail): Make prefix arg mean "continue".
Richard M. Stallman <rms@gnu.org>
parents: 17589
diff changeset
3683 'switch-to-buffer-other-frame yank-action send-actions))
15988
6a1a664be9f6 (do-auto-fill): Do break after one word as last resort
Richard M. Stallman <rms@gnu.org>
parents: 15892
diff changeset
3684
17606
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3685 (defvar set-variable-value-history nil
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3686 "History of values entered with `set-variable'.")
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3687
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3688 (defun set-variable (var val)
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3689 "Set VARIABLE to VALUE. VALUE is a Lisp object.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3690 When using this interactively, enter a Lisp object for VALUE.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3691 If you want VALUE to be a string, you must surround it with doublequotes.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3692 VALUE is used literally, not evaluated.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3693
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3694 If VARIABLE has a `variable-interactive' property, that is used as if
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3695 it were the arg to `interactive' (which see) to interactively read VALUE.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3696
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3697 If VARIABLE has been defined with `defcustom', then the type information
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3698 in the definition is used to check that VALUE is valid."
22157
7c92848a9d80 (set-variable): Offer variable at point as default.
Richard M. Stallman <rms@gnu.org>
parents: 22144
diff changeset
3699 (interactive
7c92848a9d80 (set-variable): Offer variable at point as default.
Richard M. Stallman <rms@gnu.org>
parents: 22144
diff changeset
3700 (let* ((default-var (variable-at-point))
7c92848a9d80 (set-variable): Offer variable at point as default.
Richard M. Stallman <rms@gnu.org>
parents: 22144
diff changeset
3701 (var (if (symbolp default-var)
7c92848a9d80 (set-variable): Offer variable at point as default.
Richard M. Stallman <rms@gnu.org>
parents: 22144
diff changeset
3702 (read-variable (format "Set variable (default %s): " default-var)
7c92848a9d80 (set-variable): Offer variable at point as default.
Richard M. Stallman <rms@gnu.org>
parents: 22144
diff changeset
3703 default-var)
7c92848a9d80 (set-variable): Offer variable at point as default.
Richard M. Stallman <rms@gnu.org>
parents: 22144
diff changeset
3704 (read-variable "Set variable: ")))
17606
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3705 (minibuffer-help-form '(describe-variable var))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3706 (prop (get var 'variable-interactive))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3707 (prompt (format "Set %s to value: " var))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3708 (val (if prop
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3709 ;; Use VAR's `variable-interactive' property
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3710 ;; as an interactive spec for prompting.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3711 (call-interactively `(lambda (arg)
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3712 (interactive ,prop)
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3713 arg))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3714 (read
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3715 (read-string prompt nil
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3716 'set-variable-value-history)))))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3717 (list var val)))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3718
17613
7dadfa677617 (set-variable): Simplify previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17606
diff changeset
3719 (let ((type (get var 'custom-type)))
17606
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3720 (when type
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3721 ;; Match with custom type.
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3722 (require 'wid-edit)
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3723 (setq type (widget-convert type))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3724 (unless (widget-apply type :match val)
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
3725 (error "Value `%S' does not match type %S of %S"
17606
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3726 val (car type) var))))
d8cd49a0529c (set-variable): Check VALUE against type info if available.
Richard M. Stallman <rms@gnu.org>
parents: 17594
diff changeset
3727 (set var val))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3728
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3729 ;; Define the major mode for lists of completions.
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3730
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3731 (defvar completion-list-mode-map nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3732 "Local map for completion list buffers.")
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3733 (or completion-list-mode-map
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3734 (let ((map (make-sparse-keymap)))
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3735 (define-key map [mouse-2] 'mouse-choose-completion)
7762
763a8b8e7363 (completion-list-mode-map): Unbind down-mouse-2.
Richard M. Stallman <rms@gnu.org>
parents: 7726
diff changeset
3736 (define-key map [down-mouse-2] nil)
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3737 (define-key map "\C-m" 'choose-completion)
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3738 (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>
parents: 10252
diff changeset
3739 (define-key map [left] 'previous-completion)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3740 (define-key map [right] 'next-completion)
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3741 (setq completion-list-mode-map map)))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3742
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3743 ;; Completion mode is suitable only for specially formatted data.
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3744 (put 'completion-list-mode 'mode-class 'special)
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3745
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3746 (defvar completion-reference-buffer nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3747 "Record the buffer that was current when the completion list was requested.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3748 This is a local variable in the completion list buffer.
11318
45947c4ff70b Fix typo in prev change.
Richard M. Stallman <rms@gnu.org>
parents: 11313
diff changeset
3749 Initial value is nil to avoid some compiler warnings.")
6160
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3750
16924
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3751 (defvar completion-no-auto-exit nil
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3752 "Non-nil means `choose-completion-string' should never exit the minibuffer.
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3753 This also applies to other functions such as `choose-completion'
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3754 and `mouse-choose-completion'.")
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3755
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3756 (defvar completion-base-size nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3757 "Number of chars at beginning of minibuffer not involved in completion.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3758 This is a local variable in the completion list buffer
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3759 but it talks about the buffer in `completion-reference-buffer'.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3760 If this is nil, it means to compare text to determine which part
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3761 of the tail end of the buffer's text is involved in completion.")
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3762
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3763 (defun delete-completion-window ()
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3764 "Delete the completion list window.
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3765 Go to the window from which completion was requested."
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3766 (interactive)
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3767 (let ((buf completion-reference-buffer))
16851
a689a6716261 (delete-completion-window): Handle special display frames.
Richard M. Stallman <rms@gnu.org>
parents: 16803
diff changeset
3768 (if (one-window-p t)
a689a6716261 (delete-completion-window): Handle special display frames.
Richard M. Stallman <rms@gnu.org>
parents: 16803
diff changeset
3769 (if (window-dedicated-p (selected-window))
a689a6716261 (delete-completion-window): Handle special display frames.
Richard M. Stallman <rms@gnu.org>
parents: 16803
diff changeset
3770 (delete-frame (selected-frame)))
a689a6716261 (delete-completion-window): Handle special display frames.
Richard M. Stallman <rms@gnu.org>
parents: 16803
diff changeset
3771 (delete-window (selected-window))
a689a6716261 (delete-completion-window): Handle special display frames.
Richard M. Stallman <rms@gnu.org>
parents: 16803
diff changeset
3772 (if (get-buffer-window buf)
a689a6716261 (delete-completion-window): Handle special display frames.
Richard M. Stallman <rms@gnu.org>
parents: 16803
diff changeset
3773 (select-window (get-buffer-window buf))))))
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
3774
10284
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3775 (defun previous-completion (n)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3776 "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>
parents: 10252
diff changeset
3777 (interactive "p")
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3778 (next-completion (- n)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3779
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3780 (defun next-completion (n)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3781 "Move to the next item in the completion list.
13960
5f1ba0200a33 (shell-command): Fix message spelling.
Karl Heuer <kwzh@gnu.org>
parents: 13810
diff changeset
3782 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>
parents: 10252
diff changeset
3783 (interactive "p")
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3784 (while (and (> n 0) (not (eobp)))
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3785 (let ((prop (get-text-property (point) 'mouse-face))
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3786 (end (point-max)))
10284
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3787 ;; If in a completion, move to the end of it.
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3788 (if prop
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3789 (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>
parents: 10252
diff changeset
3790 ;; Move to start of next one.
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3791 (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>
parents: 10252
diff changeset
3792 (setq n (1- n)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3793 (while (and (< n 0) (not (bobp)))
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3794 (let ((prop (get-text-property (1- (point)) 'mouse-face))
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3795 (end (point-min)))
10284
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3796 ;; If in a completion, move to the start of it.
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3797 (if prop
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3798 (goto-char (previous-single-property-change
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3799 (point) 'mouse-face nil end)))
10284
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3800 ;; Move to end of the previous completion.
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3801 (goto-char (previous-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>
parents: 10252
diff changeset
3802 ;; Move to the start of that one.
13171
ed9465203ed6 (next-completion): Specify the LIMIT arg when searching for text properties.
Richard M. Stallman <rms@gnu.org>
parents: 13137
diff changeset
3803 (goto-char (previous-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>
parents: 10252
diff changeset
3804 (setq n (1+ n))))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3805
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3806 (defun choose-completion ()
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3807 "Choose the completion that point is in or next to."
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3808 (interactive)
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3809 (let (beg end completion (buffer completion-reference-buffer)
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3810 (base-size completion-base-size))
8203
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3811 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3812 (setq end (point) beg (1+ (point))))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3813 (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
10959
e43125b71452 (completion-setup-function): Set completion-base-size.
Richard M. Stallman <rms@gnu.org>
parents: 10949
diff changeset
3814 (setq end (1- (point)) beg (point)))
8203
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3815 (if (null beg)
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3816 (error "No completion here"))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3817 (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>
parents: 8309
diff changeset
3818 (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
8468
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3819 (setq completion (buffer-substring beg end))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3820 (let ((owindow (selected-window)))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3821 (if (and (one-window-p t 'selected-frame)
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3822 (window-dedicated-p (selected-window)))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3823 ;; This is a special buffer's frame
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3824 (iconify-frame (selected-frame))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3825 (or (window-dedicated-p (selected-window))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3826 (bury-buffer)))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
3827 (select-window owindow))
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3828 (choose-completion-string completion buffer base-size)))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3829
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3830 ;; Delete the longest partial match for STRING
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3831 ;; that can be found before POINT.
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3832 (defun choose-completion-delete-max-match (string)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3833 (let ((opoint (point))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3834 (len (min (length string)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3835 (- (point) (point-min)))))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3836 (goto-char (- (point) (length string)))
7574
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
3837 (if completion-ignore-case
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
3838 (setq string (downcase string)))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3839 (while (and (> len 0)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3840 (let ((tail (buffer-substring (point)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3841 (+ (point) len))))
7574
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
3842 (if completion-ignore-case
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
3843 (setq tail (downcase tail)))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3844 (not (string= tail (substring string 0 len)))))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3845 (setq len (1- len))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3846 (forward-char 1))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3847 (delete-char len)))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3848
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3849 ;; Switch to BUFFER and insert the completion choice CHOICE.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3850 ;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3851 ;; to keep. If it is nil, use choose-completion-delete-max-match instead.
15484
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3852
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3853 ;; If BUFFER is the minibuffer, exit the minibuffer
16924
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3854 ;; unless it is reading a file name and CHOICE is a directory,
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3855 ;; or completion-no-auto-exit is non-nil.
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3856 (defun choose-completion-string (choice &optional buffer base-size)
27050
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3857 (let ((buffer (or buffer completion-reference-buffer))
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3858 (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3859 ;; If BUFFER is a minibuffer, barf unless it's the currently
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3860 ;; active minibuffer.
27050
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3861 (if (and mini-p
11159
edf66df6fbe9 (choose-completion-string): Use active-minibuffer-window.
Richard M. Stallman <rms@gnu.org>
parents: 11140
diff changeset
3862 (or (not (active-minibuffer-window))
edf66df6fbe9 (choose-completion-string): Use active-minibuffer-window.
Richard M. Stallman <rms@gnu.org>
parents: 11140
diff changeset
3863 (not (equal buffer
edf66df6fbe9 (choose-completion-string): Use active-minibuffer-window.
Richard M. Stallman <rms@gnu.org>
parents: 11140
diff changeset
3864 (window-buffer (active-minibuffer-window))))))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3865 (error "Minibuffer is not active for completion")
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3866 ;; Insert the completion into the buffer where completion was requested.
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3867 (set-buffer buffer)
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3868 (if base-size
27050
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3869 (delete-region (+ base-size (if mini-p
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3870 (minibuffer-prompt-end)
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3871 (point-min)))
5c0c5089979c (choose-completion-string): In minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 26884
diff changeset
3872 (point))
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3873 (choose-completion-delete-max-match choice))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3874 (insert choice)
7697
b52a92ea3796 (choose-completion-string): Clear mouse-face property.
Richard M. Stallman <rms@gnu.org>
parents: 7594
diff changeset
3875 (remove-text-properties (- (point) (length choice)) (point)
b52a92ea3796 (choose-completion-string): Clear mouse-face property.
Richard M. Stallman <rms@gnu.org>
parents: 7594
diff changeset
3876 '(mouse-face nil))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3877 ;; Update point in the window that BUFFER is showing in.
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3878 (let ((window (get-buffer-window buffer t)))
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3879 (set-window-point window (point)))
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
3880 ;; If completing for the minibuffer, exit it with this choice.
16924
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3881 (and (not completion-no-auto-exit)
231033e9a053 (completion-no-auto-exit): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 16851
diff changeset
3882 (equal buffer (window-buffer (minibuffer-window)))
8559
509daefd2d13 (choose-completion-string): Use plain exit-minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 8479
diff changeset
3883 minibuffer-completion-table
15484
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3884 ;; If this is reading a file name, and the file name chosen
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3885 ;; is a directory, don't exit the minibuffer.
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3886 (if (and (eq minibuffer-completion-table 'read-file-name-internal)
26054
967019d3cb93 Doc fixes.
Gerd Moellmann <gerd@gnu.org>
parents: 26003
diff changeset
3887 (file-directory-p (field-string (point-max))))
15484
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3888 (select-window (active-minibuffer-window))
e3f8bfd1bb1f (choose-completion-string): Don't exit the minibuffer
Richard M. Stallman <rms@gnu.org>
parents: 15431
diff changeset
3889 (exit-minibuffer))))))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3890
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3891 (defun completion-list-mode ()
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3892 "Major mode for buffers showing lists of possible completions.
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3893 Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3894 to select the completion near point.
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3895 Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3896 with the mouse."
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3897 (interactive)
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3898 (kill-all-local-variables)
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3899 (use-local-map completion-list-mode-map)
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3900 (setq mode-name "Completion List")
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3901 (setq major-mode 'completion-list-mode)
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3902 (make-local-variable 'completion-base-size)
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
3903 (setq completion-base-size nil)
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
3904 (run-hooks 'completion-list-mode-hook))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3905
20482
1fe822fa93e6 (completion-setup-hook): Add definition.
Richard M. Stallman <rms@gnu.org>
parents: 20465
diff changeset
3906 (defvar completion-setup-hook nil
1fe822fa93e6 (completion-setup-hook): Add definition.
Richard M. Stallman <rms@gnu.org>
parents: 20465
diff changeset
3907 "Normal hook run at the end of setting up a completion list buffer.
1fe822fa93e6 (completion-setup-hook): Add definition.
Richard M. Stallman <rms@gnu.org>
parents: 20465
diff changeset
3908 When this hook is run, the current buffer is the one in which the
1fe822fa93e6 (completion-setup-hook): Add definition.
Richard M. Stallman <rms@gnu.org>
parents: 20465
diff changeset
3909 command to display the completion list buffer was run.
1fe822fa93e6 (completion-setup-hook): Add definition.
Richard M. Stallman <rms@gnu.org>
parents: 20465
diff changeset
3910 The completion list buffer is available as the value of `standard-output'.")
1fe822fa93e6 (completion-setup-hook): Add definition.
Richard M. Stallman <rms@gnu.org>
parents: 20465
diff changeset
3911
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3912 ;; This function goes in completion-setup-hook, so that it is called
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3913 ;; after the text of the completion list buffer is written.
8203
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
3914
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3915 (defun completion-setup-function ()
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3916 (save-excursion
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
3917 (let ((mainbuf (current-buffer)))
6160
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3918 (set-buffer standard-output)
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3919 (completion-list-mode)
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3920 (make-local-variable 'completion-reference-buffer)
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3921 (setq completion-reference-buffer mainbuf)
18034
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3922 (if (eq minibuffer-completion-table 'read-file-name-internal)
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3923 ;; For file name completion,
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3924 ;; use the number of chars before the start of the
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3925 ;; last file name component.
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3926 (setq completion-base-size
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3927 (save-excursion
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3928 (set-buffer mainbuf)
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3929 (goto-char (point-max))
0d96c759902b (line-move): If moving into intangible text,
Richard M. Stallman <rms@gnu.org>
parents: 17874
diff changeset
3930 (skip-chars-backward (format "^%c" directory-sep-char))
27096
e200e2db8e99 (completion-setup-function): Count completion-size
Eli Zaretskii <eliz@gnu.org>
parents: 27050
diff changeset
3931 (- (point) (minibuffer-prompt-end))))
19227
84c681e58fd5 (completion-setup-function): Don't set completion-base-size
Richard M. Stallman <rms@gnu.org>
parents: 19160
diff changeset
3932 ;; Otherwise, in minibuffer, the whole input is being completed.
84c681e58fd5 (completion-setup-function): Don't set completion-base-size
Richard M. Stallman <rms@gnu.org>
parents: 19160
diff changeset
3933 (save-match-data
84c681e58fd5 (completion-setup-function): Don't set completion-base-size
Richard M. Stallman <rms@gnu.org>
parents: 19160
diff changeset
3934 (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
84c681e58fd5 (completion-setup-function): Don't set completion-base-size
Richard M. Stallman <rms@gnu.org>
parents: 19160
diff changeset
3935 (buffer-name mainbuf))
84c681e58fd5 (completion-setup-function): Don't set completion-base-size
Richard M. Stallman <rms@gnu.org>
parents: 19160
diff changeset
3936 (setq completion-base-size 0))))
6160
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3937 (goto-char (point-min))
28113
bfff8ed76f1c (completion-setup-function): Use display-color-p.
Dave Love <fx@gnu.org>
parents: 27836
diff changeset
3938 (if (display-mouse-p)
6160
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
3939 (insert (substitute-command-keys
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3940 "Click \\[mouse-choose-completion] on a completion to select it.\n")))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3941 (insert (substitute-command-keys
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
3942 "In this buffer, type \\[choose-completion] to \
23450
085606778286 (completion-fixup-function): Variable deleted.
Richard M. Stallman <rms@gnu.org>
parents: 23447
diff changeset
3943 select the completion near point.\n\n")))))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3944
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
3945 (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>
parents: 10252
diff changeset
3946
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3947 (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>
parents: 10252
diff changeset
3948 'switch-to-completions)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3949 (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>
parents: 10252
diff changeset
3950 'switch-to-completions)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3951 (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>
parents: 10252
diff changeset
3952 'switch-to-completions)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3953 (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>
parents: 10252
diff changeset
3954 'switch-to-completions)
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3955
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3956 (defun switch-to-completions ()
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3957 "Select the completion list window."
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
3958 (interactive)
12483
ec77cb3940f1 (switch-to-completions): Make a completions window if none.
Richard M. Stallman <rms@gnu.org>
parents: 12428
diff changeset
3959 ;; Make sure we have a completions window.
ec77cb3940f1 (switch-to-completions): Make a completions window if none.
Richard M. Stallman <rms@gnu.org>
parents: 12428
diff changeset
3960 (or (get-buffer-window "*Completions*")
ec77cb3940f1 (switch-to-completions): Make a completions window if none.
Richard M. Stallman <rms@gnu.org>
parents: 12428
diff changeset
3961 (minibuffer-completion-help))
20663
2483aa76b98d (switch-to-completions): If no completions window,
Karl Heuer <kwzh@gnu.org>
parents: 20510
diff changeset
3962 (let ((window (get-buffer-window "*Completions*")))
2483aa76b98d (switch-to-completions): If no completions window,
Karl Heuer <kwzh@gnu.org>
parents: 20510
diff changeset
3963 (when window
2483aa76b98d (switch-to-completions): If no completions window,
Karl Heuer <kwzh@gnu.org>
parents: 20510
diff changeset
3964 (select-window window)
2483aa76b98d (switch-to-completions): If no completions window,
Karl Heuer <kwzh@gnu.org>
parents: 20510
diff changeset
3965 (goto-char (point-min))
2483aa76b98d (switch-to-completions): If no completions window,
Karl Heuer <kwzh@gnu.org>
parents: 20510
diff changeset
3966 (search-forward "\n\n")
2483aa76b98d (switch-to-completions): If no completions window,
Karl Heuer <kwzh@gnu.org>
parents: 20510
diff changeset
3967 (forward-line 1))))
3947
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3968
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3969 ;; Support keyboard commands to turn on various modifiers.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3970
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3971 ;; These functions -- which are not commands -- each add one modifier
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3972 ;; to the following event.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3973
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3974 (defun event-apply-alt-modifier (ignore-prompt)
22324
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3975 "Add the Alt modifier to the following event.
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3976 For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3977 (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3978 (defun event-apply-super-modifier (ignore-prompt)
22324
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3979 "Add the Super modifier to the following event.
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3980 For example, type \\[event-apply-super-modifier] & to enter Super-&."
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3981 (vector (event-apply-modifier (read-event) 'super 23 "s-")))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3982 (defun event-apply-hyper-modifier (ignore-prompt)
22324
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3983 "Add the Hyper modifier to the following event.
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3984 For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3985 (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3986 (defun event-apply-shift-modifier (ignore-prompt)
22324
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3987 "Add the Shift modifier to the following event.
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3988 For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3989 (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3990 (defun event-apply-control-modifier (ignore-prompt)
22324
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3991 "Add the Ctrl modifier to the following event.
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3992 For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3993 (vector (event-apply-modifier (read-event) 'control 26 "C-")))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3994 (defun event-apply-meta-modifier (ignore-prompt)
22324
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3995 "Add the Meta modifier to the following event.
0c5b61cb97c0 (event-apply-alt-modifier, etc): Doc fixes.
Karl Heuer <kwzh@gnu.org>
parents: 22304
diff changeset
3996 For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3997 (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3998
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3999 (defun event-apply-modifier (event symbol lshiftby prefix)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4000 "Apply a modifier flag to event EVENT.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4001 SYMBOL is the name of this modifier, as a symbol.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4002 LSHIFTBY is the numeric value of this modifier, in keyboard events.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4003 PREFIX is the string that represents this modifier in an event type symbol."
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4004 (if (numberp event)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4005 (cond ((eq symbol 'control)
11201
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
4006 (if (and (<= (downcase event) ?z)
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
4007 (>= (downcase event) ?a))
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4008 (- (downcase event) ?a -1)
11201
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
4009 (if (and (<= (downcase event) ?Z)
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
4010 (>= (downcase event) ?A))
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4011 (- (downcase event) ?A -1)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4012 (logior (lsh 1 lshiftby) event))))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4013 ((eq symbol 'shift)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4014 (if (and (<= (downcase event) ?z)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4015 (>= (downcase event) ?a))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4016 (upcase event)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4017 (logior (lsh 1 lshiftby) event)))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4018 (t
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4019 (logior (lsh 1 lshiftby) event)))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4020 (if (memq symbol (event-modifiers event))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4021 event
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4022 (let ((event-type (if (symbolp event) event (car event))))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4023 (setq event-type (intern (concat prefix (symbol-name event-type))))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4024 (if (symbolp event)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4025 event-type
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4026 (cons event-type (cdr event)))))))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4027
11206
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
4028 (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
4029 (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
4030 (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
4031 (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
4032 (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
4033 (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
4034
3947
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4035 ;;;; Keypad support.
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4036
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4037 ;;; Make the keypad keys act like ordinary typing keys. If people add
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4038 ;;; bindings for the function key symbols, then those bindings will
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4039 ;;; override these, so this shouldn't interfere with any existing
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4040 ;;; bindings.
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4041
5342
f38861038093 (setting up kp-... keys): Make ascii-character props.
Richard M. Stallman <rms@gnu.org>
parents: 5324
diff changeset
4042 ;; Also tell read-char how to handle these keys.
3947
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4043 (mapcar
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4044 (lambda (keypad-normal)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4045 (let ((keypad (nth 0 keypad-normal))
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4046 (normal (nth 1 keypad-normal)))
5342
f38861038093 (setting up kp-... keys): Make ascii-character props.
Richard M. Stallman <rms@gnu.org>
parents: 5324
diff changeset
4047 (put keypad 'ascii-character normal)
3947
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4048 (define-key function-key-map (vector keypad) (vector normal))))
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4049 '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4050 (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4051 (kp-space ?\ )
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4052 (kp-tab ?\t)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4053 (kp-enter ?\r)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4054 (kp-multiply ?*)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4055 (kp-add ?+)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4056 (kp-separator ?,)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4057 (kp-subtract ?-)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4058 (kp-decimal ?.)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4059 (kp-divide ?/)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4060 (kp-equal ?=)))
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
4061
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
4062 ;;;;
26003
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4063 ;;;; forking a twin copy of a buffer.
26457
285ab8ddc125 * simple.el (backward-delete-char-untabify):
Sam Steingold <sds@gnu.org>
parents: 26356
diff changeset
4064 ;;;;
26003
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4065
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4066 (defvar clone-buffer-hook nil
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4067 "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>
parents: 25702
diff changeset
4068
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4069 (defun clone-process (process &optional newname)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4070 "Create a twin copy of PROCESS.
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4071 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>
parents: 25702
diff changeset
4072 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>
parents: 25702
diff changeset
4073 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>
parents: 25702
diff changeset
4074 with the current buffer instead.
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4075 Returns nil if PROCESS has already terminated."
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4076 (setq newname (or newname (process-name process)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4077 (if (string-match "<[0-9]+>\\'" newname)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4078 (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>
parents: 25702
diff changeset
4079 (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>
parents: 25702
diff changeset
4080 (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>
parents: 25702
diff changeset
4081 (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>
parents: 25702
diff changeset
4082 (new-process
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4083 (if (memq (process-status process) '(open))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4084 (apply 'open-network-stream newname
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4085 (if (process-buffer process) (current-buffer))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4086 (process-contact process))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4087 (apply 'start-process newname
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4088 (if (process-buffer process) (current-buffer))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4089 (process-command process)))))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4090 (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>
parents: 25702
diff changeset
4091 (process-kill-without-query process old-kwoq)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4092 (set-process-inherit-coding-system-flag
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4093 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>
parents: 25702
diff changeset
4094 (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>
parents: 25702
diff changeset
4095 (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>
parents: 25702
diff changeset
4096 new-process)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4097
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4098 ;; 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>
parents: 25702
diff changeset
4099 ;; - syntax-table
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4100 ;; - overlays
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4101 (defun clone-buffer (&optional newname display-flag)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4102 "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>
parents: 25702
diff changeset
4103 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>
parents: 25702
diff changeset
4104 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>
parents: 25702
diff changeset
4105
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4106 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>
parents: 25702
diff changeset
4107 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>
parents: 25702
diff changeset
4108 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>
parents: 25702
diff changeset
4109 (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>
parents: 25702
diff changeset
4110 t))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4111 (if buffer-file-name
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4112 (error "Cannot clone a file-visiting buffer"))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4113 (if (get major-mode 'no-clone)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4114 (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>
parents: 25702
diff changeset
4115 (setq newname (or newname (buffer-name)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4116 (if (string-match "<[0-9]+>\\'" newname)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4117 (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>
parents: 25702
diff changeset
4118 (let ((buf (current-buffer))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4119 (ptmin (point-min))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4120 (ptmax (point-max))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4121 (pt (point))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4122 (mk (if mark-active (mark t)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4123 (modified (buffer-modified-p))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4124 (mode major-mode)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4125 (lvars (buffer-local-variables))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4126 (process (get-buffer-process (current-buffer)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4127 (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>
parents: 25702
diff changeset
4128 (save-restriction
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4129 (widen)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4130 (with-current-buffer new
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4131 (insert-buffer-substring buf)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4132 (with-current-buffer new
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4133 (narrow-to-region ptmin ptmax)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4134 (goto-char pt)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4135 (if mk (set-mark mk))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4136 (set-buffer-modified-p modified)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4137
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4138 ;; 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>
parents: 25702
diff changeset
4139 (when process (clone-process process))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4140
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4141 ;; Now set up the major mode.
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4142 (funcall mode)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4143
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4144 ;; Set up other local variables.
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4145 (mapcar (lambda (v)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4146 (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>
parents: 25702
diff changeset
4147 (if (symbolp v)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4148 (makunbound v)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4149 (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>
parents: 25702
diff changeset
4150 (error nil)))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4151 lvars)
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4152
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4153 ;; 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>
parents: 25702
diff changeset
4154 ;; for cloning to work properly).
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4155 (run-hooks 'clone-buffer-hook))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4156 (if display-flag (pop-to-buffer new))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4157 new))
f6c190ef2f45 (shell-command, shell-command-on-region): use make-temp-file.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25702
diff changeset
4158
28193
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4159
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4160 ;;; Syntax stuff.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4161
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4162 (defconst syntax-code-table
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4163 '((?\ . 0)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4164 (?- . 0) ;whitespace
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4165 (?. . 1) ;punctuation
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4166 (?w . 2) ;word
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4167 (?_ . 3) ;symbol
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4168 (?\( . 4) ;open parenthesis
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4169 (?\) . 5) ;close parenthesis
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4170 (?\' . 6) ;expression prefix
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4171 (?\" . 7) ;string quote
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4172 (?$ . 8) ;paired delimiter
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4173 (?\\ . 9) ;escape
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4174 (?/ . 10) ;character quote
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4175 (?< . 11) ;comment start
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4176 (?> . 12) ;comment end
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4177 (?@ . 13) ;inherit
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4178 (nil . 14) ;comment fence
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4179 (nil . 15)) ;string fence
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4180 "Alist of pairs (CHAR . CODE) mapping characters to syntax codes.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4181 CHAR is a character that is allowed as first char in the string
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4182 specifying the syntax when calling `modify-syntax-entry'. CODE is the
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4183 corresponing syntax code as it is stored in a syntax cell, and
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4184 can be used as value of a `syntax-table' property..")
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4185
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4186 (defconst syntax-flag-table
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4187 '((?1 . #b10000000000000000)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4188 (?2 . #b100000000000000000)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4189 (?3 . #b1000000000000000000)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4190 (?4 . #b10000000000000000000)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4191 (?p . #b100000000000000000000)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4192 (?b . #b1000000000000000000000)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4193 (?n . #b10000000000000000000000))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4194 "Alist of pairs (CHAR . FLAG) mapping characters to syntax flags.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4195 CHAR is a character that is allowed as second or following character
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4196 in the string argument to `modify-syntax-entry' specifying the syntax.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4197 FLAG is the corresponding syntax flag value that is stored in a
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4198 syntax table.")
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4199
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4200 (defun string-to-syntax (string)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4201 "Convert a syntax specification STRING into syntax cell form.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4202 STRING should be a string as it is allowed as argument of
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4203 `modify-syntax-entry'. Value is the equivalent cons cell
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4204 \(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4205 text property."
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4206 (let* ((first-char (aref string 0))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4207 (code (or (cdr (assq first-char syntax-code-table))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4208 (error "Invalid syntax specification `%s'" string)))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4209 (length (length string))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4210 (i 1)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4211 matching-char)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4212 ;; Determine the matching character, if any.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4213 (when (and (> length 1)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4214 (memq first-char '(?\( ?\))))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4215 (setq matching-char (aref string i)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4216 i (1+ i)))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4217 ;; Add any flags to the syntax code.
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4218 (while (< i length)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4219 (let ((flag (or (assq (aref string i) syntax-flag-table)
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4220 (error "Invalid syntax flag in `%s'" string))))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4221 (setq code (logior flag code))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4222 (setq i (1+ i))))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4223
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4224 (cons code matching-char)))
89fb4e786f9c (syntax-code-table, syntax-flag-table): New variables.
Gerd Moellmann <gerd@gnu.org>
parents: 28187
diff changeset
4225
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
4226 ;;; simple.el ends here