diff options
author | Miles Bader <miles@gnu.org> | 2004-09-04 09:14:28 +0000 |
---|---|---|
committer | Miles Bader <miles@gnu.org> | 2004-09-04 09:14:28 +0000 |
commit | 6f7dde8273383c74cc722196c9b37c04faeb263f (patch) | |
tree | 5a4126925b754a52e74fa30de6521b3454f57a6d /lisp | |
parent | 32d61209ceb2b6c4b32e9d3ccc477014cc666c25 (diff) | |
parent | 90e118abf2dcc4aca4d7a7642247fa488554351e (diff) | |
download | emacs-6f7dde8273383c74cc722196c9b37c04faeb263f.tar.gz emacs-6f7dde8273383c74cc722196c9b37c04faeb263f.tar.bz2 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/ChangeLog | 224 | ||||
-rw-r--r-- | lisp/autorevert.el | 3 | ||||
-rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 48 | ||||
-rw-r--r-- | lisp/emacs-lisp/lisp.el | 6 | ||||
-rw-r--r-- | lisp/emulation/cua-base.el | 91 | ||||
-rw-r--r-- | lisp/emulation/cua-rect.el | 417 | ||||
-rw-r--r-- | lisp/help-fns.el | 27 | ||||
-rw-r--r-- | lisp/help.el | 55 | ||||
-rw-r--r-- | lisp/indent.el | 4 | ||||
-rw-r--r-- | lisp/info.el | 157 | ||||
-rw-r--r-- | lisp/isearch.el | 179 | ||||
-rw-r--r-- | lisp/macros.el | 17 | ||||
-rw-r--r-- | lisp/progmodes/compile.el | 64 | ||||
-rw-r--r-- | lisp/progmodes/etags.el | 20 | ||||
-rw-r--r-- | lisp/progmodes/grep.el | 59 | ||||
-rw-r--r-- | lisp/simple.el | 148 | ||||
-rw-r--r-- | lisp/startup.el | 3 | ||||
-rw-r--r-- | lisp/subr.el | 21 | ||||
-rw-r--r-- | lisp/term/mac-win.el | 6 | ||||
-rw-r--r-- | lisp/textmodes/ispell.el | 2 | ||||
-rw-r--r-- | lisp/textmodes/tex-mode.el | 7 | ||||
-rw-r--r-- | lisp/x-dnd.el | 17 |
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 @@ +2004-09-03 Luc Teirlinck <teirllm@auburn.edu> + + * autorevert.el (auto-revert-handler): Bind `buffer-read-only' + locally around the call to `revert-buffer'. + +2004-09-03 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-toggle-regexp): Set `isearch-success' and + `isearch-adjusted' to `t'. + (isearch-toggle-case-fold): Set `isearch-success' to `t'. + (isearch-message-prefix): Add "pending" for isearch-adjusted. + (isearch-other-meta-char): Restore isearch-point unconditionally. + (isearch-query-replace): Add new arg `regexp-flag' and use it. + Set point to start of match if region is not active in transient + mark mode (to include the current match to region boundaries). + Push the search string to `query-replace-from-history-variable'. + Add prompt "Query replace regexp" for isearch-regexp. + Add region beginning/end as last arguments of `perform-replace.' + (isearch-query-replace-regexp): Replace code by the call to + `isearch-query-replace' with arg `t'. + +2004-09-03 Richard M. Stallman <rms@gnu.org> + + * startup.el (normal-top-level): Undo previous TERM change. + +2004-09-03 Kim F. Storm <storm@cua.dk> + + * emulation/cua-rect.el (cua--overlay-keymap): New keymap for + highlight overlays; allow using RET when cursor is over a button. + (cua--highlight-rectangle): Use it. + (cua--rectangle-set-corners): Don't move backwards at eol. + (cua--forward-line): Don't move into void after eob. + + * emulation/cua-rect.el (cua--rectangle-set-corners): Ensure that + point is set (and displayed) inside rectangle. + (cua--rectangle-operation): Fix for highlight of empty lines. + (cua--highlight-rectangle): Fix highlight for tabs. + Position cursor at left/right edge of rectangle using new `cursor' + property on overlay strings. + (cua--indent-rectangle): Don't tabify. + (cua-rotate-rectangle): Ignore that point has moved. + +2004-09-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: Add ASCII equivalents for some function keys. + (mode-line-frame-identification): Sync with x-win.el. + +2004-09-02 Juri Linkov <juri@jurta.org> + + * progmodes/compile.el (compilation-buffer-name): Compare major + mode with second element of compilation-arguments instead of third + to reflect latest changes in compilation-arguments structure. + (recompile): Use global variable `compilation-directory' to get + recent compilation directory only when `recompile' is invoked NOT + in the compilation buffer. Otherwise, use `default-directory' of + the compilation buffer. + (compilation-error-properties): Allow to funcall col and end-col. + (compilation-mode-font-lock-keywords): Check col and end-col by + `integerp'. + (compilation-goto-locus): If end-mk is non-nil in transient mark + mode don't activate the mark (and don't display message in + push-mark), but highlight overlay between mk and end-mk. + + * progmodes/grep.el (grep-highlight-matches): New defcustom. + (grep-regexp-alist): Add rule to highlight grep matches. + (grep-process-setup): Set env-vars GREP_OPTIONS and GREP_COLOR. + + * info.el (Info-fontify-node): Don't compute other-tag + if Info-hide-note-references=hide. + + * help.el (function-called-at-point): + * help-fns.el (variable-at-point): + Try `find-tag-default' when other methods failed. + + * emacs-lisp/lisp.el (beginning-of-defun, end-of-defun): + Do not push mark if inhibit-mark-movement is non-nil. + + * textmodes/ispell.el (ispell-html-skip-alists): + Fix backslashes in docstring. + +2004-09-01 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-wrap-function) + (isearch-push-state-function): New defvars. + (isearch-pop-fun-state): New defsubst. + (isearch-top-state): Call function saved in `isearch-pop-fun-state'. + (isearch-push-state): Set the result of calling + `isearch-push-state-function' to the `isearch-pop-fun-state' field. + (isearch-cancel): Call function saved in `isearch-pop-fun-state' to + restore the mode-specific starting point of terminated search. + (isearch-abort): Call `isearch-cancel' instead of its duplicated code. + (isearch-repeat): Call `isearch-wrap-function' if defined. + (isearch-message-prefix): Don't add prefix "over" to the message + for wrapped search if `isearch-wrap-function' is defined. + (isearch-search): Call function saved in `isearch-pop-fun-state' to + restore the mode-specific starting point of failed search. + + * info.el (Info-search-whitespace-regexp): Fix backslashes. + (Info-search): Add new optional arguments for the sake of isearch. + Replace whitespace in Info-search-whitespace-regexp literally. + Add backward search. Don't call `Info-select-node' if regexp is + found in the same Info node. Don't add node to Info-history for + wrapped isearch. + (Info-search-backward, Info-isearch-search, Info-isearch-wrap) + (Info-isearch-push-state, Info-isearch-pop-state): New funs. + (Info-mode): Set local variables `isearch-search-fun-function', + `isearch-wrap-function', `isearch-push-state-function', + `search-whitespace-regexp'. + + * isearch.el: Remove ancient Change Log section. + (isearch-string, isearch-message-string, isearch-point) + (isearch-success, isearch-forward-flag, isearch-other-end) + (isearch-word, isearch-invalid-regexp, isearch-wrapped) + (isearch-barrier, isearch-within-brackets) + (isearch-case-fold-search): Add suffix `-state' to state-related + defsubsts to avoid name clashes with other function names. + + * simple.el (next-error): New defgroup and defface. + (next-error-highlight, next-error-highlight-no-select): + New defcustoms. + (next-error-no-select): Let-bind next-error-highlight to the value + of next-error-highlight-no-select before calling `next-error'. + + * progmodes/compile.el (compilation-goto-locus): + Use `next-error' face instead of `region'. Set 4-th argument of + `move-overlay' to `current-buffer' to move overlay to different + source buffers. Use new variable `next-error-highlight'. + + * simple.el (next-error-find-buffer): Move the rule + "if current buffer is a next-error capable buffer" after the + rule "if next-error-last-buffer is set to a live buffer". + Simplify to test all rules in one `or'. + (next-error): Doc fix. + (next-error, previous-error, first-error) + (next-error-no-select, previous-error-no-select): + Make arguments optional. + +2004-08-31 Luc Teirlinck <teirllm@auburn.edu> + + * macros.el (apply-macro-to-region-lines): Make it operate on all + lines that begin in the region, rather than on all complete lines + in the region. + +2004-08-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * x-dnd.el (x-dnd-protocol-alist): Document update. + (x-dnd-known-types): Defcustom it. + (x-dnd-handle-motif): Print message-atom in error message. + +2004-08-30 John Paul Wallington <jpw@gnu.org> + + * textmodes/tex-mode.el (tex-validate-buffer): Use distinct + strings rather than programatically constructing message. + +2004-08-30 Richard M. Stallman <rms@gnu.org> + + * emacs-lisp/lisp-mode.el (prin1-char): Don't turn S-a into A. + Don't return a string that would read as the wrong character code. + +2004-08-29 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el (cua-auto-expand-rectangles): Remove + automatic rectangle padding feature; replace by non-destructive + virtual rectangle edges feature. + (cua-virtual-rectangle-edges): New defcustom. + (cua-auto-tabify-rectangles): New defcustom. + (cua-paste): If paste into a marked rectangle, insert rectangle at + current column, even if virtual; also paste exactly as many lines + as has been marked (ignore additional lines or add empty lines), + but paste whole source if only one line is marked. + (cua--update-indications): No longer use overwrite-cursor to + indicate rectangle padding + + * emulation/cua-rect.el (cua--rectangle-padding): Remove. + (cua--rectangle-virtual-edges): New defun. + (cua--rectangle-get-corners): Remove optional PAD arg. + (cua--rectangle-set-corners): Never do padding. + (cua--forward-line): Remove optional PAD arg. Simplify. + (cua-resize-rectangle-right, cua-resize-rectangle-left) + (cua-resize-rectangle-down, cua-resize-rectangle-up): + (cua-resize-rectangle-bot, cua-resize-rectangle-top) + (cua-resize-rectangle-page-up, cua-resize-rectangle-page-down) + (cua--rectangle-move): Never do padding. Simplify. + (cua--tabify-start): New defun. + (cua--rectangle-operation): Add tabify arg. All callers changed. + (cua--pad-rectangle): Remove. + (cua--delete-rectangle): Handle delete with virtual edges. + (cua--extract-rectangle): Add spaces if rectangle has virtual edges. + (cua--insert-rectangle): Handle insert at virtual column. + Perform auto-tabify if necessary. + (cua--activate-rectangle): Remove optional FORCE arg. + Never do padding. Simplify. + (cua--highlight-rectangle): Enhance for virtual edges. + (cua-toggle-rectangle-padding): Remove command. + (cua-toggle-rectangle-virtual-edges): New command. + (cua-sequence-rectangle): Add optional TABIFY arg. Callers changed. + (cua--rectangle-post-command): Don't force rectangle padding. + (cua--init-rectangles): Bind M-p to cua-toggle-rectangle-virtual-edges. + +2004-08-28 Luc Teirlinck <teirllm@auburn.edu> + + * indent.el (edit-tab-stops-buffer): Doc fix. + +2004-08-28 Richard M. Stallman <rms@gnu.org> + + * progmodes/grep.el (grep-default-command): Use find-tag-default. + (grep-tag-default): Function deleted. + + * subr.el (find-tag-default): Moved from etags.el. + + * progmodes/etags.el (find-tag-default): Moved to subr.el. + + * emacs-lisp/lisp-mode.el (prin1-char): Put `shift' modifier + into the basic character if it has an uppercase form. + 2004-08-27 Kenichi Handa <handa@m17n.org> * international/utf-8.el (utf-8-post-read-conversion): If the @@ -534,7 +749,6 @@ (ps-generate-string-list): Comment fix. (ps-message-log-max): Code fix. - 2004-07-22 Michael Piotrowski <mxp@dynalabs.de> (tiny change) * ps-print.el (ps-begin-file): Improve the DSC compliance of the @@ -554,11 +768,9 @@ 2004-07-20 Richard M. Stallman <rms@gnu.org> - * textmodes/fill.el (fill-comment-paragraph): Handle indent-tabs-mode. - (fill-delete-newlines): Call sentence-end as function. - (fill-nobreak-p, canonically-space-region): Likewise. - (fill-nobreak-p): If this break point is at the end of the line, - don't consider the newline which follows as a reason to return t. + * textmodes/fill.el (fill-nobreak-p): If this break point is + at the end of the line, don't consider the newline which follows + as a reason to return t. 2004-07-19 John Paul Wallington <jpw@gnu.org> 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." 'no-mini t)) (if auto-revert-tail-mode (auto-revert-tail-handler) - (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)) + (let ((buffer-read-only buffer-read-only)) + (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes))) (when buffer-file-name (when eob (goto-char (point-max))) (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." (when (stringp default) (if (string-match ":+" default) (substring default (match-end 0)) - default)))) + default)))) ;; Used in old LispM code. (defalias 'common-lisp-mode 'lisp-mode) @@ -459,21 +459,37 @@ alternative printed representations that can be displayed." If CHAR is not a character, return nil." (and (integerp char) (eventp char) - (let ((c (event-basic-type char))) - (concat - "?" - (mapconcat - (lambda (modif) - (cond ((eq modif 'super) "\\s-") - (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) - (event-modifiers char) "") - (cond - ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) - ((eq c 127) "\\C-?") - (t - (condition-case nil - (string c) - (error nil)))))))) + (let ((c (event-basic-type char)) + (mods (event-modifiers char)) + string) + ;; Prevent ?A from turning into ?\S-a. + (if (and (memq 'shift mods) + (zerop (logand char ?\S-\^@)) + (not (let ((case-fold-search nil)) + (char-equal c (upcase c))))) + (setq c (upcase c) mods nil)) + ;; What string are we considering using? + (condition-case nil + (setq string + (concat + "?" + (mapconcat + (lambda (modif) + (cond ((eq modif 'super) "\\s-") + (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) + mods "") + (cond + ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) + ((eq c 127) "\\C-?") + (t + (string c))))) + (error nil)) + ;; Verify the string reads a CHAR, not to some other character. + ;; If it doesn't, return nil instead. + (and string + (= (car (read-from-string string)) char) + string)))) + (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) "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 is called as a function to find the defun's beginning." (interactive "p") (and (eq this-command 'beginning-of-defun) - (or (eq last-command 'beginning-of-defun) (push-mark))) + (or inhibit-mark-movement (eq last-command 'beginning-of-defun) + (push-mark))) (and (beginning-of-defun-raw arg) (progn (beginning-of-line) t))) @@ -226,7 +227,8 @@ If variable `end-of-defun-function' is non-nil, its value is called as a function to find the defun's end." (interactive "p") (and (eq this-command 'end-of-defun) - (or (eq last-command 'end-of-defun) (push-mark))) + (or inhibit-mark-movement (eq last-command 'end-of-defun) + (push-mark))) (if (or (null arg) (= arg 0)) (setq arg 1)) (if end-of-defun-function (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 @@ ;; completely separate set of "rectangle commands" [C-x r ...] on the ;; region to copy, kill, fill a.s.o. the virtual rectangle. ;; -;; cua-mode's superior rectangle support is based on using a true visual -;; representation of the selected rectangle. To start a rectangle, use -;; [S-return] and extend it using the normal movement keys (up, down, -;; left, right, home, end, C-home, C-end). Once the rectangle has the -;; desired size, you can cut or copy it using C-x and C-c (or C-w and M-w), -;; and you can subsequently insert it - as a rectangle - using C-v (or -;; C-y). So the only new command you need to know to work with -;; cua-mode rectangles is S-return! +;; cua-mode's superior rectangle support uses a true visual +;; representation of the selected rectangle, i.e. it highlights the +;; actual part of the buffer that is currently selected as part of the +;; rectangle. Unlike emacs' traditional rectangle commands, the +;; selected rectangle always as straight left and right edges, even +;; when those are in the middle of a TAB character or beyond the end +;; of the current line. And it does this without actually modifying +;; the buffer contents (it uses display overlays to visualize the +;; virtual dimensions of the rectangle). +;; +;; This means that cua-mode's rectangles are not limited to the actual +;; contents of the buffer, so if the cursor is currently at the end of a +;; short line, you can still extend the rectangle to include more columns +;; of longer lines in the same rectangle. And you can also have the +;; left edge of a rectangle start in the middle of a TAB character. +;; Sounds strange? Try it! +;; +;; To start a rectangle, use [S-return] and extend it using the normal +;; movement keys (up, down, left, right, home, end, C-home, +;; C-end). Once the rectangle has the desired size, you can cut or +;; copy it using C-x and C-c (or C-w and M-w), and you can +;; subsequently insert it - as a rectangle - using C-v (or C-y). So +;; the only new command you need to know to work with cua-mode +;; rectangles is S-return! ;; ;; Normally, when you paste a rectangle using C-v (C-y), each line of ;; the rectangle is inserted into the existing lines in the buffer. ;; If overwrite-mode is active when you paste a rectangle, it is ;; inserted as normal (multi-line) text. ;; -;; Furthermore, cua-mode's rectangles are not limited to the actual -;; contents of the buffer, so if the cursor is currently at the end of a -;; short line, you can still extend the rectangle to include more columns -;; of longer lines in the same rectangle. Sounds strange? Try it! -;; -;; You can enable padding for just this rectangle by pressing [M-p]; -;; this works like entering `picture-mode' where the tabs and spaces -;; are automatically converted/inserted to make the rectangle truly -;; rectangular. Or you can do it for all rectangles by setting the -;; `cua-auto-expand-rectangles' variable. +;; If you prefer the traditional rectangle marking (i.e. don't want +;; straight edges), [M-p] toggles this for the current rectangle, +;; or you can customize cua-virtual-rectangle-edges. ;; And there's more: If you want to extend or reduce the size of the ;; rectangle in one of the other corners of the rectangle, just use @@ -204,8 +213,8 @@ ;; a supplied format string (prompt) ;; [M-o] opens the rectangle by moving the highlighted text to the ;; right of the rectangle and filling the rectangle with blanks. -;; [M-p] toggles rectangle padding, i.e. insert tabs and spaces to -;; make rectangles truly rectangular +;; [M-p] toggles virtual straight rectangle edges +;; [M-P] inserts tabs and spaces (padding) to make real straight edges ;; [M-q] performs text filling on the rectangle ;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle ;; [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." ;;; Rectangle Customization -(defcustom cua-auto-expand-rectangles nil - "*If non-nil, rectangles are padded with spaces to make straight edges. -This implies modifying buffer contents by expanding tabs and inserting spaces. -Consequently, this is inhibited in read-only buffers. -Can be toggled by [M-p] while the rectangle is active," +(defcustom cua-virtual-rectangle-edges t + "*If non-nil, rectangles have virtual straight edges. +Note that although rectangles are always DISPLAYED with straight edges, the +buffer is NOT modified, until you execute a command that actually modifies it. +\[M-p] toggles this feature when a rectangle is active." :type 'boolean :group 'cua) +(defcustom cua-auto-tabify-rectangles 1000 + "*If non-nil, automatically tabify after rectangle commands. +This basically means that `tabify' is applied to all lines that +are modified by inserting or deleting a rectangle. If value is +an integer, cua will look for existing tabs in a region around +the rectangle, and only do the conversion if any tabs are already +present. The number specifies then number of characters before +and after the region marked by the rectangle to search." + :type '(choice (number :tag "Auto detect (limit)") + (const :tag "Disabled" nil) + (other :tag "Enabled" t)) + :group 'cua) + (defcustom cua-enable-rectangle-auto-help t "*If non-nil, automatically show help for region, rectangle and global mark." :type 'boolean @@ -412,7 +434,6 @@ Can be toggled by [M-p] while the rectangle is active," (frame-parameter nil 'cursor-color) "red") "Normal (non-overwrite) cursor color. -Also used to indicate that rectangle padding is not in effect. Default is to load cursor color from initial or default frame parameters. If 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." (defcustom cua-overwrite-cursor-color "yellow" "*Cursor color used when overwrite mode is set, if non-nil. -Also used to indicate that rectangle padding is in effect. Only used when `cua-enable-cursor-indications' is non-nil. If 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." (interactive "P") (setq arg (cua--prefix-arg arg)) (let ((regtxt (and cua--register (get-register cua--register))) - (count (prefix-numeric-value arg))) + (count (prefix-numeric-value arg)) + paste-column paste-lines) (cond ((and cua--register (not regtxt)) (message "Nothing in register %c" cua--register)) @@ -825,7 +846,12 @@ If global mark is active, copy from register or one character." ;; the same region that we are going to delete. ;; That would make yank a no-op. (if cua--rectangle - (cua--delete-rectangle) + (progn + (goto-char (min (mark) (point))) + (setq paste-column (cua--rectangle-left)) + (setq paste-lines (cua--delete-rectangle)) + (if (= paste-lines 1) + (setq paste-lines nil))) ;; paste all (if (string= (buffer-substring (point) (mark)) (car kill-ring)) (current-kill 1)) @@ -843,7 +869,8 @@ If global mark is active, copy from register or one character." (setq this-command 'cua--paste-rectangle) (undo-boundary) (setq buffer-undo-list (cons pt buffer-undo-list))) - (cua--insert-rectangle (cdr cua--last-killed-rectangle)) + (cua--insert-rectangle (cdr cua--last-killed-rectangle) + nil paste-column paste-lines) (if arg (goto-char pt)))) (t (yank arg))))))) @@ -1033,9 +1060,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." ((and buffer-read-only cua-read-only-cursor-color) cua-read-only-cursor-color) - ((and cua-overwrite-cursor-color - (or overwrite-mode - (and cua--rectangle (cua--rectangle-padding)))) + ((and cua-overwrite-cursor-color overwrite-mode) cua-overwrite-cursor-color) (t cua-normal-cursor-color))) (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 @@ (require 'rect) ;; If non-nil, restrict current region to this rectangle. -;; Value is a vector [top bot left right corner ins pad select]. +;; Value is a vector [top bot left right corner ins virt select]. ;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. ;; INS specifies whether to insert on left(nil) or right(t) side. -;; If PAD is non-nil, tabs are converted to spaces when necessary. +;; If VIRT is non-nil, virtual straight edges are enabled. ;; If SELECT is a regexp, only lines starting with that regexp are affected.") (defvar cua--rectangle nil) (make-variable-buffer-local 'cua--rectangle) @@ -65,6 +65,12 @@ (defvar cua--rectangle-overlays nil) (make-variable-buffer-local 'cua--rectangle-overlays) +(defvar cua--overlay-keymap + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'cua-rotate-rectangle))) + +(defvar cua--virtual-edges-debug nil) + ;; Per-buffer CUA mode undo list. (defvar cua--undo-list nil) (make-variable-buffer-local 'cua--undo-list) @@ -97,7 +103,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defvar cua--tidy-undo-counter 0 "Number of times `cua--tidy-undo-lists' have run successfully.") -;; Clean out danling entries from cua's undo list. +;; Clean out dangling entries from cua's undo list. ;; Since this list contains pointers into the standard undo list, ;; such references are only meningful as undo information if the ;; corresponding entry is still on the standard undo list. @@ -203,11 +209,11 @@ Knows about CUA rectangle highlighting in addition to standard undo." (aref cua--rectangle 5)) (cua--rectangle-left)))) -(defun cua--rectangle-padding (&optional set val) - ;; Current setting of rectangle padding +(defun cua--rectangle-virtual-edges (&optional set val) + ;; Current setting of rectangle virtual-edges (if set (aset cua--rectangle 6 val)) - (and (not buffer-read-only) + (and ;(not buffer-read-only) (aref cua--rectangle 6))) (defun cua--rectangle-restriction (&optional val bounded negated) @@ -226,7 +232,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." (if (< (cua--rectangle-bot) (cua--rectangle-top)) (message "rectangle bot < top"))) -(defun cua--rectangle-get-corners (&optional pad) +(defun cua--rectangle-get-corners () ;; Calculate the rectangular region represented by point and mark, ;; putting start in the upper left corner and end in the ;; bottom right corner. @@ -245,12 +251,12 @@ Knows about CUA rectangle highlighting in addition to standard undo." (setq r (1- r))) (setq l (prog1 r (setq r l))) (goto-char top) - (move-to-column l pad) + (move-to-column l) (setq top (point)) (goto-char bot) - (move-to-column r pad) + (move-to-column r) (setq bot (point)))) - (vector top bot l r corner 0 pad nil))) + (vector top bot l r corner 0 cua-virtual-rectangle-edges nil))) (defun cua--rectangle-set-corners () ;; Set mark and point in opposite corners of current rectangle. @@ -269,24 +275,31 @@ Knows about CUA rectangle highlighting in addition to standard undo." (setq pp (cua--rectangle-bot) pc (cua--rectangle-right) mp (cua--rectangle-top) mc (cua--rectangle-left)))) (goto-char mp) - (move-to-column mc (cua--rectangle-padding)) + (move-to-column mc) (set-mark (point)) (goto-char pp) - (move-to-column pc (cua--rectangle-padding)))) + ;; Move cursor inside rectangle, except if char at rigth edge is a tab. + (if (and (if (cua--rectangle-right-side) + (and (= (move-to-column pc) (- pc tab-width)) + (not (eolp))) + (> (move-to-column pc) pc)) + (not (bolp))) + (backward-char 1)) + )) ;;; Rectangle resizing -(defun cua--forward-line (n pad) +(defun cua--forward-line (n) ;; Move forward/backward one line. Returns t if movement. - (if (or (not pad) (< n 0)) - (= (forward-line n) 0) - (next-line 1) - t)) + (let ((pt (point))) + (and (= (forward-line n) 0) + ;; Deal with end of buffer + (or (not (eobp)) + (goto-char pt))))) (defun cua--rectangle-resized () ;; Refresh state after resizing rectangle (setq cua--buffer-and-point-before-command nil) - (cua--pad-rectangle) (cua--rectangle-insert-col 0) (cua--rectangle-set-corners) (cua--keep-active)) @@ -294,47 +307,35 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defun cua-resize-rectangle-right (n) "Resize rectangle to the right." (interactive "p") - (let ((pad (cua--rectangle-padding)) (resized (> n 0))) + (let ((resized (> n 0))) (while (> n 0) (setq n (1- n)) (cond - ((and (cua--rectangle-right-side) (or pad (eolp))) - (cua--rectangle-right (1+ (cua--rectangle-right))) - (move-to-column (cua--rectangle-right) pad)) ((cua--rectangle-right-side) - (forward-char 1) - (cua--rectangle-right (current-column))) - ((or pad (eolp)) - (cua--rectangle-left (1+ (cua--rectangle-left))) - (move-to-column (cua--rectangle-right) pad)) + (cua--rectangle-right (1+ (cua--rectangle-right))) + (move-to-column (cua--rectangle-right))) (t - (forward-char 1) - (cua--rectangle-left (current-column))))) + (cua--rectangle-left (1+ (cua--rectangle-left))) + (move-to-column (cua--rectangle-right))))) (if resized (cua--rectangle-resized)))) (defun cua-resize-rectangle-left (n) "Resize rectangle to the left." (interactive "p") - (let ((pad (cua--rectangle-padding)) resized) + (let (resized) (while (> n 0) (setq n (1- n)) (if (or (= (cua--rectangle-right) 0) (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) (setq n 0) (cond - ((and (cua--rectangle-right-side) (or pad (eolp) (bolp))) - (cua--rectangle-right (1- (cua--rectangle-right))) - (move-to-column (cua--rectangle-right) pad)) ((cua--rectangle-right-side) - (backward-char 1) - (cua--rectangle-right (current-column))) - ((or pad (eolp) (bolp)) - (cua--rectangle-left (1- (cua--rectangle-left))) - (move-to-column (cua--rectangle-right) pad)) + (cua--rectangle-right (1- (cua--rectangle-right))) + (move-to-column (cua--rectangle-right))) (t - (backward-char 1) - (cua--rectangle-left (current-column)))) + (cua--rectangle-left (1- (cua--rectangle-left))) + (move-to-column (cua--rectangle-right)))) (setq resized t))) (if resized (cua--rectangle-resized)))) @@ -342,20 +343,20 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defun cua-resize-rectangle-down (n) "Resize rectangle downwards." (interactive "p") - (let ((pad (cua--rectangle-padding)) resized) + (let (resized) (while (> n 0) (setq n (1- n)) (cond ((>= (cua--rectangle-corner) 2) (goto-char (cua--rectangle-bot)) - (when (cua--forward-line 1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line 1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-bot t) (setq resized t))) (t (goto-char (cua--rectangle-top)) - (when (cua--forward-line 1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line 1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-top t) (setq resized t))))) (if resized @@ -364,20 +365,20 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defun cua-resize-rectangle-up (n) "Resize rectangle upwards." (interactive "p") - (let ((pad (cua--rectangle-padding)) resized) + (let (resized) (while (> n 0) (setq n (1- n)) (cond ((>= (cua--rectangle-corner) 2) (goto-char (cua--rectangle-bot)) - (when (cua--forward-line -1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line -1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-bot t) (setq resized t))) (t (goto-char (cua--rectangle-top)) - (when (cua--forward-line -1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line -1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-top t) (setq resized t))))) (if resized @@ -408,7 +409,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." "Resize rectangle to bottom of buffer." (interactive) (goto-char (point-max)) - (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) + (move-to-column (cua--rectangle-column)) (cua--rectangle-bot t) (cua--rectangle-resized)) @@ -416,31 +417,29 @@ Knows about CUA rectangle highlighting in addition to standard undo." "Resize rectangle to top of buffer." (interactive) (goto-char (point-min)) - (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) + (move-to-column (cua--rectangle-column)) (cua--rectangle-top t) (cua--rectangle-resized)) (defun cua-resize-rectangle-page-up () "Resize rectangle upwards by one scroll page." (interactive) - (let ((pad (cua--rectangle-padding))) - (scroll-down) - (move-to-column (cua--rectangle-column) pad) - (if (>= (cua--rectangle-corner) 2) - (cua--rectangle-bot t) - (cua--rectangle-top t)) - (cua--rectangle-resized))) + (scroll-down) + (move-to-column (cua--rectangle-column)) + (if (>= (cua--rectangle-corner) 2) + (cua--rectangle-bot t) + (cua--rectangle-top t)) + (cua--rectangle-resized)) (defun cua-resize-rectangle-page-down () "Resize rectangle downwards by one scroll page." (interactive) - (let ((pad (cua--rectangle-padding))) - (scroll-up) - (move-to-column (cua--rectangle-column) pad) - (if (>= (cua--rectangle-corner) 2) - (cua--rectangle-bot t) - (cua--rectangle-top t)) - (cua--rectangle-resized))) + (scroll-up) + (move-to-column (cua--rectangle-column)) + (if (>= (cua--rectangle-corner) 2) + (cua--rectangle-bot t) + (cua--rectangle-top t)) + (cua--rectangle-resized)) ;;; Mouse support @@ -450,7 +449,8 @@ Knows about CUA rectangle highlighting in addition to standard undo." "Set rectangle corner at mouse click position." (interactive "e") (mouse-set-point event) - (if (cua--rectangle-padding) + ;; FIX ME -- need to calculate virtual column. + (if (cua--rectangle-virtual-edges) (move-to-column (car (posn-col-row (event-end event))) t)) (if (cua--rectangle-right-side) (cua--rectangle-right (current-column)) @@ -470,6 +470,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." (cua--deactivate t)) (setq cua--last-rectangle nil) (mouse-set-point event) + ;; FIX ME -- need to calculate virtual column. (cua-set-rectangle-mark) (setq cua--buffer-and-point-before-command nil) (setq cua--mouse-last-pos nil)) @@ -489,13 +490,13 @@ If command is repeated at same position, delete the rectangle." (let ((cua-keep-region-after-copy t)) (cua-copy-rectangle arg) (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) + (defun cua--mouse-ignore (event) (interactive "e") (setq this-command last-command)) (defun cua--rectangle-move (dir) - (let ((pad (cua--rectangle-padding)) - (moved t) + (let ((moved t) (top (cua--rectangle-top)) (bot (cua--rectangle-bot)) (l (cua--rectangle-left)) @@ -503,17 +504,17 @@ If command is repeated at same position, delete the rectangle." (cond ((eq dir 'up) (goto-char top) - (when (cua--forward-line -1 pad) + (when (cua--forward-line -1) (cua--rectangle-top t) (goto-char bot) (forward-line -1) (cua--rectangle-bot t))) ((eq dir 'down) (goto-char bot) - (when (cua--forward-line 1 pad) + (when (cua--forward-line 1) (cua--rectangle-bot t) (goto-char top) - (cua--forward-line 1 pad) + (cua--forward-line 1) (cua--rectangle-top t))) ((eq dir 'left) (when (> l 0) @@ -526,19 +527,37 @@ If command is repeated at same position, delete the rectangle." (setq moved nil))) (when moved (setq cua--buffer-and-point-before-command nil) - (cua--pad-rectangle) (cua--rectangle-set-corners) (cua--keep-active)))) ;;; Operations on current rectangle -(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct) +(defun cua--tabify-start (start end) + ;; Return position where auto-tabify should start (or nil if not required). + (save-excursion + (save-restriction + (widen) + (and (not buffer-read-only) + cua-auto-tabify-rectangles + (if (or (not (integerp cua-auto-tabify-rectangles)) + (= (point-min) (point-max)) + (progn + (goto-char (max (point-min) + (- start cua-auto-tabify-rectangles))) + (search-forward "\t" (min (point-max) + (+ end cua-auto-tabify-rectangles)) t))) + start))))) + +(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct) ;; Call FCT for each line of region with 4 parameters: ;; Region start, end, left-col, right-col ;; Point is at start when FCT is called + ;; Call fct with (s,e) = whole lines if VISIBLE non-nil. + ;; Only call fct for visible lines if VISIBLE==t. ;; Set undo boundary if UNDO is non-nil. - ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding) + ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) + ;; Perform auto-tabify after operation if TABIFY is non-nil. ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. (let* ((start (cua--rectangle-top)) (end (cua--rectangle-bot)) @@ -546,11 +565,12 @@ If command is repeated at same position, delete the rectangle." (r (1+ (cua--rectangle-right))) (m (make-marker)) (tabpad (and (integerp pad) (= pad 2))) - (sel (cua--rectangle-restriction))) + (sel (cua--rectangle-restriction)) + (tabify-start (and tabify (cua--tabify-start start end)))) (if undo (cua--rectangle-undo-boundary)) (if (integerp pad) - (setq pad (cua--rectangle-padding))) + (setq pad (cua--rectangle-virtual-edges))) (save-excursion (save-restriction (widen) @@ -558,11 +578,13 @@ If command is repeated at same position, delete the rectangle." (goto-char end) (and (bolp) (not (eolp)) (not (eobp)) (setq end (1+ end)))) - (when visible + (when (eq visible t) (setq start (max (window-start) start)) (setq end (min (window-end) end))) (goto-char end) (setq end (line-end-position)) + (if (and visible (bolp) (not (eobp))) + (setq end (1+ end))) (goto-char start) (setq start (line-beginning-position)) (narrow-to-region start end) @@ -575,7 +597,7 @@ If command is repeated at same position, delete the rectangle." (forward-char 1)) (set-marker m (point)) (move-to-column l pad) - (if (and fct (>= (current-column) l) (<= (current-column) r)) + (if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r)))) (let ((v t) (p (point))) (when sel (if (car (cdr sel)) @@ -585,8 +607,7 @@ If command is repeated at same position, delete the rectangle." (if (car (cdr (cdr sel))) (setq v (null v)))) (if visible - (unless (eolp) - (funcall fct p m l r v)) + (funcall fct p m l r v) (if v (funcall fct p m l r))))) (set-marker m nil) @@ -594,7 +615,9 @@ If command is repeated at same position, delete the rectangle." (if (not visible) (cua--rectangle-bot t)) (if post-fct - (funcall post-fct l r)))) + (funcall post-fct l r)) + (when tabify-start + (tabify tabify-start (point))))) (cond ((eq keep-clear 'keep) (cua--keep-active)) @@ -607,48 +630,96 @@ If command is repeated at same position, delete the rectangle." (put 'cua--rectangle-operation 'lisp-indent-function 4) -(defun cua--pad-rectangle (&optional pad) - (if (or pad (cua--rectangle-padding)) - (cua--rectangle-operation nil nil t t))) - (defun cua--delete-rectangle () - (cua--rectangle-operation nil nil t 2 - '(lambda (s e l r) - (if (and (> e s) (<= e (point-max))) - (delete-region s e))))) + (let ((lines 0)) + (if (not (cua--rectangle-virtual-edges)) + (cua--rectangle-operation nil nil t 2 t + '(lambda (s e l r v) + (setq lines (1+ lines)) + (if (and (> e s) (<= e (point-max))) + (delete-region s e)))) + (cua--rectangle-operation nil 1 t nil t + '(lambda (s e l r v) + (setq lines (1+ lines)) + (when (and (> e s) (<= e (point-max))) + (delete-region s e))))) + lines)) (defun cua--extract-rectangle () (let (rect) - (cua--rectangle-operation nil nil nil 1 - '(lambda (s e l r) - (setq rect (cons (buffer-substring-no-properties s e) rect)))) - (nreverse rect))) - -(defun cua--insert-rectangle (rect &optional below) + (if (not (cua--rectangle-virtual-edges)) + (cua--rectangle-operation nil nil nil nil nil ; do not tabify + '(lambda (s e l r) + (setq rect (cons (buffer-substring-no-properties s e) rect)))) + (cua--rectangle-operation nil 1 nil nil nil ; do not tabify + '(lambda (s e l r v) + (let ((copy t) (bs 0) (as 0) row) + (if (= s e) (setq e (1+ e))) + (goto-char s) + (move-to-column l) + (if (= (point) (line-end-position)) + (setq bs (- r l) + copy nil) + (skip-chars-forward "\s\t" e) + (setq bs (- (min r (current-column)) l) + s (point)) + (move-to-column r) + (skip-chars-backward "\s\t" s) + (setq as (- r (max (current-column) l)) + e (point))) + (setq row (if (and copy (> e s)) + (buffer-substring-no-properties s e) + "")) + (when (> bs 0) + (setq row (concat (make-string bs ?\s) row))) + (when (> as 0) + (setq row (concat row (make-string as ?\s)))) + (setq rect (cons row rect)))))) + (nreverse rect))) + +(defun cua--insert-rectangle (rect &optional below paste-column line-count) ;; Insert rectangle as insert-rectangle, but don't set mark and exit with ;; point at either next to top right or below bottom left corner ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. - (if (and below (eq below 'auto)) + (if (eq below 'auto) (setq below (and (bolp) (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) + (unless paste-column + (setq paste-column (current-column))) (let ((lines rect) - (insertcolumn (current-column)) (first t) + (tabify-start (cua--tabify-start (point) (point))) + last-column p) (while (or lines below) (or first (if overwrite-mode (insert ?\n) (forward-line 1) - (or (bolp) (insert ?\n)) - (move-to-column insertcolumn t))) + (or (bolp) (insert ?\n)))) + (unless overwrite-mode + (move-to-column paste-column t)) (if (not lines) (setq below nil) (insert-for-yank (car lines)) + (unless last-column + (setq last-column (current-column))) (setq lines (cdr lines)) (and first (not below) (setq p (point)))) - (setq first nil)) + (setq first nil) + (if (and line-count (= (setq line-count (1- line-count)) 0)) + (setq lines nil))) + (when (and line-count last-column (not overwrite-mode)) + (while (> line-count 0) + (forward-line 1) + (or (bolp) (insert ?\n)) + (move-to-column paste-column t) + (insert-char ?\s (- last-column paste-column -1)) + (setq line-count (1- line-count)))) + (when (and tabify-start + (not overwrite-mode)) + (tabify tabify-start (point))) (and p (not overwrite-mode) (goto-char p)))) @@ -662,7 +733,7 @@ If command is repeated at same position, delete the rectangle." (function (lambda (row) (concat row "\n"))) killed-rectangle ""))))) -(defun cua--activate-rectangle (&optional force) +(defun cua--activate-rectangle () ;; Turn on rectangular marking mode by disabling transient mark mode ;; and manually handling highlighting from a post command hook. ;; Be careful if we are already marking a rectangle. @@ -671,12 +742,8 @@ If command is repeated at same position, delete the rectangle." (eq (car cua--last-rectangle) (current-buffer)) (eq (car (cdr cua--last-rectangle)) (point))) (cdr (cdr cua--last-rectangle)) - (cua--rectangle-get-corners - (and (not buffer-read-only) - (or cua-auto-expand-rectangles - force - (eq major-mode 'picture-mode))))) - cua--status-string (if (cua--rectangle-padding) " Pad" "") + (cua--rectangle-get-corners)) + cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "") cua--last-rectangle nil)) ;; (defvar cua-save-point nil) @@ -698,7 +765,7 @@ If command is repeated at same position, delete the rectangle." ;; Each overlay extends across all the columns of the rectangle. ;; We try to reuse overlays where possible because this is more efficient ;; and results in less flicker. - ;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines, + ;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines, ;; the higlighted region may not be perfectly rectangular. (let ((deactivate-mark deactivate-mark) (old cua--rectangle-overlays) @@ -707,12 +774,67 @@ If command is repeated at same position, delete the rectangle." (right (1+ (cua--rectangle-right)))) (when (/= left right) (sit-for 0) ; make window top/bottom reliable - (cua--rectangle-operation nil t nil nil + (cua--rectangle-operation nil t nil nil nil ; do not tabify '(lambda (s e l r v) (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) - overlay) - ;; Trim old leading overlays. + overlay bs ms as) (if (= s e) (setq e (1+ e))) + (when (cua--rectangle-virtual-edges) + (let ((lb (line-beginning-position)) + (le (line-end-position)) + cl cl0 pl cr cr0 pr) + (goto-char s) + (setq cl (move-to-column l) + pl (point)) + (setq cr (move-to-column r) + pr (point)) + (if (= lb pl) + (setq cl0 0) + (goto-char (1- pl)) + (setq cl0 (current-column))) + (if (= lb le) + (setq cr0 0) + (goto-char (1- pr)) + (setq cr0 (current-column))) + (unless (and (= cl l) (= cr r)) + (when (/= cl l) + (setq bs (propertize + (make-string + (- l cl0 (if (and (= le pl) (/= le lb)) 1 0)) + (if cua--virtual-edges-debug ?. ?\s)) + 'face 'default)) + (if (/= pl le) + (setq s (1- s)))) + (cond + ((= cr r) + (if (and (/= pr le) + (/= cr0 (1- cr)) + (or bs (/= cr0 (- cr tab-width))) + (/= (mod cr tab-width) 0)) + (setq e (1- e)))) + ((= cr cl) + (setq ms (propertize + (make-string + (- r l) + (if cua--virtual-edges-debug ?, ?\s)) + 'face rface)) + (if (cua--rectangle-right-side) + (put-text-property (1- (length ms)) (length ms) 'cursor t ms) + (put-text-property 0 1 'cursor t ms)) + (setq bs (concat bs ms)) + (setq rface nil)) + (t + (setq as (propertize + (make-string + (- r cr0 (if (= le pr) 1 0)) + (if cua--virtual-edges-debug ?~ ?\s)) + 'face rface)) + (if (cua--rectangle-right-side) + (put-text-property (1- (length as)) (length as) 'cursor t as) + (put-text-property 0 1 'cursor t as)) + (if (/= pr le) + (setq e (1- e)))))))) + ;; Trim old leading overlays. (while (and old (setq overlay (car old)) (< (overlay-start overlay) s) @@ -728,8 +850,11 @@ If command is repeated at same position, delete the rectangle." (move-overlay overlay s e) (setq old (cdr old))) (setq overlay (make-overlay s e))) - (overlay-put overlay 'face rface) - (setq new (cons overlay new)))))) + (overlay-put overlay 'before-string bs) + (overlay-put overlay 'after-string as) + (overlay-put overlay 'face rface) + (overlay-put overlay 'keymap cua--overlay-keymap) + (setq new (cons overlay new)))))) ;; Trim old trailing overlays. (mapcar (function delete-overlay) old) (setq cua--rectangle-overlays (nreverse new)))) @@ -737,9 +862,9 @@ If command is repeated at same position, delete the rectangle." (defun cua--indent-rectangle (&optional ch to-col clear) ;; Indent current rectangle. (let ((col (cua--rectangle-insert-col)) - (pad (cua--rectangle-padding)) + (pad (cua--rectangle-virtual-edges)) indent) - (cua--rectangle-operation (if clear 'clear 'corners) nil t pad + (cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil '(lambda (s e l r) (move-to-column col pad) (if (and (eolp) @@ -875,23 +1000,22 @@ With prefix argument, the toggle restriction." (defun cua-rotate-rectangle () (interactive) (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) - (cua--rectangle-set-corners)) + (cua--rectangle-set-corners) + (if (cua--rectangle-virtual-edges) + (setq cua--buffer-and-point-before-command nil))) -(defun cua-toggle-rectangle-padding () +(defun cua-toggle-rectangle-virtual-edges () (interactive) - (if buffer-read-only - (message "Cannot do padding in read-only buffer.") - (cua--rectangle-padding t (not (cua--rectangle-padding))) - (cua--pad-rectangle) - (cua--rectangle-set-corners)) - (setq cua--status-string (and (cua--rectangle-padding) " Pad")) + (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges))) + (cua--rectangle-set-corners) + (setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]")) (cua--keep-active)) (defun cua-do-rectangle-padding () (interactive) (if buffer-read-only (message "Cannot do padding in read-only buffer.") - (cua--pad-rectangle t) + (cua--rectangle-operation nil nil t t t) (cua--rectangle-set-corners)) (cua--keep-active)) @@ -900,7 +1024,7 @@ With prefix argument, the toggle restriction." The text previously in the region is not overwritten by the blanks, but instead winds up to the right of the rectangle." (interactive) - (cua--rectangle-operation 'corners nil t 1 + (cua--rectangle-operation 'corners nil t 1 nil '(lambda (s e l r) (skip-chars-forward " \t") (let ((ws (- (current-column) l)) @@ -915,7 +1039,7 @@ On each line in the rectangle, all continuous whitespace starting at that column is deleted. With prefix arg, also delete whitespace to the left of that column." (interactive "P") - (cua--rectangle-operation 'clear nil t 1 + (cua--rectangle-operation 'clear nil t 1 nil '(lambda (s e l r) (when arg (skip-syntax-backward " " (line-beginning-position)) @@ -927,7 +1051,7 @@ With prefix arg, also delete whitespace to the left of that column." "Blank out CUA rectangle. The text previously in the rectangle is overwritten by the blanks." (interactive) - (cua--rectangle-operation 'keep nil nil 1 + (cua--rectangle-operation 'keep nil nil 1 nil '(lambda (s e l r) (goto-char e) (skip-syntax-forward " " (line-end-position)) @@ -942,7 +1066,7 @@ The text previously in the rectangle is overwritten by the blanks." "Align rectangle lines to left column." (interactive) (let (x) - (cua--rectangle-operation 'clear nil t t + (cua--rectangle-operation 'clear nil t t nil '(lambda (s e l r) (let ((b (line-beginning-position))) (skip-syntax-backward "^ " b) @@ -984,7 +1108,7 @@ The text previously in the rectangle is overwritten by the blanks." "Replace CUA rectangle contents with STRING on each line. The length of STRING need not be the same as the rectangle width." (interactive "sString rectangle: ") - (cua--rectangle-operation 'keep nil t t + (cua--rectangle-operation 'keep nil t t nil '(lambda (s e l r) (delete-region s e) (skip-chars-forward " \t") @@ -999,7 +1123,7 @@ The length of STRING need not be the same as the rectangle width." (defun cua-fill-char-rectangle (ch) "Replace CUA rectangle contents with CHARACTER." (interactive "cFill rectangle with character: ") - (cua--rectangle-operation 'clear nil t 1 + (cua--rectangle-operation 'clear nil t 1 nil '(lambda (s e l r) (delete-region s e) (move-to-column l t) @@ -1010,7 +1134,7 @@ The length of STRING need not be the same as the rectangle width." (interactive "sReplace regexp: \nsNew text: ") (if buffer-read-only (message "Cannot replace in read-only buffer") - (cua--rectangle-operation 'keep nil t 1 + (cua--rectangle-operation 'keep nil t 1 nil '(lambda (s e l r) (if (re-search-forward regexp e t) (replace-match newtext nil nil)))))) @@ -1018,7 +1142,7 @@ The length of STRING need not be the same as the rectangle width." (defun cua-incr-rectangle (increment) "Increment each line of CUA rectangle by prefix amount." (interactive "p") - (cua--rectangle-operation 'keep nil t 1 + (cua--rectangle-operation 'keep nil t 1 nil '(lambda (s e l r) (cond ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) @@ -1051,36 +1175,36 @@ The numbers are formatted according to the FORMAT string." (if (= (length fmt) 0) (setq fmt cua--rectangle-seq-format) (setq cua--rectangle-seq-format fmt)) - (cua--rectangle-operation 'clear nil t 1 + (cua--rectangle-operation 'clear nil t 1 nil '(lambda (s e l r) (delete-region s e) (insert (format fmt first)) (setq first (+ first incr))))) -(defmacro cua--convert-rectangle-as (command) - `(cua--rectangle-operation 'clear nil nil nil +(defmacro cua--convert-rectangle-as (command tabify) + `(cua--rectangle-operation 'clear nil nil nil ,tabify '(lambda (s e l r) (,command s e)))) (defun cua-upcase-rectangle () "Convert the rectangle to upper case." (interactive) - (cua--convert-rectangle-as upcase-region)) + (cua--convert-rectangle-as upcase-region nil)) (defun cua-downcase-rectangle () "Convert the rectangle to lower case." (interactive) - (cua--convert-rectangle-as downcase-region)) + (cua--convert-rectangle-as downcase-region nil)) (defun cua-upcase-initials-rectangle () "Convert the rectangle initials to upper case." (interactive) - (cua--convert-rectangle-as upcase-initials-region)) + (cua--convert-rectangle-as upcase-initials-region nil)) (defun cua-capitalize-rectangle () "Convert the rectangle to proper case." (interactive) - (cua--convert-rectangle-as capitalize-region)) + (cua--convert-rectangle-as capitalize-region nil)) ;;; Replace/rearrange text in current rectangle @@ -1116,7 +1240,7 @@ The numbers are formatted according to the FORMAT string." (setq z (reverse z)) (if cua--debug (print z auxbuf)) - (cua--rectangle-operation nil nil t pad + (cua--rectangle-operation nil nil t pad nil '(lambda (s e l r) (let (cc) (goto-char e) @@ -1232,9 +1356,9 @@ With prefix arg, indent to that column." "Delete char to left or right of rectangle." (interactive) (let ((col (cua--rectangle-insert-col)) - (pad (cua--rectangle-padding)) + (pad (cua--rectangle-virtual-edges)) indent) - (cua--rectangle-operation 'corners nil t pad + (cua--rectangle-operation 'corners nil t pad nil '(lambda (s e l r) (move-to-column (if (cua--rectangle-right-side t) @@ -1282,10 +1406,7 @@ With prefix arg, indent to that column." (cua--rectangle-left (current-column))) (if (>= (cua--rectangle-corner) 2) (cua--rectangle-bot t) - (cua--rectangle-top t)) - (if (cua--rectangle-padding) - (setq unread-command-events - (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events))))) + (cua--rectangle-top t)))) (if cua--rectangle (if (and mark-active (not deactivate-mark)) @@ -1379,7 +1500,7 @@ With prefix arg, indent to that column." (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) (cua--rect-M/H-key ?n 'cua-sequence-rectangle) (cua--rect-M/H-key ?o 'cua-open-rectangle) - (cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding) + (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges) (cua--rect-M/H-key ?P 'cua-do-rectangle-padding) (cua--rect-M/H-key ?q 'cua-refill-rectangle) (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')." (defun variable-at-point () "Return the bound variable symbol found around point. Return 0 if there is no such symbol." - (condition-case () - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (or (and (symbolp obj) (boundp obj) obj) - 0)))) - (error 0))) + (or (condition-case () + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (boundp obj) obj)))) + (error nil)) + (let* ((str (find-tag-default)) + (obj (if str (read str)))) + (and (symbolp obj) (boundp obj) obj)) + 0)) ;;;###autoload (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." (defun function-called-at-point () "Return a function around point or else called by the list containing point. If that doesn't give a function, return nil." - (with-syntax-table emacs-lisp-mode-syntax-table - (or (condition-case () - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) - (- (point) 1000)) (point-max)) - ;; Move up to surrounding paren, then after the open. - (backward-up-list 1) - (forward-char 1) - ;; If there is space here, this is probably something - ;; other than a real Lisp function call, so ignore it. - (if (looking-at "[ \t]") - (error "Probably not a Lisp function call")) - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil))))) + (or (with-syntax-table emacs-lisp-mode-syntax-table + (or (condition-case () + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj))) + (error nil)) + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (max (point-min) + (- (point) 1000)) (point-max)) + ;; Move up to surrounding paren, then after the open. + (backward-up-list 1) + (forward-char 1) + ;; If there is space here, this is probably something + ;; other than a real Lisp function call, so ignore it. + (if (looking-at "[ \t]") + (error "Probably not a Lisp function call")) + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil)))) + (let* ((str (find-tag-default)) + (obj (if str (read str)))) + (and (symbolp obj) (fboundp obj) obj)))) ;;; `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." "Keymap used in `edit-tab-stops'.") (defvar edit-tab-stops-buffer nil - "Buffer whose tab stops are being edited--in case -the variable `tab-stop-list' is local in that buffer.") + "Buffer whose tab stops are being edited. +This matters if the variable `tab-stop-list' is local in that buffer.") (defun edit-tab-stops () "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." :type 'boolean :group 'info) -(defcustom Info-search-whitespace-regexp "\\\\(?:\\\\s-+\\\\)" +(defcustom Info-search-whitespace-regexp "\\(?:\\s-+\\)" "*If non-nil, regular expression to match a sequence of whitespace chars. This applies to Info search for regular expressions. You 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." (defvar Info-search-case-fold nil "The value of `case-fold-search' from previous `Info-search' command.") -(defun Info-search (regexp) - "Search for REGEXP, starting from point, and select node it's found in." +(defun Info-search (regexp &optional bound noerror count direction) + "Search for REGEXP, starting from point, and select node it's found in. +If DIRECTION is `backward', search in the reverse direction." (interactive (list (read-string (if Info-search-history (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." (setq regexp (car Info-search-history))) (when regexp (let (found beg-found give-up + (backward (eq direction 'backward)) (onode Info-current-node) (ofile Info-current-file) (opoint (point)) + (opoint-min (point-min)) + (opoint-max (point-max)) (ostart (window-start)) (osubfile Info-current-subfile)) (when Info-search-whitespace-regexp - (setq regexp (replace-regexp-in-string - "[ \t\n]+" Info-search-whitespace-regexp regexp))) + (setq regexp + (mapconcat 'identity (split-string regexp "[ \t\n]+") + Info-search-whitespace-regexp))) (setq Info-search-case-fold case-fold-search) (save-excursion (save-restriction (widen) (while (and (not give-up) (or (null found) - (isearch-range-invisible beg-found found))) - (if (re-search-forward regexp nil t) - (setq found (point) beg-found (match-beginning 0)) + (if backward + (isearch-range-invisible found beg-found) + (isearch-range-invisible beg-found found)))) + (if (if backward + (re-search-backward regexp bound t) + (re-search-forward regexp bound t)) + (setq found (point) beg-found (if backward (match-end 0) + (match-beginning 0))) (setq give-up t))))) ;; If no subfiles, give error now. (if give-up (if (null Info-current-subfile) - (re-search-forward regexp) + (if backward + (re-search-backward regexp) + (re-search-forward regexp)) (setq found nil))) - (unless found + (unless (or found bound) (unwind-protect ;; Try other subfiles. (let ((list ())) @@ -1498,29 +1510,39 @@ If FORK is a string, it is the name to use for the new buffer." ;; Find the subfile we just searched. (search-forward (concat "\n" osubfile ": ")) ;; Skip that one. - (forward-line 1) + (forward-line (if backward 0 1)) ;; Make a list of all following subfiles. ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). - (while (not (eobp)) - (re-search-forward "\\(^.*\\): [0-9]+$") + (while (not (if backward (bobp) (eobp))) + (if backward + (re-search-backward "\\(^.*\\): [0-9]+$") + (re-search-forward "\\(^.*\\): [0-9]+$")) (goto-char (+ (match-end 1) 2)) (setq list (cons (cons (+ (point-min) (read (current-buffer))) (match-string-no-properties 1)) list)) - (goto-char (1+ (match-end 0)))) + (goto-char (if backward + (1- (match-beginning 0)) + (1+ (match-end 0))))) ;; Put in forward order (setq list (nreverse list)))) (while list (message "Searching subfile %s..." (cdr (car list))) (Info-read-subfile (car (car list))) + (if backward (goto-char (point-max))) (setq list (cdr list)) (setq give-up nil found nil) (while (and (not give-up) (or (null found) - (isearch-range-invisible beg-found found))) - (if (re-search-forward regexp nil t) - (setq found (point) beg-found (match-beginning 0)) + (if backward + (isearch-range-invisible found beg-found) + (isearch-range-invisible beg-found found)))) + (if (if backward + (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + (setq found (point) beg-found (if backward (match-end 0) + (match-beginning 0))) (setq give-up t))) (if give-up (setq found nil)) @@ -1534,12 +1556,20 @@ If FORK is a string, it is the name to use for the new buffer." (goto-char opoint) (Info-select-node) (set-window-start (selected-window) ostart))))) - (widen) - (goto-char found) - (Info-select-node) + + (if (and (string= osubfile Info-current-subfile) + (> found opoint-min) + (< found opoint-max)) + ;; Search landed in the same node + (goto-char found) + (widen) + (goto-char found) + (save-match-data (Info-select-node))) + ;; Use string-equal, not equal, to ignore text props. (or (and (string-equal onode Info-current-node) (equal ofile Info-current-file)) + (and isearch-mode isearch-wrapped (eq opoint opoint-min)) (setq Info-history (cons (list ofile onode opoint) Info-history)))))) @@ -1556,6 +1586,48 @@ If FORK is a string, it is the name to use for the new buffer." (if Info-search-history (Info-search (car Info-search-history)) (call-interactively 'Info-search)))) + +(defun Info-search-backward (regexp &optional bound noerror count) + "Search for REGEXP in the reverse direction." + (interactive (list (read-string + (if Info-search-history + (format "Regexp search%s backward (default `%s'): " + (if case-fold-search "" " case-sensitively") + (car Info-search-history)) + (format "Regexp search%s backward: " + (if case-fold-search "" " case-sensitively"))) + nil 'Info-search-history))) + (Info-search regexp bound noerror count 'backward)) + +(defun Info-isearch-search () + (cond + (isearch-word + (if isearch-forward 'word-search-forward 'word-search-backward)) + (isearch-regexp + (lambda (regexp bound noerror) + (condition-case nil + (progn + (Info-search regexp bound noerror nil + (unless isearch-forward 'backward)) + (point)) + (error nil)))) + (t + (if isearch-forward 'search-forward 'search-backward)))) + +(defun Info-isearch-wrap () + (if isearch-regexp + (if isearch-forward (Info-top-node) (Info-final-node)) + (goto-char (if isearch-forward (point-min) (point-max))))) + +(defun Info-isearch-push-state () + `(lambda (cmd) + (Info-isearch-pop-state cmd ,Info-current-file ,Info-current-node))) + +(defun Info-isearch-pop-state (cmd file node) + (or (and (string= Info-current-file file) + (string= Info-current-node node)) + (progn (Info-find-node file node) (sit-for 0)))) + (defun Info-extract-pointer (name &optional errorname) "Extract the value of the node-pointer named NAME. @@ -3064,6 +3136,14 @@ Advanced commands: (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) + (set (make-local-variable 'isearch-search-fun-function) + 'Info-isearch-search) + (set (make-local-variable 'isearch-wrap-function) + 'Info-isearch-wrap) + (set (make-local-variable 'isearch-push-state-function) + 'Info-isearch-push-state) + (set (make-local-variable 'search-whitespace-regexp) + Info-search-whitespace-regexp) (Info-set-mode-line) (run-hooks 'Info-mode-hook)) @@ -3445,23 +3525,24 @@ Preserve text properties." other-tag) (when not-fontified-p (when Info-hide-note-references - ;; *Note is often used where *note should have been - (goto-char start) - (skip-syntax-backward " ") - (setq other-tag - (cond ((memq (char-before) '(nil ?\. ?! ??)) - "See ") - ((memq (char-before) '(?\, ?\; ?\: ?-)) - "see ") - ((memq (char-before) '(?\( ?\[ ?\{)) - ;; Check whether the paren is preceded by - ;; an end of sentence - (skip-syntax-backward " (") - (if (memq (char-before) '(nil ?\. ?! ??)) - "See " - "see ")) - ((save-match-data (looking-at "\n\n")) - "See "))) + (when (not (eq Info-hide-note-references 'hide)) + ;; *Note is often used where *note should have been + (goto-char start) + (skip-syntax-backward " ") + (setq other-tag + (cond ((memq (char-before) '(nil ?\. ?! ??)) + "See ") + ((memq (char-before) '(?\, ?\; ?\: ?-)) + "see ") + ((memq (char-before) '(?\( ?\[ ?\{)) + ;; Check whether the paren is preceded by + ;; an end of sentence + (skip-syntax-backward " (") + (if (memq (char-before) '(nil ?\. ?! ??)) + "See " + "see ")) + ((save-match-data (looking-at "\n\n")) + "See ")))) (goto-char next) (add-text-properties (match-beginning 1) @@ -3471,7 +3552,7 @@ Preserve text properties." (if (string-match "\n" (match-string 1)) (+ start1 (match-beginning 0))))) (match-end 1)) - (if (and other-tag (not (eq Info-hide-note-references 'hide))) + (if other-tag `(display ,other-tag front-sticky nil rear-nonsticky t) '(invisible t front-sticky nil rear-nonsticky t)))) (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 @@ ;; keep the behavior. No point in forcing nonincremental search until ;; the last possible moment. -;; TODO -;; - Integrate the emacs 19 generalized command history. -;; - Hooks and options for failed search. - -;;; Change Log: - -;; Changes before those recorded in ChangeLog: - -;; Revision 1.4 92/09/14 16:26:02 liberte -;; Added prefix args to isearch-forward, etc. to switch between -;; string and regular expression searching. -;; Added some support for lemacs. -;; Added general isearch-highlight option - but only for lemacs so far. -;; Added support for frame switching in emacs 19. -;; Added word search option to isearch-edit-string. -;; Renamed isearch-quit to isearch-abort. -;; Numerous changes to comments and doc strings. -;; -;; Revision 1.3 92/06/29 13:10:08 liberte -;; Moved modal isearch-mode handling into isearch-mode. -;; Got rid of buffer-local isearch variables. -;; isearch-edit-string used by ring adjustments, completion, and -;; nonincremental searching. C-s and C-r are additional exit commands. -;; Renamed all regex to regexp. -;; Got rid of found-start and found-point globals. -;; Generalized handling of upper-case chars. - -;; Revision 1.2 92/05/27 11:33:57 liberte -;; Emacs version 19 has a search ring, which is supported here. -;; Other fixes found in the version 19 isearch are included here. -;; -;; Also see variables search-caps-disable-folding, -;; search-nonincremental-instead, search-whitespace-regexp, and -;; commands isearch-toggle-regexp, isearch-edit-string. -;; -;; semi-modal isearching is supported. - -;; Changes for 1.1 -;; 3/18/92 Fixed invalid-regexp. -;; 3/18/92 Fixed yanking in regexps. - ;;; Code: @@ -198,6 +157,15 @@ Ordinarily the text becomes invisible again at the end of the search." (defvar isearch-mode-end-hook nil "Function(s) to call after terminating an incremental search.") +(defvar isearch-wrap-function nil + "Function to call to wrap the search when search is failed. +If nil, move point to the beginning of the buffer for a forward search, +or to the end of the buffer for a backward search.") + +(defvar isearch-push-state-function nil + "Function to save a function restoring the mode-specific isearch state +to the search status stack.") + ;; Search ring. (defvar search-ring nil @@ -772,57 +740,62 @@ REGEXP says which ring to use." ;; The search status structure and stack. -(defsubst isearch-string (frame) +(defsubst isearch-string-state (frame) "Return the search string in FRAME." (aref frame 0)) -(defsubst isearch-message-string (frame) +(defsubst isearch-message-state (frame) "Return the search string to display to the user in FRAME." (aref frame 1)) -(defsubst isearch-point (frame) +(defsubst isearch-point-state (frame) "Return the point in FRAME." (aref frame 2)) -(defsubst isearch-success (frame) +(defsubst isearch-success-state (frame) "Return the success flag in FRAME." (aref frame 3)) -(defsubst isearch-forward-flag (frame) +(defsubst isearch-forward-state (frame) "Return the searching-forward flag in FRAME." (aref frame 4)) -(defsubst isearch-other-end (frame) +(defsubst isearch-other-end-state (frame) "Return the other end of the match in FRAME." (aref frame 5)) -(defsubst isearch-word (frame) +(defsubst isearch-word-state (frame) "Return the search-by-word flag in FRAME." (aref frame 6)) -(defsubst isearch-invalid-regexp (frame) +(defsubst isearch-invalid-regexp-state (frame) "Return the regexp error message in FRAME, or nil if its regexp is valid." (aref frame 7)) -(defsubst isearch-wrapped (frame) +(defsubst isearch-wrapped-state (frame) "Return the search-wrapped flag in FRAME." (aref frame 8)) -(defsubst isearch-barrier (frame) +(defsubst isearch-barrier-state (frame) "Return the barrier value in FRAME." (aref frame 9)) -(defsubst isearch-within-brackets (frame) +(defsubst isearch-within-brackets-state (frame) "Return the in-character-class flag in FRAME." (aref frame 10)) -(defsubst isearch-case-fold-search (frame) +(defsubst isearch-case-fold-search-state (frame) "Return the case-folding flag in FRAME." (aref frame 11)) +(defsubst isearch-pop-fun-state (frame) + "Return the function restoring the mode-specific isearch state in FRAME." + (aref frame 12)) (defun isearch-top-state () (let ((cmd (car isearch-cmds))) - (setq isearch-string (isearch-string cmd) - isearch-message (isearch-message-string cmd) - isearch-success (isearch-success cmd) - isearch-forward (isearch-forward-flag cmd) - isearch-other-end (isearch-other-end cmd) - isearch-word (isearch-word cmd) - isearch-invalid-regexp (isearch-invalid-regexp cmd) - isearch-wrapped (isearch-wrapped cmd) - isearch-barrier (isearch-barrier cmd) - isearch-within-brackets (isearch-within-brackets cmd) - isearch-case-fold-search (isearch-case-fold-search cmd)) - (goto-char (isearch-point cmd)))) + (setq isearch-string (isearch-string-state cmd) + isearch-message (isearch-message-state cmd) + isearch-success (isearch-success-state cmd) + isearch-forward (isearch-forward-state cmd) + isearch-other-end (isearch-other-end-state cmd) + isearch-word (isearch-word-state cmd) + isearch-invalid-regexp (isearch-invalid-regexp-state cmd) + isearch-wrapped (isearch-wrapped-state cmd) + isearch-barrier (isearch-barrier-state cmd) + isearch-within-brackets (isearch-within-brackets-state cmd) + isearch-case-fold-search (isearch-case-fold-search-state cmd)) + (if (functionp (isearch-pop-fun-state cmd)) + (funcall (isearch-pop-fun-state cmd) cmd)) + (goto-char (isearch-point-state cmd)))) (defun isearch-pop-state () (setq isearch-cmds (cdr isearch-cmds)) @@ -834,7 +807,9 @@ REGEXP says which ring to use." isearch-success isearch-forward isearch-other-end isearch-word isearch-invalid-regexp isearch-wrapped isearch-barrier - isearch-within-brackets isearch-case-fold-search) + isearch-within-brackets isearch-case-fold-search + (if isearch-push-state-function + (funcall isearch-push-state-function))) isearch-cmds))) @@ -1020,10 +995,13 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst (defun isearch-cancel () "Terminate the search and go back to the starting point." (interactive) + (if (functionp (isearch-pop-fun-state (car (last isearch-cmds)))) + (funcall (isearch-pop-fun-state (car (last isearch-cmds))) + (car (last isearch-cmds)))) (goto-char isearch-opoint) - (isearch-done t) + (isearch-done t) ; exit isearch (isearch-clean-overlays) - (signal 'quit nil)) ; and pass on quit signal + (signal 'quit nil)) ; and pass on quit signal (defun isearch-abort () "Abort incremental search mode if searching is successful, signaling quit. @@ -1035,11 +1013,9 @@ Use `isearch-exit' to quit without signaling." (if isearch-success ;; If search is successful, move back to starting point ;; and really do quit. - (progn (goto-char isearch-opoint) - (setq isearch-success nil) - (isearch-done t) ; exit isearch - (isearch-clean-overlays) - (signal 'quit nil)) ; and pass on quit signal + (progn + (setq isearch-success nil) + (isearch-cancel)) ;; If search is failing, or has an incomplete regexp, ;; rub out until it is once more successful. (while (or (not isearch-success) isearch-invalid-regexp) @@ -1064,7 +1040,9 @@ Use `isearch-exit' to quit without signaling." ;; If already have what to search for, repeat it. (or isearch-success (progn - (goto-char (if isearch-forward (point-min) (point-max))) + (if isearch-wrap-function + (funcall isearch-wrap-function) + (goto-char (if isearch-forward (point-min) (point-max)))) (setq isearch-wrapped t)))) ;; C-s in reverse or C-r in forward, change direction. (setq isearch-forward (not isearch-forward))) @@ -1106,6 +1084,7 @@ Use `isearch-exit' to quit without signaling." (interactive) (setq isearch-regexp (not isearch-regexp)) (if isearch-regexp (setq isearch-word nil)) + (setq isearch-success t isearch-adjusted t) (isearch-update)) (defun isearch-toggle-case-fold () @@ -1118,34 +1097,39 @@ Use `isearch-exit' to quit without signaling." (isearch-message-prefix nil nil isearch-nonincremental) isearch-message (if isearch-case-fold-search "in" ""))) - (setq isearch-adjusted t) + (setq isearch-success t isearch-adjusted t) (sit-for 1) (isearch-update)) -(defun isearch-query-replace () +(defun isearch-query-replace (&optional regexp-flag) "Start query-replace with string to replace from last search string." (interactive) (barf-if-buffer-read-only) + (if regexp-flag (setq isearch-regexp t)) (let ((case-fold-search isearch-case-fold-search)) (isearch-done) (isearch-clean-overlays) - (and isearch-forward isearch-other-end (goto-char isearch-other-end)) + (if (and (< isearch-other-end (point)) + (not (and transient-mark-mode mark-active + (< isearch-opoint (point))))) + (goto-char isearch-other-end)) + (set query-replace-from-history-variable + (cons isearch-string + (symbol-value query-replace-from-history-variable))) (perform-replace isearch-string - (query-replace-read-to isearch-string "Query replace" isearch-regexp) - t isearch-regexp isearch-word))) + (query-replace-read-to + isearch-string + (if isearch-regexp "Query replace regexp" "Query replace") + isearch-regexp) + t isearch-regexp isearch-word nil nil + (if (and transient-mark-mode mark-active) (region-beginning)) + (if (and transient-mark-mode mark-active) (region-end))))) (defun isearch-query-replace-regexp () "Start query-replace-regexp with string to replace from last search string." (interactive) - (let ((query-replace-interactive t) - (case-fold-search isearch-case-fold-search)) - ;; Put search string into the right ring - (setq isearch-regexp t) - (isearch-done) - (isearch-clean-overlays) - (and isearch-forward isearch-other-end (goto-char isearch-other-end)) - (call-interactively 'query-replace-regexp))) + (isearch-query-replace t)) (defun isearch-delete-char () @@ -1343,7 +1327,7 @@ barrier." ;; We have to check 2 stack frames because the last might be ;; invalid just because of a backslash. (or (not isearch-invalid-regexp) - (not (isearch-invalid-regexp (cadr isearch-cmds))) + (not (isearch-invalid-regexp-state (cadr isearch-cmds))) allow-invalid)) (if to-barrier (progn (goto-char isearch-barrier) @@ -1358,8 +1342,8 @@ barrier." ;; Also skip over postfix operators -- though horrid, ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal. (while (and previous - (or (isearch-invalid-regexp frame) - (let* ((string (isearch-string frame)) + (or (isearch-invalid-regexp-state frame) + (let* ((string (isearch-string-state frame)) (lchar (aref string (1- (length string))))) ;; The operators aren't always operators; check ;; backslashes. This doesn't handle the case of @@ -1367,7 +1351,7 @@ barrier." ;; being special, but then we should fall back to ;; the barrier anyway because it's all optional. (if (isearch-backslash - (isearch-string (car previous))) + (isearch-string-state (car previous))) (eq lchar ?\}) (memq lchar '(?* ?? ?+)))))) (setq stack previous previous (cdr previous) frame (car stack))) @@ -1375,7 +1359,7 @@ barrier." ;; `stack' now refers the most recent valid regexp that is not at ;; all optional in its last term. Now dig one level deeper and find ;; what matched before that. - (let ((last-other-end (or (isearch-other-end (car previous)) + (let ((last-other-end (or (isearch-other-end-state (car previous)) isearch-barrier))) (goto-char (if isearch-forward (max last-other-end isearch-barrier) @@ -1638,8 +1622,7 @@ Isearch mode." (let ((ab-bel (isearch-string-out-of-window isearch-point))) (if ab-bel (isearch-back-into-window (eq ab-bel 'above) isearch-point) - (or (eq (point) isearch-point) - (goto-char isearch-point)))) + (goto-char isearch-point))) (isearch-update)) (search-exit-option (let (window) @@ -1913,7 +1896,9 @@ If there is no completion possible, say so and continue searching." ;; If currently failing, display no ellipsis. (or isearch-success (setq ellipsis nil)) (let ((m (concat (if isearch-success "" "failing ") + (if isearch-adjusted "pending " "") (if (and isearch-wrapped + (not isearch-wrap-function) (if isearch-forward (> (point) isearch-opoint) (< (point) isearch-opoint))) @@ -2008,9 +1993,11 @@ Can be changed via `isearch-search-fun-function' for special needs." (if isearch-success nil ;; Ding if failed this time after succeeding last time. - (and (isearch-success (car isearch-cmds)) + (and (isearch-success-state (car isearch-cmds)) (ding)) - (goto-char (isearch-point (car isearch-cmds))))) + (if (functionp (isearch-pop-fun-state (car isearch-cmds))) + (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds))) + (goto-char (isearch-point-state (car isearch-cmds))))) ;; 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 @@ ;;; macros.el --- non-primitive commands for keyboard macros -;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 87, 92, 94, 95, 04 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev @@ -151,7 +151,7 @@ use this command, and then save the file." (cond ((= char ?\\) (insert "\\\\")) ((= char ?\") - (insert "\\\"")) + (insert "\\\"")) ((= char ?\;) (insert "\\;")) ((= char 127) @@ -240,8 +240,9 @@ Possibilities: \\<query-replace-map> ;;;###autoload (defun apply-macro-to-region-lines (top bottom &optional macro) - "For each complete line between point and mark, move to the beginning -of the line, and run the last keyboard macro. + "Apply last keyboard macro to all lines in the region. +For each line that begins in the region, move to the beginning of +the line, and run the last keyboard macro. When called from lisp, this function takes two arguments TOP and BOTTOM, 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: \\C-x ) and then select the region of un-tablified names and use -`\\[apply-macro-to-region-lines]' to build the table from the names. -" +`\\[apply-macro-to-region-lines]' to build the table from the names." (interactive "r") (or macro (progn @@ -286,10 +286,7 @@ and then select the region of un-tablified names and use (error "No keyboard macro has been defined")) (setq macro last-kbd-macro))) (save-excursion - (let ((end-marker (progn - (goto-char bottom) - (beginning-of-line) - (point-marker))) + (let ((end-marker (copy-marker bottom)) next-line-marker) (goto-char top) (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.") :version "21.4") (defface compilation-info-face - '((((class color) (min-colors 16) (background light)) + '((((class color) (min-colors 16) (background light)) (:foreground "Green3" :weight bold)) - (((class color) (min-colors 16) (background dark)) + (((class color) (min-colors 16) (background dark)) (:foreground "Green" :weight bold)) (((class color)) (:foreground "green" :weight bold)) (t (:weight bold))) @@ -579,12 +579,17 @@ Faces `compilation-error-face', `compilation-warning-face', (and end-line (setq end-line (match-string-no-properties end-line)) (setq end-line (string-to-number end-line))) - (and col - (setq col (match-string-no-properties col)) - (setq col (- (string-to-number col) compilation-first-column))) - (if (and end-col (setq end-col (match-string-no-properties end-col))) - (setq end-col (- (string-to-number end-col) compilation-first-column -1)) - (if end-line (setq end-col -1))) + (if col + (if (functionp col) + (setq col (funcall col)) + (and + (setq col (match-string-no-properties col)) + (setq col (- (string-to-number col) compilation-first-column))))) + (if (and end-col (functionp end-col)) + (setq end-col (funcall end-col)) + (if (and end-col (setq end-col (match-string-no-properties end-col))) + (setq end-col (- (string-to-number end-col) compilation-first-column -1)) + (if end-line (setq end-col -1)))) (if (consp type) ; not a static type, check what it is. (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) @@ -726,9 +731,9 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." ,@(when end-line `((,end-line compilation-line-face nil t))) - ,@(when col + ,@(when (integerp col) `((,col compilation-column-face nil t))) - ,@(when end-col + ,@(when (integerp end-col) `((,end-col compilation-column-face nil t))) ,@(nthcdr 6 item) @@ -789,7 +794,10 @@ If this is run in a Compilation mode buffer, re-use the arguments from the original use. Otherwise, recompile using `compile-command'." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) - (let ((default-directory (or compilation-directory default-directory))) + (let ((default-directory + (or (and (not (eq major-mode (nth 1 compilation-arguments))) + compilation-directory) + default-directory))) (apply 'compilation-start (or compilation-arguments `(,(eval compile-command)))))) @@ -816,8 +824,7 @@ Otherwise, construct a buffer name from MODE-NAME." (funcall name-function mode-name)) (compilation-buffer-name-function (funcall compilation-buffer-name-function mode-name)) - ((and (eq major-mode 'compilation-mode) - (equal mode-name (nth 2 compilation-arguments))) + ((eq major-mode (nth 1 compilation-arguments)) (buffer-name)) (t (concat "*" (downcase mode-name) "*")))) @@ -1522,7 +1529,8 @@ If nil, don't scroll the compilation output window." (defun compilation-goto-locus (msg mk end-mk) "Jump to an error corresponding to MSG at MK. -All arguments are markers. If END-MK is non nil, mark is set there." +All arguments are markers. If END-MK is non-nil, mark is set there +and overlay is highlighted between MK and END-MK." (if (eq (window-buffer (selected-window)) (marker-buffer msg)) ;; 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." (widen) (goto-char mk)) (if end-mk - (push-mark end-mk nil t) + (push-mark end-mk t) (if mark-active (setq mark-active))) ;; If hideshow got in the way of ;; seeing the right place, open permanently. @@ -1559,26 +1567,32 @@ All arguments are markers. If END-MK is non nil, mark is set there." compilation-highlight-regexp))) (compilation-set-window-height w) - (when (and highlight-regexp - (not (and end-mk transient-mark-mode))) + (when highlight-regexp (unless compilation-highlight-overlay (setq compilation-highlight-overlay (make-overlay (point-min) (point-min))) - (overlay-put compilation-highlight-overlay 'face 'region)) + (overlay-put compilation-highlight-overlay 'face 'next-error)) (with-current-buffer (marker-buffer mk) (save-excursion - (end-of-line) + (if end-mk (goto-char end-mk) (end-of-line)) (let ((end (point))) - (beginning-of-line) + (if mk (goto-char mk) (beginning-of-line)) (if (and (stringp highlight-regexp) (re-search-forward highlight-regexp end t)) (progn (goto-char (match-beginning 0)) - (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0))) - (move-overlay compilation-highlight-overlay (point) end)) - (sit-for 0.5) - (delete-overlay compilation-highlight-overlay))))))) - + (move-overlay compilation-highlight-overlay + (match-beginning 0) (match-end 0) + (current-buffer))) + (move-overlay compilation-highlight-overlay + (point) end (current-buffer))) + (if (numberp next-error-highlight) + (sit-for next-error-highlight)) + (if (not (eq next-error-highlight t)) + (delete-overlay compilation-highlight-overlay)))))) + (when (and (eq next-error-highlight 'fringe-arrow)) + (set (make-local-variable 'overlay-arrow-position) + (copy-marker (line-beginning-position)))))) (defun compilation-find-file (marker filename dir &rest formats) "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." (all-completions string (tags-completion-table) predicate) (try-completion string (tags-completion-table) predicate)))) -;; Return a default tag to search for, based on the text at point. -(defun find-tag-default () - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (if (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (progn (goto-char (match-end 0)) - (buffer-substring-no-properties - (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point)))) - nil))) - ;; Read a tag name from the minibuffer with defaulting and completion. (defun find-tag-tag (string) (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." :version "21.4" :group 'grep) +(defcustom grep-highlight-matches t + "*Non-nil to use special markers to highlight grep matches. + +Some grep programs are able to surround matches with special +markers in grep output. Such markers can be used to highlight +matches in grep mode. + +This option sets the environment variable GREP_COLOR to specify +markers for highlighting and GREP_OPTIONS to add the --color +option in front of any explicit grep options before starting +the grep." + :type 'boolean + :version "21.4" + :group 'grep) + (defcustom grep-scroll-output nil "*Non-nil to scroll the *grep* buffer window as output appears. @@ -230,6 +245,23 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies '(("^\\(.+?\\)[:( \t]+\ \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6)) + ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + 1 2 + ((lambda () + (setq compilation-error-screen-columns nil) + (- (match-beginning 5) (match-end 3) 8)) + . + (lambda () (- (match-end 5) (match-end 3) 8))) + nil nil + (4 (list 'face nil 'invisible t 'intangible t)) + (5 (list 'face compilation-column-face)) + (6 (list 'face nil 'invisible t 'intangible t)) + ;; highlight other matches on the same line + ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + nil nil + (1 (list 'face nil 'invisible t 'intangible t)) + (2 (list 'face compilation-column-face) t) + (3 (list 'face nil 'invisible t 'intangible t)))) ("^Binary file \\(.+\\) matches$" 1 nil nil 1)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") @@ -300,6 +332,10 @@ This variable's value takes effect when `grep-compute-defaults' is called.") (defun grep-process-setup () "Setup compilation variables and buffer for `grep'. Set up `compilation-exit-message-function' and run `grep-setup-hook'." + (when grep-highlight-matches + ;; Modify `process-environment' locally bound in `compilation-start' + (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always")) + (setenv "GREP_COLOR" "01;41")) (set (make-local-variable 'compilation-exit-message-function) (lambda (status code msg) (if (eq status 'exit) @@ -384,9 +420,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (let ((tag-default (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - ;; We use grep-tag-default instead of - ;; find-tag-default, to avoid loading etags. - 'grep-tag-default))) + 'find-tag-default))) (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) ;; Replace the thing matching for with that around cursor. @@ -457,25 +491,6 @@ temporarily highlight in visited source lines." (set (make-local-variable 'compilation-error-regexp-alist) grep-regexp-alist)) -;; This is a copy of find-tag-default from etags.el. -;;;###autoload -(defun grep-tag-default () - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (when (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (goto-char (match-end 0)) - (buffer-substring (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point)))))) - ;;;###autoload (defun grep-find (command-args) "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 @@ (setq found buffer))) (setq list (cdr list))) (switch-to-buffer found))) - + ;;; next-error support framework (defvar next-error-last-buffer nil "The most recent next-error buffer. @@ -91,51 +91,50 @@ to navigate in it.") (or (and extra-test (funcall extra-test)) next-error-function))) -;; Return a next-error capable buffer according to the following rules: -;; 1. If the current buffer is a next-error capable buffer, return it. -;; 2. If one window on the selected frame displays such buffer, return it. -;; 3. If next-error-last-buffer is set to a live buffer, use that. -;; 4. Otherwise, look for a next-error capable buffer in a buffer list. -;; 5. Signal an error if there are none. (defun next-error-find-buffer (&optional other-buffer extra-test) - (if (and (not other-buffer) - (next-error-buffer-p (current-buffer) extra-test)) - ;; The current buffer is a next-error capable buffer. - (current-buffer) - (or - (let ((window-buffers - (delete-dups - (delq nil - (mapcar (lambda (w) - (and (next-error-buffer-p (window-buffer w) extra-test) - (window-buffer w))) - (window-list)))))) - (if other-buffer - (setq window-buffers (delq (current-buffer) window-buffers))) - (if (eq (length window-buffers) 1) - (car window-buffers))) - (if (and next-error-last-buffer (buffer-name next-error-last-buffer) - (next-error-buffer-p next-error-last-buffer extra-test) - (or (not other-buffer) (not (eq next-error-last-buffer - (current-buffer))))) - next-error-last-buffer - (let ((buffers (buffer-list))) - (while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test)) - (and other-buffer - (eq (car buffers) (current-buffer))))) - (setq buffers (cdr buffers))) - (if buffers - (car buffers) - (or (and other-buffer - (next-error-buffer-p (current-buffer) extra-test) - ;; The current buffer is a next-error capable buffer. - (progn - (if other-buffer - (message "This is the only next-error capable buffer.")) - (current-buffer))) - (error "No next-error capable buffer found")))))))) - -(defun next-error (arg &optional reset) + "Return a next-error capable buffer." + (or + ;; 1. If one window on the selected frame displays such buffer, return it. + (let ((window-buffers + (delete-dups + (delq nil (mapcar (lambda (w) + (if (next-error-buffer-p + (window-buffer w) extra-test) + (window-buffer w))) + (window-list)))))) + (if other-buffer + (setq window-buffers (delq (current-buffer) window-buffers))) + (if (eq (length window-buffers) 1) + (car window-buffers))) + ;; 2. If next-error-last-buffer is set to a live buffer, use that. + (if (and next-error-last-buffer + (buffer-name next-error-last-buffer) + (next-error-buffer-p next-error-last-buffer extra-test) + (or (not other-buffer) + (not (eq next-error-last-buffer (current-buffer))))) + next-error-last-buffer) + ;; 3. If the current buffer is a next-error capable buffer, return it. + (if (and (not other-buffer) + (next-error-buffer-p (current-buffer) extra-test)) + (current-buffer)) + ;; 4. Look for a next-error capable buffer in a buffer list. + (let ((buffers (buffer-list))) + (while (and buffers + (or (not (next-error-buffer-p (car buffers) extra-test)) + (and other-buffer (eq (car buffers) (current-buffer))))) + (setq buffers (cdr buffers))) + (if buffers + (car buffers) + (or (and other-buffer + (next-error-buffer-p (current-buffer) extra-test) + ;; The current buffer is a next-error capable buffer. + (progn + (if other-buffer + (message "This is the only next-error capable buffer")) + (current-buffer))) + (error "No next-error capable buffer found")))))) + +(defun next-error (&optional arg reset) "Visit next next-error message and corresponding source code. If 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 buffer with output from the \\[compile], \\[grep] commands, or, more generally, on any buffer in Compilation mode or with Compilation Minor mode enabled, or any buffer in which -`next-error-function' is bound to an appropriate -function. To specify use of a particular buffer for error -messages, type \\[next-error] in that buffer. +`next-error-function' is bound to an appropriate function. +To specify use of a particular buffer for error messages, type +\\[next-error] in that buffer when it is the only one displayed +in the current frame. Once \\[next-error] has chosen the buffer for error messages, it stays with that buffer until you use it in some other buffer which @@ -175,7 +175,7 @@ See variables `compilation-parse-errors-function' and (define-key ctl-x-map "`" 'next-error) -(defun previous-error (n) +(defun previous-error (&optional n) "Visit previous next-error message and corresponding source code. Prefix arg N says how many error messages to move backwards (or @@ -183,9 +183,9 @@ forwards, if negative). This operates on the output from the \\[compile] and \\[grep] commands." (interactive "p") - (next-error (- n))) + (next-error (- (or n 1)))) -(defun first-error (n) +(defun first-error (&optional n) "Restart at the first error. Visit corresponding source code. With 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." (interactive "p") (next-error n t)) -(defun next-error-no-select (n) +(defun next-error-no-select (&optional n) "Move point to the next error in the next-error buffer and highlight match. Prefix arg N says how many error messages to move forwards (or backwards, if negative). Finds and highlights the source line like \\[next-error], but does not select the source buffer." (interactive "p") - (next-error n) + (let ((next-error-highlight next-error-highlight-no-select)) + (next-error n)) (pop-to-buffer next-error-last-buffer)) -(defun previous-error-no-select (n) +(defun previous-error-no-select (&optional n) "Move point to the previous error in the next-error buffer and highlight match. Prefix arg N says how many error messages to move backwards (or forwards, if negative). Finds and highlights the source line like \\[previous-error], but does not select the source buffer." (interactive "p") - (next-error-no-select (- n))) + (next-error-no-select (- (or n 1)))) + +(defgroup next-error nil + "next-error support framework." + :group 'compilation + :version "21.4") + +(defface next-error + '((t (:inherit region))) + "Face used to highlight next error locus." + :group 'next-error + :version "21.4") + +(defcustom next-error-highlight 0.1 + "*Highlighting of locations in selected source buffers. +If number, highlight the locus in next-error face for given time in seconds. +If t, use persistent overlays fontified in next-error face. +If nil, don't highlight the locus in the source buffer. +If `fringe-arrow', indicate the locus by the fringe arrow." + :type '(choice (number :tag "Delay") + (const :tag "Persistent overlay" t) + (const :tag "No highlighting" nil) + (const :tag "Fringe arrow" 'fringe-arrow)) + :group 'next-error + :version "21.4") +(defcustom next-error-highlight-no-select 0.1 + "*Highlighting of locations in non-selected source buffers. +If number, highlight the locus in next-error face for given time in seconds. +If t, use persistent overlays fontified in next-error face. +If nil, don't highlight the locus in the source buffer. +If `fringe-arrow', indicate the locus by the fringe arrow." + :type '(choice (number :tag "Delay") + (const :tag "Persistent overlay" t) + (const :tag "No highlighting" nil) + (const :tag "Fringe arrow" 'fringe-arrow)) + :group 'next-error + :version "21.4") + ;;; (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'." ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value (list (default-value 'user-full-name))) - ;; Subprocesses of Emacs do not have direct access to the terminal, - ;; so unless told otherwise they should only assume a dumb terminal. - (setenv "TERM" "dumb") ;; For root, preserve owner and group when editing files. (if (equal (user-uid) 0) (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." (setq parent (get parent 'derived-mode-parent)))) parent)) +(defun find-tag-default () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (save-excursion + (while (looking-at "\\sw\\|\\s_") + (forward-char 1)) + (if (or (re-search-backward "\\sw\\|\\s_" + (save-excursion (beginning-of-line) (point)) + t) + (re-search-forward "\\(\\sw\\|\\s_\\)+" + (save-excursion (end-of-line) (point)) + t)) + (progn (goto-char (match-end 0)) + (buffer-substring-no-properties + (point) + (progn (forward-sexp -1) + (while (looking-at "\\s'") + (forward-char 1)) + (point)))) + nil))) + (defmacro with-syntax-table (table &rest body) "Evaluate BODY with syntax table of current buffer set to TABLE. The 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 @@ (if clipboard (decode-coding-string clipboard selection-coding-system t))))) +;; Don't show the frame name; that's redundant. +(setq-default mode-line-frame-identification " ") + (defun mac-drag-n-drop (event) "Edit the files listed in the drag-n-drop event.\n\ Switch to a buffer editing the last file dropped." @@ -253,6 +256,9 @@ See the documentation of `create-fontset-from-fontset-spec for the format.") ;; Tell read-char how to convert special chars to ASCII (put 'return 'ascii-character 13) +(put 'tab 'ascii-character ?\t) +(put 'backspace 'ascii-character 127) +(put 'escape 'ascii-character ?\e) ;; ;; 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.") "*Lists of start and end keys to skip in HTML buffers. Same format as `ispell-skip-region-alist' Note - substrings of other matches must come last - (e.g. \"<[tT][tT]/\" and \"<[^ \t\n>]\").") + (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") (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." (if no-matches (insert "None!\n")) (if (interactive-p) - (message "%s mismatch%s found" - (if no-matches "No" num-matches) - (if (> num-matches 1) "es" "")))))))) + (message (cond (no-matches "No mismatches found") + ((= num-matches 1) "1 mismatch found") + (t "%d mismatches found")) + num-matches))))))) (defun tex-validate-region (start end) "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'." ) "The functions to call for different protocols when a drop is made. -This variable is used by `x-dnd-handle-uri-list' and `x-dnd-handle-moz-url'. -The list contains of (REGEXP . FUNCTION) pairs. +This variable is used by `x-dnd-handle-uri-list', `x-dnd-handle-file-name' +and `x-dnd-handle-moz-url'. The list contains of (REGEXP . FUNCTION) pairs. The functions shall take two arguments, URL, which is the URL dropped and ACTION which is the action to be performed for the drop (move, copy, link, private or ask). @@ -104,9 +104,7 @@ is successful, nil if not." :type 'boolean :group 'x) -;; Internal variables - -(defvar x-dnd-known-types +(defcustom x-dnd-known-types '("text/uri-list" "text/x-moz-url" "_NETSCAPE_URL" @@ -121,7 +119,12 @@ is successful, nil if not." "TEXT" ) "The types accepted by default for dropped data. -The types are chosen in the order they appear in the list.") +The types are chosen in the order they appear in the list." + :type '(repeat string) + :group 'x +) + +;; Internal variables (defvar x-dnd-current-state nil "The current state for a drop. @@ -865,7 +868,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." timestamp) (x-dnd-forget-drop frame))) - (t (error "Unknown Motif DND message %s %s" message data))))) + (t (error "Unknown Motif DND message %s %s" message-atom data))))) ;;; |