Article View: comp.emacs
Article #8343clarification: wrapped searches
From: bard
Date: Thu, 19 Jan 1989 20:49
Date: Thu, 19 Jan 1989 20:49
290 lines
12064 bytes
12064 bytes
I'm tired of people flaming whoever that was about misphrasing his/her
question. Here's a variant of isearch which does what [s]he wants, at least
with regexp isearch. Tell me if there are any bugs. The first part of the
file tells what the hacks do.
-- Bard the (function (lambda (x) (gargoyle)))
;; File: mutant-isearch.el
;; Bard Bloom's hacked-up incremental search.
;; Three changes:
;; - isearch-regexp-hack-spaces:
;; This variable allows the space bar to insert a regexp which
;; matches any sequence of blanks, tabs, and line breaks.
;; (in regexp search only)
;; Good for searching for a sentence split across lines, with
;; uncertain spacing. Note: You can use any regexp here.
;; Some people might want to use \W+, which matches non-word
;; characters like punctuation.
;; If you want a real space, use c-q <space>.
;; - isearch-case-fold-search:
;; If true, typing capital letters in the input will disable
;; case folding in the search. That is, searching for "gnu"
;; will get "GNU" and "Gnu", but searching for "Gnu" will only
;; get "Gnu". This is an approximation of what I really want,
;; which is capitals to match only themselves and miniscules to
;; match themselves and their capitals, but what the hey.
;; Actually, for some rather obscure reasons that are hard to fix,
;; it is buggy -- try searching for gNu in this file.
;; - isearch-push-point:
;; If true, and if you have loaded Bard Bloom's "positions"
;; package, then window-undo after an isearch will return
;; you to the beginning of the isearch. If not, then (I
;; think) it won't cause you any trouble.
;; Copyright (C) 1989 Free Software Foundation, Inc.
;; -- if they want it, otherwise copyright Bard Bloom
;; This file is intended by the author to be part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
(defvar isearch-push-point t
"If true, enable a hack for returning to the position of the
start of the isearch. This requires Bard Bloom's positions
package, which has not yet been distributed.")
(defvar isearch-regexp-hack-spaces "[ \t\r\n]+"
"*When this is non-nil, typing a space in regexp-isearch inserts this string
instead. It should be something like [ \\t\\r\\n]+, which matches any sequence of
non-words.")
(defvar isearch-case-fold-search t
"*When this is true, capital letters appearing in the input of isearch
force the case of the match to be exact. Slightly buggy.")
(defun isearch (forward &optional regexp)
"Incremental Search. Incredibly elaborate. "
(if (and isearch-push-point
(fboundp 'stack-save-current-pos))
(stack-save-current-pos))
(let ((search-string "")
(search-message "")
(cmds nil)
(success t)
(wrapped nil)
(barrier (point))
adjusted
(invalid-regexp nil)
(slow-terminal-mode (and (<= (baud-rate) search-slow-speed)
(> (window-height)
(* 4 search-slow-window-lines))))
(other-end nil) ;Start of last match if fwd, end if backwd.
(small-window nil) ;if t, using a small window
(found-point nil) ;to restore point from a small window
;; This is the window-start value found by thE search.
(found-start nil)
(initial-case-fold-search case-fold-search)
(old-case-fold-search case-fold-search)
(case-fold-search case-fold-search)
(opoint (point))
(inhibit-quit t)) ;Prevent ^G from quitting immediately.
(isearch-push-state)
(save-window-excursion
(catch 'search-done
(while t
(if isearch-case-fold-search
(progn
(setq case-fold-search
(if old-case-fold-search
(string= search-string (downcase search-string))
nil))))
(or (>= unread-command-char 0)
(progn
(or (input-pending-p)
(isearch-message))
(if (and slow-terminal-mode
(not (or small-window (pos-visible-in-window-p))))
(progn
(setq small-window t)
(setq found-point (point))
(move-to-window-line 0)
(let ((window-min-height 1))
(split-window nil (if (< search-slow-window-lines 0)
(1+ (- search-slow-window-lines))
(- (window-height)
(1+ search-slow-window-lines)))))
(or (< search-slow-window-lines 0) (other-window 1))
(goto-char found-point)))))
(let ((char (if quit-flag
?\C-g
(read-char))))
(setq quit-flag nil adjusted nil)
;; Meta character means exit search.
(cond ((and (>= char 128)
search-exit-option)
(setq unread-command-char char)
(throw 'search-done t))
((eq char search-exit-char)
;; Esc means exit search normally.
;; Except, if first thing typed, it means do nonincremental
(if (= 0 (length search-string))
(nonincremental-search forward regexp))
(throw 'search-done t))
((= char ?\C-g)
;; ^G means the user tried to quit.
(ding)
(discard-input)
(if success
;; If search is successful, move back to starting point
;; and really do quit.
(progn (goto-char opoint)
(signal 'quit nil))
;; If search is failing, rub out until it is once more
;; successful.
(while (not success) (isearch-pop))))
((or (eq char search-repeat-char)
(eq char search-reverse-char))
(if (eq forward (eq char search-repeat-char))
;; C-s in forward or C-r in reverse.
(if (equal search-string "")
;; If search string is empty, use last one.
(setq search-string
(if regexp
search-last-regexp search-last-string)
search-message
(mapconcat 'text-char-description
search-string ""))
;; If already have what to search for, repeat it.
(or success
(progn (goto-char (if forward (point-min) (point-max)))
(setq wrapped t))))
;; C-s in reverse or C-r in forward, change direction.
(setq forward (not forward)))
(setq barrier (point)) ; For subsequent \| if regexp.
(setq success t)
(or (equal search-string "")
(isearch-search))
(isearch-push-state))
((= char search-delete-char)
;; Rubout means discard last input item and move point
;; back. If buffer is empty, just beep.
(if (null (cdr cmds))
(ding)
(isearch-pop)))
(t
(cond ((or (eq char search-yank-word-char)
(eq char search-yank-line-char))
;; ^W means gobble next word from buffer.
;; ^Y means gobble rest of line from buffer.
(let ((word (save-excursion
(and (not forward) other-end
(goto-char other-end))
(buffer-substring
(point)
(save-excursion
(if (eq char search-yank-line-char)
(end-of-line)
(forward-word 1))
(point))))))
(setq search-string (concat search-string word)
search-message
(concat search-message
(mapconcat 'text-char-description
word "")))))
;; Any other control char =>
;; unread it and exit the search normally.
((and search-exit-option
(/= char search-quote-char)
(or (= char ?\177)
(and (< char ? ) (/= char ?\t) (/= char ?\r))))
(setq unread-command-char char)
(throw 'search-done t))
(t
;; Any other character => add it to the
;; search string and search.
(cond ((= char search-quote-char)
(setq char (read-quoted-char
(isearch-message t))))
((and regexp isearch-regexp-hack-spaces
(= char ? ))
(setq char isearch-regexp-hack-spaces))
((= char ?\r)
;; unix braindeath
(setq char ?\n)))
(setq search-string (concat
search-string
(if (stringp char) char
(char-to-string char)))
search-message (concat
search-message
(if (stringp char)
char
(text-char-description char))))))
(if (and (not success)
;; unsuccessful regexp search may become
;; successful by addition of characters which
;; make search-string valid
(not regexp))
nil
;; If a regexp search may have been made more
;; liberal, retreat the search start.
;; Go back to place last successful search started
;; or to the last ^S/^R (barrier), whichever is nearer.
(and regexp success cmds
(cond ((memq char '(?* ??))
(setq adjusted t)
(let ((cs (nth (if forward
5 ; other-end
3) ; saved (point)
(car (cdr cmds)))))
;; (car cmds) is after last search;
;; (car (cdr cmds)) is from before it.
(setq cs (or cs barrier))
(goto-char
(if forward
(max cs barrier)
(min cs barrier)))))
((eq char ?\|)
(setq adjusted t)
(goto-char barrier))))
;; In reverse regexp search, adding a character at
;; the end may cause zero or many more chars to be
;; matched, in the string following point.
;; Allow all those possibiities without moving point as
;; long as the match does not extend past search origin.
(if (and regexp (not forward) (not adjusted)
(condition-case ()
(looking-at search-string)
(error nil))
(<= (match-end 0) (min opoint barrier)))
(setq success t invalid-regexp nil
other-end (match-end 0))
;; Not regexp, not reverse, or no match at point.
(if (and other-end (not adjusted))
(goto-char (if forward other-end
(min opoint barrier (1+ other-end)))))
(isearch-search)))
(isearch-push-state))))))
(setq found-start (window-start (selected-window)))
(setq found-point (point)))
(if (> (length search-string) 0)
(if regexp
(setq search-last-regexp search-string)
(setq search-last-string search-string)))
;; If there was movement, mark the starting position.
;; Maybe should test difference between and set mark iff > threshold.
(if (/= (point) opoint)
(push-mark opoint)
(message ""))
(if small-window
(goto-char found-point)
;; Exiting the save-window-excursion clobbers this; restore it.
(set-window-start (selected-window) found-start t))))
Technical Details
Message-ID:
<8901192049.AA00203@toucan.LCS.MIT.EDU>Path:
arc1-ca.pugleaf.net!utzoo!attcan!uunet!lll-winken!ncis!helios.ee.lbl.gov!pasteur!agate!bionet!csd4.milw.wisc.edu!bbn!gateway!THEORY.LCS.MIT.EDU!bardReferences:
<1482@tank.uchicago.edu>Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!attcan!uunet!lll-winken!ncis!helios.ee.lbl.gov!pasteur!agate!bionet!csd4.milw.wisc.edu!bbn!gateway!THEORY.LCS.MIT.EDU!bard From: bard@THEORY.LCS.MIT.EDU Newsgroups: comp.emacs Subject: clarification: wrapped searches Message-ID: <8901192049.AA00203@toucan.LCS.MIT.EDU> Date: 19 Jan 89 20:49:58 GMT References: <1482@tank.uchicago.edu> Sender: news@bbn.COM Organization: BBN news/mail gateway Lines: 290