🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.emacs
Article #8343

clarification: wrapped searches

#8343
From: bard
Date: Thu, 19 Jan 1989 20:49
290 lines
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!bard
References: <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