aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2004-09-04 09:14:28 +0000
committerMiles Bader2004-09-04 09:14:28 +0000
commit6f7dde8273383c74cc722196c9b37c04faeb263f (patch)
tree5a4126925b754a52e74fa30de6521b3454f57a6d /lisp
parent32d61209ceb2b6c4b32e9d3ccc477014cc666c25 (diff)
parent90e118abf2dcc4aca4d7a7642247fa488554351e (diff)
downloademacs-6f7dde8273383c74cc722196c9b37c04faeb263f.tar.gz
emacs-6f7dde8273383c74cc722196c9b37c04faeb263f.zip
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-34
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-514 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-522 Update from CVS
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog224
-rw-r--r--lisp/autorevert.el3
-rw-r--r--lisp/emacs-lisp/lisp-mode.el48
-rw-r--r--lisp/emacs-lisp/lisp.el6
-rw-r--r--lisp/emulation/cua-base.el91
-rw-r--r--lisp/emulation/cua-rect.el417
-rw-r--r--lisp/help-fns.el27
-rw-r--r--lisp/help.el55
-rw-r--r--lisp/indent.el4
-rw-r--r--lisp/info.el157
-rw-r--r--lisp/isearch.el179
-rw-r--r--lisp/macros.el17
-rw-r--r--lisp/progmodes/compile.el64
-rw-r--r--lisp/progmodes/etags.el20
-rw-r--r--lisp/progmodes/grep.el59
-rw-r--r--lisp/simple.el148
-rw-r--r--lisp/startup.el3
-rw-r--r--lisp/subr.el21
-rw-r--r--lisp/term/mac-win.el6
-rw-r--r--lisp/textmodes/ispell.el2
-rw-r--r--lisp/textmodes/tex-mode.el7
-rw-r--r--lisp/x-dnd.el17
22 files changed, 1049 insertions, 526 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 66ef44650d5..96fa1656f0a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,218 @@
12004-09-03 Luc Teirlinck <teirllm@auburn.edu>
2
3 * autorevert.el (auto-revert-handler): Bind `buffer-read-only'
4 locally around the call to `revert-buffer'.
5
62004-09-03 Juri Linkov <juri@jurta.org>
7
8 * isearch.el (isearch-toggle-regexp): Set `isearch-success' and
9 `isearch-adjusted' to `t'.
10 (isearch-toggle-case-fold): Set `isearch-success' to `t'.
11 (isearch-message-prefix): Add "pending" for isearch-adjusted.
12 (isearch-other-meta-char): Restore isearch-point unconditionally.
13 (isearch-query-replace): Add new arg `regexp-flag' and use it.
14 Set point to start of match if region is not active in transient
15 mark mode (to include the current match to region boundaries).
16 Push the search string to `query-replace-from-history-variable'.
17 Add prompt "Query replace regexp" for isearch-regexp.
18 Add region beginning/end as last arguments of `perform-replace.'
19 (isearch-query-replace-regexp): Replace code by the call to
20 `isearch-query-replace' with arg `t'.
21
222004-09-03 Richard M. Stallman <rms@gnu.org>
23
24 * startup.el (normal-top-level): Undo previous TERM change.
25
262004-09-03 Kim F. Storm <storm@cua.dk>
27
28 * emulation/cua-rect.el (cua--overlay-keymap): New keymap for
29 highlight overlays; allow using RET when cursor is over a button.
30 (cua--highlight-rectangle): Use it.
31 (cua--rectangle-set-corners): Don't move backwards at eol.
32 (cua--forward-line): Don't move into void after eob.
33
34 * emulation/cua-rect.el (cua--rectangle-set-corners): Ensure that
35 point is set (and displayed) inside rectangle.
36 (cua--rectangle-operation): Fix for highlight of empty lines.
37 (cua--highlight-rectangle): Fix highlight for tabs.
38 Position cursor at left/right edge of rectangle using new `cursor'
39 property on overlay strings.
40 (cua--indent-rectangle): Don't tabify.
41 (cua-rotate-rectangle): Ignore that point has moved.
42
432004-09-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
44
45 * term/mac-win.el: Add ASCII equivalents for some function keys.
46 (mode-line-frame-identification): Sync with x-win.el.
47
482004-09-02 Juri Linkov <juri@jurta.org>
49
50 * progmodes/compile.el (compilation-buffer-name): Compare major
51 mode with second element of compilation-arguments instead of third
52 to reflect latest changes in compilation-arguments structure.
53 (recompile): Use global variable `compilation-directory' to get
54 recent compilation directory only when `recompile' is invoked NOT
55 in the compilation buffer. Otherwise, use `default-directory' of
56 the compilation buffer.
57 (compilation-error-properties): Allow to funcall col and end-col.
58 (compilation-mode-font-lock-keywords): Check col and end-col by
59 `integerp'.
60 (compilation-goto-locus): If end-mk is non-nil in transient mark
61 mode don't activate the mark (and don't display message in
62 push-mark), but highlight overlay between mk and end-mk.
63
64 * progmodes/grep.el (grep-highlight-matches): New defcustom.
65 (grep-regexp-alist): Add rule to highlight grep matches.
66 (grep-process-setup): Set env-vars GREP_OPTIONS and GREP_COLOR.
67
68 * info.el (Info-fontify-node): Don't compute other-tag
69 if Info-hide-note-references=hide.
70
71 * help.el (function-called-at-point):
72 * help-fns.el (variable-at-point):
73 Try `find-tag-default' when other methods failed.
74
75 * emacs-lisp/lisp.el (beginning-of-defun, end-of-defun):
76 Do not push mark if inhibit-mark-movement is non-nil.
77
78 * textmodes/ispell.el (ispell-html-skip-alists):
79 Fix backslashes in docstring.
80
812004-09-01 Juri Linkov <juri@jurta.org>
82
83 * isearch.el (isearch-wrap-function)
84 (isearch-push-state-function): New defvars.
85 (isearch-pop-fun-state): New defsubst.
86 (isearch-top-state): Call function saved in `isearch-pop-fun-state'.
87 (isearch-push-state): Set the result of calling
88 `isearch-push-state-function' to the `isearch-pop-fun-state' field.
89 (isearch-cancel): Call function saved in `isearch-pop-fun-state' to
90 restore the mode-specific starting point of terminated search.
91 (isearch-abort): Call `isearch-cancel' instead of its duplicated code.
92 (isearch-repeat): Call `isearch-wrap-function' if defined.
93 (isearch-message-prefix): Don't add prefix "over" to the message
94 for wrapped search if `isearch-wrap-function' is defined.
95 (isearch-search): Call function saved in `isearch-pop-fun-state' to
96 restore the mode-specific starting point of failed search.
97
98 * info.el (Info-search-whitespace-regexp): Fix backslashes.
99 (Info-search): Add new optional arguments for the sake of isearch.
100 Replace whitespace in Info-search-whitespace-regexp literally.
101 Add backward search. Don't call `Info-select-node' if regexp is
102 found in the same Info node. Don't add node to Info-history for
103 wrapped isearch.
104 (Info-search-backward, Info-isearch-search, Info-isearch-wrap)
105 (Info-isearch-push-state, Info-isearch-pop-state): New funs.
106 (Info-mode): Set local variables `isearch-search-fun-function',
107 `isearch-wrap-function', `isearch-push-state-function',
108 `search-whitespace-regexp'.
109
110 * isearch.el: Remove ancient Change Log section.
111 (isearch-string, isearch-message-string, isearch-point)
112 (isearch-success, isearch-forward-flag, isearch-other-end)
113 (isearch-word, isearch-invalid-regexp, isearch-wrapped)
114 (isearch-barrier, isearch-within-brackets)
115 (isearch-case-fold-search): Add suffix `-state' to state-related
116 defsubsts to avoid name clashes with other function names.
117
118 * simple.el (next-error): New defgroup and defface.
119 (next-error-highlight, next-error-highlight-no-select):
120 New defcustoms.
121 (next-error-no-select): Let-bind next-error-highlight to the value
122 of next-error-highlight-no-select before calling `next-error'.
123
124 * progmodes/compile.el (compilation-goto-locus):
125 Use `next-error' face instead of `region'. Set 4-th argument of
126 `move-overlay' to `current-buffer' to move overlay to different
127 source buffers. Use new variable `next-error-highlight'.
128
129 * simple.el (next-error-find-buffer): Move the rule
130 "if current buffer is a next-error capable buffer" after the
131 rule "if next-error-last-buffer is set to a live buffer".
132 Simplify to test all rules in one `or'.
133 (next-error): Doc fix.
134 (next-error, previous-error, first-error)
135 (next-error-no-select, previous-error-no-select):
136 Make arguments optional.
137
1382004-08-31 Luc Teirlinck <teirllm@auburn.edu>
139
140 * macros.el (apply-macro-to-region-lines): Make it operate on all
141 lines that begin in the region, rather than on all complete lines
142 in the region.
143
1442004-08-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
145
146 * x-dnd.el (x-dnd-protocol-alist): Document update.
147 (x-dnd-known-types): Defcustom it.
148 (x-dnd-handle-motif): Print message-atom in error message.
149
1502004-08-30 John Paul Wallington <jpw@gnu.org>
151
152 * textmodes/tex-mode.el (tex-validate-buffer): Use distinct
153 strings rather than programatically constructing message.
154
1552004-08-30 Richard M. Stallman <rms@gnu.org>
156
157 * emacs-lisp/lisp-mode.el (prin1-char): Don't turn S-a into A.
158 Don't return a string that would read as the wrong character code.
159
1602004-08-29 Kim F. Storm <storm@cua.dk>
161
162 * emulation/cua-base.el (cua-auto-expand-rectangles): Remove
163 automatic rectangle padding feature; replace by non-destructive
164 virtual rectangle edges feature.
165 (cua-virtual-rectangle-edges): New defcustom.
166 (cua-auto-tabify-rectangles): New defcustom.
167 (cua-paste): If paste into a marked rectangle, insert rectangle at
168 current column, even if virtual; also paste exactly as many lines
169 as has been marked (ignore additional lines or add empty lines),
170 but paste whole source if only one line is marked.
171 (cua--update-indications): No longer use overwrite-cursor to
172 indicate rectangle padding
173
174 * emulation/cua-rect.el (cua--rectangle-padding): Remove.
175 (cua--rectangle-virtual-edges): New defun.
176 (cua--rectangle-get-corners): Remove optional PAD arg.
177 (cua--rectangle-set-corners): Never do padding.
178 (cua--forward-line): Remove optional PAD arg. Simplify.
179 (cua-resize-rectangle-right, cua-resize-rectangle-left)
180 (cua-resize-rectangle-down, cua-resize-rectangle-up):
181 (cua-resize-rectangle-bot, cua-resize-rectangle-top)
182 (cua-resize-rectangle-page-up, cua-resize-rectangle-page-down)
183 (cua--rectangle-move): Never do padding. Simplify.
184 (cua--tabify-start): New defun.
185 (cua--rectangle-operation): Add tabify arg. All callers changed.
186 (cua--pad-rectangle): Remove.
187 (cua--delete-rectangle): Handle delete with virtual edges.
188 (cua--extract-rectangle): Add spaces if rectangle has virtual edges.
189 (cua--insert-rectangle): Handle insert at virtual column.
190 Perform auto-tabify if necessary.
191 (cua--activate-rectangle): Remove optional FORCE arg.
192 Never do padding. Simplify.
193 (cua--highlight-rectangle): Enhance for virtual edges.
194 (cua-toggle-rectangle-padding): Remove command.
195 (cua-toggle-rectangle-virtual-edges): New command.
196 (cua-sequence-rectangle): Add optional TABIFY arg. Callers changed.
197 (cua--rectangle-post-command): Don't force rectangle padding.
198 (cua--init-rectangles): Bind M-p to cua-toggle-rectangle-virtual-edges.
199
2002004-08-28 Luc Teirlinck <teirllm@auburn.edu>
201
202 * indent.el (edit-tab-stops-buffer): Doc fix.
203
2042004-08-28 Richard M. Stallman <rms@gnu.org>
205
206 * progmodes/grep.el (grep-default-command): Use find-tag-default.
207 (grep-tag-default): Function deleted.
208
209 * subr.el (find-tag-default): Moved from etags.el.
210
211 * progmodes/etags.el (find-tag-default): Moved to subr.el.
212
213 * emacs-lisp/lisp-mode.el (prin1-char): Put `shift' modifier
214 into the basic character if it has an uppercase form.
215
12004-08-27 Kenichi Handa <handa@m17n.org> 2162004-08-27 Kenichi Handa <handa@m17n.org>
2 217
3 * international/utf-8.el (utf-8-post-read-conversion): If the 218 * international/utf-8.el (utf-8-post-read-conversion): If the
@@ -534,7 +749,6 @@
534 (ps-generate-string-list): Comment fix. 749 (ps-generate-string-list): Comment fix.
535 (ps-message-log-max): Code fix. 750 (ps-message-log-max): Code fix.
536 751
537
5382004-07-22 Michael Piotrowski <mxp@dynalabs.de> (tiny change) 7522004-07-22 Michael Piotrowski <mxp@dynalabs.de> (tiny change)
539 753
540 * ps-print.el (ps-begin-file): Improve the DSC compliance of the 754 * ps-print.el (ps-begin-file): Improve the DSC compliance of the
@@ -554,11 +768,9 @@
554 768
5552004-07-20 Richard M. Stallman <rms@gnu.org> 7692004-07-20 Richard M. Stallman <rms@gnu.org>
556 770
557 * textmodes/fill.el (fill-comment-paragraph): Handle indent-tabs-mode. 771 * textmodes/fill.el (fill-nobreak-p): If this break point is
558 (fill-delete-newlines): Call sentence-end as function. 772 at the end of the line, don't consider the newline which follows
559 (fill-nobreak-p, canonically-space-region): Likewise. 773 as a reason to return t.
560 (fill-nobreak-p): If this break point is at the end of the line,
561 don't consider the newline which follows as a reason to return t.
562 774
5632004-07-19 John Paul Wallington <jpw@gnu.org> 7752004-07-19 John Paul Wallington <jpw@gnu.org>
564 776
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 796ebaa27c8..ecf768c5732 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -421,7 +421,8 @@ This is an internal function used by Auto-Revert Mode."
421 'no-mini t)) 421 'no-mini t))
422 (if auto-revert-tail-mode 422 (if auto-revert-tail-mode
423 (auto-revert-tail-handler) 423 (auto-revert-tail-handler)
424 (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)) 424 (let ((buffer-read-only buffer-read-only))
425 (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)))
425 (when buffer-file-name 426 (when buffer-file-name
426 (when eob (goto-char (point-max))) 427 (when eob (goto-char (point-max)))
427 (dolist (window eoblist) 428 (dolist (window eoblist)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index df05555ae7b..e2aac327ddc 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -363,7 +363,7 @@ if that value is non-nil."
363 (when (stringp default) 363 (when (stringp default)
364 (if (string-match ":+" default) 364 (if (string-match ":+" default)
365 (substring default (match-end 0)) 365 (substring default (match-end 0))
366 default)))) 366 default))))
367 367
368;; Used in old LispM code. 368;; Used in old LispM code.
369(defalias 'common-lisp-mode 'lisp-mode) 369(defalias 'common-lisp-mode 'lisp-mode)
@@ -459,21 +459,37 @@ alternative printed representations that can be displayed."
459If CHAR is not a character, return nil." 459If CHAR is not a character, return nil."
460 (and (integerp char) 460 (and (integerp char)
461 (eventp char) 461 (eventp char)
462 (let ((c (event-basic-type char))) 462 (let ((c (event-basic-type char))
463 (concat 463 (mods (event-modifiers char))
464 "?" 464 string)
465 (mapconcat 465 ;; Prevent ?A from turning into ?\S-a.
466 (lambda (modif) 466 (if (and (memq 'shift mods)
467 (cond ((eq modif 'super) "\\s-") 467 (zerop (logand char ?\S-\^@))
468 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) 468 (not (let ((case-fold-search nil))
469 (event-modifiers char) "") 469 (char-equal c (upcase c)))))
470 (cond 470 (setq c (upcase c) mods nil))
471 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) 471 ;; What string are we considering using?
472 ((eq c 127) "\\C-?") 472 (condition-case nil
473 (t 473 (setq string
474 (condition-case nil 474 (concat
475 (string c) 475 "?"
476 (error nil)))))))) 476 (mapconcat
477 (lambda (modif)
478 (cond ((eq modif 'super) "\\s-")
479 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
480 mods "")
481 (cond
482 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
483 ((eq c 127) "\\C-?")
484 (t
485 (string c)))))
486 (error nil))
487 ;; Verify the string reads a CHAR, not to some other character.
488 ;; If it doesn't, return nil instead.
489 (and string
490 (= (car (read-from-string string)) char)
491 string))))
492
477 493
478(defun eval-last-sexp-1 (eval-last-sexp-arg-internal) 494(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
479 "Evaluate sexp before point; print value in minibuffer. 495 "Evaluate sexp before point; print value in minibuffer.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 25fde86cd96..46d3d2625a1 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -176,7 +176,8 @@ If variable `beginning-of-defun-function' is non-nil, its value
176is called as a function to find the defun's beginning." 176is called as a function to find the defun's beginning."
177 (interactive "p") 177 (interactive "p")
178 (and (eq this-command 'beginning-of-defun) 178 (and (eq this-command 'beginning-of-defun)
179 (or (eq last-command 'beginning-of-defun) (push-mark))) 179 (or inhibit-mark-movement (eq last-command 'beginning-of-defun)
180 (push-mark)))
180 (and (beginning-of-defun-raw arg) 181 (and (beginning-of-defun-raw arg)
181 (progn (beginning-of-line) t))) 182 (progn (beginning-of-line) t)))
182 183
@@ -226,7 +227,8 @@ If variable `end-of-defun-function' is non-nil, its value
226is called as a function to find the defun's end." 227is called as a function to find the defun's end."
227 (interactive "p") 228 (interactive "p")
228 (and (eq this-command 'end-of-defun) 229 (and (eq this-command 'end-of-defun)
229 (or (eq last-command 'end-of-defun) (push-mark))) 230 (or inhibit-mark-movement (eq last-command 'end-of-defun)
231 (push-mark)))
230 (if (or (null arg) (= arg 0)) (setq arg 1)) 232 (if (or (null arg) (= arg 0)) (setq arg 1))
231 (if end-of-defun-function 233 (if end-of-defun-function
232 (if (> arg 0) 234 (if (> arg 0)
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index b39945c7712..fb3c537936f 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -141,30 +141,39 @@
141;; completely separate set of "rectangle commands" [C-x r ...] on the 141;; completely separate set of "rectangle commands" [C-x r ...] on the
142;; region to copy, kill, fill a.s.o. the virtual rectangle. 142;; region to copy, kill, fill a.s.o. the virtual rectangle.
143;; 143;;
144;; cua-mode's superior rectangle support is based on using a true visual 144;; cua-mode's superior rectangle support uses a true visual
145;; representation of the selected rectangle. To start a rectangle, use 145;; representation of the selected rectangle, i.e. it highlights the
146;; [S-return] and extend it using the normal movement keys (up, down, 146;; actual part of the buffer that is currently selected as part of the
147;; left, right, home, end, C-home, C-end). Once the rectangle has the 147;; rectangle. Unlike emacs' traditional rectangle commands, the
148;; desired size, you can cut or copy it using C-x and C-c (or C-w and M-w), 148;; selected rectangle always as straight left and right edges, even
149;; and you can subsequently insert it - as a rectangle - using C-v (or 149;; when those are in the middle of a TAB character or beyond the end
150;; C-y). So the only new command you need to know to work with 150;; of the current line. And it does this without actually modifying
151;; cua-mode rectangles is S-return! 151;; the buffer contents (it uses display overlays to visualize the
152;; virtual dimensions of the rectangle).
153;;
154;; This means that cua-mode's rectangles are not limited to the actual
155;; contents of the buffer, so if the cursor is currently at the end of a
156;; short line, you can still extend the rectangle to include more columns
157;; of longer lines in the same rectangle. And you can also have the
158;; left edge of a rectangle start in the middle of a TAB character.
159;; Sounds strange? Try it!
160;;
161;; To start a rectangle, use [S-return] and extend it using the normal
162;; movement keys (up, down, left, right, home, end, C-home,
163;; C-end). Once the rectangle has the desired size, you can cut or
164;; copy it using C-x and C-c (or C-w and M-w), and you can
165;; subsequently insert it - as a rectangle - using C-v (or C-y). So
166;; the only new command you need to know to work with cua-mode
167;; rectangles is S-return!
152;; 168;;
153;; Normally, when you paste a rectangle using C-v (C-y), each line of 169;; Normally, when you paste a rectangle using C-v (C-y), each line of
154;; the rectangle is inserted into the existing lines in the buffer. 170;; the rectangle is inserted into the existing lines in the buffer.
155;; If overwrite-mode is active when you paste a rectangle, it is 171;; If overwrite-mode is active when you paste a rectangle, it is
156;; inserted as normal (multi-line) text. 172;; inserted as normal (multi-line) text.
157;; 173;;
158;; Furthermore, cua-mode's rectangles are not limited to the actual 174;; If you prefer the traditional rectangle marking (i.e. don't want
159;; contents of the buffer, so if the cursor is currently at the end of a 175;; straight edges), [M-p] toggles this for the current rectangle,
160;; short line, you can still extend the rectangle to include more columns 176;; or you can customize cua-virtual-rectangle-edges.
161;; of longer lines in the same rectangle. Sounds strange? Try it!
162;;
163;; You can enable padding for just this rectangle by pressing [M-p];
164;; this works like entering `picture-mode' where the tabs and spaces
165;; are automatically converted/inserted to make the rectangle truly
166;; rectangular. Or you can do it for all rectangles by setting the
167;; `cua-auto-expand-rectangles' variable.
168 177
169;; And there's more: If you want to extend or reduce the size of the 178;; And there's more: If you want to extend or reduce the size of the
170;; rectangle in one of the other corners of the rectangle, just use 179;; rectangle in one of the other corners of the rectangle, just use
@@ -204,8 +213,8 @@
204;; a supplied format string (prompt) 213;; a supplied format string (prompt)
205;; [M-o] opens the rectangle by moving the highlighted text to the 214;; [M-o] opens the rectangle by moving the highlighted text to the
206;; right of the rectangle and filling the rectangle with blanks. 215;; right of the rectangle and filling the rectangle with blanks.
207;; [M-p] toggles rectangle padding, i.e. insert tabs and spaces to 216;; [M-p] toggles virtual straight rectangle edges
208;; make rectangles truly rectangular 217;; [M-P] inserts tabs and spaces (padding) to make real straight edges
209;; [M-q] performs text filling on the rectangle 218;; [M-q] performs text filling on the rectangle
210;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle 219;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle
211;; [M-R] reverse the lines in the rectangle 220;; [M-R] reverse the lines in the rectangle
@@ -347,14 +356,27 @@ managers, so try setting this to nil, if prefix override doesn't work."
347 356
348;;; Rectangle Customization 357;;; Rectangle Customization
349 358
350(defcustom cua-auto-expand-rectangles nil 359(defcustom cua-virtual-rectangle-edges t
351 "*If non-nil, rectangles are padded with spaces to make straight edges. 360 "*If non-nil, rectangles have virtual straight edges.
352This implies modifying buffer contents by expanding tabs and inserting spaces. 361Note that although rectangles are always DISPLAYED with straight edges, the
353Consequently, this is inhibited in read-only buffers. 362buffer is NOT modified, until you execute a command that actually modifies it.
354Can be toggled by [M-p] while the rectangle is active," 363\[M-p] toggles this feature when a rectangle is active."
355 :type 'boolean 364 :type 'boolean
356 :group 'cua) 365 :group 'cua)
357 366
367(defcustom cua-auto-tabify-rectangles 1000
368 "*If non-nil, automatically tabify after rectangle commands.
369This basically means that `tabify' is applied to all lines that
370are modified by inserting or deleting a rectangle. If value is
371an integer, cua will look for existing tabs in a region around
372the rectangle, and only do the conversion if any tabs are already
373present. The number specifies then number of characters before
374and after the region marked by the rectangle to search."
375 :type '(choice (number :tag "Auto detect (limit)")
376 (const :tag "Disabled" nil)
377 (other :tag "Enabled" t))
378 :group 'cua)
379
358(defcustom cua-enable-rectangle-auto-help t 380(defcustom cua-enable-rectangle-auto-help t
359 "*If non-nil, automatically show help for region, rectangle and global mark." 381 "*If non-nil, automatically show help for region, rectangle and global mark."
360 :type 'boolean 382 :type 'boolean
@@ -412,7 +434,6 @@ Can be toggled by [M-p] while the rectangle is active,"
412 (frame-parameter nil 'cursor-color) 434 (frame-parameter nil 'cursor-color)
413 "red") 435 "red")
414 "Normal (non-overwrite) cursor color. 436 "Normal (non-overwrite) cursor color.
415Also used to indicate that rectangle padding is not in effect.
416Default is to load cursor color from initial or default frame parameters. 437Default is to load cursor color from initial or default frame parameters.
417 438
418If the value is a COLOR name, then only the `cursor-color' attribute will be 439If the value is a COLOR name, then only the `cursor-color' attribute will be
@@ -462,7 +483,6 @@ a cons (TYPE . COLOR), then both properties are affected."
462 483
463(defcustom cua-overwrite-cursor-color "yellow" 484(defcustom cua-overwrite-cursor-color "yellow"
464 "*Cursor color used when overwrite mode is set, if non-nil. 485 "*Cursor color used when overwrite mode is set, if non-nil.
465Also used to indicate that rectangle padding is in effect.
466Only used when `cua-enable-cursor-indications' is non-nil. 486Only used when `cua-enable-cursor-indications' is non-nil.
467 487
468If the value is a COLOR name, then only the `cursor-color' attribute will be 488If the value is a COLOR name, then only the `cursor-color' attribute will be
@@ -806,7 +826,8 @@ If global mark is active, copy from register or one character."
806 (interactive "P") 826 (interactive "P")
807 (setq arg (cua--prefix-arg arg)) 827 (setq arg (cua--prefix-arg arg))
808 (let ((regtxt (and cua--register (get-register cua--register))) 828 (let ((regtxt (and cua--register (get-register cua--register)))
809 (count (prefix-numeric-value arg))) 829 (count (prefix-numeric-value arg))
830 paste-column paste-lines)
810 (cond 831 (cond
811 ((and cua--register (not regtxt)) 832 ((and cua--register (not regtxt))
812 (message "Nothing in register %c" cua--register)) 833 (message "Nothing in register %c" cua--register))
@@ -825,7 +846,12 @@ If global mark is active, copy from register or one character."
825 ;; the same region that we are going to delete. 846 ;; the same region that we are going to delete.
826 ;; That would make yank a no-op. 847 ;; That would make yank a no-op.
827 (if cua--rectangle 848 (if cua--rectangle
828 (cua--delete-rectangle) 849 (progn
850 (goto-char (min (mark) (point)))
851 (setq paste-column (cua--rectangle-left))
852 (setq paste-lines (cua--delete-rectangle))
853 (if (= paste-lines 1)
854 (setq paste-lines nil))) ;; paste all
829 (if (string= (buffer-substring (point) (mark)) 855 (if (string= (buffer-substring (point) (mark))
830 (car kill-ring)) 856 (car kill-ring))
831 (current-kill 1)) 857 (current-kill 1))
@@ -843,7 +869,8 @@ If global mark is active, copy from register or one character."
843 (setq this-command 'cua--paste-rectangle) 869 (setq this-command 'cua--paste-rectangle)
844 (undo-boundary) 870 (undo-boundary)
845 (setq buffer-undo-list (cons pt buffer-undo-list))) 871 (setq buffer-undo-list (cons pt buffer-undo-list)))
846 (cua--insert-rectangle (cdr cua--last-killed-rectangle)) 872 (cua--insert-rectangle (cdr cua--last-killed-rectangle)
873 nil paste-column paste-lines)
847 (if arg (goto-char pt)))) 874 (if arg (goto-char pt))))
848 (t (yank arg))))))) 875 (t (yank arg)))))))
849 876
@@ -1033,9 +1060,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
1033 ((and buffer-read-only 1060 ((and buffer-read-only
1034 cua-read-only-cursor-color) 1061 cua-read-only-cursor-color)
1035 cua-read-only-cursor-color) 1062 cua-read-only-cursor-color)
1036 ((and cua-overwrite-cursor-color 1063 ((and cua-overwrite-cursor-color overwrite-mode)
1037 (or overwrite-mode
1038 (and cua--rectangle (cua--rectangle-padding))))
1039 cua-overwrite-cursor-color) 1064 cua-overwrite-cursor-color)
1040 (t cua-normal-cursor-color))) 1065 (t cua-normal-cursor-color)))
1041 (color (if (consp cursor) (cdr cursor) cursor)) 1066 (color (if (consp cursor) (cdr cursor) cursor))
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 965fe63bced..3270b7fd62c 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -44,10 +44,10 @@
44(require 'rect) 44(require 'rect)
45 45
46;; If non-nil, restrict current region to this rectangle. 46;; If non-nil, restrict current region to this rectangle.
47;; Value is a vector [top bot left right corner ins pad select]. 47;; Value is a vector [top bot left right corner ins virt select].
48;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. 48;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
49;; INS specifies whether to insert on left(nil) or right(t) side. 49;; INS specifies whether to insert on left(nil) or right(t) side.
50;; If PAD is non-nil, tabs are converted to spaces when necessary. 50;; If VIRT is non-nil, virtual straight edges are enabled.
51;; If SELECT is a regexp, only lines starting with that regexp are affected.") 51;; If SELECT is a regexp, only lines starting with that regexp are affected.")
52(defvar cua--rectangle nil) 52(defvar cua--rectangle nil)
53(make-variable-buffer-local 'cua--rectangle) 53(make-variable-buffer-local 'cua--rectangle)
@@ -65,6 +65,12 @@
65(defvar cua--rectangle-overlays nil) 65(defvar cua--rectangle-overlays nil)
66(make-variable-buffer-local 'cua--rectangle-overlays) 66(make-variable-buffer-local 'cua--rectangle-overlays)
67 67
68(defvar cua--overlay-keymap
69 (let ((map (make-sparse-keymap)))
70 (define-key map "\r" 'cua-rotate-rectangle)))
71
72(defvar cua--virtual-edges-debug nil)
73
68;; Per-buffer CUA mode undo list. 74;; Per-buffer CUA mode undo list.
69(defvar cua--undo-list nil) 75(defvar cua--undo-list nil)
70(make-variable-buffer-local 'cua--undo-list) 76(make-variable-buffer-local 'cua--undo-list)
@@ -97,7 +103,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
97(defvar cua--tidy-undo-counter 0 103(defvar cua--tidy-undo-counter 0
98 "Number of times `cua--tidy-undo-lists' have run successfully.") 104 "Number of times `cua--tidy-undo-lists' have run successfully.")
99 105
100;; Clean out danling entries from cua's undo list. 106;; Clean out dangling entries from cua's undo list.
101;; Since this list contains pointers into the standard undo list, 107;; Since this list contains pointers into the standard undo list,
102;; such references are only meningful as undo information if the 108;; such references are only meningful as undo information if the
103;; corresponding entry is still on the standard undo list. 109;; corresponding entry is still on the standard undo list.
@@ -203,11 +209,11 @@ Knows about CUA rectangle highlighting in addition to standard undo."
203 (aref cua--rectangle 5)) 209 (aref cua--rectangle 5))
204 (cua--rectangle-left)))) 210 (cua--rectangle-left))))
205 211
206(defun cua--rectangle-padding (&optional set val) 212(defun cua--rectangle-virtual-edges (&optional set val)
207 ;; Current setting of rectangle padding 213 ;; Current setting of rectangle virtual-edges
208 (if set 214 (if set
209 (aset cua--rectangle 6 val)) 215 (aset cua--rectangle 6 val))
210 (and (not buffer-read-only) 216 (and ;(not buffer-read-only)
211 (aref cua--rectangle 6))) 217 (aref cua--rectangle 6)))
212 218
213(defun cua--rectangle-restriction (&optional val bounded negated) 219(defun cua--rectangle-restriction (&optional val bounded negated)
@@ -226,7 +232,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
226 (if (< (cua--rectangle-bot) (cua--rectangle-top)) 232 (if (< (cua--rectangle-bot) (cua--rectangle-top))
227 (message "rectangle bot < top"))) 233 (message "rectangle bot < top")))
228 234
229(defun cua--rectangle-get-corners (&optional pad) 235(defun cua--rectangle-get-corners ()
230 ;; Calculate the rectangular region represented by point and mark, 236 ;; Calculate the rectangular region represented by point and mark,
231 ;; putting start in the upper left corner and end in the 237 ;; putting start in the upper left corner and end in the
232 ;; bottom right corner. 238 ;; bottom right corner.
@@ -245,12 +251,12 @@ Knows about CUA rectangle highlighting in addition to standard undo."
245 (setq r (1- r))) 251 (setq r (1- r)))
246 (setq l (prog1 r (setq r l))) 252 (setq l (prog1 r (setq r l)))
247 (goto-char top) 253 (goto-char top)
248 (move-to-column l pad) 254 (move-to-column l)
249 (setq top (point)) 255 (setq top (point))
250 (goto-char bot) 256 (goto-char bot)
251 (move-to-column r pad) 257 (move-to-column r)
252 (setq bot (point)))) 258 (setq bot (point))))
253 (vector top bot l r corner 0 pad nil))) 259 (vector top bot l r corner 0 cua-virtual-rectangle-edges nil)))
254 260
255(defun cua--rectangle-set-corners () 261(defun cua--rectangle-set-corners ()
256 ;; Set mark and point in opposite corners of current rectangle. 262 ;; Set mark and point in opposite corners of current rectangle.
@@ -269,24 +275,31 @@ Knows about CUA rectangle highlighting in addition to standard undo."
269 (setq pp (cua--rectangle-bot) pc (cua--rectangle-right) 275 (setq pp (cua--rectangle-bot) pc (cua--rectangle-right)
270 mp (cua--rectangle-top) mc (cua--rectangle-left)))) 276 mp (cua--rectangle-top) mc (cua--rectangle-left))))
271 (goto-char mp) 277 (goto-char mp)
272 (move-to-column mc (cua--rectangle-padding)) 278 (move-to-column mc)
273 (set-mark (point)) 279 (set-mark (point))
274 (goto-char pp) 280 (goto-char pp)
275 (move-to-column pc (cua--rectangle-padding)))) 281 ;; Move cursor inside rectangle, except if char at rigth edge is a tab.
282 (if (and (if (cua--rectangle-right-side)
283 (and (= (move-to-column pc) (- pc tab-width))
284 (not (eolp)))
285 (> (move-to-column pc) pc))
286 (not (bolp)))
287 (backward-char 1))
288 ))
276 289
277;;; Rectangle resizing 290;;; Rectangle resizing
278 291
279(defun cua--forward-line (n pad) 292(defun cua--forward-line (n)
280 ;; Move forward/backward one line. Returns t if movement. 293 ;; Move forward/backward one line. Returns t if movement.
281 (if (or (not pad) (< n 0)) 294 (let ((pt (point)))
282 (= (forward-line n) 0) 295 (and (= (forward-line n) 0)
283 (next-line 1) 296 ;; Deal with end of buffer
284 t)) 297 (or (not (eobp))
298 (goto-char pt)))))
285 299
286(defun cua--rectangle-resized () 300(defun cua--rectangle-resized ()
287 ;; Refresh state after resizing rectangle 301 ;; Refresh state after resizing rectangle
288 (setq cua--buffer-and-point-before-command nil) 302 (setq cua--buffer-and-point-before-command nil)
289 (cua--pad-rectangle)
290 (cua--rectangle-insert-col 0) 303 (cua--rectangle-insert-col 0)
291 (cua--rectangle-set-corners) 304 (cua--rectangle-set-corners)
292 (cua--keep-active)) 305 (cua--keep-active))
@@ -294,47 +307,35 @@ Knows about CUA rectangle highlighting in addition to standard undo."
294(defun cua-resize-rectangle-right (n) 307(defun cua-resize-rectangle-right (n)
295 "Resize rectangle to the right." 308 "Resize rectangle to the right."
296 (interactive "p") 309 (interactive "p")
297 (let ((pad (cua--rectangle-padding)) (resized (> n 0))) 310 (let ((resized (> n 0)))
298 (while (> n 0) 311 (while (> n 0)
299 (setq n (1- n)) 312 (setq n (1- n))
300 (cond 313 (cond
301 ((and (cua--rectangle-right-side) (or pad (eolp)))
302 (cua--rectangle-right (1+ (cua--rectangle-right)))
303 (move-to-column (cua--rectangle-right) pad))
304 ((cua--rectangle-right-side) 314 ((cua--rectangle-right-side)
305 (forward-char 1) 315 (cua--rectangle-right (1+ (cua--rectangle-right)))
306 (cua--rectangle-right (current-column))) 316 (move-to-column (cua--rectangle-right)))
307 ((or pad (eolp))
308 (cua--rectangle-left (1+ (cua--rectangle-left)))
309 (move-to-column (cua--rectangle-right) pad))
310 (t 317 (t
311 (forward-char 1) 318 (cua--rectangle-left (1+ (cua--rectangle-left)))
312 (cua--rectangle-left (current-column))))) 319 (move-to-column (cua--rectangle-right)))))
313 (if resized 320 (if resized
314 (cua--rectangle-resized)))) 321 (cua--rectangle-resized))))
315 322
316(defun cua-resize-rectangle-left (n) 323(defun cua-resize-rectangle-left (n)
317 "Resize rectangle to the left." 324 "Resize rectangle to the left."
318 (interactive "p") 325 (interactive "p")
319 (let ((pad (cua--rectangle-padding)) resized) 326 (let (resized)
320 (while (> n 0) 327 (while (> n 0)
321 (setq n (1- n)) 328 (setq n (1- n))
322 (if (or (= (cua--rectangle-right) 0) 329 (if (or (= (cua--rectangle-right) 0)
323 (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) 330 (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0)))
324 (setq n 0) 331 (setq n 0)
325 (cond 332 (cond
326 ((and (cua--rectangle-right-side) (or pad (eolp) (bolp)))
327 (cua--rectangle-right (1- (cua--rectangle-right)))
328 (move-to-column (cua--rectangle-right) pad))
329 ((cua--rectangle-right-side) 333 ((cua--rectangle-right-side)
330 (backward-char 1) 334 (cua--rectangle-right (1- (cua--rectangle-right)))
331 (cua--rectangle-right (current-column))) 335 (move-to-column (cua--rectangle-right)))
332 ((or pad (eolp) (bolp))
333 (cua--rectangle-left (1- (cua--rectangle-left)))
334 (move-to-column (cua--rectangle-right) pad))
335 (t 336 (t
336 (backward-char 1) 337 (cua--rectangle-left (1- (cua--rectangle-left)))
337 (cua--rectangle-left (current-column)))) 338 (move-to-column (cua--rectangle-right))))
338 (setq resized t))) 339 (setq resized t)))
339 (if resized 340 (if resized
340 (cua--rectangle-resized)))) 341 (cua--rectangle-resized))))
@@ -342,20 +343,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
342(defun cua-resize-rectangle-down (n) 343(defun cua-resize-rectangle-down (n)
343 "Resize rectangle downwards." 344 "Resize rectangle downwards."
344 (interactive "p") 345 (interactive "p")
345 (let ((pad (cua--rectangle-padding)) resized) 346 (let (resized)
346 (while (> n 0) 347 (while (> n 0)
347 (setq n (1- n)) 348 (setq n (1- n))
348 (cond 349 (cond
349 ((>= (cua--rectangle-corner) 2) 350 ((>= (cua--rectangle-corner) 2)
350 (goto-char (cua--rectangle-bot)) 351 (goto-char (cua--rectangle-bot))
351 (when (cua--forward-line 1 pad) 352 (when (cua--forward-line 1)
352 (move-to-column (cua--rectangle-column) pad) 353 (move-to-column (cua--rectangle-column))
353 (cua--rectangle-bot t) 354 (cua--rectangle-bot t)
354 (setq resized t))) 355 (setq resized t)))
355 (t 356 (t
356 (goto-char (cua--rectangle-top)) 357 (goto-char (cua--rectangle-top))
357 (when (cua--forward-line 1 pad) 358 (when (cua--forward-line 1)
358 (move-to-column (cua--rectangle-column) pad) 359 (move-to-column (cua--rectangle-column))
359 (cua--rectangle-top t) 360 (cua--rectangle-top t)
360 (setq resized t))))) 361 (setq resized t)))))
361 (if resized 362 (if resized
@@ -364,20 +365,20 @@ Knows about CUA rectangle highlighting in addition to standard undo."
364(defun cua-resize-rectangle-up (n) 365(defun cua-resize-rectangle-up (n)
365 "Resize rectangle upwards." 366 "Resize rectangle upwards."
366 (interactive "p") 367 (interactive "p")
367 (let ((pad (cua--rectangle-padding)) resized) 368 (let (resized)
368 (while (> n 0) 369 (while (> n 0)
369 (setq n (1- n)) 370 (setq n (1- n))
370 (cond 371 (cond
371 ((>= (cua--rectangle-corner) 2) 372 ((>= (cua--rectangle-corner) 2)
372 (goto-char (cua--rectangle-bot)) 373 (goto-char (cua--rectangle-bot))
373 (when (cua--forward-line -1 pad) 374 (when (cua--forward-line -1)
374 (move-to-column (cua--rectangle-column) pad) 375 (move-to-column (cua--rectangle-column))
375 (cua--rectangle-bot t) 376 (cua--rectangle-bot t)
376 (setq resized t))) 377 (setq resized t)))
377 (t 378 (t
378 (goto-char (cua--rectangle-top)) 379 (goto-char (cua--rectangle-top))
379 (when (cua--forward-line -1 pad) 380 (when (cua--forward-line -1)
380 (move-to-column (cua--rectangle-column) pad) 381 (move-to-column (cua--rectangle-column))
381 (cua--rectangle-top t) 382 (cua--rectangle-top t)
382 (setq resized t))))) 383 (setq resized t)))))
383 (if resized 384 (if resized
@@ -408,7 +409,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
408 "Resize rectangle to bottom of buffer." 409 "Resize rectangle to bottom of buffer."
409 (interactive) 410 (interactive)
410 (goto-char (point-max)) 411 (goto-char (point-max))
411 (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) 412 (move-to-column (cua--rectangle-column))
412 (cua--rectangle-bot t) 413 (cua--rectangle-bot t)
413 (cua--rectangle-resized)) 414 (cua--rectangle-resized))
414 415
@@ -416,31 +417,29 @@ Knows about CUA rectangle highlighting in addition to standard undo."
416 "Resize rectangle to top of buffer." 417 "Resize rectangle to top of buffer."
417 (interactive) 418 (interactive)
418 (goto-char (point-min)) 419 (goto-char (point-min))
419 (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) 420 (move-to-column (cua--rectangle-column))
420 (cua--rectangle-top t) 421 (cua--rectangle-top t)
421 (cua--rectangle-resized)) 422 (cua--rectangle-resized))
422 423
423(defun cua-resize-rectangle-page-up () 424(defun cua-resize-rectangle-page-up ()
424 "Resize rectangle upwards by one scroll page." 425 "Resize rectangle upwards by one scroll page."
425 (interactive) 426 (interactive)
426 (let ((pad (cua--rectangle-padding))) 427 (scroll-down)
427 (scroll-down) 428 (move-to-column (cua--rectangle-column))
428 (move-to-column (cua--rectangle-column) pad) 429 (if (>= (cua--rectangle-corner) 2)
429 (if (>= (cua--rectangle-corner) 2) 430 (cua--rectangle-bot t)
430 (cua--rectangle-bot t) 431 (cua--rectangle-top t))
431 (cua--rectangle-top t)) 432 (cua--rectangle-resized))
432 (cua--rectangle-resized)))
433 433
434(defun cua-resize-rectangle-page-down () 434(defun cua-resize-rectangle-page-down ()
435 "Resize rectangle downwards by one scroll page." 435 "Resize rectangle downwards by one scroll page."
436 (interactive) 436 (interactive)
437 (let ((pad (cua--rectangle-padding))) 437 (scroll-up)
438 (scroll-up) 438 (move-to-column (cua--rectangle-column))
439 (move-to-column (cua--rectangle-column) pad) 439 (if (>= (cua--rectangle-corner) 2)
440 (if (>= (cua--rectangle-corner) 2) 440 (cua--rectangle-bot t)
441 (cua--rectangle-bot t) 441 (cua--rectangle-top t))
442 (cua--rectangle-top t)) 442 (cua--rectangle-resized))
443 (cua--rectangle-resized)))
444 443
445;;; Mouse support 444;;; Mouse support
446 445
@@ -450,7 +449,8 @@ Knows about CUA rectangle highlighting in addition to standard undo."
450 "Set rectangle corner at mouse click position." 449 "Set rectangle corner at mouse click position."
451 (interactive "e") 450 (interactive "e")
452 (mouse-set-point event) 451 (mouse-set-point event)
453 (if (cua--rectangle-padding) 452 ;; FIX ME -- need to calculate virtual column.
453 (if (cua--rectangle-virtual-edges)
454 (move-to-column (car (posn-col-row (event-end event))) t)) 454 (move-to-column (car (posn-col-row (event-end event))) t))
455 (if (cua--rectangle-right-side) 455 (if (cua--rectangle-right-side)
456 (cua--rectangle-right (current-column)) 456 (cua--rectangle-right (current-column))
@@ -470,6 +470,7 @@ Knows about CUA rectangle highlighting in addition to standard undo."
470 (cua--deactivate t)) 470 (cua--deactivate t))
471 (setq cua--last-rectangle nil) 471 (setq cua--last-rectangle nil)
472 (mouse-set-point event) 472 (mouse-set-point event)
473 ;; FIX ME -- need to calculate virtual column.
473 (cua-set-rectangle-mark) 474 (cua-set-rectangle-mark)
474 (setq cua--buffer-and-point-before-command nil) 475 (setq cua--buffer-and-point-before-command nil)
475 (setq cua--mouse-last-pos nil)) 476 (setq cua--mouse-last-pos nil))
@@ -489,13 +490,13 @@ If command is repeated at same position, delete the rectangle."
489 (let ((cua-keep-region-after-copy t)) 490 (let ((cua-keep-region-after-copy t))
490 (cua-copy-rectangle arg) 491 (cua-copy-rectangle arg)
491 (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) 492 (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
493
492(defun cua--mouse-ignore (event) 494(defun cua--mouse-ignore (event)
493 (interactive "e") 495 (interactive "e")
494 (setq this-command last-command)) 496 (setq this-command last-command))
495 497
496(defun cua--rectangle-move (dir) 498(defun cua--rectangle-move (dir)
497 (let ((pad (cua--rectangle-padding)) 499 (let ((moved t)
498 (moved t)
499 (top (cua--rectangle-top)) 500 (top (cua--rectangle-top))
500 (bot (cua--rectangle-bot)) 501 (bot (cua--rectangle-bot))
501 (l (cua--rectangle-left)) 502 (l (cua--rectangle-left))
@@ -503,17 +504,17 @@ If command is repeated at same position, delete the rectangle."
503 (cond 504 (cond
504 ((eq dir 'up) 505 ((eq dir 'up)
505 (goto-char top) 506 (goto-char top)
506 (when (cua--forward-line -1 pad) 507 (when (cua--forward-line -1)
507 (cua--rectangle-top t) 508 (cua--rectangle-top t)
508 (goto-char bot) 509 (goto-char bot)
509 (forward-line -1) 510 (forward-line -1)
510 (cua--rectangle-bot t))) 511 (cua--rectangle-bot t)))
511 ((eq dir 'down) 512 ((eq dir 'down)
512 (goto-char bot) 513 (goto-char bot)
513 (when (cua--forward-line 1 pad) 514 (when (cua--forward-line 1)
514 (cua--rectangle-bot t) 515 (cua--rectangle-bot t)
515 (goto-char top) 516 (goto-char top)
516 (cua--forward-line 1 pad) 517 (cua--forward-line 1)
517 (cua--rectangle-top t))) 518 (cua--rectangle-top t)))
518 ((eq dir 'left) 519 ((eq dir 'left)
519 (when (> l 0) 520 (when (> l 0)
@@ -526,19 +527,37 @@ If command is repeated at same position, delete the rectangle."
526 (setq moved nil))) 527 (setq moved nil)))
527 (when moved 528 (when moved
528 (setq cua--buffer-and-point-before-command nil) 529 (setq cua--buffer-and-point-before-command nil)
529 (cua--pad-rectangle)
530 (cua--rectangle-set-corners) 530 (cua--rectangle-set-corners)
531 (cua--keep-active)))) 531 (cua--keep-active))))
532 532
533 533
534;;; Operations on current rectangle 534;;; Operations on current rectangle
535 535
536(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct) 536(defun cua--tabify-start (start end)
537 ;; Return position where auto-tabify should start (or nil if not required).
538 (save-excursion
539 (save-restriction
540 (widen)
541 (and (not buffer-read-only)
542 cua-auto-tabify-rectangles
543 (if (or (not (integerp cua-auto-tabify-rectangles))
544 (= (point-min) (point-max))
545 (progn
546 (goto-char (max (point-min)
547 (- start cua-auto-tabify-rectangles)))
548 (search-forward "\t" (min (point-max)
549 (+ end cua-auto-tabify-rectangles)) t)))
550 start)))))
551
552(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct)
537 ;; Call FCT for each line of region with 4 parameters: 553 ;; Call FCT for each line of region with 4 parameters:
538 ;; Region start, end, left-col, right-col 554 ;; Region start, end, left-col, right-col
539 ;; Point is at start when FCT is called 555 ;; Point is at start when FCT is called
556 ;; Call fct with (s,e) = whole lines if VISIBLE non-nil.
557 ;; Only call fct for visible lines if VISIBLE==t.
540 ;; Set undo boundary if UNDO is non-nil. 558 ;; Set undo boundary if UNDO is non-nil.
541 ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding) 559 ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
560 ;; Perform auto-tabify after operation if TABIFY is non-nil.
542 ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. 561 ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
543 (let* ((start (cua--rectangle-top)) 562 (let* ((start (cua--rectangle-top))
544 (end (cua--rectangle-bot)) 563 (end (cua--rectangle-bot))
@@ -546,11 +565,12 @@ If command is repeated at same position, delete the rectangle."
546 (r (1+ (cua--rectangle-right))) 565 (r (1+ (cua--rectangle-right)))
547 (m (make-marker)) 566 (m (make-marker))
548 (tabpad (and (integerp pad) (= pad 2))) 567 (tabpad (and (integerp pad) (= pad 2)))
549 (sel (cua--rectangle-restriction))) 568 (sel (cua--rectangle-restriction))
569 (tabify-start (and tabify (cua--tabify-start start end))))
550 (if undo 570 (if undo
551 (cua--rectangle-undo-boundary)) 571 (cua--rectangle-undo-boundary))
552 (if (integerp pad) 572 (if (integerp pad)
553 (setq pad (cua--rectangle-padding))) 573 (setq pad (cua--rectangle-virtual-edges)))
554 (save-excursion 574 (save-excursion
555 (save-restriction 575 (save-restriction
556 (widen) 576 (widen)
@@ -558,11 +578,13 @@ If command is repeated at same position, delete the rectangle."
558 (goto-char end) 578 (goto-char end)
559 (and (bolp) (not (eolp)) (not (eobp)) 579 (and (bolp) (not (eolp)) (not (eobp))
560 (setq end (1+ end)))) 580 (setq end (1+ end))))
561 (when visible 581 (when (eq visible t)
562 (setq start (max (window-start) start)) 582 (setq start (max (window-start) start))
563 (setq end (min (window-end) end))) 583 (setq end (min (window-end) end)))
564 (goto-char end) 584 (goto-char end)
565 (setq end (line-end-position)) 585 (setq end (line-end-position))
586 (if (and visible (bolp) (not (eobp)))
587 (setq end (1+ end)))
566 (goto-char start) 588 (goto-char start)
567 (setq start (line-beginning-position)) 589 (setq start (line-beginning-position))
568 (narrow-to-region start end) 590 (narrow-to-region start end)
@@ -575,7 +597,7 @@ If command is repeated at same position, delete the rectangle."
575 (forward-char 1)) 597 (forward-char 1))
576 (set-marker m (point)) 598 (set-marker m (point))
577 (move-to-column l pad) 599 (move-to-column l pad)
578 (if (and fct (>= (current-column) l) (<= (current-column) r)) 600 (if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r))))
579 (let ((v t) (p (point))) 601 (let ((v t) (p (point)))
580 (when sel 602 (when sel
581 (if (car (cdr sel)) 603 (if (car (cdr sel))
@@ -585,8 +607,7 @@ If command is repeated at same position, delete the rectangle."
585 (if (car (cdr (cdr sel))) 607 (if (car (cdr (cdr sel)))
586 (setq v (null v)))) 608 (setq v (null v))))
587 (if visible 609 (if visible
588 (unless (eolp) 610 (funcall fct p m l r v)
589 (funcall fct p m l r v))
590 (if v 611 (if v
591 (funcall fct p m l r))))) 612 (funcall fct p m l r)))))
592 (set-marker m nil) 613 (set-marker m nil)
@@ -594,7 +615,9 @@ If command is repeated at same position, delete the rectangle."
594 (if (not visible) 615 (if (not visible)
595 (cua--rectangle-bot t)) 616 (cua--rectangle-bot t))
596 (if post-fct 617 (if post-fct
597 (funcall post-fct l r)))) 618 (funcall post-fct l r))
619 (when tabify-start
620 (tabify tabify-start (point)))))
598 (cond 621 (cond
599 ((eq keep-clear 'keep) 622 ((eq keep-clear 'keep)
600 (cua--keep-active)) 623 (cua--keep-active))
@@ -607,48 +630,96 @@ If command is repeated at same position, delete the rectangle."
607 630
608(put 'cua--rectangle-operation 'lisp-indent-function 4) 631(put 'cua--rectangle-operation 'lisp-indent-function 4)
609 632
610(defun cua--pad-rectangle (&optional pad)
611 (if (or pad (cua--rectangle-padding))
612 (cua--rectangle-operation nil nil t t)))
613
614(defun cua--delete-rectangle () 633(defun cua--delete-rectangle ()
615 (cua--rectangle-operation nil nil t 2 634 (let ((lines 0))
616 '(lambda (s e l r) 635 (if (not (cua--rectangle-virtual-edges))
617 (if (and (> e s) (<= e (point-max))) 636 (cua--rectangle-operation nil nil t 2 t
618 (delete-region s e))))) 637 '(lambda (s e l r v)
638 (setq lines (1+ lines))
639 (if (and (> e s) (<= e (point-max)))
640 (delete-region s e))))
641 (cua--rectangle-operation nil 1 t nil t
642 '(lambda (s e l r v)
643 (setq lines (1+ lines))
644 (when (and (> e s) (<= e (point-max)))
645 (delete-region s e)))))
646 lines))
619 647
620(defun cua--extract-rectangle () 648(defun cua--extract-rectangle ()
621 (let (rect) 649 (let (rect)
622 (cua--rectangle-operation nil nil nil 1 650 (if (not (cua--rectangle-virtual-edges))
623 '(lambda (s e l r) 651 (cua--rectangle-operation nil nil nil nil nil ; do not tabify
624 (setq rect (cons (buffer-substring-no-properties s e) rect)))) 652 '(lambda (s e l r)
625 (nreverse rect))) 653 (setq rect (cons (buffer-substring-no-properties s e) rect))))
626 654 (cua--rectangle-operation nil 1 nil nil nil ; do not tabify
627(defun cua--insert-rectangle (rect &optional below) 655 '(lambda (s e l r v)
656 (let ((copy t) (bs 0) (as 0) row)
657 (if (= s e) (setq e (1+ e)))
658 (goto-char s)
659 (move-to-column l)
660 (if (= (point) (line-end-position))
661 (setq bs (- r l)
662 copy nil)
663 (skip-chars-forward "\s\t" e)
664 (setq bs (- (min r (current-column)) l)
665 s (point))
666 (move-to-column r)
667 (skip-chars-backward "\s\t" s)
668 (setq as (- r (max (current-column) l))
669 e (point)))
670 (setq row (if (and copy (> e s))
671 (buffer-substring-no-properties s e)
672 ""))
673 (when (> bs 0)
674 (setq row (concat (make-string bs ?\s) row)))
675 (when (> as 0)
676 (setq row (concat row (make-string as ?\s))))
677 (setq rect (cons row rect))))))
678 (nreverse rect)))
679
680(defun cua--insert-rectangle (rect &optional below paste-column line-count)
628 ;; Insert rectangle as insert-rectangle, but don't set mark and exit with 681 ;; Insert rectangle as insert-rectangle, but don't set mark and exit with
629 ;; point at either next to top right or below bottom left corner 682 ;; point at either next to top right or below bottom left corner
630 ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. 683 ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines.
631 (if (and below (eq below 'auto)) 684 (if (eq below 'auto)
632 (setq below (and (bolp) 685 (setq below (and (bolp)
633 (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) 686 (or (eolp) (eobp) (= (1+ (point)) (point-max))))))
687 (unless paste-column
688 (setq paste-column (current-column)))
634 (let ((lines rect) 689 (let ((lines rect)
635 (insertcolumn (current-column))
636 (first t) 690 (first t)
691 (tabify-start (cua--tabify-start (point) (point)))
692 last-column
637 p) 693 p)
638 (while (or lines below) 694 (while (or lines below)
639 (or first 695 (or first
640 (if overwrite-mode 696 (if overwrite-mode
641 (insert ?\n) 697 (insert ?\n)
642 (forward-line 1) 698 (forward-line 1)
643 (or (bolp) (insert ?\n)) 699 (or (bolp) (insert ?\n))))
644 (move-to-column insertcolumn t))) 700 (unless overwrite-mode
701 (move-to-column paste-column t))
645 (if (not lines) 702 (if (not lines)
646 (setq below nil) 703 (setq below nil)
647 (insert-for-yank (car lines)) 704 (insert-for-yank (car lines))
705 (unless last-column
706 (setq last-column (current-column)))
648 (setq lines (cdr lines)) 707 (setq lines (cdr lines))
649 (and first (not below) 708 (and first (not below)
650 (setq p (point)))) 709 (setq p (point))))
651 (setq first nil)) 710 (setq first nil)
711 (if (and line-count (= (setq line-count (1- line-count)) 0))
712 (setq lines nil)))
713 (when (and line-count last-column (not overwrite-mode))
714 (while (> line-count 0)
715 (forward-line 1)
716 (or (bolp) (insert ?\n))
717 (move-to-column paste-column t)
718 (insert-char ?\s (- last-column paste-column -1))
719 (setq line-count (1- line-count))))
720 (when (and tabify-start
721 (not overwrite-mode))
722 (tabify tabify-start (point)))
652 (and p (not overwrite-mode) 723 (and p (not overwrite-mode)
653 (goto-char p)))) 724 (goto-char p))))
654 725
@@ -662,7 +733,7 @@ If command is repeated at same position, delete the rectangle."
662 (function (lambda (row) (concat row "\n"))) 733 (function (lambda (row) (concat row "\n")))
663 killed-rectangle ""))))) 734 killed-rectangle "")))))
664 735
665(defun cua--activate-rectangle (&optional force) 736(defun cua--activate-rectangle ()
666 ;; Turn on rectangular marking mode by disabling transient mark mode 737 ;; Turn on rectangular marking mode by disabling transient mark mode
667 ;; and manually handling highlighting from a post command hook. 738 ;; and manually handling highlighting from a post command hook.
668 ;; Be careful if we are already marking a rectangle. 739 ;; Be careful if we are already marking a rectangle.
@@ -671,12 +742,8 @@ If command is repeated at same position, delete the rectangle."
671 (eq (car cua--last-rectangle) (current-buffer)) 742 (eq (car cua--last-rectangle) (current-buffer))
672 (eq (car (cdr cua--last-rectangle)) (point))) 743 (eq (car (cdr cua--last-rectangle)) (point)))
673 (cdr (cdr cua--last-rectangle)) 744 (cdr (cdr cua--last-rectangle))
674 (cua--rectangle-get-corners 745 (cua--rectangle-get-corners))
675 (and (not buffer-read-only) 746 cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
676 (or cua-auto-expand-rectangles
677 force
678 (eq major-mode 'picture-mode)))))
679 cua--status-string (if (cua--rectangle-padding) " Pad" "")
680 cua--last-rectangle nil)) 747 cua--last-rectangle nil))
681 748
682;; (defvar cua-save-point nil) 749;; (defvar cua-save-point nil)
@@ -698,7 +765,7 @@ If command is repeated at same position, delete the rectangle."
698 ;; Each overlay extends across all the columns of the rectangle. 765 ;; Each overlay extends across all the columns of the rectangle.
699 ;; We try to reuse overlays where possible because this is more efficient 766 ;; We try to reuse overlays where possible because this is more efficient
700 ;; and results in less flicker. 767 ;; and results in less flicker.
701 ;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines, 768 ;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines,
702 ;; the higlighted region may not be perfectly rectangular. 769 ;; the higlighted region may not be perfectly rectangular.
703 (let ((deactivate-mark deactivate-mark) 770 (let ((deactivate-mark deactivate-mark)
704 (old cua--rectangle-overlays) 771 (old cua--rectangle-overlays)
@@ -707,12 +774,67 @@ If command is repeated at same position, delete the rectangle."
707 (right (1+ (cua--rectangle-right)))) 774 (right (1+ (cua--rectangle-right))))
708 (when (/= left right) 775 (when (/= left right)
709 (sit-for 0) ; make window top/bottom reliable 776 (sit-for 0) ; make window top/bottom reliable
710 (cua--rectangle-operation nil t nil nil 777 (cua--rectangle-operation nil t nil nil nil ; do not tabify
711 '(lambda (s e l r v) 778 '(lambda (s e l r v)
712 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) 779 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face))
713 overlay) 780 overlay bs ms as)
714 ;; Trim old leading overlays.
715 (if (= s e) (setq e (1+ e))) 781 (if (= s e) (setq e (1+ e)))
782 (when (cua--rectangle-virtual-edges)
783 (let ((lb (line-beginning-position))
784 (le (line-end-position))
785 cl cl0 pl cr cr0 pr)
786 (goto-char s)
787 (setq cl (move-to-column l)
788 pl (point))
789 (setq cr (move-to-column r)
790 pr (point))
791 (if (= lb pl)
792 (setq cl0 0)
793 (goto-char (1- pl))
794 (setq cl0 (current-column)))
795 (if (= lb le)
796 (setq cr0 0)
797 (goto-char (1- pr))
798 (setq cr0 (current-column)))
799 (unless (and (= cl l) (= cr r))
800 (when (/= cl l)
801 (setq bs (propertize
802 (make-string
803 (- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
804 (if cua--virtual-edges-debug ?. ?\s))
805 'face 'default))
806 (if (/= pl le)
807 (setq s (1- s))))
808 (cond
809 ((= cr r)
810 (if (and (/= pr le)
811 (/= cr0 (1- cr))
812 (or bs (/= cr0 (- cr tab-width)))
813 (/= (mod cr tab-width) 0))
814 (setq e (1- e))))
815 ((= cr cl)
816 (setq ms (propertize
817 (make-string
818 (- r l)
819 (if cua--virtual-edges-debug ?, ?\s))
820 'face rface))
821 (if (cua--rectangle-right-side)
822 (put-text-property (1- (length ms)) (length ms) 'cursor t ms)
823 (put-text-property 0 1 'cursor t ms))
824 (setq bs (concat bs ms))
825 (setq rface nil))
826 (t
827 (setq as (propertize
828 (make-string
829 (- r cr0 (if (= le pr) 1 0))
830 (if cua--virtual-edges-debug ?~ ?\s))
831 'face rface))
832 (if (cua--rectangle-right-side)
833 (put-text-property (1- (length as)) (length as) 'cursor t as)
834 (put-text-property 0 1 'cursor t as))
835 (if (/= pr le)
836 (setq e (1- e))))))))
837 ;; Trim old leading overlays.
716 (while (and old 838 (while (and old
717 (setq overlay (car old)) 839 (setq overlay (car old))
718 (< (overlay-start overlay) s) 840 (< (overlay-start overlay) s)
@@ -728,8 +850,11 @@ If command is repeated at same position, delete the rectangle."
728 (move-overlay overlay s e) 850 (move-overlay overlay s e)
729 (setq old (cdr old))) 851 (setq old (cdr old)))
730 (setq overlay (make-overlay s e))) 852 (setq overlay (make-overlay s e)))
731 (overlay-put overlay 'face rface) 853 (overlay-put overlay 'before-string bs)
732 (setq new (cons overlay new)))))) 854 (overlay-put overlay 'after-string as)
855 (overlay-put overlay 'face rface)
856 (overlay-put overlay 'keymap cua--overlay-keymap)
857 (setq new (cons overlay new))))))
733 ;; Trim old trailing overlays. 858 ;; Trim old trailing overlays.
734 (mapcar (function delete-overlay) old) 859 (mapcar (function delete-overlay) old)
735 (setq cua--rectangle-overlays (nreverse new)))) 860 (setq cua--rectangle-overlays (nreverse new))))
@@ -737,9 +862,9 @@ If command is repeated at same position, delete the rectangle."
737(defun cua--indent-rectangle (&optional ch to-col clear) 862(defun cua--indent-rectangle (&optional ch to-col clear)
738 ;; Indent current rectangle. 863 ;; Indent current rectangle.
739 (let ((col (cua--rectangle-insert-col)) 864 (let ((col (cua--rectangle-insert-col))
740 (pad (cua--rectangle-padding)) 865 (pad (cua--rectangle-virtual-edges))
741 indent) 866 indent)
742 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad 867 (cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil
743 '(lambda (s e l r) 868 '(lambda (s e l r)
744 (move-to-column col pad) 869 (move-to-column col pad)
745 (if (and (eolp) 870 (if (and (eolp)
@@ -875,23 +1000,22 @@ With prefix argument, the toggle restriction."
875(defun cua-rotate-rectangle () 1000(defun cua-rotate-rectangle ()
876 (interactive) 1001 (interactive)
877 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) 1002 (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
878 (cua--rectangle-set-corners)) 1003 (cua--rectangle-set-corners)
1004 (if (cua--rectangle-virtual-edges)
1005 (setq cua--buffer-and-point-before-command nil)))
879 1006
880(defun cua-toggle-rectangle-padding () 1007(defun cua-toggle-rectangle-virtual-edges ()
881 (interactive) 1008 (interactive)
882 (if buffer-read-only 1009 (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges)))
883 (message "Cannot do padding in read-only buffer.") 1010 (cua--rectangle-set-corners)
884 (cua--rectangle-padding t (not (cua--rectangle-padding))) 1011 (setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]"))
885 (cua--pad-rectangle)
886 (cua--rectangle-set-corners))
887 (setq cua--status-string (and (cua--rectangle-padding) " Pad"))
888 (cua--keep-active)) 1012 (cua--keep-active))
889 1013
890(defun cua-do-rectangle-padding () 1014(defun cua-do-rectangle-padding ()
891 (interactive) 1015 (interactive)
892 (if buffer-read-only 1016 (if buffer-read-only
893 (message "Cannot do padding in read-only buffer.") 1017 (message "Cannot do padding in read-only buffer.")
894 (cua--pad-rectangle t) 1018 (cua--rectangle-operation nil nil t t t)
895 (cua--rectangle-set-corners)) 1019 (cua--rectangle-set-corners))
896 (cua--keep-active)) 1020 (cua--keep-active))
897 1021
@@ -900,7 +1024,7 @@ With prefix argument, the toggle restriction."
900The text previously in the region is not overwritten by the blanks, 1024The text previously in the region is not overwritten by the blanks,
901but instead winds up to the right of the rectangle." 1025but instead winds up to the right of the rectangle."
902 (interactive) 1026 (interactive)
903 (cua--rectangle-operation 'corners nil t 1 1027 (cua--rectangle-operation 'corners nil t 1 nil
904 '(lambda (s e l r) 1028 '(lambda (s e l r)
905 (skip-chars-forward " \t") 1029 (skip-chars-forward " \t")
906 (let ((ws (- (current-column) l)) 1030 (let ((ws (- (current-column) l))
@@ -915,7 +1039,7 @@ On each line in the rectangle, all continuous whitespace starting
915at that column is deleted. 1039at that column is deleted.
916With prefix arg, also delete whitespace to the left of that column." 1040With prefix arg, also delete whitespace to the left of that column."
917 (interactive "P") 1041 (interactive "P")
918 (cua--rectangle-operation 'clear nil t 1 1042 (cua--rectangle-operation 'clear nil t 1 nil
919 '(lambda (s e l r) 1043 '(lambda (s e l r)
920 (when arg 1044 (when arg
921 (skip-syntax-backward " " (line-beginning-position)) 1045 (skip-syntax-backward " " (line-beginning-position))
@@ -927,7 +1051,7 @@ With prefix arg, also delete whitespace to the left of that column."
927 "Blank out CUA rectangle. 1051 "Blank out CUA rectangle.
928The text previously in the rectangle is overwritten by the blanks." 1052The text previously in the rectangle is overwritten by the blanks."
929 (interactive) 1053 (interactive)
930 (cua--rectangle-operation 'keep nil nil 1 1054 (cua--rectangle-operation 'keep nil nil 1 nil
931 '(lambda (s e l r) 1055 '(lambda (s e l r)
932 (goto-char e) 1056 (goto-char e)
933 (skip-syntax-forward " " (line-end-position)) 1057 (skip-syntax-forward " " (line-end-position))
@@ -942,7 +1066,7 @@ The text previously in the rectangle is overwritten by the blanks."
942 "Align rectangle lines to left column." 1066 "Align rectangle lines to left column."
943 (interactive) 1067 (interactive)
944 (let (x) 1068 (let (x)
945 (cua--rectangle-operation 'clear nil t t 1069 (cua--rectangle-operation 'clear nil t t nil
946 '(lambda (s e l r) 1070 '(lambda (s e l r)
947 (let ((b (line-beginning-position))) 1071 (let ((b (line-beginning-position)))
948 (skip-syntax-backward "^ " b) 1072 (skip-syntax-backward "^ " b)
@@ -984,7 +1108,7 @@ The text previously in the rectangle is overwritten by the blanks."
984 "Replace CUA rectangle contents with STRING on each line. 1108 "Replace CUA rectangle contents with STRING on each line.
985The length of STRING need not be the same as the rectangle width." 1109The length of STRING need not be the same as the rectangle width."
986 (interactive "sString rectangle: ") 1110 (interactive "sString rectangle: ")
987 (cua--rectangle-operation 'keep nil t t 1111 (cua--rectangle-operation 'keep nil t t nil
988 '(lambda (s e l r) 1112 '(lambda (s e l r)
989 (delete-region s e) 1113 (delete-region s e)
990 (skip-chars-forward " \t") 1114 (skip-chars-forward " \t")
@@ -999,7 +1123,7 @@ The length of STRING need not be the same as the rectangle width."
999(defun cua-fill-char-rectangle (ch) 1123(defun cua-fill-char-rectangle (ch)
1000 "Replace CUA rectangle contents with CHARACTER." 1124 "Replace CUA rectangle contents with CHARACTER."
1001 (interactive "cFill rectangle with character: ") 1125 (interactive "cFill rectangle with character: ")
1002 (cua--rectangle-operation 'clear nil t 1 1126 (cua--rectangle-operation 'clear nil t 1 nil
1003 '(lambda (s e l r) 1127 '(lambda (s e l r)
1004 (delete-region s e) 1128 (delete-region s e)
1005 (move-to-column l t) 1129 (move-to-column l t)
@@ -1010,7 +1134,7 @@ The length of STRING need not be the same as the rectangle width."
1010 (interactive "sReplace regexp: \nsNew text: ") 1134 (interactive "sReplace regexp: \nsNew text: ")
1011 (if buffer-read-only 1135 (if buffer-read-only
1012 (message "Cannot replace in read-only buffer") 1136 (message "Cannot replace in read-only buffer")
1013 (cua--rectangle-operation 'keep nil t 1 1137 (cua--rectangle-operation 'keep nil t 1 nil
1014 '(lambda (s e l r) 1138 '(lambda (s e l r)
1015 (if (re-search-forward regexp e t) 1139 (if (re-search-forward regexp e t)
1016 (replace-match newtext nil nil)))))) 1140 (replace-match newtext nil nil))))))
@@ -1018,7 +1142,7 @@ The length of STRING need not be the same as the rectangle width."
1018(defun cua-incr-rectangle (increment) 1142(defun cua-incr-rectangle (increment)
1019 "Increment each line of CUA rectangle by prefix amount." 1143 "Increment each line of CUA rectangle by prefix amount."
1020 (interactive "p") 1144 (interactive "p")
1021 (cua--rectangle-operation 'keep nil t 1 1145 (cua--rectangle-operation 'keep nil t 1 nil
1022 '(lambda (s e l r) 1146 '(lambda (s e l r)
1023 (cond 1147 (cond
1024 ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) 1148 ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t)
@@ -1051,36 +1175,36 @@ The numbers are formatted according to the FORMAT string."
1051 (if (= (length fmt) 0) 1175 (if (= (length fmt) 0)
1052 (setq fmt cua--rectangle-seq-format) 1176 (setq fmt cua--rectangle-seq-format)
1053 (setq cua--rectangle-seq-format fmt)) 1177 (setq cua--rectangle-seq-format fmt))
1054 (cua--rectangle-operation 'clear nil t 1 1178 (cua--rectangle-operation 'clear nil t 1 nil
1055 '(lambda (s e l r) 1179 '(lambda (s e l r)
1056 (delete-region s e) 1180 (delete-region s e)
1057 (insert (format fmt first)) 1181 (insert (format fmt first))
1058 (setq first (+ first incr))))) 1182 (setq first (+ first incr)))))
1059 1183
1060(defmacro cua--convert-rectangle-as (command) 1184(defmacro cua--convert-rectangle-as (command tabify)
1061 `(cua--rectangle-operation 'clear nil nil nil 1185 `(cua--rectangle-operation 'clear nil nil nil ,tabify
1062 '(lambda (s e l r) 1186 '(lambda (s e l r)
1063 (,command s e)))) 1187 (,command s e))))
1064 1188
1065(defun cua-upcase-rectangle () 1189(defun cua-upcase-rectangle ()
1066 "Convert the rectangle to upper case." 1190 "Convert the rectangle to upper case."
1067 (interactive) 1191 (interactive)
1068 (cua--convert-rectangle-as upcase-region)) 1192 (cua--convert-rectangle-as upcase-region nil))
1069 1193
1070(defun cua-downcase-rectangle () 1194(defun cua-downcase-rectangle ()
1071 "Convert the rectangle to lower case." 1195 "Convert the rectangle to lower case."
1072 (interactive) 1196 (interactive)
1073 (cua--convert-rectangle-as downcase-region)) 1197 (cua--convert-rectangle-as downcase-region nil))
1074 1198
1075(defun cua-upcase-initials-rectangle () 1199(defun cua-upcase-initials-rectangle ()
1076 "Convert the rectangle initials to upper case." 1200 "Convert the rectangle initials to upper case."
1077 (interactive) 1201 (interactive)
1078 (cua--convert-rectangle-as upcase-initials-region)) 1202 (cua--convert-rectangle-as upcase-initials-region nil))
1079 1203
1080(defun cua-capitalize-rectangle () 1204(defun cua-capitalize-rectangle ()
1081 "Convert the rectangle to proper case." 1205 "Convert the rectangle to proper case."
1082 (interactive) 1206 (interactive)
1083 (cua--convert-rectangle-as capitalize-region)) 1207 (cua--convert-rectangle-as capitalize-region nil))
1084 1208
1085 1209
1086;;; Replace/rearrange text in current rectangle 1210;;; Replace/rearrange text in current rectangle
@@ -1116,7 +1240,7 @@ The numbers are formatted according to the FORMAT string."
1116 (setq z (reverse z)) 1240 (setq z (reverse z))
1117 (if cua--debug 1241 (if cua--debug
1118 (print z auxbuf)) 1242 (print z auxbuf))
1119 (cua--rectangle-operation nil nil t pad 1243 (cua--rectangle-operation nil nil t pad nil
1120 '(lambda (s e l r) 1244 '(lambda (s e l r)
1121 (let (cc) 1245 (let (cc)
1122 (goto-char e) 1246 (goto-char e)
@@ -1232,9 +1356,9 @@ With prefix arg, indent to that column."
1232 "Delete char to left or right of rectangle." 1356 "Delete char to left or right of rectangle."
1233 (interactive) 1357 (interactive)
1234 (let ((col (cua--rectangle-insert-col)) 1358 (let ((col (cua--rectangle-insert-col))
1235 (pad (cua--rectangle-padding)) 1359 (pad (cua--rectangle-virtual-edges))
1236 indent) 1360 indent)
1237 (cua--rectangle-operation 'corners nil t pad 1361 (cua--rectangle-operation 'corners nil t pad nil
1238 '(lambda (s e l r) 1362 '(lambda (s e l r)
1239 (move-to-column 1363 (move-to-column
1240 (if (cua--rectangle-right-side t) 1364 (if (cua--rectangle-right-side t)
@@ -1282,10 +1406,7 @@ With prefix arg, indent to that column."
1282 (cua--rectangle-left (current-column))) 1406 (cua--rectangle-left (current-column)))
1283 (if (>= (cua--rectangle-corner) 2) 1407 (if (>= (cua--rectangle-corner) 2)
1284 (cua--rectangle-bot t) 1408 (cua--rectangle-bot t)
1285 (cua--rectangle-top t)) 1409 (cua--rectangle-top t))))
1286 (if (cua--rectangle-padding)
1287 (setq unread-command-events
1288 (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events)))))
1289 (if cua--rectangle 1410 (if cua--rectangle
1290 (if (and mark-active 1411 (if (and mark-active
1291 (not deactivate-mark)) 1412 (not deactivate-mark))
@@ -1379,7 +1500,7 @@ With prefix arg, indent to that column."
1379 (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) 1500 (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
1380 (cua--rect-M/H-key ?n 'cua-sequence-rectangle) 1501 (cua--rect-M/H-key ?n 'cua-sequence-rectangle)
1381 (cua--rect-M/H-key ?o 'cua-open-rectangle) 1502 (cua--rect-M/H-key ?o 'cua-open-rectangle)
1382 (cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding) 1503 (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges)
1383 (cua--rect-M/H-key ?P 'cua-do-rectangle-padding) 1504 (cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
1384 (cua--rect-M/H-key ?q 'cua-refill-rectangle) 1505 (cua--rect-M/H-key ?q 'cua-refill-rectangle)
1385 (cua--rect-M/H-key ?r 'cua-replace-in-rectangle) 1506 (cua--rect-M/H-key ?r 'cua-replace-in-rectangle)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e534c6998a7..d193ad344f5 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -461,18 +461,21 @@ face (according to `face-differs-from-default-p')."
461(defun variable-at-point () 461(defun variable-at-point ()
462 "Return the bound variable symbol found around point. 462 "Return the bound variable symbol found around point.
463Return 0 if there is no such symbol." 463Return 0 if there is no such symbol."
464 (condition-case () 464 (or (condition-case ()
465 (with-syntax-table emacs-lisp-mode-syntax-table 465 (with-syntax-table emacs-lisp-mode-syntax-table
466 (save-excursion 466 (save-excursion
467 (or (not (zerop (skip-syntax-backward "_w"))) 467 (or (not (zerop (skip-syntax-backward "_w")))
468 (eq (char-syntax (following-char)) ?w) 468 (eq (char-syntax (following-char)) ?w)
469 (eq (char-syntax (following-char)) ?_) 469 (eq (char-syntax (following-char)) ?_)
470 (forward-sexp -1)) 470 (forward-sexp -1))
471 (skip-chars-forward "'") 471 (skip-chars-forward "'")
472 (let ((obj (read (current-buffer)))) 472 (let ((obj (read (current-buffer))))
473 (or (and (symbolp obj) (boundp obj) obj) 473 (and (symbolp obj) (boundp obj) obj))))
474 0)))) 474 (error nil))
475 (error 0))) 475 (let* ((str (find-tag-default))
476 (obj (if str (read str))))
477 (and (symbolp obj) (boundp obj) obj))
478 0))
476 479
477;;;###autoload 480;;;###autoload
478(defun describe-variable (variable &optional buffer) 481(defun describe-variable (variable &optional buffer)
diff --git a/lisp/help.el b/lisp/help.el
index 52a772779a5..bf0df4358a7 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -237,32 +237,35 @@ C-w Display information on absence of warranty for GNU Emacs."
237(defun function-called-at-point () 237(defun function-called-at-point ()
238 "Return a function around point or else called by the list containing point. 238 "Return a function around point or else called by the list containing point.
239If that doesn't give a function, return nil." 239If that doesn't give a function, return nil."
240 (with-syntax-table emacs-lisp-mode-syntax-table 240 (or (with-syntax-table emacs-lisp-mode-syntax-table
241 (or (condition-case () 241 (or (condition-case ()
242 (save-excursion 242 (save-excursion
243 (or (not (zerop (skip-syntax-backward "_w"))) 243 (or (not (zerop (skip-syntax-backward "_w")))
244 (eq (char-syntax (following-char)) ?w) 244 (eq (char-syntax (following-char)) ?w)
245 (eq (char-syntax (following-char)) ?_) 245 (eq (char-syntax (following-char)) ?_)
246 (forward-sexp -1)) 246 (forward-sexp -1))
247 (skip-chars-forward "'") 247 (skip-chars-forward "'")
248 (let ((obj (read (current-buffer)))) 248 (let ((obj (read (current-buffer))))
249 (and (symbolp obj) (fboundp obj) obj))) 249 (and (symbolp obj) (fboundp obj) obj)))
250 (error nil)) 250 (error nil))
251 (condition-case () 251 (condition-case ()
252 (save-excursion 252 (save-excursion
253 (save-restriction 253 (save-restriction
254 (narrow-to-region (max (point-min) 254 (narrow-to-region (max (point-min)
255 (- (point) 1000)) (point-max)) 255 (- (point) 1000)) (point-max))
256 ;; Move up to surrounding paren, then after the open. 256 ;; Move up to surrounding paren, then after the open.
257 (backward-up-list 1) 257 (backward-up-list 1)
258 (forward-char 1) 258 (forward-char 1)
259 ;; If there is space here, this is probably something 259 ;; If there is space here, this is probably something
260 ;; other than a real Lisp function call, so ignore it. 260 ;; other than a real Lisp function call, so ignore it.
261 (if (looking-at "[ \t]") 261 (if (looking-at "[ \t]")
262 (error "Probably not a Lisp function call")) 262 (error "Probably not a Lisp function call"))
263 (let ((obj (read (current-buffer)))) 263 (let ((obj (read (current-buffer))))
264 (and (symbolp obj) (fboundp obj) obj)))) 264 (and (symbolp obj) (fboundp obj) obj))))
265 (error nil))))) 265 (error nil))))
266 (let* ((str (find-tag-default))
267 (obj (if str (read str))))
268 (and (symbolp obj) (fboundp obj) obj))))
266 269
267 270
268;;; `User' help functions 271;;; `User' help functions
diff --git a/lisp/indent.el b/lisp/indent.el
index e56db11b6f1..2d223b05ad6 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -442,8 +442,8 @@ This should be a list of integers, ordered from smallest to largest."
442 "Keymap used in `edit-tab-stops'.") 442 "Keymap used in `edit-tab-stops'.")
443 443
444(defvar edit-tab-stops-buffer nil 444(defvar edit-tab-stops-buffer nil
445 "Buffer whose tab stops are being edited--in case 445 "Buffer whose tab stops are being edited.
446the variable `tab-stop-list' is local in that buffer.") 446This matters if the variable `tab-stop-list' is local in that buffer.")
447 447
448(defun edit-tab-stops () 448(defun edit-tab-stops ()
449 "Edit the tab stops used by `tab-to-tab-stop'. 449 "Edit the tab stops used by `tab-to-tab-stop'.
diff --git a/lisp/info.el b/lisp/info.el
index 43e1dafcc6f..802fcf1642e 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -188,7 +188,7 @@ file, so be prepared for a few surprises if you enable this feature."
188 :type 'boolean 188 :type 'boolean
189 :group 'info) 189 :group 'info)
190 190
191(defcustom Info-search-whitespace-regexp "\\\\(?:\\\\s-+\\\\)" 191(defcustom Info-search-whitespace-regexp "\\(?:\\s-+\\)"
192 "*If non-nil, regular expression to match a sequence of whitespace chars. 192 "*If non-nil, regular expression to match a sequence of whitespace chars.
193This applies to Info search for regular expressions. 193This applies to Info search for regular expressions.
194You might want to use something like \"[ \\t\\r\\n]+\" instead. 194You might want to use something like \"[ \\t\\r\\n]+\" instead.
@@ -1442,8 +1442,9 @@ If FORK is a string, it is the name to use for the new buffer."
1442(defvar Info-search-case-fold nil 1442(defvar Info-search-case-fold nil
1443 "The value of `case-fold-search' from previous `Info-search' command.") 1443 "The value of `case-fold-search' from previous `Info-search' command.")
1444 1444
1445(defun Info-search (regexp) 1445(defun Info-search (regexp &optional bound noerror count direction)
1446 "Search for REGEXP, starting from point, and select node it's found in." 1446 "Search for REGEXP, starting from point, and select node it's found in.
1447If DIRECTION is `backward', search in the reverse direction."
1447 (interactive (list (read-string 1448 (interactive (list (read-string
1448 (if Info-search-history 1449 (if Info-search-history
1449 (format "Regexp search%s (default `%s'): " 1450 (format "Regexp search%s (default `%s'): "
@@ -1458,31 +1459,42 @@ If FORK is a string, it is the name to use for the new buffer."
1458 (setq regexp (car Info-search-history))) 1459 (setq regexp (car Info-search-history)))
1459 (when regexp 1460 (when regexp
1460 (let (found beg-found give-up 1461 (let (found beg-found give-up
1462 (backward (eq direction 'backward))
1461 (onode Info-current-node) 1463 (onode Info-current-node)
1462 (ofile Info-current-file) 1464 (ofile Info-current-file)
1463 (opoint (point)) 1465 (opoint (point))
1466 (opoint-min (point-min))
1467 (opoint-max (point-max))
1464 (ostart (window-start)) 1468 (ostart (window-start))
1465 (osubfile Info-current-subfile)) 1469 (osubfile Info-current-subfile))
1466 (when Info-search-whitespace-regexp 1470 (when Info-search-whitespace-regexp
1467 (setq regexp (replace-regexp-in-string 1471 (setq regexp
1468 "[ \t\n]+" Info-search-whitespace-regexp regexp))) 1472 (mapconcat 'identity (split-string regexp "[ \t\n]+")
1473 Info-search-whitespace-regexp)))
1469 (setq Info-search-case-fold case-fold-search) 1474 (setq Info-search-case-fold case-fold-search)
1470 (save-excursion 1475 (save-excursion
1471 (save-restriction 1476 (save-restriction
1472 (widen) 1477 (widen)
1473 (while (and (not give-up) 1478 (while (and (not give-up)
1474 (or (null found) 1479 (or (null found)
1475 (isearch-range-invisible beg-found found))) 1480 (if backward
1476 (if (re-search-forward regexp nil t) 1481 (isearch-range-invisible found beg-found)
1477 (setq found (point) beg-found (match-beginning 0)) 1482 (isearch-range-invisible beg-found found))))
1483 (if (if backward
1484 (re-search-backward regexp bound t)
1485 (re-search-forward regexp bound t))
1486 (setq found (point) beg-found (if backward (match-end 0)
1487 (match-beginning 0)))
1478 (setq give-up t))))) 1488 (setq give-up t)))))
1479 ;; If no subfiles, give error now. 1489 ;; If no subfiles, give error now.
1480 (if give-up 1490 (if give-up
1481 (if (null Info-current-subfile) 1491 (if (null Info-current-subfile)
1482 (re-search-forward regexp) 1492 (if backward
1493 (re-search-backward regexp)
1494 (re-search-forward regexp))
1483 (setq found nil))) 1495 (setq found nil)))
1484 1496
1485 (unless found 1497 (unless (or found bound)
1486 (unwind-protect 1498 (unwind-protect
1487 ;; Try other subfiles. 1499 ;; Try other subfiles.
1488 (let ((list ())) 1500 (let ((list ()))
@@ -1498,29 +1510,39 @@ If FORK is a string, it is the name to use for the new buffer."
1498 ;; Find the subfile we just searched. 1510 ;; Find the subfile we just searched.
1499 (search-forward (concat "\n" osubfile ": ")) 1511 (search-forward (concat "\n" osubfile ": "))
1500 ;; Skip that one. 1512 ;; Skip that one.
1501 (forward-line 1) 1513 (forward-line (if backward 0 1))
1502 ;; Make a list of all following subfiles. 1514 ;; Make a list of all following subfiles.
1503 ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). 1515 ;; Each elt has the form (VIRT-POSITION . SUBFILENAME).
1504 (while (not (eobp)) 1516 (while (not (if backward (bobp) (eobp)))
1505 (re-search-forward "\\(^.*\\): [0-9]+$") 1517 (if backward
1518 (re-search-backward "\\(^.*\\): [0-9]+$")
1519 (re-search-forward "\\(^.*\\): [0-9]+$"))
1506 (goto-char (+ (match-end 1) 2)) 1520 (goto-char (+ (match-end 1) 2))
1507 (setq list (cons (cons (+ (point-min) 1521 (setq list (cons (cons (+ (point-min)
1508 (read (current-buffer))) 1522 (read (current-buffer)))
1509 (match-string-no-properties 1)) 1523 (match-string-no-properties 1))
1510 list)) 1524 list))
1511 (goto-char (1+ (match-end 0)))) 1525 (goto-char (if backward
1526 (1- (match-beginning 0))
1527 (1+ (match-end 0)))))
1512 ;; Put in forward order 1528 ;; Put in forward order
1513 (setq list (nreverse list)))) 1529 (setq list (nreverse list))))
1514 (while list 1530 (while list
1515 (message "Searching subfile %s..." (cdr (car list))) 1531 (message "Searching subfile %s..." (cdr (car list)))
1516 (Info-read-subfile (car (car list))) 1532 (Info-read-subfile (car (car list)))
1533 (if backward (goto-char (point-max)))
1517 (setq list (cdr list)) 1534 (setq list (cdr list))
1518 (setq give-up nil found nil) 1535 (setq give-up nil found nil)
1519 (while (and (not give-up) 1536 (while (and (not give-up)
1520 (or (null found) 1537 (or (null found)
1521 (isearch-range-invisible beg-found found))) 1538 (if backward
1522 (if (re-search-forward regexp nil t) 1539 (isearch-range-invisible found beg-found)
1523 (setq found (point) beg-found (match-beginning 0)) 1540 (isearch-range-invisible beg-found found))))
1541 (if (if backward
1542 (re-search-backward regexp nil t)
1543 (re-search-forward regexp nil t))
1544 (setq found (point) beg-found (if backward (match-end 0)
1545 (match-beginning 0)))
1524 (setq give-up t))) 1546 (setq give-up t)))
1525 (if give-up 1547 (if give-up
1526 (setq found nil)) 1548 (setq found nil))
@@ -1534,12 +1556,20 @@ If FORK is a string, it is the name to use for the new buffer."
1534 (goto-char opoint) 1556 (goto-char opoint)
1535 (Info-select-node) 1557 (Info-select-node)
1536 (set-window-start (selected-window) ostart))))) 1558 (set-window-start (selected-window) ostart)))))
1537 (widen) 1559
1538 (goto-char found) 1560 (if (and (string= osubfile Info-current-subfile)
1539 (Info-select-node) 1561 (> found opoint-min)
1562 (< found opoint-max))
1563 ;; Search landed in the same node
1564 (goto-char found)
1565 (widen)
1566 (goto-char found)
1567 (save-match-data (Info-select-node)))
1568
1540 ;; Use string-equal, not equal, to ignore text props. 1569 ;; Use string-equal, not equal, to ignore text props.
1541 (or (and (string-equal onode Info-current-node) 1570 (or (and (string-equal onode Info-current-node)
1542 (equal ofile Info-current-file)) 1571 (equal ofile Info-current-file))
1572 (and isearch-mode isearch-wrapped (eq opoint opoint-min))
1543 (setq Info-history (cons (list ofile onode opoint) 1573 (setq Info-history (cons (list ofile onode opoint)
1544 Info-history)))))) 1574 Info-history))))))
1545 1575
@@ -1556,6 +1586,48 @@ If FORK is a string, it is the name to use for the new buffer."
1556 (if Info-search-history 1586 (if Info-search-history
1557 (Info-search (car Info-search-history)) 1587 (Info-search (car Info-search-history))
1558 (call-interactively 'Info-search)))) 1588 (call-interactively 'Info-search))))
1589
1590(defun Info-search-backward (regexp &optional bound noerror count)
1591 "Search for REGEXP in the reverse direction."
1592 (interactive (list (read-string
1593 (if Info-search-history
1594 (format "Regexp search%s backward (default `%s'): "
1595 (if case-fold-search "" " case-sensitively")
1596 (car Info-search-history))
1597 (format "Regexp search%s backward: "
1598 (if case-fold-search "" " case-sensitively")))
1599 nil 'Info-search-history)))
1600 (Info-search regexp bound noerror count 'backward))
1601
1602(defun Info-isearch-search ()
1603 (cond
1604 (isearch-word
1605 (if isearch-forward 'word-search-forward 'word-search-backward))
1606 (isearch-regexp
1607 (lambda (regexp bound noerror)
1608 (condition-case nil
1609 (progn
1610 (Info-search regexp bound noerror nil
1611 (unless isearch-forward 'backward))
1612 (point))
1613 (error nil))))
1614 (t
1615 (if isearch-forward 'search-forward 'search-backward))))
1616
1617(defun Info-isearch-wrap ()
1618 (if isearch-regexp
1619 (if isearch-forward (Info-top-node) (Info-final-node))
1620 (goto-char (if isearch-forward (point-min) (point-max)))))
1621
1622(defun Info-isearch-push-state ()
1623 `(lambda (cmd)
1624 (Info-isearch-pop-state cmd ,Info-current-file ,Info-current-node)))
1625
1626(defun Info-isearch-pop-state (cmd file node)
1627 (or (and (string= Info-current-file file)
1628 (string= Info-current-node node))
1629 (progn (Info-find-node file node) (sit-for 0))))
1630
1559 1631
1560(defun Info-extract-pointer (name &optional errorname) 1632(defun Info-extract-pointer (name &optional errorname)
1561 "Extract the value of the node-pointer named NAME. 1633 "Extract the value of the node-pointer named NAME.
@@ -3064,6 +3136,14 @@ Advanced commands:
3064 (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) 3136 (setq desktop-save-buffer 'Info-desktop-buffer-misc-data)
3065 (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) 3137 (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t)
3066 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 3138 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
3139 (set (make-local-variable 'isearch-search-fun-function)
3140 'Info-isearch-search)
3141 (set (make-local-variable 'isearch-wrap-function)
3142 'Info-isearch-wrap)
3143 (set (make-local-variable 'isearch-push-state-function)
3144 'Info-isearch-push-state)
3145 (set (make-local-variable 'search-whitespace-regexp)
3146 Info-search-whitespace-regexp)
3067 (Info-set-mode-line) 3147 (Info-set-mode-line)
3068 (run-hooks 'Info-mode-hook)) 3148 (run-hooks 'Info-mode-hook))
3069 3149
@@ -3445,23 +3525,24 @@ Preserve text properties."
3445 other-tag) 3525 other-tag)
3446 (when not-fontified-p 3526 (when not-fontified-p
3447 (when Info-hide-note-references 3527 (when Info-hide-note-references
3448 ;; *Note is often used where *note should have been 3528 (when (not (eq Info-hide-note-references 'hide))
3449 (goto-char start) 3529 ;; *Note is often used where *note should have been
3450 (skip-syntax-backward " ") 3530 (goto-char start)
3451 (setq other-tag 3531 (skip-syntax-backward " ")
3452 (cond ((memq (char-before) '(nil ?\. ?! ??)) 3532 (setq other-tag
3453 "See ") 3533 (cond ((memq (char-before) '(nil ?\. ?! ??))
3454 ((memq (char-before) '(?\, ?\; ?\: ?-)) 3534 "See ")
3455 "see ") 3535 ((memq (char-before) '(?\, ?\; ?\: ?-))
3456 ((memq (char-before) '(?\( ?\[ ?\{)) 3536 "see ")
3457 ;; Check whether the paren is preceded by 3537 ((memq (char-before) '(?\( ?\[ ?\{))
3458 ;; an end of sentence 3538 ;; Check whether the paren is preceded by
3459 (skip-syntax-backward " (") 3539 ;; an end of sentence
3460 (if (memq (char-before) '(nil ?\. ?! ??)) 3540 (skip-syntax-backward " (")
3461 "See " 3541 (if (memq (char-before) '(nil ?\. ?! ??))
3462 "see ")) 3542 "See "
3463 ((save-match-data (looking-at "\n\n")) 3543 "see "))
3464 "See "))) 3544 ((save-match-data (looking-at "\n\n"))
3545 "See "))))
3465 (goto-char next) 3546 (goto-char next)
3466 (add-text-properties 3547 (add-text-properties
3467 (match-beginning 1) 3548 (match-beginning 1)
@@ -3471,7 +3552,7 @@ Preserve text properties."
3471 (if (string-match "\n" (match-string 1)) 3552 (if (string-match "\n" (match-string 1))
3472 (+ start1 (match-beginning 0))))) 3553 (+ start1 (match-beginning 0)))))
3473 (match-end 1)) 3554 (match-end 1))
3474 (if (and other-tag (not (eq Info-hide-note-references 'hide))) 3555 (if other-tag
3475 `(display ,other-tag front-sticky nil rear-nonsticky t) 3556 `(display ,other-tag front-sticky nil rear-nonsticky t)
3476 '(invisible t front-sticky nil rear-nonsticky t)))) 3557 '(invisible t front-sticky nil rear-nonsticky t))))
3477 (add-text-properties 3558 (add-text-properties
diff --git a/lisp/isearch.el b/lisp/isearch.el
index ad6f6b21ebc..63cbb07dcf9 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -57,47 +57,6 @@
57;; keep the behavior. No point in forcing nonincremental search until 57;; keep the behavior. No point in forcing nonincremental search until
58;; the last possible moment. 58;; the last possible moment.
59 59
60;; TODO
61;; - Integrate the emacs 19 generalized command history.
62;; - Hooks and options for failed search.
63
64;;; Change Log:
65
66;; Changes before those recorded in ChangeLog:
67
68;; Revision 1.4 92/09/14 16:26:02 liberte
69;; Added prefix args to isearch-forward, etc. to switch between
70;; string and regular expression searching.
71;; Added some support for lemacs.
72;; Added general isearch-highlight option - but only for lemacs so far.
73;; Added support for frame switching in emacs 19.
74;; Added word search option to isearch-edit-string.
75;; Renamed isearch-quit to isearch-abort.
76;; Numerous changes to comments and doc strings.
77;;
78;; Revision 1.3 92/06/29 13:10:08 liberte
79;; Moved modal isearch-mode handling into isearch-mode.
80;; Got rid of buffer-local isearch variables.
81;; isearch-edit-string used by ring adjustments, completion, and
82;; nonincremental searching. C-s and C-r are additional exit commands.
83;; Renamed all regex to regexp.
84;; Got rid of found-start and found-point globals.
85;; Generalized handling of upper-case chars.
86
87;; Revision 1.2 92/05/27 11:33:57 liberte
88;; Emacs version 19 has a search ring, which is supported here.
89;; Other fixes found in the version 19 isearch are included here.
90;;
91;; Also see variables search-caps-disable-folding,
92;; search-nonincremental-instead, search-whitespace-regexp, and
93;; commands isearch-toggle-regexp, isearch-edit-string.
94;;
95;; semi-modal isearching is supported.
96
97;; Changes for 1.1
98;; 3/18/92 Fixed invalid-regexp.
99;; 3/18/92 Fixed yanking in regexps.
100
101;;; Code: 60;;; Code:
102 61
103 62
@@ -198,6 +157,15 @@ Ordinarily the text becomes invisible again at the end of the search."
198(defvar isearch-mode-end-hook nil 157(defvar isearch-mode-end-hook nil
199 "Function(s) to call after terminating an incremental search.") 158 "Function(s) to call after terminating an incremental search.")
200 159
160(defvar isearch-wrap-function nil
161 "Function to call to wrap the search when search is failed.
162If nil, move point to the beginning of the buffer for a forward search,
163or to the end of the buffer for a backward search.")
164
165(defvar isearch-push-state-function nil
166 "Function to save a function restoring the mode-specific isearch state
167to the search status stack.")
168
201;; Search ring. 169;; Search ring.
202 170
203(defvar search-ring nil 171(defvar search-ring nil
@@ -772,57 +740,62 @@ REGEXP says which ring to use."
772 740
773;; The search status structure and stack. 741;; The search status structure and stack.
774 742
775(defsubst isearch-string (frame) 743(defsubst isearch-string-state (frame)
776 "Return the search string in FRAME." 744 "Return the search string in FRAME."
777 (aref frame 0)) 745 (aref frame 0))
778(defsubst isearch-message-string (frame) 746(defsubst isearch-message-state (frame)
779 "Return the search string to display to the user in FRAME." 747 "Return the search string to display to the user in FRAME."
780 (aref frame 1)) 748 (aref frame 1))
781(defsubst isearch-point (frame) 749(defsubst isearch-point-state (frame)
782 "Return the point in FRAME." 750 "Return the point in FRAME."
783 (aref frame 2)) 751 (aref frame 2))
784(defsubst isearch-success (frame) 752(defsubst isearch-success-state (frame)
785 "Return the success flag in FRAME." 753 "Return the success flag in FRAME."
786 (aref frame 3)) 754 (aref frame 3))
787(defsubst isearch-forward-flag (frame) 755(defsubst isearch-forward-state (frame)
788 "Return the searching-forward flag in FRAME." 756 "Return the searching-forward flag in FRAME."
789 (aref frame 4)) 757 (aref frame 4))
790(defsubst isearch-other-end (frame) 758(defsubst isearch-other-end-state (frame)
791 "Return the other end of the match in FRAME." 759 "Return the other end of the match in FRAME."
792 (aref frame 5)) 760 (aref frame 5))
793(defsubst isearch-word (frame) 761(defsubst isearch-word-state (frame)
794 "Return the search-by-word flag in FRAME." 762 "Return the search-by-word flag in FRAME."
795 (aref frame 6)) 763 (aref frame 6))
796(defsubst isearch-invalid-regexp (frame) 764(defsubst isearch-invalid-regexp-state (frame)
797 "Return the regexp error message in FRAME, or nil if its regexp is valid." 765 "Return the regexp error message in FRAME, or nil if its regexp is valid."
798 (aref frame 7)) 766 (aref frame 7))
799(defsubst isearch-wrapped (frame) 767(defsubst isearch-wrapped-state (frame)
800 "Return the search-wrapped flag in FRAME." 768 "Return the search-wrapped flag in FRAME."
801 (aref frame 8)) 769 (aref frame 8))
802(defsubst isearch-barrier (frame) 770(defsubst isearch-barrier-state (frame)
803 "Return the barrier value in FRAME." 771 "Return the barrier value in FRAME."
804 (aref frame 9)) 772 (aref frame 9))
805(defsubst isearch-within-brackets (frame) 773(defsubst isearch-within-brackets-state (frame)
806 "Return the in-character-class flag in FRAME." 774 "Return the in-character-class flag in FRAME."
807 (aref frame 10)) 775 (aref frame 10))
808(defsubst isearch-case-fold-search (frame) 776(defsubst isearch-case-fold-search-state (frame)
809 "Return the case-folding flag in FRAME." 777 "Return the case-folding flag in FRAME."
810 (aref frame 11)) 778 (aref frame 11))
779(defsubst isearch-pop-fun-state (frame)
780 "Return the function restoring the mode-specific isearch state in FRAME."
781 (aref frame 12))
811 782
812(defun isearch-top-state () 783(defun isearch-top-state ()
813 (let ((cmd (car isearch-cmds))) 784 (let ((cmd (car isearch-cmds)))
814 (setq isearch-string (isearch-string cmd) 785 (setq isearch-string (isearch-string-state cmd)
815 isearch-message (isearch-message-string cmd) 786 isearch-message (isearch-message-state cmd)
816 isearch-success (isearch-success cmd) 787 isearch-success (isearch-success-state cmd)
817 isearch-forward (isearch-forward-flag cmd) 788 isearch-forward (isearch-forward-state cmd)
818 isearch-other-end (isearch-other-end cmd) 789 isearch-other-end (isearch-other-end-state cmd)
819 isearch-word (isearch-word cmd) 790 isearch-word (isearch-word-state cmd)
820 isearch-invalid-regexp (isearch-invalid-regexp cmd) 791 isearch-invalid-regexp (isearch-invalid-regexp-state cmd)
821 isearch-wrapped (isearch-wrapped cmd) 792 isearch-wrapped (isearch-wrapped-state cmd)
822 isearch-barrier (isearch-barrier cmd) 793 isearch-barrier (isearch-barrier-state cmd)
823 isearch-within-brackets (isearch-within-brackets cmd) 794 isearch-within-brackets (isearch-within-brackets-state cmd)
824 isearch-case-fold-search (isearch-case-fold-search cmd)) 795 isearch-case-fold-search (isearch-case-fold-search-state cmd))
825 (goto-char (isearch-point cmd)))) 796 (if (functionp (isearch-pop-fun-state cmd))
797 (funcall (isearch-pop-fun-state cmd) cmd))
798 (goto-char (isearch-point-state cmd))))
826 799
827(defun isearch-pop-state () 800(defun isearch-pop-state ()
828 (setq isearch-cmds (cdr isearch-cmds)) 801 (setq isearch-cmds (cdr isearch-cmds))
@@ -834,7 +807,9 @@ REGEXP says which ring to use."
834 isearch-success isearch-forward isearch-other-end 807 isearch-success isearch-forward isearch-other-end
835 isearch-word 808 isearch-word
836 isearch-invalid-regexp isearch-wrapped isearch-barrier 809 isearch-invalid-regexp isearch-wrapped isearch-barrier
837 isearch-within-brackets isearch-case-fold-search) 810 isearch-within-brackets isearch-case-fold-search
811 (if isearch-push-state-function
812 (funcall isearch-push-state-function)))
838 isearch-cmds))) 813 isearch-cmds)))
839 814
840 815
@@ -1020,10 +995,13 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
1020(defun isearch-cancel () 995(defun isearch-cancel ()
1021 "Terminate the search and go back to the starting point." 996 "Terminate the search and go back to the starting point."
1022 (interactive) 997 (interactive)
998 (if (functionp (isearch-pop-fun-state (car (last isearch-cmds))))
999 (funcall (isearch-pop-fun-state (car (last isearch-cmds)))
1000 (car (last isearch-cmds))))
1023 (goto-char isearch-opoint) 1001 (goto-char isearch-opoint)
1024 (isearch-done t) 1002 (isearch-done t) ; exit isearch
1025 (isearch-clean-overlays) 1003 (isearch-clean-overlays)
1026 (signal 'quit nil)) ; and pass on quit signal 1004 (signal 'quit nil)) ; and pass on quit signal
1027 1005
1028(defun isearch-abort () 1006(defun isearch-abort ()
1029 "Abort incremental search mode if searching is successful, signaling quit. 1007 "Abort incremental search mode if searching is successful, signaling quit.
@@ -1035,11 +1013,9 @@ Use `isearch-exit' to quit without signaling."
1035 (if isearch-success 1013 (if isearch-success
1036 ;; If search is successful, move back to starting point 1014 ;; If search is successful, move back to starting point
1037 ;; and really do quit. 1015 ;; and really do quit.
1038 (progn (goto-char isearch-opoint) 1016 (progn
1039 (setq isearch-success nil) 1017 (setq isearch-success nil)
1040 (isearch-done t) ; exit isearch 1018 (isearch-cancel))
1041 (isearch-clean-overlays)
1042 (signal 'quit nil)) ; and pass on quit signal
1043 ;; If search is failing, or has an incomplete regexp, 1019 ;; If search is failing, or has an incomplete regexp,
1044 ;; rub out until it is once more successful. 1020 ;; rub out until it is once more successful.
1045 (while (or (not isearch-success) isearch-invalid-regexp) 1021 (while (or (not isearch-success) isearch-invalid-regexp)
@@ -1064,7 +1040,9 @@ Use `isearch-exit' to quit without signaling."
1064 ;; If already have what to search for, repeat it. 1040 ;; If already have what to search for, repeat it.
1065 (or isearch-success 1041 (or isearch-success
1066 (progn 1042 (progn
1067 (goto-char (if isearch-forward (point-min) (point-max))) 1043 (if isearch-wrap-function
1044 (funcall isearch-wrap-function)
1045 (goto-char (if isearch-forward (point-min) (point-max))))
1068 (setq isearch-wrapped t)))) 1046 (setq isearch-wrapped t))))
1069 ;; C-s in reverse or C-r in forward, change direction. 1047 ;; C-s in reverse or C-r in forward, change direction.
1070 (setq isearch-forward (not isearch-forward))) 1048 (setq isearch-forward (not isearch-forward)))
@@ -1106,6 +1084,7 @@ Use `isearch-exit' to quit without signaling."
1106 (interactive) 1084 (interactive)
1107 (setq isearch-regexp (not isearch-regexp)) 1085 (setq isearch-regexp (not isearch-regexp))
1108 (if isearch-regexp (setq isearch-word nil)) 1086 (if isearch-regexp (setq isearch-word nil))
1087 (setq isearch-success t isearch-adjusted t)
1109 (isearch-update)) 1088 (isearch-update))
1110 1089
1111(defun isearch-toggle-case-fold () 1090(defun isearch-toggle-case-fold ()
@@ -1118,34 +1097,39 @@ Use `isearch-exit' to quit without signaling."
1118 (isearch-message-prefix nil nil isearch-nonincremental) 1097 (isearch-message-prefix nil nil isearch-nonincremental)
1119 isearch-message 1098 isearch-message
1120 (if isearch-case-fold-search "in" ""))) 1099 (if isearch-case-fold-search "in" "")))
1121 (setq isearch-adjusted t) 1100 (setq isearch-success t isearch-adjusted t)
1122 (sit-for 1) 1101 (sit-for 1)
1123 (isearch-update)) 1102 (isearch-update))
1124 1103
1125(defun isearch-query-replace () 1104(defun isearch-query-replace (&optional regexp-flag)
1126 "Start query-replace with string to replace from last search string." 1105 "Start query-replace with string to replace from last search string."
1127 (interactive) 1106 (interactive)
1128 (barf-if-buffer-read-only) 1107 (barf-if-buffer-read-only)
1108 (if regexp-flag (setq isearch-regexp t))
1129 (let ((case-fold-search isearch-case-fold-search)) 1109 (let ((case-fold-search isearch-case-fold-search))
1130 (isearch-done) 1110 (isearch-done)
1131 (isearch-clean-overlays) 1111 (isearch-clean-overlays)
1132 (and isearch-forward isearch-other-end (goto-char isearch-other-end)) 1112 (if (and (< isearch-other-end (point))
1113 (not (and transient-mark-mode mark-active
1114 (< isearch-opoint (point)))))
1115 (goto-char isearch-other-end))
1116 (set query-replace-from-history-variable
1117 (cons isearch-string
1118 (symbol-value query-replace-from-history-variable)))
1133 (perform-replace 1119 (perform-replace
1134 isearch-string 1120 isearch-string
1135 (query-replace-read-to isearch-string "Query replace" isearch-regexp) 1121 (query-replace-read-to
1136 t isearch-regexp isearch-word))) 1122 isearch-string
1123 (if isearch-regexp "Query replace regexp" "Query replace")
1124 isearch-regexp)
1125 t isearch-regexp isearch-word nil nil
1126 (if (and transient-mark-mode mark-active) (region-beginning))
1127 (if (and transient-mark-mode mark-active) (region-end)))))
1137 1128
1138(defun isearch-query-replace-regexp () 1129(defun isearch-query-replace-regexp ()
1139 "Start query-replace-regexp with string to replace from last search string." 1130 "Start query-replace-regexp with string to replace from last search string."
1140 (interactive) 1131 (interactive)
1141 (let ((query-replace-interactive t) 1132 (isearch-query-replace t))
1142 (case-fold-search isearch-case-fold-search))
1143 ;; Put search string into the right ring
1144 (setq isearch-regexp t)
1145 (isearch-done)
1146 (isearch-clean-overlays)
1147 (and isearch-forward isearch-other-end (goto-char isearch-other-end))
1148 (call-interactively 'query-replace-regexp)))
1149 1133
1150 1134
1151(defun isearch-delete-char () 1135(defun isearch-delete-char ()
@@ -1343,7 +1327,7 @@ barrier."
1343 ;; We have to check 2 stack frames because the last might be 1327 ;; We have to check 2 stack frames because the last might be
1344 ;; invalid just because of a backslash. 1328 ;; invalid just because of a backslash.
1345 (or (not isearch-invalid-regexp) 1329 (or (not isearch-invalid-regexp)
1346 (not (isearch-invalid-regexp (cadr isearch-cmds))) 1330 (not (isearch-invalid-regexp-state (cadr isearch-cmds)))
1347 allow-invalid)) 1331 allow-invalid))
1348 (if to-barrier 1332 (if to-barrier
1349 (progn (goto-char isearch-barrier) 1333 (progn (goto-char isearch-barrier)
@@ -1358,8 +1342,8 @@ barrier."
1358 ;; Also skip over postfix operators -- though horrid, 1342 ;; Also skip over postfix operators -- though horrid,
1359 ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal. 1343 ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal.
1360 (while (and previous 1344 (while (and previous
1361 (or (isearch-invalid-regexp frame) 1345 (or (isearch-invalid-regexp-state frame)
1362 (let* ((string (isearch-string frame)) 1346 (let* ((string (isearch-string-state frame))
1363 (lchar (aref string (1- (length string))))) 1347 (lchar (aref string (1- (length string)))))
1364 ;; The operators aren't always operators; check 1348 ;; The operators aren't always operators; check
1365 ;; backslashes. This doesn't handle the case of 1349 ;; backslashes. This doesn't handle the case of
@@ -1367,7 +1351,7 @@ barrier."
1367 ;; being special, but then we should fall back to 1351 ;; being special, but then we should fall back to
1368 ;; the barrier anyway because it's all optional. 1352 ;; the barrier anyway because it's all optional.
1369 (if (isearch-backslash 1353 (if (isearch-backslash
1370 (isearch-string (car previous))) 1354 (isearch-string-state (car previous)))
1371 (eq lchar ?\}) 1355 (eq lchar ?\})
1372 (memq lchar '(?* ?? ?+)))))) 1356 (memq lchar '(?* ?? ?+))))))
1373 (setq stack previous previous (cdr previous) frame (car stack))) 1357 (setq stack previous previous (cdr previous) frame (car stack)))
@@ -1375,7 +1359,7 @@ barrier."
1375 ;; `stack' now refers the most recent valid regexp that is not at 1359 ;; `stack' now refers the most recent valid regexp that is not at
1376 ;; all optional in its last term. Now dig one level deeper and find 1360 ;; all optional in its last term. Now dig one level deeper and find
1377 ;; what matched before that. 1361 ;; what matched before that.
1378 (let ((last-other-end (or (isearch-other-end (car previous)) 1362 (let ((last-other-end (or (isearch-other-end-state (car previous))
1379 isearch-barrier))) 1363 isearch-barrier)))
1380 (goto-char (if isearch-forward 1364 (goto-char (if isearch-forward
1381 (max last-other-end isearch-barrier) 1365 (max last-other-end isearch-barrier)
@@ -1638,8 +1622,7 @@ Isearch mode."
1638 (let ((ab-bel (isearch-string-out-of-window isearch-point))) 1622 (let ((ab-bel (isearch-string-out-of-window isearch-point)))
1639 (if ab-bel 1623 (if ab-bel
1640 (isearch-back-into-window (eq ab-bel 'above) isearch-point) 1624 (isearch-back-into-window (eq ab-bel 'above) isearch-point)
1641 (or (eq (point) isearch-point) 1625 (goto-char isearch-point)))
1642 (goto-char isearch-point))))
1643 (isearch-update)) 1626 (isearch-update))
1644 (search-exit-option 1627 (search-exit-option
1645 (let (window) 1628 (let (window)
@@ -1913,7 +1896,9 @@ If there is no completion possible, say so and continue searching."
1913 ;; If currently failing, display no ellipsis. 1896 ;; If currently failing, display no ellipsis.
1914 (or isearch-success (setq ellipsis nil)) 1897 (or isearch-success (setq ellipsis nil))
1915 (let ((m (concat (if isearch-success "" "failing ") 1898 (let ((m (concat (if isearch-success "" "failing ")
1899 (if isearch-adjusted "pending " "")
1916 (if (and isearch-wrapped 1900 (if (and isearch-wrapped
1901 (not isearch-wrap-function)
1917 (if isearch-forward 1902 (if isearch-forward
1918 (> (point) isearch-opoint) 1903 (> (point) isearch-opoint)
1919 (< (point) isearch-opoint))) 1904 (< (point) isearch-opoint)))
@@ -2008,9 +1993,11 @@ Can be changed via `isearch-search-fun-function' for special needs."
2008 (if isearch-success 1993 (if isearch-success
2009 nil 1994 nil
2010 ;; Ding if failed this time after succeeding last time. 1995 ;; Ding if failed this time after succeeding last time.
2011 (and (isearch-success (car isearch-cmds)) 1996 (and (isearch-success-state (car isearch-cmds))
2012 (ding)) 1997 (ding))
2013 (goto-char (isearch-point (car isearch-cmds))))) 1998 (if (functionp (isearch-pop-fun-state (car isearch-cmds)))
1999 (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds)))
2000 (goto-char (isearch-point-state (car isearch-cmds)))))
2014 2001
2015 2002
2016;; Called when opening an overlay, and we are still in isearch. 2003;; Called when opening an overlay, and we are still in isearch.
diff --git a/lisp/macros.el b/lisp/macros.el
index 72ba3f11721..0de5d223ee0 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,6 +1,6 @@
1;;; macros.el --- non-primitive commands for keyboard macros 1;;; macros.el --- non-primitive commands for keyboard macros
2 2
3;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 86, 87, 92, 94, 95, 04 Free Software Foundation, Inc.
4 4
5;; Maintainer: FSF 5;; Maintainer: FSF
6;; Keywords: abbrev 6;; Keywords: abbrev
@@ -151,7 +151,7 @@ use this command, and then save the file."
151 (cond ((= char ?\\) 151 (cond ((= char ?\\)
152 (insert "\\\\")) 152 (insert "\\\\"))
153 ((= char ?\") 153 ((= char ?\")
154 (insert "\\\"")) 154 (insert "\\\""))
155 ((= char ?\;) 155 ((= char ?\;)
156 (insert "\\;")) 156 (insert "\\;"))
157 ((= char 127) 157 ((= char 127)
@@ -240,8 +240,9 @@ Possibilities: \\<query-replace-map>
240 240
241;;;###autoload 241;;;###autoload
242(defun apply-macro-to-region-lines (top bottom &optional macro) 242(defun apply-macro-to-region-lines (top bottom &optional macro)
243 "For each complete line between point and mark, move to the beginning 243 "Apply last keyboard macro to all lines in the region.
244of the line, and run the last keyboard macro. 244For each line that begins in the region, move to the beginning of
245the line, and run the last keyboard macro.
245 246
246When called from lisp, this function takes two arguments TOP and 247When called from lisp, this function takes two arguments TOP and
247BOTTOM, describing the current region. TOP must be before BOTTOM. 248BOTTOM, describing the current region. TOP must be before BOTTOM.
@@ -277,8 +278,7 @@ and write a macro to massage a word into a table entry:
277 \\C-x ) 278 \\C-x )
278 279
279and then select the region of un-tablified names and use 280and then select the region of un-tablified names and use
280`\\[apply-macro-to-region-lines]' to build the table from the names. 281`\\[apply-macro-to-region-lines]' to build the table from the names."
281"
282 (interactive "r") 282 (interactive "r")
283 (or macro 283 (or macro
284 (progn 284 (progn
@@ -286,10 +286,7 @@ and then select the region of un-tablified names and use
286 (error "No keyboard macro has been defined")) 286 (error "No keyboard macro has been defined"))
287 (setq macro last-kbd-macro))) 287 (setq macro last-kbd-macro)))
288 (save-excursion 288 (save-excursion
289 (let ((end-marker (progn 289 (let ((end-marker (copy-marker bottom))
290 (goto-char bottom)
291 (beginning-of-line)
292 (point-marker)))
293 next-line-marker) 290 next-line-marker)
294 (goto-char top) 291 (goto-char top)
295 (if (not (bolp)) 292 (if (not (bolp))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 32fa246b9f6..ea174233289 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -458,9 +458,9 @@ starting the compilation process.")
458 :version "21.4") 458 :version "21.4")
459 459
460(defface compilation-info-face 460(defface compilation-info-face
461 '((((class color) (min-colors 16) (background light)) 461 '((((class color) (min-colors 16) (background light))
462 (:foreground "Green3" :weight bold)) 462 (:foreground "Green3" :weight bold))
463 (((class color) (min-colors 16) (background dark)) 463 (((class color) (min-colors 16) (background dark))
464 (:foreground "Green" :weight bold)) 464 (:foreground "Green" :weight bold))
465 (((class color)) (:foreground "green" :weight bold)) 465 (((class color)) (:foreground "green" :weight bold))
466 (t (:weight bold))) 466 (t (:weight bold)))
@@ -579,12 +579,17 @@ Faces `compilation-error-face', `compilation-warning-face',
579 (and end-line 579 (and end-line
580 (setq end-line (match-string-no-properties end-line)) 580 (setq end-line (match-string-no-properties end-line))
581 (setq end-line (string-to-number end-line))) 581 (setq end-line (string-to-number end-line)))
582 (and col 582 (if col
583 (setq col (match-string-no-properties col)) 583 (if (functionp col)
584 (setq col (- (string-to-number col) compilation-first-column))) 584 (setq col (funcall col))
585 (if (and end-col (setq end-col (match-string-no-properties end-col))) 585 (and
586 (setq end-col (- (string-to-number end-col) compilation-first-column -1)) 586 (setq col (match-string-no-properties col))
587 (if end-line (setq end-col -1))) 587 (setq col (- (string-to-number col) compilation-first-column)))))
588 (if (and end-col (functionp end-col))
589 (setq end-col (funcall end-col))
590 (if (and end-col (setq end-col (match-string-no-properties end-col)))
591 (setq end-col (- (string-to-number end-col) compilation-first-column -1))
592 (if end-line (setq end-col -1))))
588 (if (consp type) ; not a static type, check what it is. 593 (if (consp type) ; not a static type, check what it is.
589 (setq type (or (and (car type) (match-end (car type)) 1) 594 (setq type (or (and (car type) (match-end (car type)) 1)
590 (and (cdr type) (match-end (cdr type)) 0) 595 (and (cdr type) (match-end (cdr type)) 0)
@@ -726,9 +731,9 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
726 ,@(when end-line 731 ,@(when end-line
727 `((,end-line compilation-line-face nil t))) 732 `((,end-line compilation-line-face nil t)))
728 733
729 ,@(when col 734 ,@(when (integerp col)
730 `((,col compilation-column-face nil t))) 735 `((,col compilation-column-face nil t)))
731 ,@(when end-col 736 ,@(when (integerp end-col)
732 `((,end-col compilation-column-face nil t))) 737 `((,end-col compilation-column-face nil t)))
733 738
734 ,@(nthcdr 6 item) 739 ,@(nthcdr 6 item)
@@ -789,7 +794,10 @@ If this is run in a Compilation mode buffer, re-use the arguments from the
789original use. Otherwise, recompile using `compile-command'." 794original use. Otherwise, recompile using `compile-command'."
790 (interactive) 795 (interactive)
791 (save-some-buffers (not compilation-ask-about-save) nil) 796 (save-some-buffers (not compilation-ask-about-save) nil)
792 (let ((default-directory (or compilation-directory default-directory))) 797 (let ((default-directory
798 (or (and (not (eq major-mode (nth 1 compilation-arguments)))
799 compilation-directory)
800 default-directory)))
793 (apply 'compilation-start (or compilation-arguments 801 (apply 'compilation-start (or compilation-arguments
794 `(,(eval compile-command)))))) 802 `(,(eval compile-command))))))
795 803
@@ -816,8 +824,7 @@ Otherwise, construct a buffer name from MODE-NAME."
816 (funcall name-function mode-name)) 824 (funcall name-function mode-name))
817 (compilation-buffer-name-function 825 (compilation-buffer-name-function
818 (funcall compilation-buffer-name-function mode-name)) 826 (funcall compilation-buffer-name-function mode-name))
819 ((and (eq major-mode 'compilation-mode) 827 ((eq major-mode (nth 1 compilation-arguments))
820 (equal mode-name (nth 2 compilation-arguments)))
821 (buffer-name)) 828 (buffer-name))
822 (t 829 (t
823 (concat "*" (downcase mode-name) "*")))) 830 (concat "*" (downcase mode-name) "*"))))
@@ -1522,7 +1529,8 @@ If nil, don't scroll the compilation output window."
1522 1529
1523(defun compilation-goto-locus (msg mk end-mk) 1530(defun compilation-goto-locus (msg mk end-mk)
1524 "Jump to an error corresponding to MSG at MK. 1531 "Jump to an error corresponding to MSG at MK.
1525All arguments are markers. If END-MK is non nil, mark is set there." 1532All arguments are markers. If END-MK is non-nil, mark is set there
1533and overlay is highlighted between MK and END-MK."
1526 (if (eq (window-buffer (selected-window)) 1534 (if (eq (window-buffer (selected-window))
1527 (marker-buffer msg)) 1535 (marker-buffer msg))
1528 ;; If the compilation buffer window is selected, 1536 ;; If the compilation buffer window is selected,
@@ -1538,7 +1546,7 @@ All arguments are markers. If END-MK is non nil, mark is set there."
1538 (widen) 1546 (widen)
1539 (goto-char mk)) 1547 (goto-char mk))
1540 (if end-mk 1548 (if end-mk
1541 (push-mark end-mk nil t) 1549 (push-mark end-mk t)
1542 (if mark-active (setq mark-active))) 1550 (if mark-active (setq mark-active)))
1543 ;; If hideshow got in the way of 1551 ;; If hideshow got in the way of
1544 ;; seeing the right place, open permanently. 1552 ;; seeing the right place, open permanently.
@@ -1559,26 +1567,32 @@ All arguments are markers. If END-MK is non nil, mark is set there."
1559 compilation-highlight-regexp))) 1567 compilation-highlight-regexp)))
1560 (compilation-set-window-height w) 1568 (compilation-set-window-height w)
1561 1569
1562 (when (and highlight-regexp 1570 (when highlight-regexp
1563 (not (and end-mk transient-mark-mode)))
1564 (unless compilation-highlight-overlay 1571 (unless compilation-highlight-overlay
1565 (setq compilation-highlight-overlay 1572 (setq compilation-highlight-overlay
1566 (make-overlay (point-min) (point-min))) 1573 (make-overlay (point-min) (point-min)))
1567 (overlay-put compilation-highlight-overlay 'face 'region)) 1574 (overlay-put compilation-highlight-overlay 'face 'next-error))
1568 (with-current-buffer (marker-buffer mk) 1575 (with-current-buffer (marker-buffer mk)
1569 (save-excursion 1576 (save-excursion
1570 (end-of-line) 1577 (if end-mk (goto-char end-mk) (end-of-line))
1571 (let ((end (point))) 1578 (let ((end (point)))
1572 (beginning-of-line) 1579 (if mk (goto-char mk) (beginning-of-line))
1573 (if (and (stringp highlight-regexp) 1580 (if (and (stringp highlight-regexp)
1574 (re-search-forward highlight-regexp end t)) 1581 (re-search-forward highlight-regexp end t))
1575 (progn 1582 (progn
1576 (goto-char (match-beginning 0)) 1583 (goto-char (match-beginning 0))
1577 (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0))) 1584 (move-overlay compilation-highlight-overlay
1578 (move-overlay compilation-highlight-overlay (point) end)) 1585 (match-beginning 0) (match-end 0)
1579 (sit-for 0.5) 1586 (current-buffer)))
1580 (delete-overlay compilation-highlight-overlay))))))) 1587 (move-overlay compilation-highlight-overlay
1581 1588 (point) end (current-buffer)))
1589 (if (numberp next-error-highlight)
1590 (sit-for next-error-highlight))
1591 (if (not (eq next-error-highlight t))
1592 (delete-overlay compilation-highlight-overlay))))))
1593 (when (and (eq next-error-highlight 'fringe-arrow))
1594 (set (make-local-variable 'overlay-arrow-position)
1595 (copy-marker (line-beginning-position))))))
1582 1596
1583(defun compilation-find-file (marker filename dir &rest formats) 1597(defun compilation-find-file (marker filename dir &rest formats)
1584 "Find a buffer for file FILENAME. 1598 "Find a buffer for file FILENAME.
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 4464df3a916..ddbd2ce6f35 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -772,26 +772,6 @@ Assumes the tags table is the current buffer."
772 (all-completions string (tags-completion-table) predicate) 772 (all-completions string (tags-completion-table) predicate)
773 (try-completion string (tags-completion-table) predicate)))) 773 (try-completion string (tags-completion-table) predicate))))
774 774
775;; Return a default tag to search for, based on the text at point.
776(defun find-tag-default ()
777 (save-excursion
778 (while (looking-at "\\sw\\|\\s_")
779 (forward-char 1))
780 (if (or (re-search-backward "\\sw\\|\\s_"
781 (save-excursion (beginning-of-line) (point))
782 t)
783 (re-search-forward "\\(\\sw\\|\\s_\\)+"
784 (save-excursion (end-of-line) (point))
785 t))
786 (progn (goto-char (match-end 0))
787 (buffer-substring-no-properties
788 (point)
789 (progn (forward-sexp -1)
790 (while (looking-at "\\s'")
791 (forward-char 1))
792 (point))))
793 nil)))
794
795;; Read a tag name from the minibuffer with defaulting and completion. 775;; Read a tag name from the minibuffer with defaulting and completion.
796(defun find-tag-tag (string) 776(defun find-tag-tag (string)
797 (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil)) 777 (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 5b678f26171..9d48fd37569 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -64,6 +64,21 @@ will be parsed and highlighted as soon as you try to move to them."
64 :version "21.4" 64 :version "21.4"
65 :group 'grep) 65 :group 'grep)
66 66
67(defcustom grep-highlight-matches t
68 "*Non-nil to use special markers to highlight grep matches.
69
70Some grep programs are able to surround matches with special
71markers in grep output. Such markers can be used to highlight
72matches in grep mode.
73
74This option sets the environment variable GREP_COLOR to specify
75markers for highlighting and GREP_OPTIONS to add the --color
76option in front of any explicit grep options before starting
77the grep."
78 :type 'boolean
79 :version "21.4"
80 :group 'grep)
81
67(defcustom grep-scroll-output nil 82(defcustom grep-scroll-output nil
68 "*Non-nil to scroll the *grep* buffer window as output appears. 83 "*Non-nil to scroll the *grep* buffer window as output appears.
69 84
@@ -230,6 +245,23 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
230 '(("^\\(.+?\\)[:( \t]+\ 245 '(("^\\(.+?\\)[:( \t]+\
231\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ 246\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
232\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6)) 247\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6))
248 ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
249 1 2
250 ((lambda ()
251 (setq compilation-error-screen-columns nil)
252 (- (match-beginning 5) (match-end 3) 8))
253 .
254 (lambda () (- (match-end 5) (match-end 3) 8)))
255 nil nil
256 (4 (list 'face nil 'invisible t 'intangible t))
257 (5 (list 'face compilation-column-face))
258 (6 (list 'face nil 'invisible t 'intangible t))
259 ;; highlight other matches on the same line
260 ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
261 nil nil
262 (1 (list 'face nil 'invisible t 'intangible t))
263 (2 (list 'face compilation-column-face) t)
264 (3 (list 'face nil 'invisible t 'intangible t))))
233 ("^Binary file \\(.+\\) matches$" 1 nil nil 1)) 265 ("^Binary file \\(.+\\) matches$" 1 nil nil 1))
234 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") 266 "Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
235 267
@@ -300,6 +332,10 @@ This variable's value takes effect when `grep-compute-defaults' is called.")
300(defun grep-process-setup () 332(defun grep-process-setup ()
301 "Setup compilation variables and buffer for `grep'. 333 "Setup compilation variables and buffer for `grep'.
302Set up `compilation-exit-message-function' and run `grep-setup-hook'." 334Set up `compilation-exit-message-function' and run `grep-setup-hook'."
335 (when grep-highlight-matches
336 ;; Modify `process-environment' locally bound in `compilation-start'
337 (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always"))
338 (setenv "GREP_COLOR" "01;41"))
303 (set (make-local-variable 'compilation-exit-message-function) 339 (set (make-local-variable 'compilation-exit-message-function)
304 (lambda (status code msg) 340 (lambda (status code msg)
305 (if (eq status 'exit) 341 (if (eq status 'exit)
@@ -384,9 +420,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
384 (let ((tag-default 420 (let ((tag-default
385 (funcall (or find-tag-default-function 421 (funcall (or find-tag-default-function
386 (get major-mode 'find-tag-default-function) 422 (get major-mode 'find-tag-default-function)
387 ;; We use grep-tag-default instead of 423 'find-tag-default)))
388 ;; find-tag-default, to avoid loading etags.
389 'grep-tag-default)))
390 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") 424 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
391 (grep-default (or (car grep-history) grep-command))) 425 (grep-default (or (car grep-history) grep-command)))
392 ;; Replace the thing matching for with that around cursor. 426 ;; Replace the thing matching for with that around cursor.
@@ -457,25 +491,6 @@ temporarily highlight in visited source lines."
457 (set (make-local-variable 'compilation-error-regexp-alist) 491 (set (make-local-variable 'compilation-error-regexp-alist)
458 grep-regexp-alist)) 492 grep-regexp-alist))
459 493
460;; This is a copy of find-tag-default from etags.el.
461;;;###autoload
462(defun grep-tag-default ()
463 (save-excursion
464 (while (looking-at "\\sw\\|\\s_")
465 (forward-char 1))
466 (when (or (re-search-backward "\\sw\\|\\s_"
467 (save-excursion (beginning-of-line) (point))
468 t)
469 (re-search-forward "\\(\\sw\\|\\s_\\)+"
470 (save-excursion (end-of-line) (point))
471 t))
472 (goto-char (match-end 0))
473 (buffer-substring (point)
474 (progn (forward-sexp -1)
475 (while (looking-at "\\s'")
476 (forward-char 1))
477 (point))))))
478
479;;;###autoload 494;;;###autoload
480(defun grep-find (command-args) 495(defun grep-find (command-args)
481 "Run grep via find, with user-specified args COMMAND-ARGS. 496 "Run grep via find, with user-specified args COMMAND-ARGS.
diff --git a/lisp/simple.el b/lisp/simple.el
index 325fbd8e702..be50da39474 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -65,7 +65,7 @@
65 (setq found buffer))) 65 (setq found buffer)))
66 (setq list (cdr list))) 66 (setq list (cdr list)))
67 (switch-to-buffer found))) 67 (switch-to-buffer found)))
68 68
69;;; next-error support framework 69;;; next-error support framework
70(defvar next-error-last-buffer nil 70(defvar next-error-last-buffer nil
71 "The most recent next-error buffer. 71 "The most recent next-error buffer.
@@ -91,51 +91,50 @@ to navigate in it.")
91 (or (and extra-test (funcall extra-test)) 91 (or (and extra-test (funcall extra-test))
92 next-error-function))) 92 next-error-function)))
93 93
94;; Return a next-error capable buffer according to the following rules:
95;; 1. If the current buffer is a next-error capable buffer, return it.
96;; 2. If one window on the selected frame displays such buffer, return it.
97;; 3. If next-error-last-buffer is set to a live buffer, use that.
98;; 4. Otherwise, look for a next-error capable buffer in a buffer list.
99;; 5. Signal an error if there are none.
100(defun next-error-find-buffer (&optional other-buffer extra-test) 94(defun next-error-find-buffer (&optional other-buffer extra-test)
101 (if (and (not other-buffer) 95 "Return a next-error capable buffer."
102 (next-error-buffer-p (current-buffer) extra-test)) 96 (or
103 ;; The current buffer is a next-error capable buffer. 97 ;; 1. If one window on the selected frame displays such buffer, return it.
104 (current-buffer) 98 (let ((window-buffers
105 (or 99 (delete-dups
106 (let ((window-buffers 100 (delq nil (mapcar (lambda (w)
107 (delete-dups 101 (if (next-error-buffer-p
108 (delq nil 102 (window-buffer w) extra-test)
109 (mapcar (lambda (w) 103 (window-buffer w)))
110 (and (next-error-buffer-p (window-buffer w) extra-test) 104 (window-list))))))
111 (window-buffer w))) 105 (if other-buffer
112 (window-list)))))) 106 (setq window-buffers (delq (current-buffer) window-buffers)))
113 (if other-buffer 107 (if (eq (length window-buffers) 1)
114 (setq window-buffers (delq (current-buffer) window-buffers))) 108 (car window-buffers)))
115 (if (eq (length window-buffers) 1) 109 ;; 2. If next-error-last-buffer is set to a live buffer, use that.
116 (car window-buffers))) 110 (if (and next-error-last-buffer
117 (if (and next-error-last-buffer (buffer-name next-error-last-buffer) 111 (buffer-name next-error-last-buffer)
118 (next-error-buffer-p next-error-last-buffer extra-test) 112 (next-error-buffer-p next-error-last-buffer extra-test)
119 (or (not other-buffer) (not (eq next-error-last-buffer 113 (or (not other-buffer)
120 (current-buffer))))) 114 (not (eq next-error-last-buffer (current-buffer)))))
121 next-error-last-buffer 115 next-error-last-buffer)
122 (let ((buffers (buffer-list))) 116 ;; 3. If the current buffer is a next-error capable buffer, return it.
123 (while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test)) 117 (if (and (not other-buffer)
124 (and other-buffer 118 (next-error-buffer-p (current-buffer) extra-test))
125 (eq (car buffers) (current-buffer))))) 119 (current-buffer))
126 (setq buffers (cdr buffers))) 120 ;; 4. Look for a next-error capable buffer in a buffer list.
127 (if buffers 121 (let ((buffers (buffer-list)))
128 (car buffers) 122 (while (and buffers
129 (or (and other-buffer 123 (or (not (next-error-buffer-p (car buffers) extra-test))
130 (next-error-buffer-p (current-buffer) extra-test) 124 (and other-buffer (eq (car buffers) (current-buffer)))))
131 ;; The current buffer is a next-error capable buffer. 125 (setq buffers (cdr buffers)))
132 (progn 126 (if buffers
133 (if other-buffer 127 (car buffers)
134 (message "This is the only next-error capable buffer.")) 128 (or (and other-buffer
135 (current-buffer))) 129 (next-error-buffer-p (current-buffer) extra-test)
136 (error "No next-error capable buffer found")))))))) 130 ;; The current buffer is a next-error capable buffer.
137 131 (progn
138(defun next-error (arg &optional reset) 132 (if other-buffer
133 (message "This is the only next-error capable buffer"))
134 (current-buffer)))
135 (error "No next-error capable buffer found"))))))
136
137(defun next-error (&optional arg reset)
139 "Visit next next-error message and corresponding source code. 138 "Visit next next-error message and corresponding source code.
140 139
141If all the error messages parsed so far have been processed already, 140If all the error messages parsed so far have been processed already,
@@ -153,9 +152,10 @@ compilation, grep, or occur buffer. It can also operate on any
153buffer with output from the \\[compile], \\[grep] commands, or, 152buffer with output from the \\[compile], \\[grep] commands, or,
154more generally, on any buffer in Compilation mode or with 153more generally, on any buffer in Compilation mode or with
155Compilation Minor mode enabled, or any buffer in which 154Compilation Minor mode enabled, or any buffer in which
156`next-error-function' is bound to an appropriate 155`next-error-function' is bound to an appropriate function.
157function. To specify use of a particular buffer for error 156To specify use of a particular buffer for error messages, type
158messages, type \\[next-error] in that buffer. 157\\[next-error] in that buffer when it is the only one displayed
158in the current frame.
159 159
160Once \\[next-error] has chosen the buffer for error messages, 160Once \\[next-error] has chosen the buffer for error messages,
161it stays with that buffer until you use it in some other buffer which 161it stays with that buffer until you use it in some other buffer which
@@ -175,7 +175,7 @@ See variables `compilation-parse-errors-function' and
175 175
176(define-key ctl-x-map "`" 'next-error) 176(define-key ctl-x-map "`" 'next-error)
177 177
178(defun previous-error (n) 178(defun previous-error (&optional n)
179 "Visit previous next-error message and corresponding source code. 179 "Visit previous next-error message and corresponding source code.
180 180
181Prefix arg N says how many error messages to move backwards (or 181Prefix arg N says how many error messages to move backwards (or
@@ -183,9 +183,9 @@ forwards, if negative).
183 183
184This operates on the output from the \\[compile] and \\[grep] commands." 184This operates on the output from the \\[compile] and \\[grep] commands."
185 (interactive "p") 185 (interactive "p")
186 (next-error (- n))) 186 (next-error (- (or n 1))))
187 187
188(defun first-error (n) 188(defun first-error (&optional n)
189 "Restart at the first error. 189 "Restart at the first error.
190Visit corresponding source code. 190Visit corresponding source code.
191With prefix arg N, visit the source code of the Nth error. 191With prefix arg N, visit the source code of the Nth error.
@@ -193,25 +193,63 @@ This operates on the output from the \\[compile] command, for instance."
193 (interactive "p") 193 (interactive "p")
194 (next-error n t)) 194 (next-error n t))
195 195
196(defun next-error-no-select (n) 196(defun next-error-no-select (&optional n)
197 "Move point to the next error in the next-error buffer and highlight match. 197 "Move point to the next error in the next-error buffer and highlight match.
198Prefix arg N says how many error messages to move forwards (or 198Prefix arg N says how many error messages to move forwards (or
199backwards, if negative). 199backwards, if negative).
200Finds and highlights the source line like \\[next-error], but does not 200Finds and highlights the source line like \\[next-error], but does not
201select the source buffer." 201select the source buffer."
202 (interactive "p") 202 (interactive "p")
203 (next-error n) 203 (let ((next-error-highlight next-error-highlight-no-select))
204 (next-error n))
204 (pop-to-buffer next-error-last-buffer)) 205 (pop-to-buffer next-error-last-buffer))
205 206
206(defun previous-error-no-select (n) 207(defun previous-error-no-select (&optional n)
207 "Move point to the previous error in the next-error buffer and highlight match. 208 "Move point to the previous error in the next-error buffer and highlight match.
208Prefix arg N says how many error messages to move backwards (or 209Prefix arg N says how many error messages to move backwards (or
209forwards, if negative). 210forwards, if negative).
210Finds and highlights the source line like \\[previous-error], but does not 211Finds and highlights the source line like \\[previous-error], but does not
211select the source buffer." 212select the source buffer."
212 (interactive "p") 213 (interactive "p")
213 (next-error-no-select (- n))) 214 (next-error-no-select (- (or n 1))))
215
216(defgroup next-error nil
217 "next-error support framework."
218 :group 'compilation
219 :version "21.4")
220
221(defface next-error
222 '((t (:inherit region)))
223 "Face used to highlight next error locus."
224 :group 'next-error
225 :version "21.4")
226
227(defcustom next-error-highlight 0.1
228 "*Highlighting of locations in selected source buffers.
229If number, highlight the locus in next-error face for given time in seconds.
230If t, use persistent overlays fontified in next-error face.
231If nil, don't highlight the locus in the source buffer.
232If `fringe-arrow', indicate the locus by the fringe arrow."
233 :type '(choice (number :tag "Delay")
234 (const :tag "Persistent overlay" t)
235 (const :tag "No highlighting" nil)
236 (const :tag "Fringe arrow" 'fringe-arrow))
237 :group 'next-error
238 :version "21.4")
214 239
240(defcustom next-error-highlight-no-select 0.1
241 "*Highlighting of locations in non-selected source buffers.
242If number, highlight the locus in next-error face for given time in seconds.
243If t, use persistent overlays fontified in next-error face.
244If nil, don't highlight the locus in the source buffer.
245If `fringe-arrow', indicate the locus by the fringe arrow."
246 :type '(choice (number :tag "Delay")
247 (const :tag "Persistent overlay" t)
248 (const :tag "No highlighting" nil)
249 (const :tag "Fringe arrow" 'fringe-arrow))
250 :group 'next-error
251 :version "21.4")
252
215;;; 253;;;
216 254
217(defun fundamental-mode () 255(defun fundamental-mode ()
diff --git a/lisp/startup.el b/lisp/startup.el
index 1a37a471c61..786ec31174d 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -348,9 +348,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
348 ;; `user-full-name' is now known; reset its standard-value here. 348 ;; `user-full-name' is now known; reset its standard-value here.
349 (put 'user-full-name 'standard-value 349 (put 'user-full-name 'standard-value
350 (list (default-value 'user-full-name))) 350 (list (default-value 'user-full-name)))
351 ;; Subprocesses of Emacs do not have direct access to the terminal,
352 ;; so unless told otherwise they should only assume a dumb terminal.
353 (setenv "TERM" "dumb")
354 ;; For root, preserve owner and group when editing files. 351 ;; For root, preserve owner and group when editing files.
355 (if (equal (user-uid) 0) 352 (if (equal (user-uid) 0)
356 (setq backup-by-copying-when-mismatch t)) 353 (setq backup-by-copying-when-mismatch t))
diff --git a/lisp/subr.el b/lisp/subr.el
index cadfa3fde34..a55de922e90 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1969,6 +1969,27 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards."
1969 (setq parent (get parent 'derived-mode-parent)))) 1969 (setq parent (get parent 'derived-mode-parent))))
1970 parent)) 1970 parent))
1971 1971
1972(defun find-tag-default ()
1973 "Determine default tag to search for, based on text at point.
1974If there is no plausible default, return nil."
1975 (save-excursion
1976 (while (looking-at "\\sw\\|\\s_")
1977 (forward-char 1))
1978 (if (or (re-search-backward "\\sw\\|\\s_"
1979 (save-excursion (beginning-of-line) (point))
1980 t)
1981 (re-search-forward "\\(\\sw\\|\\s_\\)+"
1982 (save-excursion (end-of-line) (point))
1983 t))
1984 (progn (goto-char (match-end 0))
1985 (buffer-substring-no-properties
1986 (point)
1987 (progn (forward-sexp -1)
1988 (while (looking-at "\\s'")
1989 (forward-char 1))
1990 (point))))
1991 nil)))
1992
1972(defmacro with-syntax-table (table &rest body) 1993(defmacro with-syntax-table (table &rest body)
1973 "Evaluate BODY with syntax table of current buffer set to TABLE. 1994 "Evaluate BODY with syntax table of current buffer set to TABLE.
1974The syntax table of the current buffer is saved, BODY is evaluated, and the 1995The syntax table of the current buffer is saved, BODY is evaluated, and the
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index eea8e95ce83..7cb0bfe9de5 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -141,6 +141,9 @@
141 (if clipboard 141 (if clipboard
142 (decode-coding-string clipboard selection-coding-system t))))) 142 (decode-coding-string clipboard selection-coding-system t)))))
143 143
144;; Don't show the frame name; that's redundant.
145(setq-default mode-line-frame-identification " ")
146
144(defun mac-drag-n-drop (event) 147(defun mac-drag-n-drop (event)
145 "Edit the files listed in the drag-n-drop event.\n\ 148 "Edit the files listed in the drag-n-drop event.\n\
146Switch to a buffer editing the last file dropped." 149Switch to a buffer editing the last file dropped."
@@ -253,6 +256,9 @@ See the documentation of `create-fontset-from-fontset-spec for the format.")
253 256
254;; Tell read-char how to convert special chars to ASCII 257;; Tell read-char how to convert special chars to ASCII
255(put 'return 'ascii-character 13) 258(put 'return 'ascii-character 13)
259(put 'tab 'ascii-character ?\t)
260(put 'backspace 'ascii-character 127)
261(put 'escape 'ascii-character ?\e)
256 262
257;; 263;;
258;; Available colors 264;; Available colors
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 77c63379e2b..435e2e5f27a 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1228,7 +1228,7 @@ for skipping in latex mode.")
1228 "*Lists of start and end keys to skip in HTML buffers. 1228 "*Lists of start and end keys to skip in HTML buffers.
1229Same format as `ispell-skip-region-alist' 1229Same format as `ispell-skip-region-alist'
1230Note - substrings of other matches must come last 1230Note - substrings of other matches must come last
1231 (e.g. \"<[tT][tT]/\" and \"<[^ \t\n>]\").") 1231 (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
1232 1232
1233 1233
1234(defvar ispell-local-pdict ispell-personal-dictionary 1234(defvar ispell-local-pdict ispell-personal-dictionary
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 7cab20ef81f..08d25997a11 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1145,9 +1145,10 @@ on the line for the invalidity you want to see."
1145 (if no-matches 1145 (if no-matches
1146 (insert "None!\n")) 1146 (insert "None!\n"))
1147 (if (interactive-p) 1147 (if (interactive-p)
1148 (message "%s mismatch%s found" 1148 (message (cond (no-matches "No mismatches found")
1149 (if no-matches "No" num-matches) 1149 ((= num-matches 1) "1 mismatch found")
1150 (if (> num-matches 1) "es" "")))))))) 1150 (t "%d mismatches found"))
1151 num-matches)))))))
1151 1152
1152(defun tex-validate-region (start end) 1153(defun tex-validate-region (start end)
1153 "Check for mismatched braces or $'s in region. 1154 "Check for mismatched braces or $'s in region.
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 7d43a10556e..0f9237f3409 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -58,8 +58,8 @@ The default value for this variable is `x-dnd-default-test-function'."
58 ) 58 )
59 59
60 "The functions to call for different protocols when a drop is made. 60 "The functions to call for different protocols when a drop is made.
61This variable is used by `x-dnd-handle-uri-list' and `x-dnd-handle-moz-url'. 61This variable is used by `x-dnd-handle-uri-list', `x-dnd-handle-file-name'
62The list contains of (REGEXP . FUNCTION) pairs. 62and `x-dnd-handle-moz-url'. The list contains of (REGEXP . FUNCTION) pairs.
63The functions shall take two arguments, URL, which is the URL dropped and 63The functions shall take two arguments, URL, which is the URL dropped and
64ACTION which is the action to be performed for the drop (move, copy, link, 64ACTION which is the action to be performed for the drop (move, copy, link,
65private or ask). 65private or ask).
@@ -104,9 +104,7 @@ is successful, nil if not."
104 :type 'boolean 104 :type 'boolean
105 :group 'x) 105 :group 'x)
106 106
107;; Internal variables 107(defcustom x-dnd-known-types
108
109(defvar x-dnd-known-types
110 '("text/uri-list" 108 '("text/uri-list"
111 "text/x-moz-url" 109 "text/x-moz-url"
112 "_NETSCAPE_URL" 110 "_NETSCAPE_URL"
@@ -121,7 +119,12 @@ is successful, nil if not."
121 "TEXT" 119 "TEXT"
122 ) 120 )
123 "The types accepted by default for dropped data. 121 "The types accepted by default for dropped data.
124The types are chosen in the order they appear in the list.") 122The types are chosen in the order they appear in the list."
123 :type '(repeat string)
124 :group 'x
125)
126
127;; Internal variables
125 128
126(defvar x-dnd-current-state nil 129(defvar x-dnd-current-state nil
127 "The current state for a drop. 130 "The current state for a drop.
@@ -865,7 +868,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
865 timestamp) 868 timestamp)
866 (x-dnd-forget-drop frame))) 869 (x-dnd-forget-drop frame)))
867 870
868 (t (error "Unknown Motif DND message %s %s" message data))))) 871 (t (error "Unknown Motif DND message %s %s" message-atom data)))))
869 872
870 873
871;;; 874;;;
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-08 11:52:24 +0000