;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.96 1991/04/21 00:50:30 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.97 1991/04/23 06:45:42 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(lambda ()
(backward-one-page end)))))
(if start
- (with-variable-value! (ref-variable-object case-fold-search) true
- (lambda ()
- (if (re-search-forward "Edwin Variables:[ \t]*" start)
- (parse-local-variables buffer
- (re-match-start 0)
- (re-match-end 0))))))))))
+ (if (re-search-forward "Edwin Variables:[ \t]*" start end true)
+ (parse-local-variables buffer
+ (re-match-start 0)
+ (re-match-end 0))))))))
(define (evaluate sexp)
(scode-eval (syntax sexp system-global-syntax-table)
(let ((m1
(horizontal-space-end
(if prefix?
- (or (match-forward prefix start)
+ (or (match-forward prefix start end false)
(editor-error
"Local variables entry is missing the prefix"))
start))))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.96 1991/04/21 00:50:46 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.97 1991/04/23 06:39:19 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(set-current-major-mode! (ref-mode-object fundamental))
(disable-buffer-auto-save! buffer)
(let ((mark
- (line-start (search-forward "\n<<" (buffer-start buffer))
+ (line-start (search-forward "\n<<"
+ (buffer-start buffer)
+ (buffer-end buffer))
0)))
(delete-string (line-end mark -1) (line-end mark 0))
(insert-newlines (- (window-y-size (current-window))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.99 1991/04/21 00:50:55 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.100 1991/04/23 06:39:49 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(lambda (start)
(without-group-clipped! (buffer-group buffer)
(lambda ()
- (re-search-forward regexp start)))))
+ (re-search-forward regexp start (group-end start))))))
(win
(lambda (mark)
(buffer-widen! buffer)
(nth-menu-item 4))
\f
(define (find-menu)
- (search-forward "\n* menu:" (buffer-start (current-buffer))))
+ (let ((buffer (current-buffer)))
+ (search-forward "\n* menu:"
+ (buffer-start buffer)
+ (buffer-end buffer)
+ true)))
(define (collect-menu-items mark)
(let ((item (next-menu-item mark)))
(collect-menu-items item)))))
(define (next-menu-item mark)
- (re-search-forward "\n\\*[ \t]+" (line-end mark 0)))
+ (re-search-forward "\n\\*[ \t]+"
+ (line-end mark 0)
+ (group-end mark)
+ false))
(define (menu-item-keyword item)
- (let ((end (char-search-forward #\: item (line-end item 0))))
+ (let ((end (char-search-forward #\: item (line-end item 0) false)))
(if (not end)
(error "Menu item missing colon"))
(extract-string item (mark-1+ end))))
(define (menu-item-name item)
- (let ((colon (char-search-forward #\: item (line-end item 0))))
+ (let ((colon (char-search-forward #\: item (line-end item 0) false)))
(if (not colon)
(error "Menu item missing colon."))
(if (match-forward "::" (mark-1+ colon))
(error "Menu item missing node name"))
(extract-string start
(let ((end (line-end start 0)))
- (if (re-search-forward "[.,\t]" start end)
+ (if (re-search-forward "[.,\t]" start end false)
(re-match-start 0)
end))))
\f
(collect-cref-items item)))))
(define (next-cref-item start)
- (re-search-forward "\\*Note[ \t\n]*" start))
+ (re-search-forward "\\*Note[ \t\n]*" start (group-end start) true))
(define (cref-item-keyword item)
- (let ((colon (char-search-forward #\: item (group-end item))))
+ (let ((colon (char-search-forward #\: item (group-end item) false)))
(if (not colon)
(error "Cross reference missing colon."))
(%cref-item-keyword item (mark-1+ colon))))
(string-trim string)))
(define (cref-item-name item)
- (let ((colon (char-search-forward #\: item (group-end item))))
+ (let ((colon (char-search-forward #\: item (group-end item) false)))
(if (not colon)
(error "Cross reference missing colon."))
(if (match-forward "::" (mark-1+ colon))
(ref-variable info-history))))
(define (node-start start end)
- (line-start (search-backward "\n\1f" start end 'ERROR) 2 'ERROR))
+ (line-start (or (search-backward "\n\1f" start end false)
+ (editor-error))
+ 2
+ 'ERROR))
(define (node-region node)
(make-region node (node-end node)))
(define (node-end node)
(let ((end (group-end node)))
(let loop ((start node))
- (let ((mark (re-search-forward "[\f\1f]" start)))
+ (let ((mark (re-search-forward "[\f\1f]" start end false)))
(cond ((not mark) end)
((char=? (extract-left-char (re-match-start 0)) #\newline)
(mark-1+ (re-match-start 0)))
(else (loop mark)))))))
(define (next-node start end)
- (let ((mark (search-forward "\n\1f" start end)))
+ (let ((mark (search-forward "\n\1f" start end false)))
(and mark
(line-start mark 1))))
(define ((field-value-extractor field) node)
(let ((end (line-end node 0)))
- (let ((mark (re-search-forward field node end)))
+ (let ((mark (re-search-forward field node end true)))
(and mark
(string-trim
(extract-string mark
(define (extract-tag-entry node)
(let ((end (line-end node 0)))
- (let ((mark (search-forward "Node:" node end)))
+ (let ((mark (search-forward "Node:" node end true)))
(and mark
(string-trim
(extract-string node
(mark (line-start end -8))
(tag-table-end
(and mark
- (search-forward tag-table-end-string mark)
+ (search-forward tag-table-end-string mark end true)
(re-match-start 0)))
(tag-table-start
(and tag-table-end
(search-backward tag-table-start-string
- tag-table-end)
+ tag-table-end
+ (buffer-start buffer)
+ true)
(re-match-end 0))))
(if (and tag-table-end (not tag-table-start))
(begin
(let ((mark
(or (search-forward (string-append "Node: " nodename "\177")
(ref-variable info-tag-table-start)
- (ref-variable info-tag-table-end))
+ (ref-variable info-tag-table-end)
+ true)
(editor-error "No such node: " nodename))))
;; Force order of events, since read-subfile has side-effect.
(let ((index
(+ (- index (subfile-index (car subfiles)))
(mark-index
(let ((buffer (current-buffer)))
- (search-forward "\n\1f"
- (buffer-start buffer)
- (buffer-end buffer)
- 'ERROR)))))
+ (or (search-forward "\n\1f"
+ (buffer-start buffer)
+ (buffer-end buffer)
+ false)
+ (editor-error))))))
(loop (cdr subfiles)))))
(define (set-current-subfile! pathname)
(define (subfile-list)
(let ((result
- (let loop ((start
- (let ((start (ref-variable info-tag-table-start)))
- (search-forward "\n\1f\nIndirect:\n"
- (group-start start)
- start
- 'ERROR))))
+ (let loop
+ ((start
+ (let ((start (ref-variable info-tag-table-start)))
+ (or (search-forward "\n\1f\nIndirect:\n"
+ (group-start start)
+ start
+ true)
+ (editor-error)))))
(if (match-forward "\1f" start)
'()
(begin
- (search-forward ": " start (group-end start) 'ERROR)
+ (if (not (search-forward ": " start (group-end start) false))
+ (editor-error))
(let* ((colon (re-match-start 0))
(index (read-index-from-mark (re-match-end 0))))
(cons (cons (extract-string start colon) index)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/iserch.scm,v 1.11 1991/03/22 00:32:01 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/iserch.scm,v 1.12 1991/04/23 06:40:24 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(with-editor-interrupts-enabled
(lambda ()
(if forward?
- (if regexp?
- (re-search-forward text start)
- (search-forward text start))
- (if regexp?
- (re-search-backward text start)
- (search-backward text start))))))))))))
\ No newline at end of file
+ (let ((end (group-end start)))
+ (if regexp?
+ (re-search-forward text start end)
+ (search-forward text start end)))
+ (let ((end (group-start start)))
+ (if regexp?
+ (re-search-backward text start end)
+ (search-backward text start end)))))))))))))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/lincom.scm,v 1.108 1991/04/21 00:51:10 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/lincom.scm,v 1.109 1991/04/23 06:41:30 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
moves down one line first (killing newline after current line)."
"P"
(lambda (argument)
- (set-current-point!
- (horizontal-space-start
- (line-end (current-point) (if (not argument) -1 0) 'ERROR)))
- (let ((point (current-point)))
- (region-delete! (make-region point (line-start point 1 'ERROR)))
- (if (ref-variable fill-prefix)
- (let ((match (match-forward (ref-variable fill-prefix))))
- (if match (delete-string match))))
- (delete-horizontal-space)
+ (let ((point
+ (mark-left-inserting-copy
+ (horizontal-space-start
+ (line-end (current-point) (if (not argument) -1 0) 'ERROR))))
+ (fill-prefix (ref-variable fill-prefix)))
+ (delete-string point (line-start point 1 'ERROR))
+ (if fill-prefix
+ (let ((m
+ (match-forward fill-prefix point (line-end point 0) false)))
+ (if m
+ (delete-string point m))))
+ (delete-horizontal-space point)
(if (or (line-start? point)
(line-end? point)
(not (or (char-set-member?
(char-set-member?
(ref-variable delete-indentation-left-protected)
(mark-right-char point)))))
- (insert-chars #\Space 1)))))
+ (insert-char #\space point))
+ (mark-temporary! point)
+ (set-current-point! point))))
(define-variable delete-indentation-right-protected
"\\[delete-indentation] won't insert a space to the right of these."
(define (tabify-region start end)
(let ((start (mark-left-inserting-copy start))
(end (mark-left-inserting-copy end))
- (pattern (re-compile-pattern "[ \t][ \t]+" false))
(tab-width (group-tab-width (mark-group start))))
(do ()
- ((not (re-search-buffer-forward pattern false false
- (mark-group start)
- (mark-index start)
- (mark-index end))))
+ ((not (re-search-forward "[ \t][ \t]+" start end false)))
(move-mark-to! start (re-match-start 0))
(let ((end-column (mark-column (re-match-end 0))))
(delete-string start (re-match-end 0))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/replaz.scm,v 1.65 1989/04/28 22:52:40 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/replaz.scm,v 1.66 1991/04/23 06:42:12 cph Exp $
;;;
-;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
;;; Massachusetts Institute of Technology, Department of
(old-notification (ref-variable auto-push-point-notification)))
(define (find-next-occurrence start receiver)
- (if (if replace-words-only?
- (re-search-forward (force words-only-source) start)
- (search-forward source start))
+ (if (let ((end (group-end start)))
+ (if replace-words-only?
+ (re-search-forward (force words-only-source) start end)
+ (search-forward source start end)))
(receiver (re-match-start 0) (re-match-end 0))
- (begin (if clear-on-exit? (clear-message))
- false)))
+ (begin
+ (if clear-on-exit? (clear-message))
+ false)))
(define (query-loop start end)
(undo-boundary! end)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sercom.scm,v 1.56 1991/04/21 00:52:01 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sercom.scm,v 1.57 1991/04/23 06:43:29 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
;;;; Variables
(define-variable-per-buffer case-fold-search
- "*True if searches should ignore case.
+ "True if searches should ignore case.
Automatically becomes local when set in any fashion."
- true)
+ true
+ 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)
+ "Character to repeat incremental search forwards."
+ #\C-s
+ char?)
(define-variable search-reverse-char
- "*Character to repeat incremental search backwards."
- #\C-r)
+ "Character to repeat incremental search backwards."
+ #\C-r
+ char?)
(define-variable search-exit-char
- "*Character to exit incremental search."
- #\altmode)
+ "Character to exit incremental search."
+ #\altmode
+ char?)
(define-variable search-delete-char
- "*Character to delete from incremental search string."
- #\rubout)
+ "Character to delete from incremental search string."
+ #\rubout
+ char?)
(define-variable search-quote-char
- "*Character to quote special characters for incremental search."
- #\C-q)
+ "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)
+ "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)
+ "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."
- true)
+ "True means random control characters terminate incremental search."
+ true
+ boolean?)
(define-variable search-slow-speed
- "*Highest terminal speed at which to use \"slow\" style incremental search.
+ "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)
+ 1200
+ exact-nonnegative-integer?)
(define-variable search-slow-window-lines
- "*Number of lines in slow search display windows.
+ "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)
+ 1
+ exact-integer?)
\f
;;;; String Search
(set-variable! search-last-regexp regexp)
(list regexp))))
-(define (search-command procedure pattern)
- (let ((mark (procedure pattern)))
- (if mark
- (begin
- (push-current-mark! (current-point))
- (set-current-point! mark))
- (editor-failure))))
-
(define-command search-forward
"Search forward from point for a character string.
Sets point at the end of the occurrence found."
(search-prompt "Search")
(lambda (string)
- (search-command search-forward string)))
+ (let ((point (current-point)))
+ (let ((mark (search-forward string point (group-end point))))
+ (if mark
+ (begin
+ (push-current-mark! point)
+ (set-current-point! mark))
+ (editor-failure))))))
(define-command search-backward
"Search backward from point for a character string.
Sets point at the beginning of the occurrence found."
(search-prompt "Search backward")
(lambda (string)
- (search-command search-backward string)))
+ (let ((point (current-point)))
+ (let ((mark (search-backward string point (group-start point))))
+ (if mark
+ (begin
+ (push-current-mark! point)
+ (set-current-point! mark))
+ (editor-failure))))))
(define-command re-search-forward
"Search forward from point for a regular expression.
Sets point at the end of the occurrence found."
(search-prompt "RE search")
(lambda (regexp)
- (search-command re-search-forward regexp)))
+ (let ((point (current-point)))
+ (let ((mark (re-search-forward regexp point (group-end point))))
+ (if mark
+ (begin
+ (push-current-mark! point)
+ (set-current-point! mark))
+ (editor-failure))))))
(define-command re-search-backward
"Search backward from point for a character string.
Sets point at the beginning of the occurrence found."
(search-prompt "RE search backward")
(lambda (regexp)
- (search-command re-search-backward regexp)))
+ (let ((point (current-point)))
+ (let ((mark (re-search-backward regexp point (group-start point))))
+ (if mark
+ (begin
+ (push-current-mark! point)
+ (set-current-point! mark))
+ (editor-failure))))))
\f
;;;; Incremental Search
(character-search false)))
(define (character-search forward?)
- (define (char-search char)
- (search-finish
- (let ((point (current-point)))
- (if forward?
- (char-search-forward char point (group-end point))
- (char-search-backward char point (group-start point))))))
-
- (define (string-search operator)
- (search-finish (operator (ref-variable search-last-string))))
-
- (define (search-finish mark)
- (if mark
- (set-current-point! mark)
- (editor-failure)))
-
(let ((char (prompt-for-char "Character search")))
(let ((test-for
(lambda (char*)
(char=? char (remap-alias-char char*)))))
- (cond ((test-for #\C-a)
- (dispatch-on-command
- (if forward?
- (ref-command-object search-forward)
- (ref-command-object search-backward))))
- ((test-for #\C-s)
- (string-search search-forward))
- ((test-for #\C-r)
- (string-search search-backward))
- ((test-for #\C-q)
- (char-search (prompt-for-char "Quote character")))
- (else
- (char-search char))))))
\ No newline at end of file
+ (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)))))))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.69 1989/04/28 22:53:42 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.70 1991/04/23 06:44:12 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define-variable definition-start
"Regexp to match start of a definition."
- "^\\s(")
+ "^\\s("
+ string?)
(define (definition-start? mark)
(re-match-forward (ref-variable definition-start) mark))
(define (forward-one-definition-start mark)
(and (re-search-forward (ref-variable definition-start)
- (if (line-start? mark) (line-end mark 0) mark))
+ (if (line-start? mark) (line-end mark 0) mark)
+ (group-end mark))
(re-match-start 0)))
(define (backward-one-definition-start mark)
- (re-search-backward (ref-variable definition-start) mark))
+ (re-search-backward (ref-variable definition-start) mark (group-start mark)))
(define (forward-one-definition-end mark)
(define (loop start)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tagutl.scm,v 1.36 1991/03/15 23:40:26 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tagutl.scm,v 1.37 1991/04/23 06:44:29 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(re-search-backward
"\\sw\\|\\s_"
(or (re-match-forward "\\(\\sw\\|\\s_\\)*" point end)
- point))))
+ point)
+ (group-start point))))
(and mark
(let ((mark (mark1+ mark)))
(let ((mark*
(extract-string mark* mark)))))))))
\f
(define (find-tag string buffer start find-file)
- (let ((tag
- (let loop ((mark start))
- (let ((mark (search-forward string mark)))
- (and mark
- (or (re-match-forward find-tag-match-regexp mark)
- (loop mark)))))))
- (if (not tag)
- (editor-failure "No "
- (if (group-start? start) "" "more ")
- "entries containing "
- string)
- (let ((pathname
- (merge-pathnames
- (tag->pathname tag)
- (pathname-directory-path (buffer-pathname buffer))))
- (regexp
- (string-append
- "^"
- (re-quote-string (extract-string (mark-1+ tag)
- (line-start tag 0)))))
- (start
- (-1+
- (string->number
- (let ((mark (search-forward "," tag)))
- (extract-string mark (line-end mark 0)))))))
- (set-buffer-point! buffer (line-end tag 0))
- (find-file pathname)
- (let* ((buffer (current-buffer))
- (group (buffer-group buffer))
- (end (group-end-index group)))
- (buffer-widen! buffer)
- (push-current-mark! (current-point))
- (let ((mark
- (let loop ((offset 1000))
- (let ((index (- start offset)))
- (if (positive? index)
- (or (re-search-forward
- regexp
- (make-mark group index)
- (make-mark group (min (+ start offset) end)))
- (loop (* 3 offset)))
- (re-search-forward regexp (make-mark group 0)))))))
- (if (not mark)
- (editor-failure regexp
- " not found in "
- (pathname-name-string pathname))
- (set-current-point! (line-start mark 0)))))))))
+ (let ((end (group-end start)))
+ (let ((tag
+ (let loop ((mark start))
+ (let ((mark (search-forward string mark end)))
+ (and mark
+ (or (re-match-forward find-tag-match-regexp mark)
+ (loop mark)))))))
+ (if (not tag)
+ (editor-failure "No "
+ (if (group-start? start) "" "more ")
+ "entries containing "
+ string)
+ (let ((pathname
+ (merge-pathnames
+ (tag->pathname tag)
+ (pathname-directory-path (buffer-pathname buffer))))
+ (regexp
+ (string-append
+ "^"
+ (re-quote-string (extract-string (mark-1+ tag)
+ (line-start tag 0)))))
+ (start
+ (-1+
+ (string->number
+ (let ((mark (search-forward "," tag end)))
+ (extract-string mark (line-end mark 0)))))))
+ (set-buffer-point! buffer (line-end tag 0))
+ (find-file pathname)
+ (let* ((buffer (current-buffer))
+ (group (buffer-group buffer))
+ (end (group-end-index group)))
+ (buffer-widen! buffer)
+ (push-current-mark! (current-point))
+ (let ((mark
+ (let loop ((offset 1000))
+ (let ((index (- start offset)))
+ (if (positive? index)
+ (or (re-search-forward
+ regexp
+ (make-mark group index)
+ (make-mark group (min (+ start offset) end)))
+ (loop (* 3 offset)))
+ (re-search-forward regexp
+ (make-mark group 0)
+ end))))))
+ (if (not mark)
+ (editor-failure regexp
+ " not found in "
+ (pathname-name-string pathname))
+ (set-current-point! (line-start mark 0))))))))))
(define find-tag-match-regexp
"[^\n\177]*\177")
(lambda (regexp)
(set! tags-loop-continuation
(lambda ()
- (let ((mark (re-search-forward regexp (current-point))))
+ (let ((mark
+ (let ((point (current-point)))
+ (re-search-forward regexp point (group-end point)))))
(if mark
(begin
(set-current-point! mark)
projects / mit-scheme.git / commitdiff