346 lines
11 KiB
Scheme
346 lines
11 KiB
Scheme
#| -*-Scheme-*-
|
||
|
||
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
|
||
1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
|
||
2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
|
||
2017, 2018, 2019, 2020 Massachusetts Institute of Technology
|
||
|
||
This file is part of MIT/GNU Scheme.
|
||
|
||
MIT/GNU Scheme is free software; you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation; either version 2 of the License, or (at
|
||
your option) any later version.
|
||
|
||
MIT/GNU Scheme is distributed in the hope that it will be useful, but
|
||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with MIT/GNU Scheme; if not, write to the Free Software
|
||
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
|
||
USA.
|
||
|
||
|#
|
||
|
||
;;;; Search Commands
|
||
;;; package: (edwin)
|
||
|
||
|
||
|
||
;;;; Variables
|
||
|
||
(define-variable-per-buffer case-fold-search
|
||
"True if searches should ignore case.
|
||
Automatically becomes local when set in any fashion.
|
||
If given a numeric argument, most of the search commands will toggle
|
||
this variable temporarily."
|
||
#t
|
||
boolean?)
|
||
|
||
(define-variable search-last-string
|
||
"Last string search for by a non-regexp search command.
|
||
This does not include direct calls to the primitive search functions,
|
||
and does not include searches that are aborted."
|
||
""
|
||
string?)
|
||
|
||
(define-variable search-last-regexp
|
||
"Last string searched for by a regexp search command.
|
||
This does not include direct calls to the primitive search functions,
|
||
and does not include searches that are aborted."
|
||
""
|
||
string?)
|
||
|
||
(define-variable search-repeat-char
|
||
"Character to repeat incremental search forwards."
|
||
#\C-s
|
||
char?)
|
||
|
||
(define-variable search-reverse-char
|
||
"Character to repeat incremental search backwards."
|
||
#\C-r
|
||
char?)
|
||
|
||
(define-variable search-exit-char
|
||
"Character to exit incremental search."
|
||
#\return
|
||
char?)
|
||
|
||
(define-variable search-delete-char
|
||
"Character to delete from incremental search string."
|
||
#\rubout
|
||
char?)
|
||
|
||
(define-variable search-quote-char
|
||
"Character to quote special characters for incremental search."
|
||
#\C-q
|
||
char?)
|
||
|
||
(define-variable search-yank-word-char
|
||
"Character to pull next word from buffer into search string."
|
||
#\C-w
|
||
char?)
|
||
|
||
(define-variable search-yank-line-char
|
||
"Character to pull rest of line from buffer into search string."
|
||
#\C-y
|
||
char?)
|
||
|
||
(define-variable search-exit-option
|
||
"True means random control characters terminate incremental search."
|
||
#t
|
||
boolean?)
|
||
|
||
(define-variable search-slow-speed
|
||
"Highest terminal speed at which to use \"slow\" style incremental search.
|
||
This is the style where a one-line window is created to show the line
|
||
that the search has reached."
|
||
1200
|
||
exact-nonnegative-integer?)
|
||
|
||
(define-variable search-slow-window-lines
|
||
"Number of lines in slow search display windows.
|
||
These are the short windows used during incremental search on slow terminals.
|
||
Negative means put the slow search window at the top (normally it's at bottom)
|
||
and the value is minus the number of lines."
|
||
1
|
||
exact-integer?)
|
||
|
||
;;;; String Search
|
||
|
||
;;; these should print the numeric-argument when there is one
|
||
(define (search-prompt prompt)
|
||
(lambda ()
|
||
(let ((string
|
||
(prompt-for-string prompt (ref-variable search-last-string))))
|
||
(set-variable! search-last-string string)
|
||
(list (command-argument) string))))
|
||
|
||
(define (re-search-prompt prompt)
|
||
(lambda ()
|
||
(let ((regexp
|
||
(prompt-for-string prompt (ref-variable search-last-regexp))))
|
||
(set-variable! search-last-regexp regexp)
|
||
(list (command-argument) regexp))))
|
||
|
||
(define (search-failure string)
|
||
(editor-error "Search failed: " (write-to-string string)))
|
||
|
||
(define (opposite-case-fold toggle-case-fold? thunk)
|
||
(if toggle-case-fold?
|
||
(with-variable-value! (ref-variable-object case-fold-search)
|
||
(not (ref-variable case-fold-search))
|
||
thunk)
|
||
(thunk)))
|
||
|
||
(define-command search-forward
|
||
"Search forward from point for STRING.
|
||
Set point to the end of the occurrence found."
|
||
(search-prompt "Search")
|
||
(lambda (toggle-case-fold? string)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(let ((point (current-point)))
|
||
(let ((mark (search-forward string point (group-end point))))
|
||
(if (not mark) (search-failure string))
|
||
(set-current-point! mark)))))))
|
||
|
||
(define-command search-backward
|
||
"Search backward from point for STRING.
|
||
Set point to the beginning of the occurrence found."
|
||
(search-prompt "Search backward")
|
||
(lambda (toggle-case-fold? string)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(let ((point (current-point)))
|
||
(let ((mark (search-backward string point (group-start point))))
|
||
(if (not mark) (search-failure string))
|
||
(set-current-point! mark)))))))
|
||
|
||
(define-command re-search-forward
|
||
"Search forward from point for regular expression REGEXP.
|
||
Set point to the end of the occurrence found."
|
||
(re-search-prompt "RE search")
|
||
(lambda (toggle-case-fold? regexp)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(let ((point (current-point)))
|
||
(let ((mark (re-search-forward regexp point (group-end point))))
|
||
(if (not mark) (search-failure regexp))
|
||
(set-current-point! mark)))))))
|
||
|
||
(define-command re-search-backward
|
||
"Search backward from point for regular expression REGEXP.
|
||
Set point to the beginning of the occurrence found.
|
||
The match found is the one starting last in the buffer
|
||
and yet ending before the place of the origin of the search."
|
||
(re-search-prompt "RE search backward")
|
||
(lambda (toggle-case-fold? regexp)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(let ((point (current-point)))
|
||
(let ((mark (re-search-backward regexp point (group-start point))))
|
||
(if (not mark) (search-failure regexp))
|
||
(set-current-point! mark)))))))
|
||
|
||
;;;; Word Search
|
||
|
||
(define-command word-search-forward
|
||
"Search forward from point for STRING, ignoring differences in punctuation.
|
||
Set point to the end of the occurrence found."
|
||
(search-prompt "Word search")
|
||
(lambda (toggle-case-fold? string)
|
||
((ref-command re-search-forward)
|
||
toggle-case-fold?
|
||
(string->wordified-regexp string (ref-variable syntax-table)))))
|
||
|
||
(define-command word-search-backward
|
||
"Search backward from point for STRING, ignoring differences in punctuation.
|
||
Set point to the beginning of the occurrence found."
|
||
(search-prompt "Word search backward")
|
||
(lambda (toggle-case-fold? string)
|
||
((ref-command re-search-backward)
|
||
toggle-case-fold?
|
||
(string->wordified-regexp string (ref-variable syntax-table)))))
|
||
|
||
(define (string->wordified-regexp string syntax-table)
|
||
(apply
|
||
string-append
|
||
(let ((end (string-length string)))
|
||
(let ((index
|
||
(substring-find-next-char-of-syntax string 0 end
|
||
syntax-table #\w)))
|
||
(if index
|
||
(cons "\\b"
|
||
(let loop ((start index))
|
||
(let ((index
|
||
(substring-find-next-char-not-of-syntax
|
||
string start end
|
||
syntax-table #\w)))
|
||
(if index
|
||
(cons (substring string start index)
|
||
(let ((index
|
||
(substring-find-next-char-of-syntax
|
||
string (+ index 1) end
|
||
syntax-table #\w)))
|
||
(if index
|
||
(cons "\\W+" (loop index))
|
||
'("\\b"))))
|
||
(cons (substring string start end) '("\\b"))))))
|
||
'())))))
|
||
|
||
;;;; Incremental Search
|
||
|
||
(define-command isearch-forward
|
||
"Do incremental search forward.
|
||
As you type characters, they add to the search string and are found.
|
||
A numeric argument allows you to toggle case-fold-search but this
|
||
information is lost whenever you exit search, even if you do a C-s C-s.
|
||
Type Delete to cancel characters from end of search string.
|
||
Type RET to exit, leaving point at location found.
|
||
Type C-s to search again forward, C-r to search again backward.
|
||
Type C-w to yank word from buffer onto end of search string and search for it.
|
||
Type C-y to yank rest of line onto end of search string, etc.
|
||
Type C-q to quote control character to search for it.
|
||
Other control and meta characters terminate the search
|
||
and are then executed normally.
|
||
The above special characters are mostly controlled by parameters;
|
||
do M-x variable-apropos on search-.*-char to find them.
|
||
C-g while searching or when search has failed
|
||
cancels input back to what has been found successfully.
|
||
C-g when search is successful aborts and moves point to starting point."
|
||
"P"
|
||
(lambda (toggle-case-fold?)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(isearch #t #f)))))
|
||
|
||
(define-command isearch-forward-regexp
|
||
"Do incremental search forward for regular expression.
|
||
Like ordinary incremental search except that your input
|
||
is treated as a regexp. See \\[isearch-forward] for more info."
|
||
"P"
|
||
(lambda (toggle-case-fold?)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(isearch #t #t)))))
|
||
|
||
(define-command isearch-backward
|
||
"Do incremental search backward.
|
||
See \\[isearch-forward] for more information."
|
||
"P"
|
||
(lambda (toggle-case-fold?)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(isearch #f #f)))))
|
||
|
||
(define-command isearch-backward-regexp
|
||
"Do incremental search backward for regular expression.
|
||
Like ordinary incremental search except that your input
|
||
is treated as a regexp. See \\[isearch-forward] for more info."
|
||
"P"
|
||
(lambda (toggle-case-fold?)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(isearch #f #t)))))
|
||
|
||
;;;; Character Search
|
||
;;; (Courtesy of Jonathan Rees)
|
||
|
||
(define-command char-search-forward
|
||
"Search for a single character.
|
||
Special characters:
|
||
C-a calls \\[search-forward].
|
||
C-r searches backwards for the current default.
|
||
C-s searches forward for the current default.
|
||
C-q quotes the character to be searched for;
|
||
this allows search for special characters."
|
||
"P"
|
||
(lambda (toggle-case-fold?)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(character-search #t)))))
|
||
|
||
(define-command char-search-backward
|
||
"Like \\[char-search-forward], but searches backwards."
|
||
"P"
|
||
(lambda (toggle-case-fold?)
|
||
(opposite-case-fold toggle-case-fold?
|
||
(lambda ()
|
||
(character-search #f)))))
|
||
|
||
(define (character-search forward?)
|
||
(let ((char (prompt-for-char "Character search")))
|
||
(let ((test-for
|
||
(lambda (char*)
|
||
(char=? char (remap-alias-key char*)))))
|
||
(if (test-for #\C-a)
|
||
(dispatch-on-command
|
||
(if forward?
|
||
(ref-command-object search-forward)
|
||
(ref-command-object search-backward)))
|
||
(let ((mark
|
||
(let ((m (current-point)))
|
||
(cond ((test-for #\C-s)
|
||
(search-forward (ref-variable search-last-string)
|
||
m
|
||
(group-end m)))
|
||
((test-for #\C-r)
|
||
(search-backward (ref-variable search-last-string)
|
||
m
|
||
(group-start m)))
|
||
(else
|
||
(let ((char
|
||
(if (test-for #\C-q)
|
||
(prompt-for-char "Quote character")
|
||
char)))
|
||
(if forward?
|
||
(char-search-forward char m (group-end m))
|
||
(char-search-backward char m
|
||
(group-start m)))))))))
|
||
(if mark
|
||
(set-current-point! mark)
|
||
(editor-failure)))))))
|