Mercurial > emacs
diff lisp/isearch.el @ 89909:68c22ea6027c
Sync to HEAD
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Fri, 16 Apr 2004 12:51:06 +0000 |
parents | 2f877ed80fa6 |
children | 4c90ffeb71c5 |
line wrap: on
line diff
--- a/lisp/isearch.el Thu Apr 15 01:08:34 2004 +0000 +++ b/lisp/isearch.el Fri Apr 16 12:51:06 2004 +0000 @@ -1,6 +1,6 @@ ;;; isearch.el --- incremental search minor mode -;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1999, 2000, 01, 2003 +;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1999, 2000, 01, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu> @@ -236,10 +236,10 @@ (or (char-table-p (nth 1 map)) (error "The initialization of isearch-mode-map must be updated")) ;; Make all multibyte characters search for themselves. - ;; Fixme: is this range right? - (set-char-table-range (nth 1 map) (cons #x100 #x3FFFFF) + (set-char-table-range (nth 1 map) (cons #x100 (max-char)) 'isearch-printing-char) - ;; Make function keys, etc, exit the search. + ;; Make function keys, etc, which aren't bound to a scrolling-function + ;; exit the search. (define-key map [t] 'isearch-other-control-char) ;; Control chars, by default, end isearch mode transparently. ;; We need these explicit definitions because, in a dense keymap, @@ -297,6 +297,7 @@ ;; Nothing special for + because it matches at least once. (define-key map "*" 'isearch-*-char) (define-key map "?" 'isearch-*-char) + (define-key map "{" 'isearch-{-char) (define-key map "|" 'isearch-|-char) ;; Turned off because I find I expect to get the global definition--rms. @@ -1182,21 +1183,30 @@ (isearch-update)) +(defun isearch-{-char () + "Handle \{ specially in regexps." + (interactive) + (isearch-*-char t)) + ;; *, ?, and | chars can make a regexp more liberal. ;; They can make a regexp match sooner or make it succeed instead of failing. ;; So go back to place last successful search started ;; or to the last ^S/^R (barrier), whichever is nearer. ;; + needs no special handling because the string must match at least once. -(defun isearch-*-char () - "Handle * and ? specially in regexps." +(defun isearch-*-char (&optional want-backslash) + "Handle * and ? specially in regexps. +When WANT-BACKSLASH is non-nil, do special handling for \{." (interactive) (if isearch-regexp (let ((idx (length isearch-string))) (while (and (> idx 0) (eq (aref isearch-string (1- idx)) ?\\)) (setq idx (1- idx))) - (when (= (mod (- (length isearch-string) idx) 2) 0) + ;; * and ? are special when not preceded by \. + ;; { is special when it is preceded by \. + (when (= (mod (- (length isearch-string) idx) 2) + (if want-backslash 1 0)) (setq isearch-adjusted t) ;; Get the isearch-other-end from before the last search. ;; We want to start from there, @@ -1221,18 +1231,176 @@ (goto-char isearch-barrier))) (isearch-process-search-char last-command-char)) +(defun isearch-unread-key-sequence (keylist) + "Unread the given key-sequence KEYLIST. +Scroll-bar or mode-line events are processed appropriately." + (cancel-kbd-macro-events) + (apply 'isearch-unread keylist) + ;; If the event was a scroll-bar or mode-line click, the event will have + ;; been prefixed by a symbol such as vertical-scroll-bar. We must remove + ;; it here, because this symbol will be attached to the event again next + ;; time it gets read by read-key-sequence. + ;; + ;; (Old comment from isearch-other-meta-char: "Note that we don't have to + ;; modify the event anymore in 21 because read_key_sequence no longer + ;; modifies events to produce fake prefix keys.") + (if (and (> (length keylist) 1) + (symbolp (car keylist)) + (listp (cadr keylist)) + (not (numberp (posn-point + (event-start (cadr keylist) ))))) + (pop unread-command-events))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; scrolling within Isearch mode. Alan Mackenzie (acm@muc.de), 2003/2/24 +;; +;; The idea here is that certain vertical scrolling commands (like C-l +;; `recenter') should be usable WITHIN Isearch mode. For a command to be +;; suitable, it must NOT alter the buffer, swap to another buffer or frame, +;; tamper with isearch's state, or move point. It is unacceptable for the +;; search string to be scrolled out of the current window. If a command +;; attempts this, we scroll the text back again. +;; +;; We implement this feature with a property called `isearch-scroll'. +;; If a command's symbol has the value t for this property it is a +;; scrolling command. The feature needs to be enabled by setting the +;; customizable variable `isearch-allow-scroll' to a non-nil value. +;; +;; The universal argument commands (e.g. C-u) in simple.el are marked +;; as scrolling commands, and isearch.el has been amended to allow +;; prefix arguments to be passed through to scrolling commands. Thus +;; M-0 C-l will scroll point to the top of the window. +;; +;; Horizontal scrolling commands are currently not catered for. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Set the isearch-scroll property on some standard functions: +;; Scroll-bar functions: +(if (fboundp 'scroll-bar-toolkit-scroll) + (put 'scroll-bar-toolkit-scroll 'isearch-scroll t)) +(if (fboundp 'mac-handle-scroll-bar-event) + (put 'mac-handle-scroll-bar-event 'isearch-scroll t)) +(if (fboundp 'w32-handle-scroll-bar-event) + (put 'w32-handle-scroll-bar-event 'isearch-scroll t)) + +;; Commands which scroll the window: +(put 'recenter 'isearch-scroll t) +(put 'reposition-window 'isearch-scroll t) +(put 'scroll-up 'isearch-scroll t) +(put 'scroll-down 'isearch-scroll t) + +;; Commands which act on the other window +(put 'list-buffers 'isearch-scroll t) +(put 'scroll-other-window 'isearch-scroll t) +(put 'scroll-other-window-down 'isearch-scroll t) +(put 'beginning-of-buffer-other-window 'isearch-scroll t) +(put 'end-of-buffer-other-window 'isearch-scroll t) + +;; Commands which change the window layout +(put 'delete-other-windows 'isearch-scroll t) +(put 'balance-windows 'isearch-scroll t) +(put 'split-window-vertically 'isearch-scroll t) +(put 'enlarge-window 'isearch-scroll t) + +;; Universal argument commands +(put 'universal-argument 'isearch-scroll t) +(put 'negative-argument 'isearch-scroll t) +(put 'digit-argument 'isearch-scroll t) + +(defcustom isearch-allow-scroll nil + "If non-nil, scrolling commands are allowed during incremental search." + :type 'boolean + :group 'isearch) + +(defun isearch-string-out-of-window (isearch-point) + "Test whether the search string is currently outside of the window. +Return nil if it's completely visible, or if point is visible, +together with as much of the search string as will fit; the symbol +`above' if we need to scroll the text downwards; the symbol `below', +if upwards." + (let ((w-start (window-start)) + (w-end (window-end nil t)) + (w-L1 (save-excursion (move-to-window-line 1) (point))) + (w-L-1 (save-excursion (move-to-window-line -1) (point))) + start end) ; start and end of search string in buffer + (if isearch-forward + (setq end isearch-point start (or isearch-other-end isearch-point)) + (setq start isearch-point end (or isearch-other-end isearch-point))) + (cond ((or (and (>= start w-start) (<= end w-end)) + (if isearch-forward + (and (>= isearch-point w-L-1) (< isearch-point w-end)) ; point on Line -1 + (and (>= isearch-point w-start) (< isearch-point w-L1)))) ; point on Line 0 + nil) + ((and (< start w-start) + (< isearch-point w-L-1)) + 'above) + (t 'below)))) + +(defun isearch-back-into-window (above isearch-point) + "Scroll the window to bring the search string back into view. +Restore point to ISEARCH-POINT in the process. ABOVE is t when the +search string is above the top of the window, nil when it is beneath +the bottom." + (let (start end) + (if isearch-forward + (setq end isearch-point start (or isearch-other-end isearch-point)) + (setq start isearch-point end (or isearch-other-end isearch-point))) + (if above + (progn + (goto-char start) + (recenter 0) + (when (>= isearch-point (window-end nil t)) + (goto-char isearch-point) + (recenter -1))) + (goto-char end) + (recenter -1) + (when (< isearch-point (window-start)) + (goto-char isearch-point) + (recenter 0)))) + (goto-char isearch-point)) + +(defun isearch-reread-key-sequence-naturally (keylist) + "Reread key sequence KEYLIST with Isearch mode's keymap deactivated. +Return the key sequence as a string/vector." + (isearch-unread-key-sequence keylist) + (let (overriding-terminal-local-map) + (read-key-sequence nil))) ; This will go through function-key-map, if nec. + +(defun isearch-lookup-scroll-key (key-seq) + "If KEY-SEQ is bound to a scrolling command, return it as a symbol. +Otherwise return nil." + (let* ((overriding-terminal-local-map nil) + (binding (key-binding key-seq))) + (and binding (symbolp binding) (commandp binding) + (eq (get binding 'isearch-scroll) t) + binding))) (defalias 'isearch-other-control-char 'isearch-other-meta-char) -(defun isearch-other-meta-char () - "Exit the search normally and reread this key sequence. -But only if `search-exit-option' is non-nil, the default. -If it is the symbol `edit', the search string is edited in the minibuffer -and the meta character is unread so that it applies to editing the string." - (interactive) - (let* ((key (this-command-keys)) +(defun isearch-other-meta-char (&optional arg) + "Process a miscellaneous key sequence in Isearch mode. + +Try to convert the current key-sequence to something usable in Isearch +mode, either by converting it with `function-key-map', downcasing a +key with C-<upper case>, or finding a \"scrolling command\" bound to +it. \(In the last case, we may have to read more events.) If so, +either unread the converted sequence or execute the command. + +Otherwise, if `search-exit-option' is non-nil (the default) unread the +key-sequence and exit the search normally. If it is the symbol +`edit', the search string is edited in the minibuffer and the meta +character is unread so that it applies to editing the string. + +ARG is the prefix argument. It will be transmitted through to the +scrolling command or to the command whose key-sequence exits +Isearch mode." + (interactive "P") + (let* ((key (if current-prefix-arg ; not nec the same as ARG + (substring (this-command-keys) universal-argument-num-events) + (this-command-keys))) (main-event (aref key 0)) - (keylist (listify-key-sequence key))) + (keylist (listify-key-sequence key)) + scroll-command isearch-point) (cond ((and (= (length key) 1) (let ((lookup (lookup-key function-key-map key))) (not (or (null lookup) (integerp lookup) @@ -1284,23 +1452,27 @@ ((eq search-exit-option 'edit) (apply 'isearch-unread keylist) (isearch-edit-string)) + ;; Handle a scrolling function. + ((and isearch-allow-scroll + (progn (setq key (isearch-reread-key-sequence-naturally keylist)) + (setq keylist (listify-key-sequence key)) + (setq main-event (aref key 0)) + (setq scroll-command (isearch-lookup-scroll-key key)))) + ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a + ;; complete key sequence, possibly as modified by function-key-map, + ;; not merely the one or two event fragment which invoked + ;; isearch-other-meta-char in the first place. + (setq isearch-point (point)) + (setq prefix-arg arg) + (command-execute scroll-command) + (let ((ab-bel (isearch-string-out-of-window isearch-point))) + (if ab-bel + (isearch-back-into-window (eq ab-bel 'above) isearch-point))) + (isearch-update)) (search-exit-option (let (window) - (cancel-kbd-macro-events) - (apply 'isearch-unread keylist) - - ;; Properly handle scroll-bar and mode-line clicks for - ;; which a dummy prefix event was generated as (aref key - ;; 0). Note that we don't have to modify the event - ;; anymore in 21 because read_key_sequence no longer modifies - ;; events to produce fake prefix keys. - (when (and (> (length key) 1) - (symbolp (aref key 0)) - (listp (aref key 1)) - (not (numberp (posn-point - (event-start (aref key 1)))))) - (pop unread-command-events) - (setq main-event (car unread-command-events))) + (isearch-unread-key-sequence keylist) + (setq main-event (car unread-command-events)) ;; If we got a mouse click event, that event contains the ;; window clicked on. maybe it was read with the buffer @@ -1330,8 +1502,9 @@ (isearch-done) (isearch-clean-overlays)) (isearch-done) - (isearch-clean-overlays)))) - (t;; otherwise nil + (isearch-clean-overlays) + (setq prefix-arg arg)))) + (t;; otherwise nil (isearch-process-search-string key key))))) (defun isearch-quote-char () @@ -1961,26 +2134,30 @@ :group 'isearch) (defface isearch - '((((type tty pc) (class color)) - (:background "magenta4" :foreground "cyan1")) - (((class color) (background light)) + '((((class color) (min-colors 88) (background light)) ;; The background must not be too dark, for that means ;; the character is hard to see when the cursor is there. (:background "magenta2" :foreground "lightskyblue1")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "palevioletred2" :foreground "brown4")) + (((class color) (min-colors 16)) + (:background "magenta4" :foreground "cyan1")) + (((class color) (min-colors 8)) + (:background "magenta4" :foreground "cyan1")) (t (:inverse-video t))) "Face for highlighting Isearch matches." :group 'isearch-faces) (defvar isearch 'isearch) (defface isearch-lazy-highlight-face - '((((type tty pc) (class color)) + '((((class color) (min-colors 88) (background light)) + (:background "paleturquoise")) + (((class color) (min-colors 88) (background dark)) + (:background "paleturquoise4")) + (((class color) (min-colors 16)) (:background "turquoise3")) - (((class color) (background light)) - (:background "paleturquoise")) - (((class color) (background dark)) - (:background "paleturquoise4")) + (((class color) (min-colors 8)) + (:background "turquoise3")) (t (:underline t))) "Face for lazy highlighting of Isearch matches other than the current one." :group 'isearch-faces) @@ -1994,6 +2171,7 @@ (defvar isearch-lazy-highlight-last-string nil) (defvar isearch-lazy-highlight-window nil) (defvar isearch-lazy-highlight-window-start nil) +(defvar isearch-lazy-highlight-window-end nil) (defvar isearch-lazy-highlight-case-fold-search nil) (defvar isearch-lazy-highlight-regexp nil) @@ -2028,12 +2206,15 @@ (not (eq isearch-lazy-highlight-regexp isearch-regexp)) (not (= (window-start) - isearch-lazy-highlight-window-start)))) + isearch-lazy-highlight-window-start)) + (not (= (window-end) ; Window may have been split/joined. + isearch-lazy-highlight-window-end)))) ;; something important did indeed change (isearch-lazy-highlight-cleanup t) ;kill old loop & remove overlays (when (not isearch-invalid-regexp) (setq isearch-lazy-highlight-window (selected-window) isearch-lazy-highlight-window-start (window-start) + isearch-lazy-highlight-window-end (window-end) isearch-lazy-highlight-start (point) isearch-lazy-highlight-end (point) isearch-lazy-highlight-last-string isearch-string @@ -2121,4 +2302,5 @@ isearch-case-fold-search case-fold) (isearch-search)) +;;; arch-tag: 74850515-f7d8-43a6-8a2c-ca90a4c1e675 ;;; isearch.el ends here