annotate lisp/simple.el @ 12546:f4fb791df099

(Fx_list_fonts): Don't free thisinfo if it is 0.
author Karl Heuer <kwzh@gnu.org>
date Mon, 17 Jul 1995 22:25:39 +0000
parents ec77cb3940f1
children c0a5d0d00c18
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
11235
e6bdaaa6ce1b Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 11206
diff changeset
3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5 ;; This file is part of GNU Emacs.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 ;; 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
9 ;; the Free Software Foundation; either version 2, or (at your option)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 ;; any later version.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 ;; GNU Emacs is distributed in the hope that it will be useful,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 ;; GNU General Public License for more details.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 ;; You should have received a copy of the GNU General Public License
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
2315
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
21 ;;; Commentary:
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
22
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
23 ;; 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
24 ;; major mode or to file-handling.
9e7ec92a4fdf Added or corrected Commentary headers
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2301
diff changeset
25
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
26 ;;; Code:
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
28 (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
29 "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
30 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
31 With arg, insert that many newlines.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
32 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
33 (interactive "*P")
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
34 ;; 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
35 ;; 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
36 ;; 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
37 ;; the end of the previous line.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
38 (let ((flag (and (not (bobp))
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
39 (bolp)
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
40 (< (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
41 (- (point) 2))))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
42 (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
43 (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
44 (beforepos (point)))
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
45 (if flag (backward-char 1))
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
46 ;; 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
47 ;; 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
48 (let ((last-command-char ?\n)
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
49 ;; 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
50 ;; 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
51 ;; 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
52 (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
53 (unwind-protect
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
54 (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
55 ;; 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
56 (if flag (forward-char 1))))
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
57 ;; If we did *not* get an error, cancel that forward-char.
9e7727cdbb68 (newline): Put point at right place if insert gets error.
Richard M. Stallman <rms@gnu.org>
parents: 12355
diff changeset
58 (if flag (backward-char 1))
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
59 ;; Mark the newline(s) `hard'.
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
60 (if use-hard-newlines
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
61 (let* ((from (- (point) (if arg (prefix-numeric-value arg) 1)))
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
62 (sticky (get-text-property from 'rear-nonsticky)))
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
63 (put-text-property from (point) 'hard 't)
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
64 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
65 (if (and (listp sticky) (not (memq 'hard sticky)))
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
66 (put-text-property from (point) 'rear-nonsticky
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
67 (cons 'hard sticky)))))
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
68 ;; 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
69 ;; 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
70 (or flag
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
71 (save-excursion
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
72 (goto-char beforepos)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
73 (beginning-of-line)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
74 (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
75 (> (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
76 (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
77 (if flag (forward-char 1))
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
78 ;; 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
79 ;; 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
80 ;; 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
81 (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
82 (move-to-left-margin nil t)))
10863
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
83 nil)
8e6b25e41a99 (newline): Moved from cmds.c. Indents last
Boris Goldowsky <boris@gnu.org>
parents: 10854
diff changeset
84
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 (defun open-line (arg)
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
86 "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
87 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
88 if the line would have been blank.
1063
25b929c06f83 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
89 With arg N, insert N newlines."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 (interactive "*p")
1063
25b929c06f83 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
91 (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
92 (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
93 (loc (point)))
11324
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
94 (newline arg)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
95 (goto-char loc)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
96 (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
97 (cond ((bolp)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
98 (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
99 (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
100 (forward-line 1)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
101 (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
102 (goto-char loc)
3190c85854b6 (newline): Don't indent afterward if at page sep line.
Richard M. Stallman <rms@gnu.org>
parents: 11318
diff changeset
103 (end-of-line)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 (defun split-line ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 "Split current line, moving portion beyond point vertically down."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 (skip-chars-forward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 (let ((col (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 (pos (point)))
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
111 (newline 1)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 (indent-to col 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 (goto-char pos)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 (defun quoted-insert (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 "Read next input character and insert it.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
117 This is useful for inserting control characters.
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1812
diff changeset
118 You may also type up to 3 octal digits, to insert a character with that code.
2215
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
119
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
120 In overwrite mode, this function inserts the character anyway, and
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
121 does not handle octal digits specially. This means that if you use
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
122 overwrite as your normal editing mode, you can use this function to
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
123 insert characters when necessary.
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
124
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
125 In binary overwrite mode, this function does overwrite, and octal
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
126 digits are interpreted as a character code. This is supposed to make
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
127 this function useful in editing binary files."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128 (interactive "*p")
2215
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
129 (let ((char (if (or (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
130 (eq overwrite-mode '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
131 (read-quoted-char)
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
132 (read-char))))
10779
7d9423ce104d (quoted-insert): Use insert-and-inherit.
Richard M. Stallman <rms@gnu.org>
parents: 10722
diff changeset
133 (if (> arg 0)
7d9423ce104d (quoted-insert): Use insert-and-inherit.
Richard M. Stallman <rms@gnu.org>
parents: 10722
diff changeset
134 (if (eq overwrite-mode 'overwrite-mode-binary)
7d9423ce104d (quoted-insert): Use insert-and-inherit.
Richard M. Stallman <rms@gnu.org>
parents: 10722
diff changeset
135 (delete-char arg)))
7d9423ce104d (quoted-insert): Use insert-and-inherit.
Richard M. Stallman <rms@gnu.org>
parents: 10722
diff changeset
136 (while (> arg 0)
7d9423ce104d (quoted-insert): Use insert-and-inherit.
Richard M. Stallman <rms@gnu.org>
parents: 10722
diff changeset
137 (insert-and-inherit char)
7d9423ce104d (quoted-insert): Use insert-and-inherit.
Richard M. Stallman <rms@gnu.org>
parents: 10722
diff changeset
138 (setq arg (1- arg)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 (defun delete-indentation (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 "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
142 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
143 With argument, join this line to following line."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 (interactive "*P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 (if arg (forward-line 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 (if (eq (preceding-char) ?\n)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 (delete-region (point) (1- (point)))
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
150 ;; If the second line started with the fill prefix,
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
151 ;; delete the prefix.
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
152 (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
153 (<= (+ (point) (length fill-prefix)) (point-max))
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
154 (string= fill-prefix
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
155 (buffer-substring (point)
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
156 (+ (point) (length fill-prefix)))))
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
157 (delete-region (point) (+ (point) (length fill-prefix))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 (fixup-whitespace))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 (defun fixup-whitespace ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 "Fixup white space between objects around point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162 Leave one space or none, according to the context."
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 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 (delete-horizontal-space)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166 (if (or (looking-at "^\\|\\s)")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 (save-excursion (forward-char -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 (looking-at "$\\|\\s(\\|\\s'")))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169 nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 (insert ?\ ))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 (defun delete-horizontal-space ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 "Delete all spaces and tabs around point."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 (defun just-one-space ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179 "Delete all spaces and tabs around point, leaving one space."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 (if (= (following-char) ? )
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 (forward-char 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 (insert ? ))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 (defun delete-blank-lines ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188 "On blank line, delete all surrounding blank lines, leaving just one.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 On isolated blank line, delete that one.
7817
d729f75fff04 (delete-blank-lines): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7762
diff changeset
190 On nonblank line, delete any immediately following blank lines."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191 (interactive "*")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
192 (let (thisblank singleblank)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 (setq thisblank (looking-at "[ \t]*$"))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
196 ;; Set singleblank if there is just one blank line here.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 (setq singleblank
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 (and thisblank
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
199 (not (looking-at "[ \t]*\n[ \t]*$"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
200 (or (bobp)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
201 (progn (forward-line -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202 (not (looking-at "[ \t]*$")))))))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
203 ;; 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
204 (if thisblank
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
205 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
206 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207 (if singleblank (forward-line 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
208 (delete-region (point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
209 (if (re-search-backward "[^ \t\n]" nil t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210 (progn (forward-line 1) (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211 (point-min)))))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
212 ;; Delete following blank lines, unless the current line is blank
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
213 ;; and there are no following blank lines.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 (if (not (and thisblank singleblank))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217 (forward-line 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
218 (delete-region (point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
219 (if (re-search-forward "[^ \t\n]" nil t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220 (progn (beginning-of-line) (point))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
221 (point-max)))))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
222 ;; 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
223 ;; Delete the line, leaving point at eob.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
224 (if (looking-at "^[ \t]*\n\\'")
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
225 (delete-region (point) (point-max)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 (defun back-to-indentation ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 "Move point to the first non-whitespace character on this line."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230 (beginning-of-line 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231 (skip-chars-forward " \t"))
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))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
257
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
258 ;; Internal subroutine of delete-char
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
259 (defun kill-forward-chars (arg)
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
260 (if (listp arg) (setq arg (car arg)))
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
261 (if (eq arg '-) (setq arg -1))
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
262 (kill-region (point) (+ (point) arg)))
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
263
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
264 ;; Internal subroutine of backward-delete-char
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
265 (defun kill-backward-chars (arg)
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
266 (if (listp arg) (setq arg (car arg)))
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
267 (if (eq arg '-) (setq arg -1))
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
268 (kill-region (point) (- (point) arg)))
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
269
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
270 (defun backward-delete-char-untabify (arg &optional killp)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271 "Delete characters backward, changing tabs into spaces.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
272 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
273 Interactively, ARG is the prefix arg (default 1)
8600
0c56de09028d (backward-delete-char-untabify): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8559
diff changeset
274 and KILLP is t if a prefix arg was specified."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
275 (interactive "*p\nP")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
276 (let ((count arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
277 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278 (while (and (> count 0) (not (bobp)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279 (if (= (preceding-char) ?\t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 (let ((col (current-column)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 (forward-char -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 (setq col (- col (current-column)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283 (insert-char ?\ col)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284 (delete-char 1)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285 (forward-char -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 (setq count (1- count)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 (delete-backward-char arg killp)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288 ;; In overwrite mode, back over columns while clearing them out,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 ;; unless at end of line.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 (and overwrite-mode (not (eolp))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 (save-excursion (insert-char ?\ arg))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293 (defun zap-to-char (arg char)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 "Kill up to and including ARG'th occurrence of CHAR.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 Goes backward if ARG is negative; error if CHAR not found."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 (interactive "p\ncZap to char: ")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
297 (kill-region (point) (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 (search-forward (char-to-string char) nil nil arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
299 ; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300 (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302 (defun beginning-of-buffer (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303 "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
304 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
305
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
306 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
307 of the accessible part of the buffer.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
308
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
309 Don't use this command in Lisp programs!
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 \(goto-char (point-min)) is faster and avoids clobbering the mark."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 (push-mark)
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
313 (let ((size (- (point-max) (point-min))))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
314 (goto-char (if arg
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
315 (+ (point-min)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
316 (if (> size 10000)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
317 ;; Avoid overflow for large buffer sizes!
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
318 (* (prefix-numeric-value arg)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
319 (/ size 10))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
320 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
321 (point-min))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
322 (if arg (forward-line 1)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
323
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
324 (defun end-of-buffer (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
325 "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
326 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
327
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
328 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
329 of the accessible part of the buffer.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
330
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
331 Don't use this command in Lisp programs!
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
332 \(goto-char (point-max)) is faster and avoids clobbering the mark."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
333 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
334 (push-mark)
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
335 (let ((size (- (point-max) (point-min))))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
336 (goto-char (if arg
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
337 (- (point-max)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
338 (if (> size 10000)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
339 ;; Avoid overflow for large buffer sizes!
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
340 (* (prefix-numeric-value arg)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
341 (/ size 10))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
342 (/ (* size (prefix-numeric-value arg)) 10)))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
343 (point-max))))
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
344 ;; 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
345 ;; adjust it to the beginning of a line.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
346 (if arg (forward-line 1)
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
347 ;; If the end of the buffer is not already on the screen,
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
348 ;; then scroll specially to put it near, but not at, the bottom.
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
349 (if (let ((old-point (point)))
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
350 (save-excursion
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
351 (goto-char (window-start))
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
352 (vertical-motion (window-height))
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
353 (< (point) old-point)))
7877
0eb805c768af (end-of-buffer): Recenter overlay lists.
Richard M. Stallman <rms@gnu.org>
parents: 7817
diff changeset
354 (progn
0eb805c768af (end-of-buffer): Recenter overlay lists.
Richard M. Stallman <rms@gnu.org>
parents: 7817
diff changeset
355 (overlay-recenter (point))
0eb805c768af (end-of-buffer): Recenter overlay lists.
Richard M. Stallman <rms@gnu.org>
parents: 7817
diff changeset
356 (recenter -3)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 (defun mark-whole-buffer ()
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
359 "Put point at beginning and mark at end of buffer.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
360 You probably should not use this function in Lisp programs;
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
361 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
362 that uses or sets the mark."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
363 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
364 (push-mark (point))
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
365 (push-mark (point-max) nil t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
366 (goto-char (point-min)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 (defun count-lines-region (start end)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3487
diff changeset
369 "Print number of lines and characters in the region."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 (interactive "r")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 (message "Region has %d lines, %d characters"
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372 (count-lines start end) (- end start)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
373
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
374 (defun what-line ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
375 "Print the current line number (in the buffer) of point."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
376 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 (save-restriction
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 (widen)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 (message "Line %d"
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 (1+ (count-lines 1 (point)))))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 (defun count-lines (start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385 "Return number of lines between START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
386 This is usually the number of newlines between them,
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
387 but can be one more if START is not equal to END
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
388 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
389 (save-excursion
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
390 (save-restriction
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
391 (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
392 (goto-char (point-min))
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
393 (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
394 (save-match-data
2421
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
395 (let ((done 0))
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
396 (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
397 (setq done (+ 40 done)))
eb9815e0a71d (count-lines): Use save-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 2416
diff changeset
398 (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
399 (setq done (+ 1 done)))
5151
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
400 (goto-char (point-max))
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
401 (if (and (/= start end)
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
402 (not (bolp)))
8b31cff02267 (count-lines): In selective-display case,
Richard M. Stallman <rms@gnu.org>
parents: 5135
diff changeset
403 (1+ done)
9554
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
404 done)))
d3f3f3db986d (count-lines): Do save-match-data only when necessary.
Richard M. Stallman <rms@gnu.org>
parents: 9539
diff changeset
405 (- (buffer-size) (forward-line (buffer-size)))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
406
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
407 (defun what-cursor-position ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
408 "Print info on cursor position (on screen and within buffer)."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
409 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
410 (let* ((char (following-char))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
411 (beg (point-min))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
412 (end (point-max))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
413 (pos (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
414 (total (buffer-size))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
415 (percent (if (> total 50000)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416 ;; Avoid overflow from multiplying by 100!
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
417 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
418 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
419 (hscroll (if (= (window-hscroll) 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
420 ""
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
421 (format " Hscroll=%d" (window-hscroll))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
422 (col (current-column)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
423 (if (= pos end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 (if (or (/= beg 1) (/= end (1+ total)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 pos total percent beg end col hscroll)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 (message "point=%d of %d(%d%%) column %d %s"
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 pos total percent col hscroll))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 (if (or (/= beg 1) (/= end (1+ total)))
10352
cc26982277e4 (what-cursor-position): Show char in decimal, hex, octal.
Richard M. Stallman <rms@gnu.org>
parents: 10351
diff changeset
430 (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s"
cc26982277e4 (what-cursor-position): Show char in decimal, hex, octal.
Richard M. Stallman <rms@gnu.org>
parents: 10351
diff changeset
431 (single-key-description char) char char char pos total percent beg end col hscroll)
cc26982277e4 (what-cursor-position): Show char in decimal, hex, octal.
Richard M. Stallman <rms@gnu.org>
parents: 10351
diff changeset
432 (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s"
cc26982277e4 (what-cursor-position): Show char in decimal, hex, octal.
Richard M. Stallman <rms@gnu.org>
parents: 10351
diff changeset
433 (single-key-description char) char char char pos total percent col hscroll)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
435 (defun fundamental-mode ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
436 "Major mode not specialized for anything in particular.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 Other major modes are defined by comparison with this one."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
439 (kill-all-local-variables))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440
4894
1574c6c6561f (eval-expression): Fix typo: missing paren.
Roland McGrath <roland@gnu.org>
parents: 4886
diff changeset
441 (defvar read-expression-map (cons 'keymap minibuffer-local-map)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
442 "Minibuffer keymap used for reading Lisp expressions.")
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
443 (define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
444
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445 (put 'eval-expression 'disabled t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
446
4289
4d0c57f01eed (read-expression-history): New defvar.
Roland McGrath <roland@gnu.org>
parents: 4287
diff changeset
447 (defvar read-expression-history nil)
4d0c57f01eed (read-expression-history): New defvar.
Roland McGrath <roland@gnu.org>
parents: 4287
diff changeset
448
4d0c57f01eed (read-expression-history): New defvar.
Roland McGrath <roland@gnu.org>
parents: 4287
diff changeset
449 ;; We define this, rather than making `eval' interactive,
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
450 ;; for the sake of completion of names like eval-region, eval-current-buffer.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 (defun eval-expression (expression)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452 "Evaluate EXPRESSION and print value in minibuffer.
954
9e51bb887797 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 921
diff changeset
453 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
454 (interactive
5068
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
455 (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
456 nil read-expression-map t
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
457 'read-expression-history)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458 (setq values (cons (eval expression) values))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
459 (prin1 (car values) t))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
460
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461 (defun edit-and-eval-command (prompt command)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
462 "Prompting with PROMPT, let user edit COMMAND and eval result.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
463 COMMAND is a Lisp expression. Let user edit that expression in
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 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
465 (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
466 (prin1-to-string command)
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
467 read-expression-map t
9a42f23df119 (eval-expression): Don't bind minibuffer-history-sexp-flag.
Richard M. Stallman <rms@gnu.org>
parents: 4894
diff changeset
468 '(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
469 ;; If command was added to command-history as a string,
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
470 ;; get rid of that. We want only evallable expressions there.
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
471 (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
472 (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
473
53e092e189c6 (edit-and-eval-command): Elements of command-history are forms, not strings.
Karl Heuer <kwzh@gnu.org>
parents: 9554
diff changeset
474 ;; 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
475 ;; 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
476 (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
477 (setq command-history (cons command command-history)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 (eval command)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
479
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
480 (defun repeat-complex-command (arg)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
481 "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
482 A complex command is one which used the minibuffer.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
483 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
484 The result is executed, repeating the command as changed.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
485 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
486 it is added to the front of the command history.
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
487 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
488 to get different commands to edit and resubmit."
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
489 (interactive "p")
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
490 (let ((elt (nth (1- arg) command-history))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
491 (minibuffer-history-position arg)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
492 (minibuffer-history-sexp-flag t)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
493 newcmd)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
494 (if elt
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
495 (progn
4821
2c16f99ef5dc (edit-and-eval-command): Let `read-from-minibuffer' manipulate the
Brian Fox <bfox@gnu.org>
parents: 4765
diff changeset
496 (setq newcmd
8734
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
497 (let ((print-level nil))
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
498 (read-from-minibuffer
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
499 "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
500 (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
501
5135
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
502 ;; If command was added to command-history as a string,
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
503 ;; get rid of that. We want only evallable expressions there.
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
504 (if (stringp (car command-history))
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
505 (setq command-history (cdr command-history)))
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
506
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
507 ;; 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
508 ;; add it to the history.
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
509 (or (equal newcmd (car command-history))
b8731641d26a (repeat-complex-command): Undo Oct 2 change.
Richard M. Stallman <rms@gnu.org>
parents: 5068
diff changeset
510 (setq command-history (cons newcmd command-history)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
511 (eval newcmd))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
512 (ding))))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
513
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
514 (defvar minibuffer-history nil
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
515 "Default minibuffer history list.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
516 This is used for all minibuffer input
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
517 except when an alternate history list is specified.")
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
518 (defvar minibuffer-history-sexp-flag nil
7373
451602bf12e4 (minibuffer-history-sexp-flag): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 7333
diff changeset
519 "Non-nil when doing history operations on `command-history'.
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
520 More generally, indicates that the history list being acted on
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
521 contains expressions rather than strings.")
862
46630543d659 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 859
diff changeset
522 (setq minibuffer-history-variable 'minibuffer-history)
46630543d659 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 859
diff changeset
523 (setq minibuffer-history-position nil)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
524 (defvar minibuffer-history-search-history nil)
858
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
525
921
c5c4c2ee8f26 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 892
diff changeset
526 (mapcar
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
527 (lambda (key-and-command)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
528 (mapcar
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
529 (lambda (keymap-and-completionp)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
530 ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
531 ;; 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
532 ;; 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
533 (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
534 (car key-and-command)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
535 (let ((command (cdr key-and-command)))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
536 (if (consp command)
1826
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
537 ;; (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
538 ;; 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
539 ;; 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
540 (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
541 (progn (error "EMACS BUG!") (cdr command))
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
542 (car command))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
543 command))))
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
544 '((minibuffer-local-map . nil)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
545 (minibuffer-local-ns-map . nil)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
546 (minibuffer-local-completion-map . t)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
547 (minibuffer-local-must-match-map . t)
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
548 (read-expression-map . nil))))
1838
34da3c151be4 Restore nuked information in minibuffer history bindings.
Roland McGrath <roland@gnu.org>
parents: 1837
diff changeset
549 '(("\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
550 ([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
551 ("\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
552 ([prior] . (previous-history-element . previous-complete-history-element))
921
c5c4c2ee8f26 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 892
diff changeset
553 ("\er" . previous-matching-history-element)
c5c4c2ee8f26 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 892
diff changeset
554 ("\es" . next-matching-history-element)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
555
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
556 (defun previous-matching-history-element (regexp n)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
557 "Find the previous history element that matches REGEXP.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
558 \(Previous history elements refer to earlier actions.)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
559 With prefix argument N, search for Nth previous match.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
560 If N is negative, find the next or Nth next match."
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
561 (interactive
2681
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
562 (let* ((enable-recursive-minibuffers t)
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
563 (minibuffer-history-sexp-flag nil)
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
564 (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
565 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
566 minibuffer-local-map
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
567 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
568 'minibuffer-history-search-history)))
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
569 ;; 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
570 (list (if (string= regexp "")
11961
b5efbe330c86 (previous-matching-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 11572
diff changeset
571 (if minibuffer-history-search-history
b5efbe330c86 (previous-matching-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 11572
diff changeset
572 (car minibuffer-history-search-history)
b5efbe330c86 (previous-matching-history-element):
Karl Heuer <kwzh@gnu.org>
parents: 11572
diff changeset
573 (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
574 regexp)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
575 (prefix-numeric-value current-prefix-arg))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
576 (let ((history (symbol-value minibuffer-history-variable))
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
577 prevpos
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
578 (pos minibuffer-history-position))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
579 (while (/= n 0)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
580 (setq prevpos pos)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
581 (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
582 (if (= pos prevpos)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
583 (error (if (= pos 1)
892
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
584 "No later matching history item"
3a9943a4a440 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 874
diff changeset
585 "No earlier matching history item")))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
586 (if (string-match regexp
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
587 (if minibuffer-history-sexp-flag
8734
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
588 (let ((print-level nil))
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
589 (prin1-to-string (nth (1- pos) history)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
590 (nth (1- pos) history)))
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
591 (setq n (+ n (if (< n 0) 1 -1)))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
592 (setq minibuffer-history-position pos)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
593 (erase-buffer)
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
594 (let ((elt (nth (1- pos) history)))
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
595 (insert (if minibuffer-history-sexp-flag
8734
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
596 (let ((print-level nil))
bd55f44d82f1 (repeat-complex-command, next-history-element,
Richard M. Stallman <rms@gnu.org>
parents: 8695
diff changeset
597 (prin1-to-string elt))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
598 elt)))
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
599 (goto-char (point-min)))
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
600 (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
601 (eq (car (car command-history)) 'next-matching-history-element))
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
602 (setq command-history (cdr command-history))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
603
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
604 (defun next-matching-history-element (regexp n)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
605 "Find the next history element that matches REGEXP.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
606 \(The next history element refers to a more recent action.)
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
607 With prefix argument N, search for Nth next match.
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
608 If N is negative, find the previous or Nth previous match."
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
609 (interactive
2681
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
610 (let* ((enable-recursive-minibuffers t)
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
611 (minibuffer-history-sexp-flag nil)
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
612 (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
613 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
614 minibuffer-local-map
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
615 nil
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
616 'minibuffer-history-search-history)))
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
617 ;; 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
618 (list (if (string= regexp "")
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
619 (setcar minibuffer-history-search-history
9ebd08f578f0 (previous-matching-history-element): If minibuf is empty,
Richard M. Stallman <rms@gnu.org>
parents: 2669
diff changeset
620 (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
621 regexp)
1135
e33f6475229a *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1063
diff changeset
622 (prefix-numeric-value current-prefix-arg))))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
623 (previous-matching-history-element regexp (- n)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
624
858
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
625 (defun next-history-element (n)
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
626 "Insert the next element of the minibuffer history into the minibuffer."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
627 (interactive "p")
10722
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
628 (or (zerop n)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
629 (let ((narg (min (max 1 (- minibuffer-history-position n))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
630 (length (symbol-value minibuffer-history-variable)))))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
631 (if (or (zerop narg)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
632 (= minibuffer-history-position narg))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
633 (error (if (if (zerop narg)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
634 (> n 0)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
635 (= minibuffer-history-position 1))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
636 "End of history; no next item"
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
637 "Beginning of history; no preceding item"))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
638 (erase-buffer)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
639 (setq minibuffer-history-position narg)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
640 (let ((elt (nth (1- minibuffer-history-position)
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
641 (symbol-value minibuffer-history-variable))))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
642 (insert
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
643 (if minibuffer-history-sexp-flag
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
644 (let ((print-level nil))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
645 (prin1-to-string elt))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
646 elt)))
8ba6f9709cff (next-history-element): Do nothing if n is 0.
Richard M. Stallman <rms@gnu.org>
parents: 10597
diff changeset
647 (goto-char (point-min))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
648
858
b11800dc877d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 846
diff changeset
649 (defun previous-history-element (n)
1145
e6cefcaba564 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1135
diff changeset
650 "Inserts the previous element of the minibuffer history into the minibuffer."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
651 (interactive "p")
859
5f325fbc093d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 858
diff changeset
652 (next-history-element (- n)))
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
653
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
654 (defun next-complete-history-element (n)
5324
f091cdec77e2 (next-complete-history-element): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5151
diff changeset
655 "Get next element of history which is a completion of minibuffer contents."
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
656 (interactive "p")
1826
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
657 (let ((point-at-start (point)))
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
658 (next-matching-history-element
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
659 (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
6ca05c5f8979 (next-complete-history-element): Restore point after replacing the
Roland McGrath <roland@gnu.org>
parents: 1824
diff changeset
660 ;; 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
661 ;; 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
662 ;; 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
663 (goto-char point-at-start)))
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
664
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
665 (defun previous-complete-history-element (n)
5324
f091cdec77e2 (next-complete-history-element): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5151
diff changeset
666 "\
f091cdec77e2 (next-complete-history-element): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5151
diff changeset
667 Get previous element of history which is a completion of minibuffer contents."
1811
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
668 (interactive "p")
3e4f8b1da4e9 ({next,previous}-complete-history-element): New functions.
Roland McGrath <roland@gnu.org>
parents: 1771
diff changeset
669 (next-complete-history-element (- n)))
874
b945f592b94d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 870
diff changeset
670
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
671 (defun goto-line (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
672 "Goto line ARG, counting from line 1 at beginning of buffer."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
673 (interactive "NGoto line: ")
9343
ee9866892683 (goto-line): Call prefix-numeric-value.
Richard M. Stallman <rms@gnu.org>
parents: 9065
diff changeset
674 (setq arg (prefix-numeric-value arg))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
675 (save-restriction
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
676 (widen)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
677 (goto-char 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
678 (if (eq selective-display t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
679 (re-search-forward "[\n\C-m]" nil 'end (1- arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
680 (forward-line (1- arg)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
681
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
682 ;Put this on C-x u, so we can force that rather than C-_ into startup msg
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
683 (define-function 'advertised-undo 'undo)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
684
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
685 (defun undo (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
686 "Undo some previous changes.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
687 Repeat this command to undo more changes.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
688 A numeric argument serves as a repeat count."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
689 (interactive "*p")
5935
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
690 ;; 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
691 ;; for the following command.
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
692 (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
693 (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
694 (recent-save (recent-auto-save-p)))
582
a9c4bc19b2aa *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 513
diff changeset
695 (or (eq (selected-window) (minibuffer-window))
a9c4bc19b2aa *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 513
diff changeset
696 (message "Undo!"))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
697 (or (eq last-command 'undo)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
698 (progn (undo-start)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
699 (undo-more 1)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
700 (undo-more (or arg 1))
6386
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
701 ;; 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
702 ;; 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
703 (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
704 done)
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
705 (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
706 (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
707 (progn
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
708 (setq done t)
1eabdff45c61 (undo): Don't let the undo entries for the undo
Richard M. Stallman <rms@gnu.org>
parents: 6237
diff changeset
709 (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
710 (setq tail (cdr tail))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
711 (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
712 (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
713 ;; 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
714 (setq this-command 'undo))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
715
2947
518509536741 (pending-undo-list): Var declared.
Richard M. Stallman <rms@gnu.org>
parents: 2935
diff changeset
716 (defvar pending-undo-list nil
518509536741 (pending-undo-list): Var declared.
Richard M. Stallman <rms@gnu.org>
parents: 2935
diff changeset
717 "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
718
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
719 (defun undo-start ()
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
720 "Set `pending-undo-list' to the front of the undo list.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
721 The next call to `undo-more' will undo the most recently made change."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
722 (if (eq buffer-undo-list t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
723 (error "No undo information in this buffer"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
724 (setq pending-undo-list buffer-undo-list))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
725
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
726 (defun undo-more (count)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
727 "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
728 Call `undo-start' to get ready to undo recent changes,
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
729 then call `undo-more' one or more times to undo them."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
730 (or pending-undo-list
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
731 (error "No further undo information"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
732 (setq pending-undo-list (primitive-undo count pending-undo-list)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
733
4374
1a64d641cea4 (shell-command-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 4289
diff changeset
734 (defvar shell-command-history nil
1a64d641cea4 (shell-command-history): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 4289
diff changeset
735 "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
736
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
737 (defvar shell-command-switch "-c"
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
738 "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
739
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
740 (defun shell-command (command &optional output-buffer)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
741 "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
742
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
743 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
744 The output appears in the buffer `*Async Shell Command*'.
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
745
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
746 Otherwise, COMMAND is executed synchronously. The output appears
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
747 in the buffer `*Shell Command Output*'.
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
748 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
749 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
750 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
751 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
752 then `*Shell Command Output*' is deleted.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
753
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
754 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
755 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
756 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
757 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
758 insert output in current buffer. (This cannot be done asynchronously.)
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
759 In either case, the output is inserted after point (leaving mark after it)."
4488
b0a70d8d9af4 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 4477
diff changeset
760 (interactive (list (read-from-minibuffer "Shell command: "
b0a70d8d9af4 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 4477
diff changeset
761 nil nil nil 'shell-command-history)
b0a70d8d9af4 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 4477
diff changeset
762 current-prefix-arg))
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
763 (if (and output-buffer
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
764 (not (or (bufferp output-buffer) (stringp output-buffer))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
765 (progn (barf-if-buffer-read-only)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
766 (push-mark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
767 ;; We do not use -f for csh; we will not support broken use of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
768 ;; .cshrcs. Even the BSD csh manual says to use
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
769 ;; "if ($?prompt) exit" before things which are not useful
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
770 ;; non-interactively. Besides, if someone wants their other
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
771 ;; aliases for shell commands then they can still have them.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
772 (call-process shell-file-name nil t nil
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
773 shell-command-switch command)
3029
2bf7bd92bd43 (shell-command): Don't activate mark even momentarily.
Richard M. Stallman <rms@gnu.org>
parents: 2947
diff changeset
774 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
2bf7bd92bd43 (shell-command): Don't activate mark even momentarily.
Richard M. Stallman <rms@gnu.org>
parents: 2947
diff changeset
775 ;; It is cleaner to avoid activation, even though the command
2bf7bd92bd43 (shell-command): Don't activate mark even momentarily.
Richard M. Stallman <rms@gnu.org>
parents: 2947
diff changeset
776 ;; loop would deactivate the mark because we inserted text.
2bf7bd92bd43 (shell-command): Don't activate mark even momentarily.
Richard M. Stallman <rms@gnu.org>
parents: 2947
diff changeset
777 (goto-char (prog1 (mark t)
2bf7bd92bd43 (shell-command): Don't activate mark even momentarily.
Richard M. Stallman <rms@gnu.org>
parents: 2947
diff changeset
778 (set-marker (mark-marker) (point)
2bf7bd92bd43 (shell-command): Don't activate mark even momentarily.
Richard M. Stallman <rms@gnu.org>
parents: 2947
diff changeset
779 (current-buffer)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
780 ;; Preserve the match data in case called from a program.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
781 (let ((data (match-data)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
782 (unwind-protect
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
783 (if (string-match "[ \t]*&[ \t]*$" command)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
784 ;; Command ending with ampersand means asynchronous.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
785 (let ((buffer (get-buffer-create
11072
c5fbb6f272f2 (shell-command): Use *Async Shell Command* for
Richard M. Stallman <rms@gnu.org>
parents: 11036
diff changeset
786 (or output-buffer "*Asynch Shell Command*")))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
787 (directory default-directory)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
788 proc)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
789 ;; Remove the ampersand.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
790 (setq command (substring command 0 (match-beginning 0)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
791 ;; If will kill a process, query first.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
792 (setq proc (get-buffer-process buffer))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
793 (if proc
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
794 (if (yes-or-no-p "A command is running. Kill it? ")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
795 (kill-process proc)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
796 (error "Shell command in progress")))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
797 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
798 (set-buffer buffer)
9065
e321617e3fc6 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 8998
diff changeset
799 (setq buffer-read-only nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
800 (erase-buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
801 (display-buffer buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
802 (setq default-directory directory)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
803 (setq proc (start-process "Shell" buffer
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
804 shell-file-name
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
805 shell-command-switch command))
7076
3497b7f6f0e7 (shell-command): Remove space after `:' in mode-line-process.
Richard M. Stallman <rms@gnu.org>
parents: 7063
diff changeset
806 (setq mode-line-process '(":%s"))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
807 (set-process-sentinel proc 'shell-command-sentinel)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
808 (set-process-filter proc 'shell-command-filter)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
809 ))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
810 (shell-command-on-region (point) (point) command nil))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
811 (store-match-data data)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
812
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
813 ;; We have a sentinel to prevent insertion of a termination message
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
814 ;; in the buffer itself.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
815 (defun shell-command-sentinel (process signal)
6949
319678b541eb (shell-command-sentinel): Do nothing if buffer is dead.
Richard M. Stallman <rms@gnu.org>
parents: 6943
diff changeset
816 (if (and (memq (process-status process) '(exit signal))
319678b541eb (shell-command-sentinel): Do nothing if buffer is dead.
Richard M. Stallman <rms@gnu.org>
parents: 6943
diff changeset
817 (buffer-name (process-buffer process)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
818 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
819 (message "%s: %s."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
820 (car (cdr (cdr (process-command process))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
821 (substring signal 0 -1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
822 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
823 (set-buffer (process-buffer process))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
824 (setq mode-line-process nil))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
825 (delete-process process))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
826
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
827 (defun shell-command-filter (proc string)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
828 ;; Do save-excursion by hand so that we can leave point numerically unchanged
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
829 ;; despite an insertion immediately after it.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
830 (let* ((obuf (current-buffer))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
831 (buffer (process-buffer proc))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
832 opoint
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
833 (window (get-buffer-window buffer))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
834 (pos (window-start window)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
835 (unwind-protect
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
836 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
837 (set-buffer buffer)
6951
a517c80bbe8d (shell-command-filter): If point was at end, leave it at end.
Richard M. Stallman <rms@gnu.org>
parents: 6949
diff changeset
838 (or (= (point) (point-max))
a517c80bbe8d (shell-command-filter): If point was at end, leave it at end.
Richard M. Stallman <rms@gnu.org>
parents: 6949
diff changeset
839 (setq opoint (point)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
840 (goto-char (point-max))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
841 (insert-before-markers string))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
842 ;; insert-before-markers moved this marker: set it back.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
843 (set-window-start window pos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
844 ;; Finish our save-excursion.
6951
a517c80bbe8d (shell-command-filter): If point was at end, leave it at end.
Richard M. Stallman <rms@gnu.org>
parents: 6949
diff changeset
845 (if opoint
a517c80bbe8d (shell-command-filter): If point was at end, leave it at end.
Richard M. Stallman <rms@gnu.org>
parents: 6949
diff changeset
846 (goto-char opoint))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
847 (set-buffer obuf))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
848
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
849 (defun shell-command-on-region (start end command
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
850 &optional output-buffer replace)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
851 "Execute string COMMAND in inferior shell with region as input.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
852 Normally display output (if any) in temp buffer `*Shell Command Output*';
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
853 Prefix arg means replace the region with it.
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
854
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
855 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
856 If REPLACE is non-nil, that means insert the output
10912
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
857 in place of text from START to END, putting point and mark around it.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
858
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
859 If the output is one line, it is displayed in the echo area,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
860 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
861 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
862 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
863 then `*Shell Command Output*' is deleted.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
864
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
865 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
866 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
867 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
868 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
869 insert output in the current buffer.
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
870 In either case, the output is inserted after point (leaving mark after it)."
10805
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
871 (interactive (let ((string
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
872 ;; 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
873 ;; 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
874 ;; 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
875 (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
876 nil nil nil
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
877 'shell-command-history)))
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
878 (list (region-beginning) (region-end)
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
879 string
7b7874738e7c (shell-command-on-region): When computing interactive args,
Richard M. Stallman <rms@gnu.org>
parents: 10779
diff changeset
880 current-prefix-arg
10912
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
881 current-prefix-arg)))
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
882 (if (or replace
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
883 (and output-buffer
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
884 (not (or (bufferp output-buffer) (stringp output-buffer)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
885 ;; Replace specified region with output from command.
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
886 (let ((swap (and replace (< (point) (mark)))))
10912
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
887 ;; Don't muck with mark unless REPLACE says we should.
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
888 (goto-char start)
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
889 (and replace (push-mark))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
890 (call-process-region start end shell-file-name t t nil
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
891 shell-command-switch command)
8604
7fff44ad20c9 (shell-command-on-region): Don't delete current buffer.
Karl Heuer <kwzh@gnu.org>
parents: 8600
diff changeset
892 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
7fff44ad20c9 (shell-command-on-region): Don't delete current buffer.
Karl Heuer <kwzh@gnu.org>
parents: 8600
diff changeset
893 (and shell-buffer (not (eq shell-buffer (current-buffer)))
7fff44ad20c9 (shell-command-on-region): Don't delete current buffer.
Karl Heuer <kwzh@gnu.org>
parents: 8600
diff changeset
894 (kill-buffer shell-buffer)))
10912
be434b59c22e (shell-command-on-region): Obey REPLACE even if
Richard M. Stallman <rms@gnu.org>
parents: 10863
diff changeset
895 ;; Don't muck with mark unless REPLACE says we should.
10852
55552df3bd18 (shell-command-on-region): Rename arg; doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10813
diff changeset
896 (and replace swap (exchange-point-and-mark)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
897 ;; No prefix argument: put the output in a temp buffer,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
898 ;; replacing its entire contents.
9539
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
899 (let ((buffer (get-buffer-create
164a7cb8d0ea (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 9434
diff changeset
900 (or output-buffer "*Shell Command Output*")))
5635
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
901 (success nil))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
902 (unwind-protect
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
903 (if (eq buffer (current-buffer))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
904 ;; If the input is the same buffer as the output,
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
905 ;; delete everything but the specified region,
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
906 ;; then replace that region with the output.
9065
e321617e3fc6 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 8998
diff changeset
907 (progn (setq buffer-read-only nil)
e321617e3fc6 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 8998
diff changeset
908 (delete-region end (point-max))
5635
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
909 (delete-region (point-min) start)
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
910 (call-process-region (point-min) (point-max)
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
911 shell-file-name t t nil
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
912 shell-command-switch command)
5635
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
913 (setq success t))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
914 ;; Clear the output buffer, then run the command with output there.
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
915 (save-excursion
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
916 (set-buffer buffer)
9065
e321617e3fc6 (shell-command, shell-command-on-region):
Richard M. Stallman <rms@gnu.org>
parents: 8998
diff changeset
917 (setq buffer-read-only nil)
5635
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
918 (erase-buffer))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
919 (call-process-region start end shell-file-name
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
920 nil buffer nil
9779
1286985b5a26 (shell-command-switch): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9771
diff changeset
921 shell-command-switch command)
5635
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
922 (setq success t))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
923 ;; Report the amount of output.
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
924 (let ((lines (save-excursion
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
925 (set-buffer buffer)
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
926 (if (= (buffer-size) 0)
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
927 0
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
928 (count-lines (point-min) (point-max))))))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
929 (cond ((= lines 0)
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
930 (if success
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
931 (message "(Shell command completed with no output)"))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
932 (kill-buffer buffer))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
933 ((and success (= lines 1))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
934 (message "%s"
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
935 (save-excursion
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
936 (set-buffer buffer)
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
937 (goto-char (point-min))
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
938 (buffer-substring (point)
7426
58372be37e3a (shell-command-on-region): Don't kill output buffer when in the one line case.
Richard M. Stallman <rms@gnu.org>
parents: 7373
diff changeset
939 (progn (end-of-line) (point))))))
5635
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
940 (t
82a127d7ef7d (shell-command-on-region): If we quit the command,
Richard M. Stallman <rms@gnu.org>
parents: 5564
diff changeset
941 (set-window-start (display-buffer buffer) 1))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
942
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
943 (defconst universal-argument-map
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
944 (let ((map (make-sparse-keymap)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
945 (define-key map [t] 'universal-argument-other-key)
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
946 (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
947 (define-key map [switch-frame] nil)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
948 (define-key map [?\C-u] 'universal-argument-more)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
949 (define-key map [?-] 'universal-argument-minus)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
950 (define-key map [?0] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
951 (define-key map [?1] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
952 (define-key map [?2] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
953 (define-key map [?3] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
954 (define-key map [?4] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
955 (define-key map [?5] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
956 (define-key map [?6] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
957 (define-key map [?7] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
958 (define-key map [?8] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
959 (define-key map [?9] 'digit-argument)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
960 map)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
961 "Keymap used while processing \\[universal-argument].")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
962
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
963 (defvar universal-argument-num-events nil
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
964 "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
965 `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
966 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
967
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
968 (defun universal-argument ()
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
969 "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
970 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
971 \\[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
972 \\[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
973 Repeating \\[universal-argument] without digits or minus sign
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
974 multiplies the argument by 4 each time."
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
975 (interactive)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
976 (setq prefix-arg (list 4))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
977 (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
978 (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
979
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
980 ;; 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
981 ;; 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
982 (defun universal-argument-more (arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
983 (interactive "P")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
984 (if (consp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
985 (setq prefix-arg (list (* 4 (car arg))))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
986 (setq prefix-arg arg)
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
987 (setq overriding-terminal-local-map nil))
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
988 (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
989
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
990 (defun negative-argument (arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
991 "Begin a negative numeric argument for the next command.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
992 \\[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
993 (interactive "P")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
994 (cond ((integerp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
995 (setq prefix-arg (- arg)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
996 ((eq arg '-)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
997 (setq prefix-arg nil))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
998 (t
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
999 (setq prefix-arg '-)))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1000 (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
1001 (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
1002
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1003 (defun digit-argument (arg)
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1004 "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
1005 \\[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
1006 (interactive "P")
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1007 (let ((digit (- (logand last-command-char ?\177) ?0)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1008 (cond ((integerp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1009 (setq prefix-arg (+ (* arg 10)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1010 (if (< arg 0) (- digit) digit))))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1011 ((eq arg '-)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1012 ;; Treat -0 as just -, so that -01 will work.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1013 (setq prefix-arg (if (zerop digit) '- (- digit))))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1014 (t
12313
eca218b0a8ca (negative-argument, digit-argument):
Richard M. Stallman <rms@gnu.org>
parents: 12266
diff changeset
1015 (setq prefix-arg digit))))
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1016 (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
1017 (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
1018
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1019 ;; 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
1020 ;; command if digits have already been entered.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1021 (defun universal-argument-minus (arg)
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1022 (interactive "P")
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1023 (if (integerp arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1024 (universal-argument-other-key arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1025 (negative-argument arg)))
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1026
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1027 ;; 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
1028 ;; executed as a command.
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1029 (defun universal-argument-other-key (arg)
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1030 (interactive "P")
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1031 (setq prefix-arg arg)
12334
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1032 (let* ((key (this-command-keys))
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1033 (keylist (listify-key-sequence key)))
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1034 (setq unread-command-events
326cccb5f51a (universal-argument-num-events): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12320
diff changeset
1035 (nthcdr universal-argument-num-events keylist)))
12320
979836b1a1a9 (universal-argument-other-key): Call reset-this-command-lengths.
Richard M. Stallman <rms@gnu.org>
parents: 12313
diff changeset
1036 (reset-this-command-lengths)
12266
bdc0826013e0 (universal-argument-map): New var.
Karl Heuer <kwzh@gnu.org>
parents: 12230
diff changeset
1037 (setq overriding-terminal-local-map nil))
12230
7275b8e0d272 (universal-argument, describe-arg): Restore Lisp code,
Karl Heuer <kwzh@gnu.org>
parents: 11975
diff changeset
1038
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1039 (defun forward-to-indentation (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1040 "Move forward ARG lines and position at first nonblank character."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1041 (interactive "p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1042 (forward-line arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1043 (skip-chars-forward " \t"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1044
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1045 (defun backward-to-indentation (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1046 "Move backward ARG lines and position at first nonblank character."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1047 (interactive "p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1048 (forward-line (- arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1049 (skip-chars-forward " \t"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1050
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1051 (defvar kill-whole-line nil
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1052 "*If non-nil, `kill-line' with no arg at beg of line kills the whole line.")
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1053
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1054 (defun kill-line (&optional arg)
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1055 "Kill the rest of the current line; if no nonblanks there, kill thru newline.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1056 With prefix argument, kill that many lines from point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1057 Negative arguments kill lines backward.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1058
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1059 When calling from a program, nil means \"no arg\",
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1060 a number counts as a prefix arg.
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1061
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1062 If `kill-whole-line' is non-nil, then kill the whole line
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1063 when given no argument at the beginning of a line."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1064 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1065 (kill-region (point)
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1066 ;; It is better to move point to the other end of the kill
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1067 ;; before killing. That way, in a read-only buffer, point
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1068 ;; moves across the text that is copied to the kill ring.
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1069 ;; The choice has no effect on undo now that undo records
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1070 ;; the value of point from before the command was run.
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1071 (progn
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1072 (if arg
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1073 (forward-line (prefix-numeric-value arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1074 (if (eobp)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1075 (signal 'end-of-buffer nil))
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1076 (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1077 (forward-line 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1078 (end-of-line)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1079 (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1080
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1081 ;;;; Window system cut and paste hooks.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1082
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1083 (defvar interprogram-cut-function nil
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1084 "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
1085
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1086 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
1087 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
1088 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
1089 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
1090 programs.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1091
3034
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1092 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
1093 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
1094 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
1095 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
1096 nil means appending to an \"old\" kill.")
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1097
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1098 (defvar interprogram-paste-function nil
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1099 "Function to call to get text cut from other programs.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1100
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1101 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
1102 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
1103 This variable holds a function that Emacs calls to obtain
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1104 text that other programs have provided for pasting.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1105
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1106 The function should be called with no arguments. If the function
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1107 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
1108 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
1109 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
1110
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1111 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
1112 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
1113 most recent string, the function should return nil. If it is
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1114 difficult to tell whether Emacs or some other program provided the
540b047ece4d *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 715
diff changeset
1115 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
1116 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
1117
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1118
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1119
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1120 ;;;; The kill ring data structure.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1121
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1122 (defvar kill-ring nil
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1123 "List of killed text sequences.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1124 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
1125 facilities offered by window systems, use of this variable should
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1126 interact nicely with `interprogram-cut-function' and
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1127 `interprogram-paste-function'. The functions `kill-new',
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1128 `kill-append', and `current-kill' are supposed to implement this
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1129 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
1130 ring directly.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1131
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1132 (defconst kill-ring-max 30
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1133 "*Maximum length of kill ring before oldest elements are thrown away.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1134
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1135 (defvar kill-ring-yank-pointer nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1136 "The tail of the kill ring whose car is the last thing yanked.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1137
8763
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1138 (defun kill-new (string &optional replace)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1139 "Make STRING the latest kill in the kill ring.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1140 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
1141 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
1142 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
1143 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
1144 (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
1145 (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
1146 (if replace
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1147 (setcar kill-ring string)
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1148 (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
1149 (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
1150 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1151 (setq kill-ring-yank-pointer kill-ring)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1152 (if interprogram-cut-function
3034
dd65780e6246 (kill-new): Pass t as 2nd arg to interprogram-cut-function.
Richard M. Stallman <rms@gnu.org>
parents: 3029
diff changeset
1153 (funcall interprogram-cut-function string t)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1154
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1155 (defun kill-append (string before-p)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1156 "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
1157 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
1158 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
1159 it."
8763
2b54e6deed2f (kill-new): New optional argument means replace most recent kill.
Karl Heuer <kwzh@gnu.org>
parents: 8734
diff changeset
1160 (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
1161 (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
1162 (concat (car kill-ring) string)) t))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1163
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1164 (defun current-kill (n &optional do-not-move)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1165 "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
1166 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
1167 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
1168 kill ring and returned as the latest kill.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1169 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1170 yanking point; just return the Nth kill forward."
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1171 (let ((interprogram-paste (and (= n 0)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1172 interprogram-paste-function
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1173 (funcall interprogram-paste-function))))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1174 (if interprogram-paste
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1175 (progn
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1176 ;; Disable the interprogram cut function when we add the new
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1177 ;; 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
1178 ;; selection, with identical text.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1179 (let ((interprogram-cut-function nil))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1180 (kill-new interprogram-paste))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1181 interprogram-paste)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1182 (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
1183 (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
1184 (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
1185 (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
1186 kill-ring)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1187 (or do-not-move
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1188 (setq kill-ring-yank-pointer ARGth-kill-element))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1189 (car ARGth-kill-element)))))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1190
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1191
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1192
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1193 ;;;; Commands for manipulating the kill ring.
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
1194
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1195 (defvar kill-read-only-ok nil
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1196 "*Non-nil means don't signal an error for killing read-only text.")
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1197
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1198 (defun kill-region (beg end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1199 "Kill between point and mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1200 The text is deleted but saved in the kill ring.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1201 The command \\[yank] can retrieve it from there.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1202 \(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
1203 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
1204 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
1205 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
1206
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1207 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
1208 Supply two arguments, character numbers indicating the stretch of text
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1209 to be killed.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1210 Any command that calls this function is a \"kill command\".
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1211 If the previous command was also a kill command,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1212 the text killed this time appends to the text killed last time
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1213 to make one entry in the kill ring."
1834
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1214 (interactive "r")
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1215 (cond
1834
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1216
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1217 ;; If the buffer is read-only, we should beep, in case the person
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1218 ;; just isn't aware of this. However, there's no harm in putting
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1219 ;; the region's text in the kill ring, anyway.
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1220 ((or (and buffer-read-only (not inhibit-read-only))
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1221 (text-property-not-all beg end 'read-only nil))
1834
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1222 (copy-region-as-kill beg end)
1982
d65c1fefc636 * simple.el (kill-region): If the buffer is read-only, call
Jim Blandy <jimb@redhat.com>
parents: 1838
diff changeset
1223 ;; This should always barf, and give us the correct error.
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1224 (if kill-read-only-ok
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1225 (message "Read only text copied to kill ring")
10012
4b936f4cad5c (kill-region): Set this-command unconditionally.
Karl Heuer <kwzh@gnu.org>
parents: 9876
diff changeset
1226 (setq this-command 'kill-region)
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
1227 (barf-if-buffer-read-only)))
1834
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1228
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1229 ;; In certain cases, we can arrange for the undo list and the kill
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1230 ;; ring to share the same string object. This code does that.
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1231 ((not (or (eq buffer-undo-list t)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1232 (eq last-command 'kill-region)
10034
1c6132b72da9 (kill-region): Use = to compare positions.
Richard M. Stallman <rms@gnu.org>
parents: 10012
diff changeset
1233 ;; Use = since positions may be numbers or markers.
1c6132b72da9 (kill-region): Use = to compare positions.
Richard M. Stallman <rms@gnu.org>
parents: 10012
diff changeset
1234 (= beg end)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1235 ;; Don't let the undo list be truncated before we can even access it.
3967
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1236 (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1237 (old-list buffer-undo-list)
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1238 tail)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1239 (delete-region beg end)
3967
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1240 ;; Search back in buffer-undo-list for this string,
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1241 ;; in case a change hook made property changes.
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1242 (setq tail buffer-undo-list)
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1243 (while (not (stringp (car (car tail))))
42932adb7074 (kill-region): Cope with change hooks that change props.
Richard M. Stallman <rms@gnu.org>
parents: 3947
diff changeset
1244 (setq tail (cdr tail)))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1245 ;; Take the same string recorded for undo
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1246 ;; and put it in the kill-ring.
10012
4b936f4cad5c (kill-region): Set this-command unconditionally.
Karl Heuer <kwzh@gnu.org>
parents: 9876
diff changeset
1247 (kill-new (car (car tail)))))
1834
9a1f696c1734 * simple.el (kill-region): If the buffer is read-only, do beep,
Jim Blandy <jimb@redhat.com>
parents: 1826
diff changeset
1248
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1249 (t
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1250 (copy-region-as-kill beg end)
10012
4b936f4cad5c (kill-region): Set this-command unconditionally.
Karl Heuer <kwzh@gnu.org>
parents: 9876
diff changeset
1251 (delete-region beg end)))
4b936f4cad5c (kill-region): Set this-command unconditionally.
Karl Heuer <kwzh@gnu.org>
parents: 9876
diff changeset
1252 (setq this-command 'kill-region))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1253
9876
75ecf866cfb8 Comment reason for preceding change.
Karl Heuer <kwzh@gnu.org>
parents: 9870
diff changeset
1254 ;; 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
1255 ;; 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
1256 ;; then corrects it with the intended C-w.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1257 (defun copy-region-as-kill (beg end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1258 "Save the region as if killed, but don't kill it.
617
cde1f15848c6 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 582
diff changeset
1259 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
1260 system cut and paste."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1261 (interactive "r")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1262 (if (eq last-command 'kill-region)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1263 (kill-append (buffer-substring beg end) (< end beg))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1264 (kill-new (buffer-substring beg end)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1265 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1266
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1267 (defun kill-ring-save (beg end)
2111
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1268 "Save the region as if killed, but don't kill it.
3467
002945794814 (kill-ring-save): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3408
diff changeset
1269 This command is similar to `copy-region-as-kill', except that it gives
2111
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1270 visual feedback indicating the extent of the region being copied.
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1271 If `interprogram-cut-function' is non-nil, also save the text for a window
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1272 system cut and paste."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1273 (interactive "r")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1274 (copy-region-as-kill beg end)
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
1275 (if (interactive-p)
2850
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1276 (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
1277 (opoint (point))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1278 ;; 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
1279 ;; 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
1280 (inhibit-quit t))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1281 (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
1282 (progn
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1283 ;; Swap point and mark.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1284 (set-marker (mark-marker) (point) (current-buffer))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1285 (goto-char other-end)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1286 (sit-for 1)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1287 ;; Swap back.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1288 (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
1289 (goto-char opoint)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1290 ;; If user quit, deactivate the mark
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1291 ;; 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
1292 (and quit-flag mark-active
4287
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1293 (deactivate-mark)))
2850
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1294 (let* ((killed-text (current-kill 0))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1295 (message-len (min (length killed-text) 40)))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1296 (if (= (point) beg)
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1297 ;; Don't say "killed"; that is misleading.
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1298 (message "Saved text until \"%s\""
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1299 (substring killed-text (- message-len)))
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1300 (message "Saved text from \"%s\""
f5f7e7295ec2 (keyboard-quit): Run deactivate-mark-hook.
Richard M. Stallman <rms@gnu.org>
parents: 2844
diff changeset
1301 (substring killed-text 0 message-len))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1302
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1303 (defun append-next-kill ()
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1304 "Cause following command, if it kills, to append to previous kill."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1305 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1306 (if (interactive-p)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1307 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1308 (setq this-command 'kill-region)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1309 (message "If the next command is a kill, it will append"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1310 (setq last-command 'kill-region)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1311
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1312 (defun yank-pop (arg)
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1313 "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
1314 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
1315 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
1316 previously-killed text. `yank-pop' deletes that text and inserts in its
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1317 place a different stretch of killed text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1318
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1319 With no argument, the previous kill is inserted.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1320 With argument N, insert the Nth previous kill.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1321 If N is negative, this is a more recent kill.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1322
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1323 The sequence of kills wraps around, so that after the oldest one
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1324 comes the newest one."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1325 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1326 (if (not (eq last-command 'yank))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1327 (error "Previous command was not a yank"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1328 (setq this-command 'yank)
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
1329 (let ((before (< (point) (mark t))))
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
1330 (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
1331 (set-marker (mark-marker) (point) (current-buffer))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1332 (insert (current-kill arg))
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1333 (if before
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1334 ;; 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
1335 ;; 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
1336 ;; 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
1337 (goto-char (prog1 (mark t)
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1338 (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
1339 nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1340
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1341 (defun yank (&optional arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1342 "Reinsert the last stretch of killed text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1343 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
1344 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
1345 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
1346 With argument N, reinsert the Nth most recently killed stretch of killed
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1347 text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1348 See also the command \\[yank-pop]."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1349 (interactive "*P")
5935
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1350 ;; 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
1351 ;; for the following command.
a2b7fc4645d9 (undo, yank): Set this-command to t at start,
Richard M. Stallman <rms@gnu.org>
parents: 5893
diff changeset
1352 (setq this-command t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1353 (push-mark (point))
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1354 (insert (current-kill (cond
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1355 ((listp arg) 0)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1356 ((eq arg '-) -1)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1357 (t (1- arg)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1358 (if (consp arg)
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1359 ;; 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
1360 ;; 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
1361 ;; 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
1362 (goto-char (prog1 (mark t)
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1363 (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
1364 ;; 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
1365 (setq this-command 'yank)
2111
d38d32084c15 * simple.el (kill-ring-save): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 2075
diff changeset
1366 nil)
715
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1367
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1368 (defun rotate-yank-pointer (arg)
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1369 "Rotate the yanking point in the kill ring.
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1370 With argument, rotate that many kills forward (or backward, if negative)."
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1371 (interactive "p")
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1372 (current-kill arg))
7af12ccaa6c1 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 658
diff changeset
1373
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1374
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1375 (defun insert-buffer (buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1376 "Insert after point the contents of BUFFER.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1377 Puts mark after the inserted text.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1378 BUFFER may be a buffer or a buffer name."
1331
dd2c33afcef2 (insert-buffer): Before reading arg, barf if read-only.
Richard M. Stallman <rms@gnu.org>
parents: 1321
diff changeset
1379 (interactive (list (progn (barf-if-buffer-read-only)
8998
25406f41c336 (insert-buffer): Default to first buffer other than current one.
Richard M. Stallman <rms@gnu.org>
parents: 8768
diff changeset
1380 (read-buffer "Insert buffer: "
25406f41c336 (insert-buffer): Default to first buffer other than current one.
Richard M. Stallman <rms@gnu.org>
parents: 8768
diff changeset
1381 (other-buffer (current-buffer) t)
25406f41c336 (insert-buffer): Default to first buffer other than current one.
Richard M. Stallman <rms@gnu.org>
parents: 8768
diff changeset
1382 t))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1383 (or (bufferp buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1384 (setq buffer (get-buffer buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1385 (let (start end newmark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1386 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1387 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1388 (set-buffer buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1389 (setq start (point-min) end (point-max)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1390 (insert-buffer-substring buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1391 (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
1392 (push-mark newmark))
d65c1fefc636 * simple.el (kill-region): If the buffer is read-only, call
Jim Blandy <jimb@redhat.com>
parents: 1838
diff changeset
1393 nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1394
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1395 (defun append-to-buffer (buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1396 "Append to specified buffer the text of the region.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1397 It is inserted into that buffer before its point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1398
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1399 When calling from a program, give three arguments:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1400 BUFFER (or buffer name), START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1401 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
1402 (interactive
10048
db01a04d2afb (append-to-buffer): Don't use current buffer as default.
Richard M. Stallman <rms@gnu.org>
parents: 10034
diff changeset
1403 (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
1404 (region-beginning) (region-end)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1405 (let ((oldbuf (current-buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1406 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1407 (set-buffer (get-buffer-create buffer))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1408 (insert-buffer-substring oldbuf start end))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1409
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1410 (defun prepend-to-buffer (buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1411 "Prepend to specified buffer the text of the region.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1412 It is inserted into that buffer after its point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1413
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1414 When calling from a program, give three arguments:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1415 BUFFER (or buffer name), START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1416 START and END specify the portion of the current buffer to be copied."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1417 (interactive "BPrepend to buffer: \nr")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1418 (let ((oldbuf (current-buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1419 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1420 (set-buffer (get-buffer-create buffer))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1421 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1422 (insert-buffer-substring oldbuf start end)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1423
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1424 (defun copy-to-buffer (buffer start end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1425 "Copy to specified buffer the text of the region.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1426 It is inserted into that buffer, replacing existing text there.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1427
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1428 When calling from a program, give three arguments:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1429 BUFFER (or buffer name), START and END.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1430 START and END specify the portion of the current buffer to be copied."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1431 (interactive "BCopy to buffer: \nr")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1432 (let ((oldbuf (current-buffer)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1433 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1434 (set-buffer (get-buffer-create buffer))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1435 (erase-buffer)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1436 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1437 (insert-buffer-substring oldbuf start end)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1438
4040
d06d7295d3eb Put error-conditions and error-message properties on 'mark-inactive.
Roland McGrath <roland@gnu.org>
parents: 3967
diff changeset
1439 (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
1440 (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
1441
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
1442 (defun mark (&optional force)
3487
8c151ebeff9c (mark): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3467
diff changeset
1443 "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
1444 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
1445 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
1446 if there is no mark at all.
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
1447
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1448 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
1449 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
1450 (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
1451 (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
1452 (signal 'mark-inactive nil)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1453
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
1454 ;; 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
1455 ;; run deactivate-mark-hook. This shorthand should simplify.
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
1456 (defsubst deactivate-mark ()
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
1457 "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
1458 \(That makes a difference only in Transient Mark mode.)
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
1459 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
1460 (if transient-mark-mode
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
1461 (progn
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
1462 (setq mark-active nil)
0998ca7d922c (deactivate-mark): Do nothing unless transient-mark-mode.
Richard M. Stallman <rms@gnu.org>
parents: 7698
diff changeset
1463 (run-hooks 'deactivate-mark-hook))))
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
1464
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1465 (defun set-mark (pos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1466 "Set this buffer's mark to POS. Don't use this function!
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1467 That is to say, don't use this function unless you want
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1468 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
1469 mark position to be lost.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1470
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1471 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
1472 This is why most applications should use push-mark, not set-mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1473
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1474 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
1475 purposes. The mark saves a location for the user's convenience.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1476 Most editing commands should not alter the mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1477 To remember a location for internal use in the Lisp program,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1478 store it in a Lisp variable. Example:
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1479
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1480 (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1481
4287
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1482 (if pos
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1483 (progn
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1484 (setq mark-active t)
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1485 (run-hooks 'activate-mark-hook)
20486b99584f (kill-ring-save): Delete spurious `message' call.
Richard M. Stallman <rms@gnu.org>
parents: 4217
diff changeset
1486 (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
1487 ;; 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
1488 ;; 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
1489 ;; 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
1490 (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
1491 (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
1492 (set-marker (mark-marker) nil)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1493
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1494 (defvar mark-ring nil
8695
0f702e9ab06d (mark-ring): Add permanent-local prop. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8660
diff changeset
1495 "The list of former marks of the current buffer, most recent first.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1496 (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
1497 (put 'mark-ring 'permanent-local t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1498
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1499 (defconst mark-ring-max 16
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1500 "*Maximum size of mark ring. Start discarding off end if gets this big.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1501
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1502 (defvar global-mark-ring nil
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1503 "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
1504
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1505 (defconst global-mark-ring-max 16
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1506 "*Maximum size of global mark ring. \
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1507 Start discarding off end if gets this big.")
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1508
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1509 (defun set-mark-command (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1510 "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
1511 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
1512 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
1513 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
1514 \(does not affect global mark ring\).
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1515
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1516 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
1517 purposes. See the documentation of `set-mark' for more information."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1518 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1519 (if (null arg)
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
1520 (progn
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1521 (push-mark nil nil t))
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
1522 (if (null (mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1523 (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
1524 (goto-char (mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1525 (pop-mark))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1526
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
1527 (defun push-mark (&optional location nomsg activate)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1528 "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
1529 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
1530 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
1531 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
1532 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
1533
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
1534 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
1535 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
1536
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
1537 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
1538 (if (null (mark t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1539 nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1540 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1541 (if (> (length mark-ring) mark-ring-max)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1542 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1543 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1544 (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
1545 (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
1546 ;; 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
1547 (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
1548 (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
1549 ;; 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
1550 ;; 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
1551 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
1552 (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
1553 (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
1554 (progn
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1555 (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
1556 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
1557 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1558 (or nomsg executing-macro (> (minibuffer-depth) 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1559 (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
1560 (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
1561 (set-mark (mark t)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1562 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1563
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1564 (defun pop-mark ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1565 "Pop off mark ring into the buffer's actual mark.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1566 Does not set point. Does nothing if mark ring is empty."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1567 (if mark-ring
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1568 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1569 (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
1570 (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
1571 (deactivate-mark)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1572 (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
1573 (if (null (mark t)) (ding))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1574 (setq mark-ring (cdr mark-ring)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1575
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1576 (define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1577 (defun exchange-point-and-mark ()
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
1578 "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
1579 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
1580 and it reactivates the mark."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1581 (interactive nil)
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
1582 (let ((omark (mark t)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1583 (if (null omark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1584 (error "No mark set in this buffer"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1585 (set-mark (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1586 (goto-char omark)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1587 nil))
2796
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1588
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1589 (defun transient-mark-mode (arg)
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1590 "Toggle Transient Mark mode.
2935
653e14f61220 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 2850
diff changeset
1591 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
1592
5372
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
1593 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
1594 Changing the buffer \"deactivates\" the mark.
ac927443eae9 (transient-mark-mode): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5343
diff changeset
1595 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
1596 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
1597 incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
2796
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1598 (interactive "P")
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1599 (setq transient-mark-mode
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1600 (if (null arg)
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1601 (not transient-mark-mode)
e0a9c4815584 (transient-mark-mode): New command.
Richard M. Stallman <rms@gnu.org>
parents: 2681
diff changeset
1602 (> (prefix-numeric-value arg) 0))))
5811
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1603
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1604 (defun pop-global-mark ()
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1605 "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
1606 (interactive)
7881
4ab8723cd491 (pop-global-mark): Discard entries for nonexistent buffers.
Richard M. Stallman <rms@gnu.org>
parents: 7877
diff changeset
1607 ;; 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
1608 (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
1609 (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
1610 (or global-mark-ring
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1611 (error "No global mark set"))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1612 (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
1613 (buffer (marker-buffer marker))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1614 (position (marker-position marker)))
10351
e34cbd5276bd (pop-global-mark): Make pop-global-mark treat
Richard M. Stallman <rms@gnu.org>
parents: 10284
diff changeset
1615 (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
1616 (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
1617 (set-buffer buffer)
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1618 (or (and (>= position (point-min))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1619 (<= position (point-max)))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1620 (widen))
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1621 (goto-char position)
7cc27fc3c661 (global-mark-ring, global-mark-ring-max): New variables.
Roland McGrath <roland@gnu.org>
parents: 5805
diff changeset
1622 (switch-to-buffer buffer)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1623
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1624 (defvar next-line-add-newlines t
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1625 "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1626
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1627 (defun next-line (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1628 "Move cursor vertically down ARG lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1629 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
1630 the cursor is positioned after the character in that line which spans this
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1631 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
1632 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
1633 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
1634 to create a line, and moves the cursor to that line. Otherwise it moves the
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1635 cursor to the end of the buffer (if already at the end of the buffer, an error
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1636 is signaled).
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1637
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1638 The command \\[set-goal-column] can be used to create
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1639 a semipermanent goal column to which this command always moves.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1640 Then it does not try to move vertically. This goal column is stored
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1641 in `goal-column', which is nil when there is none.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1642
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1643 If you are thinking of using this in a Lisp program, consider
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1644 using `forward-line' instead. It is usually easier to use
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1645 and more reliable (no dependence on goal column, etc.)."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1646 (interactive "p")
5675
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
1647 (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
1648 (let ((opoint (point)))
8309
a4dbf8e6c78f (line-move, next-line): Check last line moved over
Richard M. Stallman <rms@gnu.org>
parents: 8203
diff changeset
1649 (end-of-line)
a4dbf8e6c78f (line-move, next-line): Check last line moved over
Richard M. Stallman <rms@gnu.org>
parents: 8203
diff changeset
1650 (if (eobp)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
1651 (newline 1)
5675
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
1652 (goto-char opoint)
3191bf405867 (next-line): Move error signaling and special end of
Richard M. Stallman <rms@gnu.org>
parents: 5635
diff changeset
1653 (line-move arg)))
10226
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1654 (if (interactive-p)
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1655 (condition-case nil
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1656 (line-move arg)
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1657 ((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
1658 (line-move arg)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1659 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1660
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1661 (defun previous-line (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1662 "Move cursor vertically up ARG lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1663 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
1664 the cursor is positioned after the character in that line which spans this
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1665 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
1666
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1667 The command \\[set-goal-column] can be used to create
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1668 a semipermanent goal column to which this command always moves.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1669 Then it does not try to move vertically.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1670
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1671 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
1672 `forward-line' with a negative argument instead. It is usually easier
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1673 to use and more reliable (no dependence on goal column, etc.)."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1674 (interactive "p")
10226
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1675 (if (interactive-p)
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1676 (condition-case nil
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1677 (line-move (- arg))
1817c5332316 (next-line, previous-line): If interactive and not in
Richard M. Stallman <rms@gnu.org>
parents: 10165
diff changeset
1678 ((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
1679 (line-move (- arg)))
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 (defconst track-eol nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1683 "*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
1684 This means moving to the end of each line moved onto.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1685 The beginning of a blank line does not count as the end of a line.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1686
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
1687 (defvar goal-column nil
04b4499061fd (goal-column): Don't put the defvar inside the make-variable-buffer-local.
Richard M. Stallman <rms@gnu.org>
parents: 1459
diff changeset
1688 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
04b4499061fd (goal-column): Don't put the defvar inside the make-variable-buffer-local.
Richard M. Stallman <rms@gnu.org>
parents: 1459
diff changeset
1689 (make-variable-buffer-local 'goal-column)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1690
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1691 (defvar temporary-goal-column 0
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1692 "Current goal column for vertical motion.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1693 It is the column where point was
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1694 at the start of current run of vertical motion commands.
513
12facf6e03ed *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 475
diff changeset
1695 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
1696
10949
99c9f475a355 (line-move-ignore-invisible): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10943
diff changeset
1697 (defvar line-move-ignore-invisible nil
99c9f475a355 (line-move-ignore-invisible): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10943
diff changeset
1698 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
99c9f475a355 (line-move-ignore-invisible): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10943
diff changeset
1699 Outline mode sets this.")
99c9f475a355 (line-move-ignore-invisible): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10943
diff changeset
1700
11326
0d5ebc078c51 (line-move): Turn off intangibility for intermediate stops.
Richard M. Stallman <rms@gnu.org>
parents: 11324
diff changeset
1701 ;; 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
1702 ;; Arg says how many lines to move.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1703 (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
1704 ;; 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
1705 ;; for intermediate positions.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1706 (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
1707 (opoint (point))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1708 new)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1709 (unwind-protect
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1710 (progn
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1711 (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
1712 (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
1713 (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
1714 (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
1715 ;; 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
1716 ;; 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
1717 (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
1718 9999
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1719 (current-column))))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1720 (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
1721 (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
1722 ;; 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
1723 (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
1724 (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
1725 ;; 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
1726 ;; 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
1727 ;; 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
1728 (end-of-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1729 (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
1730 (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
1731 (bolp)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1732 (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
1733 'beginning-of-buffer
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1734 'end-of-buffer)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1735 nil))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1736 ;; 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
1737 (while (> arg 0)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1738 (end-of-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1739 (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
1740 (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
1741 ;; 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
1742 ;; 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
1743 (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
1744 (let ((prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1745 (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
1746 (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
1747 prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1748 (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
1749 (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
1750 (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
1751 (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
1752 (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
1753 (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
1754 (while (< arg 0)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1755 (beginning-of-line)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1756 (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
1757 (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
1758 (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
1759 (let ((prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1760 (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
1761 (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
1762 prop
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1763 (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
1764 (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
1765 (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
1766 (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
1767 (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
1768 (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
1769 (move-to-column (or goal-column temporary-goal-column)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1770 ;; Remember where we moved to, go back home,
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1771 ;; then do the motion over again
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1772 ;; in just one step, with intangibility and point-motion hooks
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1773 ;; enabled this time.
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1774 (setq new (point))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1775 (goto-char opoint)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1776 (setq inhibit-point-motion-hooks nil)
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1777 (goto-char new)))
266653a85b65 (line-move): Fix previous change: if we get an error,
Richard M. Stallman <rms@gnu.org>
parents: 11362
diff changeset
1778 nil)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779
1771
3f0f18d4eb8c * simple.el (set-goal-column): Make this command disabled by default.
Jim Blandy <jimb@redhat.com>
parents: 1760
diff changeset
1780 ;;; 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
1781 ;;; 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
1782 (put 'set-goal-column 'disabled t)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1783
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 (defun set-goal-column (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785 "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
1786 Those commands will move to this position in the line moved to
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1787 rather than trying to keep the same horizontal position.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1788 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
1789 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
1790 The goal column is stored in the variable `goal-column'."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792 (if arg
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 (setq goal-column nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795 (message "No goal column"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 (setq goal-column (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1797 (message (substitute-command-keys
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1798 "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1799 goal-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1800 nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1801
2597
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1802 ;;; Partial support for horizontal autoscrolling. Someday, this feature
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1803 ;;; will be built into the C level and all the (hscroll-point-visible) calls
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1804 ;;; will go away.
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1805
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1806 (defvar hscroll-step 0
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1807 "*The number of columns to try scrolling a window by when point moves out.
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1808 If that fails to bring point back on frame, point is centered instead.
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1809 If this is zero, point is always centered after it moves off frame.")
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1810
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1811 (defun hscroll-point-visible ()
6743
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1812 "Scrolls the selected window horizontally to make point visible."
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1813 (save-excursion
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1814 (set-buffer (window-buffer))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1815 (if (not (or truncate-lines
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1816 (> (window-hscroll) 0)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1817 (and truncate-partial-width-windows
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1818 (< (window-width) (frame-width)))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1819 ;; Point is always visible when lines are wrapped.
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1820 ()
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1821 ;; If point is on the invisible part of the line before window-start,
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1822 ;; then hscrolling can't bring it back, so reset window-start first.
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1823 (and (< (point) (window-start))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1824 (let ((ws-bol (save-excursion
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1825 (goto-char (window-start))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1826 (beginning-of-line)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1827 (point))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1828 (and (>= (point) ws-bol)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1829 (set-window-start nil ws-bol))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1830 (let* ((here (hscroll-window-column))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1831 (left (min (window-hscroll) 1))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1832 (right (1- (window-width))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1833 ;; Allow for the truncation glyph, if we're not exactly at eol.
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1834 (if (not (and (= here right)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1835 (= (following-char) ?\n)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1836 (setq right (1- right)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1837 (cond
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1838 ;; If too far away, just recenter. But don't show too much
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1839 ;; white space off the end of the line.
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1840 ((or (< here (- left hscroll-step))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1841 (> here (+ right hscroll-step)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1842 (let ((eol (save-excursion (end-of-line) (hscroll-window-column))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1843 (scroll-left (min (- here (/ (window-width) 2))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1844 (- eol (window-width) -5)))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1845 ;; Within range. Scroll by one step (or maybe not at all).
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1846 ((< here left)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1847 (scroll-right hscroll-step))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1848 ((> here right)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1849 (scroll-left hscroll-step)))))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1850
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1851 ;; This function returns the window's idea of the display column of point,
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1852 ;; assuming that the window is already known to be truncated rather than
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1853 ;; wrapped, and that we've already handled the case where point is on the
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1854 ;; part of the line before window-start. We ignore window-width; if point
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1855 ;; is beyond the right margin, we want to know how far. The return value
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1856 ;; includes the effects of window-hscroll, window-start, and the prompt
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1857 ;; string in the minibuffer. It may be negative due to hscroll.
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1858 (defun hscroll-window-column ()
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1859 (let* ((hscroll (window-hscroll))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1860 (startpos (save-excursion
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1861 (beginning-of-line)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1862 (if (= (point) (save-excursion
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1863 (goto-char (window-start))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1864 (beginning-of-line)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1865 (point)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1866 (goto-char (window-start)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1867 (point)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1868 (hpos (+ (if (and (eq (selected-window) (minibuffer-window))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1869 (= 1 (window-start))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1870 (= startpos (point-min)))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1871 (minibuffer-prompt-width)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1872 0)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1873 (min 0 (- 1 hscroll))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1874 val)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1875 (car (cdr (compute-motion startpos (cons hpos 0)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1876 (point) (cons 0 1)
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1877 1000000 (cons hscroll 0) nil)))))
77349221ca81 (hscroll-window-column): New function.
Karl Heuer <kwzh@gnu.org>
parents: 6696
diff changeset
1878
2597
562d2dea4f05 (hscroll-step): New variable.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2577
diff changeset
1879
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1880 ;; rms: (1) The definitions of arrow keys should not simply restate
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1881 ;; what keys they are. The arrow keys should run the ordinary commands.
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1882 ;; (2) The arrow keys are just one of many common ways of moving point
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1883 ;; within a line. Real horizontal autoscrolling would be a good feature,
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1884 ;; but supporting it only for arrow keys is too incomplete to be desirable.
2577
b28675709d41 (down-arrow): New function. Uses next-line-add-newlines to suppress
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2568
diff changeset
1885
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1886 ;;;;; Make arrow keys do the right thing for improved terminal support
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1887 ;;;;; When we implement true horizontal autoscrolling, right-arrow and
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1888 ;;;;; left-arrow can lose the (if truncate-lines ...) clause and become
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1889 ;;;;; aliases. These functions are bound to the corresponding keyboard
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1890 ;;;;; events in loaddefs.el.
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1891
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1892 ;;(defun right-arrow (arg)
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1893 ;; "Move right one character on the screen (with prefix ARG, that many chars).
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1894 ;;Scroll right if needed to keep point horizontally onscreen."
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1895 ;; (interactive "P")
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1896 ;; (forward-char arg)
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1897 ;; (hscroll-point-visible))
2577
b28675709d41 (down-arrow): New function. Uses next-line-add-newlines to suppress
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2568
diff changeset
1898
2608
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1899 ;;(defun left-arrow (arg)
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1900 ;; "Move left one character on the screen (with prefix ARG, that many chars).
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1901 ;;Scroll left if needed to keep point horizontally onscreen."
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1902 ;; (interactive "P")
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1903 ;; (backward-char arg)
cd5e799be39b (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
Richard M. Stallman <rms@gnu.org>
parents: 2597
diff changeset
1904 ;; (hscroll-point-visible))
8006
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1905
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1906 (defun scroll-other-window-down (lines)
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1907 "Scroll the \"other window\" down."
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1908 (interactive "P")
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1909 (scroll-other-window
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1910 ;; Just invert the argument's meaning.
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1911 ;; 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
1912 (if (eq lines '-) nil
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1913 (if (null lines) '-
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
1914 (- (prefix-numeric-value lines))))))
8057
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1915
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1916 (defun beginning-of-buffer-other-window (arg)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1917 "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
1918 Leave mark at previous position.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1919 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
1920 (interactive "P")
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1921 (let ((orig-window (selected-window))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1922 (window (other-window-for-scrolling)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1923 ;; 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
1924 ;; 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
1925 (unwind-protect
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1926 (progn
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1927 (select-window window)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1928 ;; 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
1929 (beginning-of-buffer arg)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1930 ;; Set point accordingly.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1931 (recenter '(t)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1932 (select-window orig-window))))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1933
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1934 (defun end-of-buffer-other-window (arg)
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1935 "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
1936 Leave mark at previous position.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1937 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
1938 (interactive "P")
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1939 ;; See beginning-of-buffer-other-window for comments.
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1940 (let ((orig-window (selected-window))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1941 (window (other-window-for-scrolling)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1942 (unwind-protect
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1943 (progn
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1944 (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
1945 (end-of-buffer arg)
8057
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1946 (recenter '(t)))
11a0c2f22d7e (beginning-of-buffer-other-window)
Richard M. Stallman <rms@gnu.org>
parents: 8006
diff changeset
1947 (select-window orig-window))))
2568
15014ba142a7 All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2446
diff changeset
1948
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1949 (defun transpose-chars (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950 "Interchange characters around point, moving forward one character.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 With prefix arg ARG, effect is to take character before point
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 and drag it forward past ARG other characters (backward if ARG negative).
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 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
1954 (interactive "*P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1955 (and (null arg) (eolp) (forward-char -1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1956 (transpose-subr 'forward-char (prefix-numeric-value arg)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1957
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1958 (defun transpose-words (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1959 "Interchange words around point, leaving point at end of them.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1960 With prefix arg ARG, effect is to take word before or around point
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1961 and drag it forward past ARG other words (backward if ARG negative).
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1962 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
1963 are interchanged."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1964 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1965 (transpose-subr 'forward-word arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 (defun transpose-sexps (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 "Like \\[transpose-words] but applies to sexps.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1969 Does not work on a sexp that point is in the middle of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1970 if it is a list or string."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1971 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1972 (transpose-subr 'forward-sexp arg))
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 transpose-lines (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 "Exchange current line and previous line, leaving point after both.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1976 With argument ARG, takes previous line and moves it past ARG lines.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1977 With argument 0, interchanges line point is in with line mark is in."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1978 (interactive "*p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1979 (transpose-subr (function
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 (lambda (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1981 (if (= arg 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1982 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1983 ;; Move forward over a line,
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1984 ;; but create a newline if none exists yet.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1985 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1986 (if (eobp)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1987 (newline)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988 (forward-char 1)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1989 (forward-line arg))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1990 arg))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1991
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1992 (defun transpose-subr (mover arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1993 (let (start1 end1 start2 end2)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1994 (if (= arg 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1995 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1996 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1997 (funcall mover 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1998 (setq end2 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1999 (funcall mover -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2000 (setq start2 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2001 (goto-char (mark))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2002 (funcall mover 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2003 (setq end1 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2004 (funcall mover -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2005 (setq start1 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2006 (transpose-subr-1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2007 (exchange-point-and-mark)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2008 (while (> arg 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2009 (funcall mover -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2010 (setq start1 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2011 (funcall mover 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 (setq end1 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 (funcall mover 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2014 (setq end2 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2015 (funcall mover -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2016 (setq start2 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2017 (transpose-subr-1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2018 (goto-char end2)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2019 (setq arg (1- arg)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2020 (while (< arg 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2021 (funcall mover -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2022 (setq start2 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2023 (funcall mover -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2024 (setq start1 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2025 (funcall mover 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2026 (setq end1 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2027 (funcall mover 1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2028 (setq end2 (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2029 (transpose-subr-1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2030 (setq arg (1+ arg)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2031
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2032 (defun transpose-subr-1 ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2033 (if (> (min end1 end2) (max start1 start2))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2034 (error "Don't have two things to transpose"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2035 (let ((word1 (buffer-substring start1 end1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2036 (word2 (buffer-substring start2 end2)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2037 (delete-region start2 end2)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2038 (goto-char start2)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2039 (insert word1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2040 (goto-char (if (< start1 start2) start1
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2041 (+ start1 (- (length word1) (length word2)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2042 (delete-char (length word1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2043 (insert word2)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2044
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2045 (defconst comment-column 32
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2046 "*Column to indent right-margin comments to.
1581
9de0900ca56a * simple.el (comment-column): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 1556
diff changeset
2047 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
2048 Each mode establishes a different default value for this variable; you
6237
7c95bb9f534b (comment-column): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6174
diff changeset
2049 can set the value for a particular mode using that mode's hook.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2050 (make-variable-buffer-local 'comment-column)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2051
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2052 (defconst comment-start nil
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2053 "*String to insert to start a new comment, or nil if no comment syntax.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2054
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2055 (defconst comment-start-skip nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2056 "*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
2057 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2058 at the place matched by the close of the first pair.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2059
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2060 (defconst comment-end ""
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2061 "*String to insert to end a new comment.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2062 Should be an empty string if comments are terminated by end-of-line.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2063
2299
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2064 (defconst comment-indent-hook nil
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2065 "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
2066 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
2067 the comment's starting delimiter.")
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2068
53abb56a18fa * simple.el (comment-indent-function): New variable, intended to
Jim Blandy <jimb@redhat.com>
parents: 2215
diff changeset
2069 (defconst comment-indent-function
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2070 '(lambda () comment-column)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2071 "Function to compute desired indentation for a comment.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2072 This function is called with no args with point at the beginning of
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2073 the comment's starting delimiter.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2074
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2075 (defconst block-comment-start nil
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2076 "*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
2077 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
2078 Note that the regular expression `comment-start-skip' should skip this string
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2079 as well as the `comment-start' string.")
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2080
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2081 (defconst block-comment-end nil
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2082 "*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
2083 Should be an empty string if comments are terminated by end-of-line.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2084 If nil, use `comment-end' instead.")
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2085
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2086 (defun indent-for-comment ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2087 "Indent this line's comment to comment column, or insert an empty comment."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2088 (interactive "*")
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2089 (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
2090 (looking-at "[ \t]*$")))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2091 (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
2092 (ender (or (and empty block-comment-end) comment-end)))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2093 (if (null starter)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2094 (error "No comment syntax defined")
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2095 (let* ((eolpos (save-excursion (end-of-line) (point)))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2096 cpos indent begpos)
11975
dd80dd6aa77f (indent-for-comment): move to beginning of line only
Karl Heuer <kwzh@gnu.org>
parents: 11961
diff changeset
2097 (beginning-of-line)
10983
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2098 (if (re-search-forward comment-start-skip eolpos 'move)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2099 (progn (setq cpos (point-marker))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2100 ;; Find the start of the comment delimiter.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2101 ;; If there were paren-pairs in comment-start-skip,
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2102 ;; position at the end of the first pair.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2103 (if (match-end 1)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2104 (goto-char (match-end 1))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2105 ;; If comment-start-skip matched a string with
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2106 ;; internal whitespace (not final whitespace) then
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2107 ;; the delimiter start at the end of that
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2108 ;; whitespace. Otherwise, it starts at the
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2109 ;; beginning of what was matched.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2110 (skip-syntax-backward " " (match-beginning 0))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2111 (skip-syntax-backward "^ " (match-beginning 0)))))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2112 (setq begpos (point))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2113 ;; Compute desired indent.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2114 (if (= (current-column)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2115 (setq indent (if comment-indent-hook
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2116 (funcall comment-indent-hook)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2117 (funcall comment-indent-function))))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2118 (goto-char begpos)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2119 ;; If that's different from current, change it.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2120 (skip-chars-backward " \t")
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2121 (delete-region (point) begpos)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2122 (indent-to indent))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2123 ;; An existing comment?
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2124 (if cpos
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2125 (progn (goto-char cpos)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2126 (set-marker cpos nil))
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2127 ;; No, insert one.
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2128 (insert starter)
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2129 (save-excursion
8ad27030d73f (block-comment-start, block-comment-end): New vars.
Richard M. Stallman <rms@gnu.org>
parents: 10959
diff changeset
2130 (insert ender)))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2131
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2132 (defun set-comment-column (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2133 "Set the comment column based on point.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2134 With no arg, set the comment column to the current column.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2135 With just minus as arg, kill any comment on this line.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2136 With any other arg, set comment column to indentation of the previous comment
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2137 and then align or create a comment on this line at that column."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2138 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2139 (if (eq arg '-)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2140 (kill-comment nil)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2141 (if arg
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2142 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2143 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2144 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2145 (re-search-backward comment-start-skip)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2146 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147 (re-search-forward comment-start-skip)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2148 (goto-char (match-beginning 0))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2149 (setq comment-column (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2150 (message "Comment column set to %d" comment-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2151 (indent-for-comment))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2152 (setq comment-column (current-column))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2153 (message "Comment column set to %d" comment-column))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2154
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2155 (defun kill-comment (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2156 "Kill the comment on this line, if any.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2157 With argument, kill comments on that many lines starting with this one."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2158 ;; this function loses in a lot of situations. it incorrectly recognises
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2159 ;; comment delimiters sometimes (ergo, inside a string), doesn't work
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2160 ;; with multi-line comments, can kill extra whitespace if comment wasn't
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2161 ;; through end-of-line, et cetera.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2162 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2163 (or comment-start-skip (error "No comment syntax defined"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2164 (let ((count (prefix-numeric-value arg)) endc)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2165 (while (> count 0)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2166 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2167 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2168 (setq endc (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2169 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2170 (and (string< "" comment-end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2171 (setq endc
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2172 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2173 (re-search-forward (regexp-quote comment-end) endc 'move)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2174 (skip-chars-forward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2175 (point))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2176 (beginning-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2177 (if (re-search-forward comment-start-skip endc t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2178 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2179 (goto-char (match-beginning 0))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2180 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2181 (kill-region (point) endc)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2182 ;; to catch comments a line beginnings
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2183 (indent-according-to-mode))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2184 (if arg (forward-line 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2185 (setq count (1- count)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2186
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2187 (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
2188 "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
2189 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
2190 Numeric prefix arg ARG means use ARG comment characters.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2191 If ARG is negative, delete that many comment characters instead.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2192 Comments are terminated on each line, even for syntax in which newline does
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2193 not end the comment. Blank lines do not get comments."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2194 ;; 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
2195 ;; 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
2196 ;; is easy enough. No option is made here for other than commenting
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2197 ;; every line.
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2198 (interactive "r\nP")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2199 (or comment-start (error "No comment syntax is defined"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2200 (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2201 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2202 (save-restriction
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2203 (let ((cs comment-start) (ce comment-end)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2204 numarg)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2205 (if (consp arg) (setq numarg t)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2206 (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
2207 ;; 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
2208 ;; 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
2209 (while (> numarg 1)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2210 (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
2211 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
2212 (setq numarg (1- numarg))))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2213 ;; Loop over all lines from BEG to END.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2214 (narrow-to-region beg end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2215 (goto-char beg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2216 (while (not (eobp))
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2217 (if (or (eq numarg t) (< numarg 0))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2218 (progn
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2219 ;; 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
2220 (if (eq numarg t)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2221 (while (looking-at (regexp-quote cs))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2222 (delete-char (length cs)))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2223 (let ((count numarg))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2224 (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
2225 (looking-at (regexp-quote cs)))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2226 (delete-char (length cs)))))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2227 ;; Delete comment end from end of line.
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2228 (if (string= "" ce)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2229 nil
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2230 (if (eq numarg t)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2231 (progn
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2232 (end-of-line)
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2233 ;; 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
2234 ;; 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
2235 ;; though.
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2236 (skip-chars-backward " \t")
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2237 (if (and (>= (- (point) (point-min)) (length ce))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2238 (save-excursion
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2239 (backward-char (length ce))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2240 (looking-at (regexp-quote ce))))
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2241 (delete-char (- (length ce)))))
5767
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2242 (let ((count numarg))
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2243 (while (> 1 (setq count (1+ count)))
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2244 (end-of-line)
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2245 ;; 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
2246 ;; that is pretty brain-damaged though
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2247 (skip-chars-backward " \t")
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2248 (save-excursion
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2249 (backward-char (length ce))
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2250 (if (looking-at (regexp-quote ce))
8fef255fe6b3 (comment-region): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5764
diff changeset
2251 (delete-char (length ce))))))))
1459
a7394244aa9a (comment-region): Do move to next line, in neg arg case.
Richard M. Stallman <rms@gnu.org>
parents: 1331
diff changeset
2252 (forward-line 1))
5730
5810e7311c05 (comment-region): Handle comment-end deletion for C-u.
Richard M. Stallman <rms@gnu.org>
parents: 5675
diff changeset
2253 ;; Insert at beginning and at end.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254 (if (looking-at "[ \t]*$") ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2255 (insert cs)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2256 (if (string= "" ce) ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2257 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2258 (insert ce)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2259 (search-forward "\n" nil 'move)))))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2260
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2261 (defun backward-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2262 "Move backward until encountering the end of a word.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2263 With argument, do this that many times.
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2264 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
2265 (interactive "p")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2266 (forward-word (- arg)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2267
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2268 (defun mark-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2269 "Set mark arg words away from point."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2270 (interactive "p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2271 (push-mark
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2272 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2273 (forward-word arg)
2824
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2274 (point))
c684bce3e977 (yank, yank-pop): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2805
diff changeset
2275 nil t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2276
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2277 (defun kill-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2278 "Kill characters forward until encountering the end of a word.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2279 With argument, do this that many times."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2280 (interactive "p")
7063
9a0d189fd877 (kill-line, kill-word): Don't use save-excursion.
Richard M. Stallman <rms@gnu.org>
parents: 6951
diff changeset
2281 (kill-region (point) (progn (forward-word arg) (point))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2282
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2283 (defun backward-kill-word (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2284 "Kill characters backward until encountering the end of a word.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2285 With argument, do this that many times."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2286 (interactive "p")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2287 (kill-word (- arg)))
2416
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2288
6174
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2289 (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
2290 "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
2291 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
2292 or adjacent to a word."
2416
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2293 (save-excursion
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2294 (let ((oldpoint (point)) (start (point)) (end (point)))
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2295 (skip-syntax-backward "w_") (setq start (point))
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2296 (goto-char oldpoint)
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2297 (skip-syntax-forward "w_") (setq end (point))
cd01176e9dc5 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2315
diff changeset
2298 (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
2299 ;; 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
2300 (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
2301 (progn
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2302 ;; 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
2303 (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
2304 (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
2305 (point)))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2306 (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
2307 ;; 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
2308 ;; 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
2309 (progn
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2310 (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
2311 (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
2312 (point)))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2313 (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
2314 (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
2315 (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
2316 (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
2317 (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
2318 (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
2319 (buffer-substring start end)))
3902f1241d1c (current-word): Check properly for bolp. New optional arg STRICT. Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6160
diff changeset
2320 (buffer-substring start end)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2321
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2322 (defconst fill-prefix nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2323 "*String for filling to insert at front of new line, or nil for none.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2324 Setting this variable automatically makes it local to the current buffer.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2325 (make-variable-buffer-local 'fill-prefix)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2326
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2327 (defconst auto-fill-inhibit-regexp nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2328 "*Regexp to match lines which should not be auto-filled.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2329
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2330 (defun do-auto-fill ()
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2331 (let (fc justify bol give-up)
10471
3eb77f03f53e (do-auto-fill): justification renamed to current-justification.
Richard M. Stallman <rms@gnu.org>
parents: 10469
diff changeset
2332 (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
2333 (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
2334 (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
2335 (<= (current-column) fc))
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2336 (save-excursion (beginning-of-line)
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2337 (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
2338 (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
2339 (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
2340 nil ;; Auto-filling not required
10813
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2341 (if (memq justify '(full center right))
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2342 (save-excursion (unjustify-current-line)))
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2343 (while (and (not give-up) (> (current-column) fc))
5769
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2344 ;; Determine where to split the line.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2345 (let ((fill-point
5769
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2346 (let ((opoint (point))
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2347 bounce
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2348 (first t))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2349 (save-excursion
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2350 (move-to-column (1+ fc))
5769
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2351 ;; Move back to a word boundary.
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2352 (while (or first
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2353 ;; If this is after period and a single space,
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2354 ;; move back once more--we don't want to break
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2355 ;; the line there and make it look like a
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2356 ;; sentence end.
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2357 (and (not (bobp))
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2358 (not bounce)
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2359 sentence-end-double-space
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2360 (save-excursion (forward-char -1)
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2361 (and (looking-at "\\. ")
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2362 (not (looking-at "\\. "))))))
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2363 (setq first nil)
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2364 (skip-chars-backward "^ \t\n")
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2365 ;; If we find nowhere on the line to break it,
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2366 ;; break after one word. Set bounce to t
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2367 ;; so we will not keep going in this while loop.
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2368 (if (bolp)
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2369 (progn
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2370 (re-search-forward "[ \t]" opoint t)
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2371 (setq bounce t)))
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2372 (skip-chars-backward " \t"))
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2373 ;; Let fill-point be set to the place where we end up.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2374 (point)))))
5769
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2375 ;; If that place is not the beginning of the line,
95188ebbb0bc (do-auto-fill): Don't break line at period-single-space.
Richard M. Stallman <rms@gnu.org>
parents: 5767
diff changeset
2376 ;; break the line there.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2377 (if (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2378 (goto-char fill-point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2379 (not (bolp)))
4477
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2380 (let ((prev-column (current-column)))
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2381 ;; If point is at the fill-point, do not `save-excursion'.
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2382 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2383 ;; point will end up before it rather than after it.
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2384 (if (save-excursion
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2385 (skip-chars-backward " \t")
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2386 (= (point) fill-point))
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
2387 (indent-new-comment-line t)
4477
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2388 (save-excursion
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2389 (goto-char fill-point)
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
2390 (indent-new-comment-line t)))
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2391 ;; Now do justification, if required
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2392 (if (not (eq justify 'left))
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2393 (save-excursion
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2394 (end-of-line 0)
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2395 (justify-current-line justify nil t)))
4477
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2396 ;; If making the new line didn't reduce the hpos of
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2397 ;; the end of the line, then give up now;
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2398 ;; trying again will not help.
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2399 (if (>= (current-column) prev-column)
7101a887f80d (do-auto-fill): Don't keep breaking the line
Richard M. Stallman <rms@gnu.org>
parents: 4374
diff changeset
2400 (setq give-up t)))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2401 ;; No place to break => stop trying.
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2402 (setq give-up t))))
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2403 ;; justify last line
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2404 (justify-current-line justify t t))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2405
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2406 (defun auto-fill-mode (&optional arg)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2407 "Toggle auto-fill mode.
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2408 With arg, turn Auto-Fill mode on if and only if arg is positive.
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2409 In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2410 automatically breaks the line at a previous space."
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2411 (interactive "P")
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2412 (prog1 (setq auto-fill-function
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2413 (if (if (null arg)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2414 (not auto-fill-function)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2415 (> (prefix-numeric-value arg) 0))
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2416 'do-auto-fill
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2417 nil))
11572
09d49f6e0af9 (auto-fill-mode): Use force-mode-line-update.
Karl Heuer <kwzh@gnu.org>
parents: 11479
diff changeset
2418 (force-mode-line-update)))
6907
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2419
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2420 ;; 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
2421 (defun auto-fill-function ()
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2422 "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
2423 nil)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2424
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2425 (defun turn-on-auto-fill ()
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2426 "Unconditionally turn on Auto Fill mode."
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2427 (auto-fill-mode 1))
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2428
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2429 (defun set-fill-column (arg)
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2430 "Set `fill-column' to current column, or to argument if given.
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2431 The variable `fill-column' has a separate value for each buffer."
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2432 (interactive "P")
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2433 (setq fill-column (if (integerp arg) arg (current-column)))
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2434 (message "fill-column set to %d" fill-column))
35e524a24c7f (auto-fill-function): New function (doc placeholder).
Richard M. Stallman <rms@gnu.org>
parents: 6837
diff changeset
2435
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2436 (defconst comment-multi-line nil
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2437 "*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
2438 on new line, with no new terminator or starter.
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2439 This is obsolete because you might as well use \\[newline-and-indent].")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2440
10422
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
2441 (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
2442 "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
2443 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
2444 under the previous comment line.
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2445
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2446 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
2447 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
2448 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
2449
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
2450 The inserted newline is marked hard if `use-hard-newlines' is true,
3c447e2caef3 (open-line, split-line, next-line): Use `newline'
Richard M. Stallman <rms@gnu.org>
parents: 10352
diff changeset
2451 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
2452 (interactive)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2453 (let (comcol comstart)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2454 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2455 (delete-region (point)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2456 (progn (skip-chars-forward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2457 (point)))
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2458 (if soft (insert-and-inherit ?\n) (newline 1))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2459 (if (not comment-multi-line)
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2460 (save-excursion
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2461 (if (and comment-start-skip
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2462 (let ((opoint (point)))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2463 (forward-line -1)
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2464 (re-search-forward comment-start-skip opoint t)))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2465 ;; The old line is a comment.
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2466 ;; Set WIN to the pos of the comment-start.
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2467 ;; But if the comment is empty, look at preceding lines
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2468 ;; 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
2469
6a2af2832a42 (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip.
Richard M. Stallman <rms@gnu.org>
parents: 10912
diff changeset
2470 ;; If comment-start-skip contains a \(...\) pair,
6a2af2832a42 (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip.
Richard M. Stallman <rms@gnu.org>
parents: 10912
diff changeset
2471 ;; the real comment delimiter starts at the end of that pair.
6a2af2832a42 (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip.
Richard M. Stallman <rms@gnu.org>
parents: 10912
diff changeset
2472 (let ((win (or (match-end 1) (match-beginning 0))))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2473 (while (and (eolp) (not (bobp))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2474 (let (opoint)
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2475 (beginning-of-line)
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2476 (setq opoint (point))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2477 (forward-line -1)
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2478 (re-search-forward comment-start-skip opoint t)))
10943
6a2af2832a42 (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip.
Richard M. Stallman <rms@gnu.org>
parents: 10912
diff changeset
2479 (setq win (or (match-end 1) (match-beginning 0))))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2480 ;; Indent this line like what we found.
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2481 (goto-char win)
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2482 (setq comcol (current-column))
10597
b357342180c2 (indent-new-comment-line): Obey the convention
Richard M. Stallman <rms@gnu.org>
parents: 10525
diff changeset
2483 (setq comstart
b357342180c2 (indent-new-comment-line): Obey the convention
Richard M. Stallman <rms@gnu.org>
parents: 10525
diff changeset
2484 (buffer-substring (point) (match-end 0)))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2485 (if comcol
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2486 (let ((comment-column comcol)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2487 (comment-start comstart)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2488 (comment-end comment-end))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2489 (and comment-end (not (equal comment-end ""))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2490 ; (if (not comment-multi-line)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2491 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2492 (forward-char -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2493 (insert comment-end)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2494 (forward-char 1))
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2495 ; (setq comment-column (+ comment-column (length comment-start))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2496 ; comment-start "")
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2497 ; )
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2498 )
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2499 (if (not (eolp))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2500 (setq comment-end ""))
10469
2546bad34200 (do-auto-fill): Fill, don't fill, or fill-and-justify
Richard M. Stallman <rms@gnu.org>
parents: 10422
diff changeset
2501 (insert-and-inherit ?\n)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2502 (forward-char -1)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2503 (indent-for-comment)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2504 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2505 ;; Make sure we delete the newline inserted above.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2506 (end-of-line)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2507 (delete-char 1)))
10813
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2508 (if (null fill-prefix)
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2509 (indent-according-to-mode)
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2510 (indent-to-left-margin)
bccf0295c66e (open-line): indent when inserting fil-prefix.
Boris Goldowsky <boris@gnu.org>
parents: 10805
diff changeset
2511 (insert-and-inherit fill-prefix)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2512
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2513 (defun set-selective-display (arg)
1027
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2514 "Set `selective-display' to ARG; clear it if no arg.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2515 When the value of `selective-display' is a number > 0,
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2516 lines whose indentation is >= that value are not displayed.
f0000f6f7942 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 954
diff changeset
2517 The variable `selective-display' has a separate value for each buffer."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2518 (interactive "P")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2519 (if (eq selective-display t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2520 (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
2521 (let ((current-vpos
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2522 (save-restriction
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2523 (narrow-to-region (point-min) (point))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2524 (goto-char (window-start))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2525 (vertical-motion (window-height)))))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2526 (setq selective-display
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2527 (and arg (prefix-numeric-value arg)))
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2528 (recenter current-vpos))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2529 (set-window-start (selected-window) (window-start (selected-window)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2530 (princ "selective-display set to " t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2531 (prin1 selective-display t)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2532 (princ "." t))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2533
2215
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2534 (defconst overwrite-mode-textual " Ovwrt"
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2535 "The string displayed in the mode line when in overwrite mode.")
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2536 (defconst overwrite-mode-binary " Bin Ovwrt"
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2537 "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
2538
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2539 (defun overwrite-mode (arg)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540 "Toggle overwrite mode.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2541 With arg, turn overwrite mode on iff arg is positive.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2542 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
2543 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
2544 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
2545 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
2546 \\[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
2547 is supposed to make it easier to insert characters when necessary."
475
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 (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
2550 (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
2551 (> (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
2552 '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
2553 (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
2554
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2555 (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
2556 "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
2557 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
2558 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
2559 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
2560 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
2561 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
2562 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
2563 \\[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
2564 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
2565
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2566 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
2567 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
2568 `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
2569 (interactive "P")
a7d915ce7676 src/ * simple.el (quoted-insert): In overwrite mode, don't read digits
Jim Blandy <jimb@redhat.com>
parents: 2111
diff changeset
2570 (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
2571 (if (if (null arg)
2301
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2572 (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
2573 (> (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
2574 '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
2575 (force-mode-line-update))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2576
2301
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2577 (defvar line-number-mode nil
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2578 "*Non-nil means display line number in mode line.")
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2579
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2580 (defun line-number-mode (arg)
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2581 "Toggle Line Number mode.
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2582 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
2583 When Line Number mode is enabled, the line number appears
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2584 in the mode line."
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2585 (interactive "P")
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2586 (setq line-number-mode
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2587 (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
2588 (> (prefix-numeric-value arg) 0)))
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2589 (force-mode-line-update))
1380ea427dee (line-number-mode): New function and variable.
Richard M. Stallman <rms@gnu.org>
parents: 2299
diff changeset
2590
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2591 (defvar blink-matching-paren t
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2592 "*Non-nil means show matching open-paren when close-paren is inserted.")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2593
2669
0931cd677ff4 (blink-matching-paren-distance): Change default to 12,000.
Richard M. Stallman <rms@gnu.org>
parents: 2608
diff changeset
2594 (defconst blink-matching-paren-distance 12000
0931cd677ff4 (blink-matching-paren-distance): Change default to 12,000.
Richard M. Stallman <rms@gnu.org>
parents: 2608
diff changeset
2595 "*If non-nil, is maximum distance to search for matching open-paren.")
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2596
9771
3a51735d4a55 (blink-matching-delay): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9750
diff changeset
2597 (defconst blink-matching-delay 1
3a51735d4a55 (blink-matching-delay): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9750
diff changeset
2598 "*The number of seconds that `blink-matching-open' will delay at a match.")
3a51735d4a55 (blink-matching-delay): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9750
diff changeset
2599
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2600 (defun blink-matching-open ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2601 "Move cursor momentarily to the beginning of the sexp before point."
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2602 (interactive)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2603 (and (> (point) (1+ (point-min)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2604 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
2605 ;; 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
2606 (= 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
2607 (save-excursion
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
2608 (forward-char -1)
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
2609 (skip-syntax-backward "/\\")
b2157de450ca (blink-matching-open): Do blink if an even number of
Richard M. Stallman <rms@gnu.org>
parents: 9629
diff changeset
2610 (point)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2611 (let* ((oldpos (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2612 (blinkpos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2613 (mismatch))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2614 (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2615 (save-restriction
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2616 (if blink-matching-paren-distance
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2617 (narrow-to-region (max (point-min)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2618 (- (point) blink-matching-paren-distance))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2619 oldpos))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2620 (condition-case ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2621 (setq blinkpos (scan-sexps oldpos -1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2622 (error nil)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2623 (and blinkpos (/= (char-syntax (char-after blinkpos))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2624 ?\$)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2625 (setq mismatch
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2626 (/= (char-after (1- oldpos))
8006
6e58b282df42 (scroll-other-window-down): New command.
Richard M. Stallman <rms@gnu.org>
parents: 7881
diff changeset
2627 (matching-paren (char-after blinkpos)))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2628 (if mismatch (setq blinkpos nil))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2629 (if blinkpos
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2630 (progn
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2631 (goto-char blinkpos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2632 (if (pos-visible-in-window-p)
9771
3a51735d4a55 (blink-matching-delay): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 9750
diff changeset
2633 (sit-for blink-matching-delay)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2634 (goto-char blinkpos)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2635 (message
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2636 "Matches %s"
6539
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2637 ;; Show what precedes the open in its line, if anything.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2638 (if (save-excursion
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2639 (skip-chars-backward " \t")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2640 (not (bolp)))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2641 (buffer-substring (progn (beginning-of-line) (point))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2642 (1+ blinkpos))
6539
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2643 ;; 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
2644 (if (save-excursion
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2645 (forward-char 1)
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2646 (skip-chars-forward " \t")
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2647 (not (eolp)))
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2648 (buffer-substring blinkpos
b705afc2b2ec (blink-matching-open): Now three strategies for choosing
Richard M. Stallman <rms@gnu.org>
parents: 6386
diff changeset
2649 (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
2650 ;; 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
2651 ;; if there is one.
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2652 (if (save-excursion
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2653 (skip-chars-backward "\n \t")
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2654 (not (bobp)))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2655 (concat
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2656 (buffer-substring (progn
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2657 (skip-chars-backward "\n \t")
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2658 (beginning-of-line)
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2659 (point))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2660 (progn (end-of-line)
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2661 (skip-chars-backward " \t")
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2662 (point)))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2663 ;; 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
2664 "..."
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2665 (buffer-substring blinkpos (1+ blinkpos)))
d79ecfc2776c (blink-matching-open): Check there is a previous
Richard M. Stallman <rms@gnu.org>
parents: 9343
diff changeset
2666 ;; 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
2667 (buffer-substring blinkpos (1+ blinkpos))))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2668 (cond (mismatch
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2669 (message "Mismatched parentheses"))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2670 ((not blink-matching-paren-distance)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2671 (message "Unmatched parenthesis"))))))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2672
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2673 ;Turned off because it makes dbx bomb out.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2674 (setq blink-paren-function 'blink-matching-open)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2675
2805
5efa58250e35 (push-mark): Don't activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2796
diff changeset
2676 ;; 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
2677 ;; 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
2678 ;; that happens in the QUIT macro at the C code level.
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2679 (defun keyboard-quit ()
2075
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2680 "Signal a quit condition.
ec62da254d4d (set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2023
diff changeset
2681 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
2682 At top-level, as an editor command, this simply beeps."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683 (interactive)
4042
4b4ab64225f7 (deactivate-mark): New function.
Roland McGrath <roland@gnu.org>
parents: 4040
diff changeset
2684 (deactivate-mark)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2685 (signal 'quit nil))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2686
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2687 (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
2688
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2689 (defvar buffer-quit-function nil
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2690 "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
2691 \\[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
2692 \(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
2693
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2694 (defun keyboard-escape-quit ()
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2695 "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
2696 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
2697 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
2698 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
2699 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
2700 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
2701 (interactive)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2702 (cond ((eq last-command 'mode-exited) nil)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2703 ((> (minibuffer-depth) 0)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2704 (abort-recursive-edit))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2705 (current-prefix-arg
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2706 nil)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2707 ((and transient-mark-mode
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2708 mark-active)
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2709 (deactivate-mark))
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2710 (buffer-quit-function
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2711 (funcall buffer-quit-function))
10085
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2712 ((not (one-window-p t))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2713 (delete-other-windows))))
f7b9813ea757 (keyboard-escape-quit): New command.
Richard M. Stallman <rms@gnu.org>
parents: 10048
diff changeset
2714
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2715 (define-key global-map "\e\e\e" 'keyboard-escape-quit)
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2716
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2717 (defun set-variable (var val)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2718 "Set VARIABLE to VALUE. VALUE is a Lisp object.
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2719 When using this interactively, supply a Lisp expression for VALUE.
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2720 If you want VALUE to be a string, you must surround it with doublequotes.
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2721
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2722 If VARIABLE has a `variable-interactive' property, that is used as if
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2723 it were the arg to `interactive' (which see) to interactively read the value."
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2724 (interactive
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2725 (let* ((var (read-variable "Set variable: "))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2726 (minibuffer-help-form
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2727 '(funcall myhelp))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2728 (myhelp
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2729 (function
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2730 (lambda ()
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2731 (with-output-to-temp-buffer "*Help*"
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2732 (prin1 var)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2733 (princ "\nDocumentation:\n")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2734 (princ (substring (documentation-property var 'variable-documentation)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2735 1))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2736 (if (boundp var)
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2737 (let ((print-length 20))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2738 (princ "\n\nCurrent value: ")
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2739 (prin1 (symbol-value var))))
9846
6a9a8abb0b6e (set-variable): Set help-mode in *Help* buffer.
Karl Heuer <kwzh@gnu.org>
parents: 9779
diff changeset
2740 (save-excursion
6a9a8abb0b6e (set-variable): Set help-mode in *Help* buffer.
Karl Heuer <kwzh@gnu.org>
parents: 9779
diff changeset
2741 (set-buffer standard-output)
6a9a8abb0b6e (set-variable): Set help-mode in *Help* buffer.
Karl Heuer <kwzh@gnu.org>
parents: 9779
diff changeset
2742 (help-mode))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2743 nil)))))
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2744 (list var
846
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2745 (let ((prop (get var 'variable-interactive)))
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2746 (if prop
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2747 ;; Use VAR's `variable-interactive' property
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2748 ;; as an interactive spec for prompting.
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2749 (call-interactively (list 'lambda '(arg)
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2750 (list 'interactive prop)
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2751 'arg))
20674ae6bf52 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 762
diff changeset
2752 (eval-minibuffer (format "Set %s to value: " var)))))))
475
fb215f87f4a9 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2753 (set var val))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2754
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2755 ;; Define the major mode for lists of completions.
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
2756
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2757 (defvar completion-list-mode-map nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2758 "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
2759 (or completion-list-mode-map
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2760 (let ((map (make-sparse-keymap)))
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2761 (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
2762 (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
2763 (define-key map "\C-m" 'choose-completion)
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2764 (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
2765 (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
2766 (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
2767 (setq completion-list-mode-map map)))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2768
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2769 ;; 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
2770 (put 'completion-list-mode 'mode-class 'special)
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2771
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2772 (defvar completion-reference-buffer nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2773 "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
2774 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
2775 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
2776
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2777 (defvar completion-base-size nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2778 "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
2779 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
2780 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
2781 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
2782 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
2783
10165
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2784 (defun delete-completion-window ()
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2785 "Delete the completion list window.
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2786 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
2787 (interactive)
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2788 (let ((buf completion-reference-buffer))
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2789 (delete-window (selected-window))
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2790 (if (get-buffer-window buf)
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2791 (select-window (get-buffer-window buf)))))
10a032873be6 (buffer-quit-function): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 10085
diff changeset
2792
10284
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2793 (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
2794 "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
2795 (interactive "p")
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2796 (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
2797
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2798 (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
2799 "Move to the next 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
2800 WIth prefix argument N, move N items (negative N means move backward)."
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2801 (interactive "p")
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2802 (while (and (> n 0) (not (eobp)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2803 (let ((prop (get-text-property (point) 'mouse-face)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2804 ;; 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
2805 (if prop
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2806 (goto-char (next-single-property-change (point) 'mouse-face)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2807 ;; Move to start of next one.
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2808 (goto-char (next-single-property-change (point) 'mouse-face)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2809 (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
2810 (while (and (< n 0) (not (bobp)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2811 (let ((prop (get-text-property (1- (point)) 'mouse-face)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2812 ;; 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
2813 (if prop
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2814 (goto-char (previous-single-property-change (point) 'mouse-face)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2815 ;; Move to end of the previous completion.
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2816 (goto-char (previous-single-property-change (point) 'mouse-face))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2817 ;; Move to the start of that one.
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2818 (goto-char (previous-single-property-change (point) 'mouse-face)))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2819 (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
2820
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2821 (defun choose-completion ()
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2822 "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
2823 (interactive)
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2824 (let (beg end completion (buffer completion-reference-buffer)
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2825 (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
2826 (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
2827 (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
2828 (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
2829 (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
2830 (if (null beg)
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2831 (error "No completion here"))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2832 (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
2833 (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
2834 (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
2835 (let ((owindow (selected-window)))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
2836 (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
2837 (window-dedicated-p (selected-window)))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
2838 ;; 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
2839 (iconify-frame (selected-frame))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
2840 (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
2841 (bury-buffer)))
52940ba43041 (choose-completion): Bury or iconify the completion list
Richard M. Stallman <rms@gnu.org>
parents: 8442
diff changeset
2842 (select-window owindow))
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2843 (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
2844
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2845 ;; 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
2846 ;; that can be found before POINT.
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2847 (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
2848 (let ((opoint (point))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2849 (len (min (length string)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2850 (- (point) (point-min)))))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2851 (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
2852 (if completion-ignore-case
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
2853 (setq string (downcase string)))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2854 (while (and (> len 0)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2855 (let ((tail (buffer-substring (point)
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2856 (+ (point) len))))
7574
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
2857 (if completion-ignore-case
040547adfab2 (completion-setup-function): Make highlight span single spaces.
Richard M. Stallman <rms@gnu.org>
parents: 7463
diff changeset
2858 (setq tail (downcase tail)))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2859 (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
2860 (setq len (1- len))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2861 (forward-char 1))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2862 (delete-char len)))
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2863
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2864 ;; 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
2865 ;; 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
2866 ;; to keep. If it is nil, use choose-completion-delete-max-match instead.
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2867 (defun choose-completion-string (choice &optional buffer base-size)
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2868 (let ((buffer (or buffer completion-reference-buffer)))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
2869 ;; 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
2870 ;; active minibuffer.
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
2871 (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
11159
edf66df6fbe9 (choose-completion-string): Use active-minibuffer-window.
Richard M. Stallman <rms@gnu.org>
parents: 11140
diff changeset
2872 (or (not (active-minibuffer-window))
edf66df6fbe9 (choose-completion-string): Use active-minibuffer-window.
Richard M. Stallman <rms@gnu.org>
parents: 11140
diff changeset
2873 (not (equal buffer
edf66df6fbe9 (choose-completion-string): Use active-minibuffer-window.
Richard M. Stallman <rms@gnu.org>
parents: 11140
diff changeset
2874 (window-buffer (active-minibuffer-window))))))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
2875 (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
2876 ;; 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
2877 (set-buffer buffer)
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2878 (if base-size
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2879 (delete-region (+ base-size (point-min)) (point))
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2880 (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
2881 (insert choice)
7697
b52a92ea3796 (choose-completion-string): Clear mouse-face property.
Richard M. Stallman <rms@gnu.org>
parents: 7594
diff changeset
2882 (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
2883 '(mouse-face nil))
7333
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
2884 ;; 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
2885 (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
2886 (set-window-point window (point)))
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
2887 ;; If completing for the minibuffer, exit it with this choice.
7a0395228878 (choose-completion-string): Barf if completing into
Richard M. Stallman <rms@gnu.org>
parents: 7076
diff changeset
2888 (and (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
2889 minibuffer-completion-table
509daefd2d13 (choose-completion-string): Use plain exit-minibuffer,
Richard M. Stallman <rms@gnu.org>
parents: 8479
diff changeset
2890 (exit-minibuffer)))))
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2891
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
2892 (defun completion-list-mode ()
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2893 "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
2894 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
2895 to select the completion near point.
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2896 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
2897 with the mouse."
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2898 (interactive)
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2899 (kill-all-local-variables)
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
2900 (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
2901 (setq mode-name "Completion List")
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
2902 (setq major-mode 'completion-list-mode)
8479
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2903 (make-local-variable 'completion-base-size)
582ac9a744c4 (completion-base-size): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8468
diff changeset
2904 (setq completion-base-size nil)
4217
997e8a52f9fd (completion-list-mode): Renamed from completion-mode.
Richard M. Stallman <rms@gnu.org>
parents: 4103
diff changeset
2905 (run-hooks 'completion-list-mode-hook))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2906
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2907 (defvar completion-fixup-function nil
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2908 "A function to customize how completions are identified in completion lists.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2909 `completion-setup-function' calls this function with no arguments
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2910 each time it has found what it thinks is one completion.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2911 Point is at the end of the completion in the completion list buffer.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2912 If this function moves point, it can alter the end of that completion.")
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2913
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2914 ;; 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
2915 ;; 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
2916
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2917 (defun completion-setup-function ()
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2918 (save-excursion
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2919 (let ((mainbuf (current-buffer)))
6160
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2920 (set-buffer standard-output)
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2921 (completion-list-mode)
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2922 (make-local-variable 'completion-reference-buffer)
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2923 (setq completion-reference-buffer mainbuf)
11313
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2924 ;;; The value 0 is right in most cases, but not for file name completion.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2925 ;;; so this has to be turned off.
5704f8216dbd (completion-setup-function): Undo March 11 change.
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
2926 ;;; (setq completion-base-size 0)
6160
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2927 (goto-char (point-min))
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2928 (if window-system
5a40bc311e2f (completion-list-mode): Set completion-reference-buffer
Richard M. Stallman <rms@gnu.org>
parents: 5944
diff changeset
2929 (insert (substitute-command-keys
6549
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2930 "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
2931 (insert (substitute-command-keys
d66e48956d3e (choose-completion-delete-max-match): Renamed from
Richard M. Stallman <rms@gnu.org>
parents: 6539
diff changeset
2932 "In this buffer, type \\[choose-completion] to \
6674
7ada27b4bf3c (completion-setup-function): Add mouse-face properties.
Karl Heuer <kwzh@gnu.org>
parents: 6549
diff changeset
2933 select the completion near point.\n\n"))
7ada27b4bf3c (completion-setup-function): Add mouse-face properties.
Karl Heuer <kwzh@gnu.org>
parents: 6549
diff changeset
2934 (forward-line 1)
8203
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2935 (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2936 (let ((beg (match-beginning 0))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2937 (end (point)))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2938 (if completion-fixup-function
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2939 (funcall completion-fixup-function))
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2940 (put-text-property beg (point) 'mouse-face 'highlight)
7f13bc5470d9 (completion-setup-function): Put on mouse-face prop
Richard M. Stallman <rms@gnu.org>
parents: 8080
diff changeset
2941 (goto-char end))))))
4082
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2942
1d4aa358d9a0 (completion-mode): New major mode.
Richard M. Stallman <rms@gnu.org>
parents: 4044
diff changeset
2943 (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
2944
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2945 (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
2946 '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
2947 (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
2948 '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
2949 (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
2950 '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
2951 (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
2952 '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
2953
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2954 (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
2955 "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
2956 (interactive)
12483
ec77cb3940f1 (switch-to-completions): Make a completions window if none.
Richard M. Stallman <rms@gnu.org>
parents: 12428
diff changeset
2957 ;; 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
2958 (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
2959 (minibuffer-completion-help))
10284
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2960 (select-window (get-buffer-window "*Completions*"))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2961 (goto-char (point-min))
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2962 (search-forward "\n\n")
832491972c95 (switch-to-completions): New command, with bindings in minibuf completion maps.
Richard M. Stallman <rms@gnu.org>
parents: 10252
diff changeset
2963 (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
2964
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2965 ;; Support keyboard commands to turn on various modifiers.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2966
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2967 ;; 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
2968 ;; to the following event.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2969
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2970 (defun event-apply-alt-modifier (ignore-prompt)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2971 (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
2972 (defun event-apply-super-modifier (ignore-prompt)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2973 (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
2974 (defun event-apply-hyper-modifier (ignore-prompt)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2975 (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
2976 (defun event-apply-shift-modifier (ignore-prompt)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2977 (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
2978 (defun event-apply-control-modifier (ignore-prompt)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2979 (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
2980 (defun event-apply-meta-modifier (ignore-prompt)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2981 (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
2982
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2983 (defun event-apply-modifier (event symbol lshiftby prefix)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2984 "Apply a modifier flag to event EVENT.
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2985 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
2986 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
2987 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
2988 (if (numberp event)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2989 (cond ((eq symbol 'control)
11201
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
2990 (if (and (<= (downcase event) ?z)
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
2991 (>= (downcase event) ?a))
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2992 (- (downcase event) ?a -1)
11201
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
2993 (if (and (<= (downcase event) ?Z)
f6caea9275af (event-apply-modifier): Fix off-by-one errors.
Karl Heuer <kwzh@gnu.org>
parents: 11159
diff changeset
2994 (>= (downcase event) ?A))
11140
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2995 (- (downcase event) ?A -1)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2996 (logior (lsh 1 lshiftby) event))))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2997 ((eq symbol 'shift)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2998 (if (and (<= (downcase event) ?z)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
2999 (>= (downcase event) ?a))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3000 (upcase event)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3001 (logior (lsh 1 lshiftby) event)))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3002 (t
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3003 (logior (lsh 1 lshiftby) event)))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3004 (if (memq symbol (event-modifiers event))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3005 event
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3006 (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
3007 (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
3008 (if (symbolp event)
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3009 event-type
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3010 (cons event-type (cdr event)))))))
97ed670a6123 (event-apply-modifier): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11072
diff changeset
3011
11206
60b7ab7d4fec Change bindings of event-apply-control-modifier,
Karl Heuer <kwzh@gnu.org>
parents: 11201
diff changeset
3012 (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
3013 (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
3014 (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
3015 (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
3016 (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
3017 (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
3018
3947
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3019 ;;;; Keypad support.
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3020
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3021 ;;; 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
3022 ;;; 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
3023 ;;; 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
3024 ;;; bindings.
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3025
5342
f38861038093 (setting up kp-... keys): Make ascii-character props.
Richard M. Stallman <rms@gnu.org>
parents: 5324
diff changeset
3026 ;; 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
3027 (mapcar
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3028 (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
3029 (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
3030 (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
3031 (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
3032 (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
3033 '((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
3034 (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
3035 (kp-space ?\ )
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3036 (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
3037 (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
3038 (kp-multiply ?*)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3039 (kp-add ?+)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3040 (kp-separator ?,)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3041 (kp-subtract ?-)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3042 (kp-decimal ?.)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3043 (kp-divide ?/)
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3044 (kp-equal ?=)))
924d8515c250 * simple.el: Add bindings to function-key-map so that the keypad
Jim Blandy <jimb@redhat.com>
parents: 3936
diff changeset
3045
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 617
diff changeset
3046 ;;; simple.el ends here