From 3254bbe1885bf4924610bad719daa0d8da2a17fe Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 23 Apr 1991 06:45:42 +0000 Subject: [PATCH] Always supply LIMIT argument to search procedures. --- v7/src/edwin/fileio.scm | 14 ++-- v7/src/edwin/hlpcom.scm | 6 +- v7/src/edwin/info.scm | 75 +++++++++++-------- v7/src/edwin/iserch.scm | 16 ++-- v7/src/edwin/lincom.scm | 33 +++++---- v7/src/edwin/replaz.scm | 16 ++-- v7/src/edwin/sercom.scm | 158 +++++++++++++++++++++++----------------- v7/src/edwin/syntax.scm | 10 ++- v7/src/edwin/tagutl.scm | 106 ++++++++++++++------------- 9 files changed, 246 insertions(+), 188 deletions(-) diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm index 1f1523815..39cbf2cf8 100644 --- a/v7/src/edwin/fileio.scm +++ b/v7/src/edwin/fileio.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -206,12 +206,10 @@ at the end of a file." (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) @@ -234,7 +232,7 @@ at the end of a file." (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)))) diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm index 9778b8c19..c6a2ca390 100644 --- a/v7/src/edwin/hlpcom.scm +++ b/v7/src/edwin/hlpcom.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -280,7 +280,9 @@ If you want VALUE to be a string, you must surround it with doublequotes." (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)) diff --git a/v7/src/edwin/info.scm b/v7/src/edwin/info.scm index 0fee1b7cd..001008d3f 100644 --- a/v7/src/edwin/info.scm +++ b/v7/src/edwin/info.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -335,7 +335,7 @@ except for \\[info-cease-edit] to return to Info." (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) @@ -429,7 +429,11 @@ except for \\[info-cease-edit] to return to Info." (nth-menu-item 4)) (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))) @@ -440,16 +444,19 @@ except for \\[info-cease-edit] to return to Info." (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)) @@ -461,7 +468,7 @@ except for \\[info-cease-edit] to return to Info." (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)))) @@ -487,10 +494,10 @@ The name may be an abbreviation of the reference name." (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)))) @@ -501,7 +508,7 @@ The name may be an abbreviation of the reference name." (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)) @@ -696,7 +703,10 @@ The name may be an abbreviation of the reference name." (ref-variable info-history)))) (define (node-start start end) - (line-start (search-backward "\n" start end 'ERROR) 2 'ERROR)) + (line-start (or (search-backward "\n" start end false) + (editor-error)) + 2 + 'ERROR)) (define (node-region node) (make-region node (node-end node))) @@ -704,20 +714,20 @@ The name may be an abbreviation of the reference name." (define (node-end node) (let ((end (group-end node))) (let loop ((start node)) - (let ((mark (re-search-forward "[\f]" start))) + (let ((mark (re-search-forward "[\f]" 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" start end))) + (let ((mark (search-forward "\n" 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 @@ -780,7 +790,7 @@ The name may be an abbreviation of the reference name." (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 @@ -797,12 +807,14 @@ The name may be an abbreviation of the reference name." (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 @@ -832,7 +844,8 @@ The name may be an abbreviation of the reference name." (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 @@ -858,10 +871,11 @@ The name may be an abbreviation of the reference name." (+ (- index (subfile-index (car subfiles))) (mark-index (let ((buffer (current-buffer))) - (search-forward "\n" - (buffer-start buffer) - (buffer-end buffer) - 'ERROR))))) + (or (search-forward "\n" + (buffer-start buffer) + (buffer-end buffer) + false) + (editor-error)))))) (loop (cdr subfiles))))) (define (set-current-subfile! pathname) @@ -881,16 +895,19 @@ The name may be an abbreviation of the reference name." (define (subfile-list) (let ((result - (let loop ((start - (let ((start (ref-variable info-tag-table-start))) - (search-forward "\n\nIndirect:\n" - (group-start start) - start - 'ERROR)))) + (let loop + ((start + (let ((start (ref-variable info-tag-table-start))) + (or (search-forward "\n\nIndirect:\n" + (group-start start) + start + true) + (editor-error))))) (if (match-forward "" 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) diff --git a/v7/src/edwin/iserch.scm b/v7/src/edwin/iserch.scm index b854b772f..b026be3e1 100644 --- a/v7/src/edwin/iserch.scm +++ b/v7/src/edwin/iserch.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -337,9 +337,11 @@ (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 diff --git a/v7/src/edwin/lincom.scm b/v7/src/edwin/lincom.scm index 900918744..5ea81357f 100644 --- a/v7/src/edwin/lincom.scm +++ b/v7/src/edwin/lincom.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -429,15 +429,18 @@ Leaves one space in place of them. With argument, 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? @@ -446,7 +449,9 @@ moves down one line first (killing newline after current line)." (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." @@ -490,13 +495,9 @@ The variable tab-width controls the action." (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)) diff --git a/v7/src/edwin/replaz.scm b/v7/src/edwin/replaz.scm index aff52f782..0b1493399 100644 --- a/v7/src/edwin/replaz.scm +++ b/v7/src/edwin/replaz.scm @@ -1,8 +1,8 @@ ;;; -*-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 @@ -115,12 +115,14 @@ With an argument, replace only matches surrounded by word boundaries." (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) diff --git a/v7/src/edwin/sercom.scm b/v7/src/edwin/sercom.scm index 0e20d873d..3bf870be6 100644 --- a/v7/src/edwin/sercom.scm +++ b/v7/src/edwin/sercom.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -49,66 +49,79 @@ ;;;; 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?) ;;;; String Search @@ -126,41 +139,57 @@ and the value is minus the number of lines." (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)))))) ;;;; Incremental Search @@ -229,35 +258,34 @@ Special characters: (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 diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm index a6eb494ae..85ac05043 100644 --- a/v7/src/edwin/syntax.scm +++ b/v7/src/edwin/syntax.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -341,18 +341,20 @@ a comment ending." (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) diff --git a/v7/src/edwin/tagutl.scm b/v7/src/edwin/tagutl.scm index da075a86d..352990591 100644 --- a/v7/src/edwin/tagutl.scm +++ b/v7/src/edwin/tagutl.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -125,7 +125,8 @@ See documentation of variable tags-file-name." (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* @@ -136,53 +137,56 @@ See documentation of variable tags-file-name." (extract-string mark* mark))))))))) (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") @@ -199,7 +203,9 @@ See documentation of variable tags-file-name." (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) -- 2.25.1