arguments are (PATTERN MARK END #!OPTIONAL CASE-FOLD-SEARCH).
* Reimplement paragraph and region filling commands, to fix bugs and
create new functionality. Default region filling is now done by
paragraphs rather than treating the entire region as a single
paragraph.
* Implement M-x mail-fill-yanked-message.
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.47 1991/04/21 00:50:39 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.48 1991/04/23 06:46:56 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(declare (usual-integrations))
\f
-(define-command fill-paragraph
- "Fill this (or next) paragraph.
-Point stays the same."
- ()
- (lambda ()
- (fill-region (paragraph-text-region (current-point))
- (ref-variable fill-prefix)
- (ref-variable fill-column))))
-
-(define-command fill-region
- "Fill text from point to mark."
- "r"
- (lambda (region)
- (fill-region region
- (ref-variable fill-prefix)
- (ref-variable fill-column))))
-
(define-variable-per-buffer fill-column
- "*Column beyond which automatic line-wrapping should happen.
+ "Column beyond which automatic line-wrapping should happen.
Automatically becomes local when set in any fashion."
- 70)
+ 70
+ exact-nonnegative-integer?)
(define-command set-fill-column
"Set fill column to argument or current column.
"P"
(lambda (argument)
(let ((column (or argument (current-column))))
- (local-set-variable! fill-column column)
- (temporary-message "Fill column set to " (write-to-string column)))))
+ (set-variable! fill-column column)
+ (temporary-message "Fill column set to " (number->string column)))))
-(define-variable fill-prefix
+(define-variable-per-buffer fill-prefix
"String for auto-fill to insert at start of new line, or #F."
- false)
+ false
+ string-or-false?)
(define-command set-fill-prefix
- "Set fill-prefix to text between point and start of line."
- ()
- (lambda ()
- (if (line-start? (current-point))
- (begin
- (local-set-variable! fill-prefix false)
- (message "Fill prefix cancelled"))
- (let ((string (extract-string (line-start (current-point) 0))))
- (local-set-variable! fill-prefix string)
- (message "Fill prefix now \"" (ref-variable fill-prefix) "\"")))))
+ "Set the fill-prefix to the current line up to point.
+Filling expects lines to start with the fill prefix
+and reinserts the fill prefix in each resulting line."
+ "d"
+ (lambda (point)
+ (let ((string (extract-string (line-start point 0) point)))
+ (if (string-null? string)
+ (begin
+ (set-variable! fill-prefix false)
+ (message "fill-prefix cancelled"))
+ (begin
+ (set-variable! fill-prefix string)
+ (message "fill-prefix: \"" string "\""))))))
\f
-(define (fill-region region fill-prefix fill-column)
- (let ((start (region-start region))
- (end (region-end region)))
- (let ((start (mark-right-inserting (skip-chars-forward "\n" start end)))
- (end (mark-left-inserting (skip-chars-backward "\n" end start))))
- (with-narrowed-region! (make-region start end)
- (lambda ()
- (let ((point (mark-left-inserting-copy start)))
- (let loop ()
- (let ((ending (forward-sentence point 1 false)))
- (if (and ending (not (group-end? ending)))
- (begin
- (move-mark-to! point ending)
- (if (char=? #\newline (mark-right-char point))
- (insert-char #\space point))
- (loop)))))
- (move-mark-to! point start)
+(define-command fill-paragraph
+ "Fill paragraph at or after point.
+Prefix arg means justify as well."
+ "d\nP"
+ (lambda (point justify?)
+ ((ref-command fill-region-as-paragraph) (paragraph-text-region point)
+ justify?)))
+
+(define-command fill-region-as-paragraph
+ "Fill region as one paragraph: break lines to fit fill-column.
+Prefix arg means justify too."
+ "r\nP"
+ (lambda (region justify?)
+ (let ((start (region-start region)))
+ (fill-region-as-paragraph
+ start
+ (region-end region)
+ (mark-local-ref start (ref-variable-object fill-prefix))
+ (mark-local-ref start (ref-variable-object fill-column))
+ justify?))))
+
+(define-command fill-individual-paragraphs
+ "Fill each paragraph in region according to its individual fill prefix."
+ "r\nP"
+ (lambda (region justify?)
+ (let ((start (region-start region)))
+ (fill-individual-paragraphs
+ start
+ (region-end region)
+ (mark-local-ref start (ref-variable-object fill-column))
+ justify?
+ false))))
+
+(define-command fill-region
+ "Fill each of the paragraphs in the region.
+Prefix arg means justify as well."
+ "r\nP"
+ (lambda (region justify?)
+ (let ((start (region-start region)))
+ (fill-region start
+ (region-end region)
+ (mark-local-ref start (ref-variable-object fill-prefix))
+ (mark-local-ref start (ref-variable-object fill-column))
+ justify?))))
+
+(define-command justify-current-line
+ "Add spaces to line point is in, so it ends at fill-column."
+ "d"
+ (lambda (point)
+ (justify-line point
+ (mark-local-ref point (ref-variable-object fill-prefix))
+ (mark-local-ref point (ref-variable-object fill-column)))))
+\f
+(define (fill-region-as-paragraph start end fill-prefix fill-column justify?)
+ (let ((start (mark-right-inserting-copy (skip-chars-forward "\n" start end)))
+ (end (mark-left-inserting-copy (skip-chars-backward "\n" end start))))
+ (let ((point (mark-left-inserting-copy start)))
+ ;; Delete the fill prefix from every line except the first.
+ (if fill-prefix
+ (begin
+ (if (>= (string-length fill-prefix) fill-column)
+ (editor-error "fill-prefix too long for specified width"))
+ (let ((m (match-forward fill-prefix start end false)))
+ (if m
+ (begin
+ (move-mark-to! point m)
+ (move-mark-to! start m))))
(let loop ()
- (if fill-prefix
- (let ((end (match-forward fill-prefix point)))
- (if end
- (delete-string point end))))
(let ((m (char-search-forward #\newline point end)))
(if m
(begin
(move-mark-to! point m)
- (delete-left-char point)
- (insert-char #\space point)
+ (let ((m (match-forward fill-prefix point end false)))
+ (if m
+ (delete-string point m)))
(loop)))))
- (delete-horizontal-space end)
- (move-mark-to! point start)
- (let loop ()
- (if (not (group-end? point))
+ (move-mark-to! point start)))
+ ;; Make sure sentences ending at end of line get an extra space.
+ (let loop ()
+ (let ((m (re-search-forward "[.?!][])\"']*$" point end false)))
+ (if m
+ (begin
+ (move-mark-to! point m)
+ (insert-char #\space point)
+ (loop)))))
+ ;; Change all newlines to spaces.
+ (move-mark-to! point start)
+ (let loop ()
+ (let ((m (char-search-forward #\newline point end)))
+ (if m
+ (begin
+ (move-mark-to! point m)
+ (delete-left-char point)
+ (insert-char #\space point)
+ (loop)))))
+ ;; Flush excess spaces, except in the paragraph indentation.
+ (move-mark-to! point (skip-chars-forward " \t" start end))
+ (let loop ()
+ (if (re-search-forward " *" point end false)
+ (begin
+ (move-mark-to! point (delete-match))
+ (insert-string (if (fill:sentence-end? point start) " " " ")
+ point)
+ (loop))))
+ (delete-string (horizontal-space-start end) end)
+ (insert-string " " end)
+ (move-mark-to! point start)
+ (let loop ()
+ (let ((target (move-to-column point fill-column)))
+ (if (mark>= target end)
+ (delete-string (horizontal-space-start end) end)
+ (begin
+ (move-mark-to!
+ point
+ (let ((m (skip-chars-backward "^ \n" target point)))
+ (if (mark> m point)
+ m
+ (skip-chars-forward "^ \n" target end))))
+ (if (mark< point end)
+ (begin
+ (delete-horizontal-space point)
+ (insert-newline point)
+ (if justify?
+ (fill:call-with-line-marks (mark-1+ point)
+ fill-prefix
+ (lambda (start end)
+ (fill:justify-line start end fill-column))))
+ (if fill-prefix (insert-string fill-prefix point))))
+ (loop)))))
+ (mark-temporary! point)
+ (mark-temporary! end)
+ (mark-temporary! start))))
+\f
+(define (fill-region start end fill-prefix fill-column justify?)
+ (let ((start (mark-right-inserting-copy start))
+ (end (mark-left-inserting-copy end))
+ (point (mark-left-inserting-copy start))
+ (pend (mark-left-inserting-copy start)))
+ (let loop ()
+ (if (mark< point end)
+ (begin
+ (move-mark-to! pend
+ (or (forward-one-paragraph point end fill-prefix)
+ end))
+ (if (mark>= (or (backward-one-paragraph pend start fill-prefix)
+ start)
+ point)
+ (fill-region-as-paragraph point
+ pend
+ fill-prefix
+ fill-column
+ justify?))
+ (move-mark-to! point pend)
+ (loop))))
+ (mark-temporary! pend)
+ (mark-temporary! point)
+ (mark-temporary! end)
+ (mark-temporary! start)))
+
+(define (fill-individual-paragraphs start end fill-column justify? mail?)
+ (let ((start (mark-right-inserting-copy start))
+ (end (mark-left-inserting-copy end))
+ (point (mark-left-inserting-copy start))
+ (pend (mark-left-inserting-copy start)))
+ (let loop ()
+ (move-mark-to! point (skip-chars-forward " \t\n" point end))
+ (if (mark< point end)
+ (let ((fill-prefix (extract-string (line-start point 0) point)))
+ (move-mark-to! pend
+ (or (forward-one-paragraph point end fill-prefix)
+ end))
+ (let ((m
+ (if mail?
+ (let loop ((m point))
+ (let ((m*
+ (re-search-forward "^[ \t]*[^ \t\n]*:" m pend
+ false)))
+ (if m*
+ (let ((m* (line-end m* 0)))
+ (if (mark< m* pend)
+ (loop (mark1+ m*))
+ pend))
+ m)))
+ point)))
+ (if (mark= m point)
(begin
- (if fill-prefix
- (insert-string fill-prefix point))
- (let ((target (move-to-column point fill-column)))
- (if (not (group-end? target))
- (let ((end
- (let ((end
- (char-search-backward #\space
- (mark1+ target)
- point)))
- (if end
- (mark1+ end)
- (let ((m
- (char-search-forward #\space
- target
- end)))
- (and m
- (mark-1+ m)))))))
- (if end
- (begin
- (move-mark-to! point end)
- (delete-horizontal-space point)
- (insert-newline point)
- (loop)))))))))))))))
+ (fill-region-as-paragraph point pend
+ fill-prefix fill-column
+ justify?)
+ (move-mark-to! point pend)
+ (loop))
+ (begin
+ (move-mark-to! point m)
+ (loop)))))))
+ (mark-temporary! pend)
+ (mark-temporary! point)
+ (mark-temporary! end)
+ (mark-temporary! start)))
+\f
+(define (justify-line mark fill-prefix fill-column)
+ (fill:call-with-line-marks mark fill-prefix
+ (lambda (start end)
+ (let ((point (mark-left-inserting-copy start)))
+ (let loop ()
+ (if (re-search-forward " *" point end false)
+ (begin
+ (move-mark-to! point (delete-match))
+ (insert-string (if (fill:sentence-end? point start) " " " ")
+ point)
+ (loop))))
+ (mark-temporary! point))
+ (fill:justify-line start end fill-column))))
+
+(define (fill:call-with-line-marks mark fill-prefix procedure)
+ (let ((end (mark-left-inserting-copy (line-end mark 0))))
+ (let ((start
+ (mark-right-inserting-copy
+ (skip-chars-forward
+ " \t"
+ (let ((start (line-start end 0)))
+ (or (and fill-prefix
+ (match-forward fill-prefix start end false))
+ start))
+ end))))
+ (procedure start end)
+ (mark-temporary! start)
+ (mark-temporary! end))))
+
+(define (fill:justify-line start end fill-column)
+ (let ((point (mark-right-inserting-copy end)))
+ (do ((ncols (- fill-column (mark-column end)) (- ncols 1)))
+ ((<= ncols 0))
+ (do ((i (+ 3 (random 3)) (- i 1)))
+ ((= i 0))
+ (move-mark-to!
+ point
+ (skip-chars-backward " "
+ (or (char-search-backward #\space point start)
+ (char-search-backward #\space end start)
+ start)
+ start)))
+ (insert-char #\space point))
+ (mark-temporary! point)))
+
+(define (fill:sentence-end? point start)
+ (let ((m (skip-chars-backward "])\"'" point start)))
+ (and (not (group-start? m))
+ (memv (extract-left-char m) '(#\. #\? #\!)))))
\f
(define-command auto-fill-mode
"Toggle auto-fill mode.
"Breaks the line if it exceeds the fill column, then inserts a space."
"p"
(lambda (argument)
- (insert-chars #\Space argument)
+ (insert-chars #\space argument)
(auto-fill-break)))
(define-command auto-fill-newline
((ref-command newline) argument)))
(define-minor-mode auto-fill "Fill" "")
-
(define-key 'auto-fill #\space 'auto-fill-space)
(define-key 'auto-fill #\return 'auto-fill-newline)
(line-end? (horizontal-space-end point))))
(define-variable-per-buffer left-margin
- "*Column for the default indent-line-function to indent to.
+ "Column for the default indent-line-function to indent to.
Linefeed indents to this column in Fundamental mode.
Automatically becomes local when set in any fashion."
- 0)
+ 0
+ exact-nonnegative-integer?)
(define (center-line mark)
(let ((mark (mark-permanent! mark)))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.35 1991/04/21 00:51:24 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.36 1991/04/23 06:50:04 cph Exp $
Copyright (c) 1989-91 Massachusetts Institute of Technology
(declare (usual-integrations))
(package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 35 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 36 '()))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.50 1991/04/21 00:51:43 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.51 1991/04/23 06:47:00 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(define (replace-match replacement)
(let ((m (mark-left-inserting-copy (re-match-start 0))))
(delete-string m (re-match-end 0))
- (insert-string m replacement)
+ (insert-string replacement m)
(mark-temporary! m)
m))
registers
string start end))
\f
-(define-macro (define-search name key-name searcher compile-key
- mark-limit mark-compare)
- `(DEFINE (,name ,key-name #!OPTIONAL START END LIMIT?)
- (LET ((START (IF (DEFAULT-OBJECT? START) (CURRENT-POINT) START)))
- (LET ((END (IF (DEFAULT-OBJECT? END) (,mark-limit START) END)))
- (LET ((LIMIT? (AND (NOT (DEFAULT-OBJECT? LIMIT?)) LIMIT?)))
- (IF (NOT (,mark-compare START END))
- (ERROR ,(string-append (symbol->string name)
- ": Marks incorrectly related")
- START END))
- (OR (LET ((GROUP (MARK-GROUP START)))
- (,searcher GROUP
- (MARK-INDEX START)
- (MARK-INDEX END)
- (,compile-key ,key-name
- (GROUP-CASE-FOLD-SEARCH GROUP))))
- (LIMIT-MARK-MOTION LIMIT? END)))))))
-
-(define-search search-forward string
- %re-search-forward re-compile-string group-end mark<=)
-
-(define-search re-search-forward regexp
- %re-search-forward re-compile-pattern group-end mark<=)
-
-(define (%re-search-forward group start end pattern)
- (let ((index
- (re-search-buffer-forward pattern
- (group-case-fold-search group)
- (group-syntax-table group)
- group start end)))
- (and index
- (make-mark group index))))
-
-(define-search search-backward string
- %re-search-backward re-compile-string group-start mark>=)
-
-(define-search re-search-backward regexp
- %re-search-backward re-compile-pattern group-start mark>=)
-
-(define (%re-search-backward group start end pattern)
- (let ((index
- (re-search-buffer-backward pattern
- (group-case-fold-search group)
- (group-syntax-table group)
- group end start)))
- (and index
- (make-mark group index))))
+(define (search-forward string start end #!optional case-fold-search)
+ (%re-search string start end
+ (if (default-object? case-fold-search)
+ (group-case-fold-search (mark-group start))
+ case-fold-search)
+ re-compile-string
+ re-search-buffer-forward))
+
+(define (search-backward string end start #!optional case-fold-search)
+ (%re-search string start end
+ (if (default-object? case-fold-search)
+ (group-case-fold-search (mark-group start))
+ case-fold-search)
+ re-compile-string
+ re-search-buffer-backward))
+
+(define (re-search-forward regexp start end #!optional case-fold-search)
+ (%re-search regexp start end
+ (if (default-object? case-fold-search)
+ (group-case-fold-search (mark-group start))
+ case-fold-search)
+ re-compile-pattern
+ re-search-buffer-forward))
+
+(define (re-search-backward regexp end start #!optional case-fold-search)
+ (%re-search regexp start end
+ (if (default-object? case-fold-search)
+ (group-case-fold-search (mark-group start))
+ case-fold-search)
+ re-compile-pattern
+ re-search-buffer-backward))
+
+(define (%re-search string start end case-fold-search compile-string search)
+ (if (not (mark<= start end))
+ (error "Marks incorrectly related:" start end))
+ (let ((group (mark-group start)))
+ (let ((index
+ (search (compile-string string case-fold-search)
+ case-fold-search
+ (group-syntax-table group)
+ group
+ (mark-index start)
+ (mark-index end))))
+ (and index
+ (make-mark group index)))))
(define (re-match-forward regexp start #!optional end case-fold-search)
(let ((group (mark-group start)))
(group-syntax-table group)
group
(mark-index start)
- (if (default-object? end)
- (group-end-index group)
- (begin
- (if (not (and (eq? group (mark-group end))
- (fix:<= (mark-index start)
- (mark-index end))))
- (error "Marks incorrectly related:" start end))
- (mark-index end))))))
+ (mark-index
+ (if (default-object? end)
+ (group-end-mark group)
+ (begin
+ (if (not (mark<= start end))
+ (error "Marks incorrectly related:" start end))
+ end))))))
(and index
(make-mark group index))))))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.14 1990/10/03 04:55:57 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.15 1991/04/23 06:47:05 cph Exp $
;;;
-;;; Copyright (c) 1986, 1989, 1990 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
(local-set-variable! comment-indent-hook lisp-comment-indentation)
(local-set-variable! comment-start ";")
(local-set-variable! comment-end "")
- (local-set-variable! paragraph-start "^$")
- (local-set-variable! paragraph-separate (ref-variable paragraph-start))
+ (let ((separate (string-append "^$\\|" (ref-variable page-delimiter))))
+ (local-set-variable! paragraph-start separate)
+ (local-set-variable! paragraph-separate separate))
+ (local-set-variable! paragraph-ignore-fill-prefix true)
(local-set-variable! indent-line-procedure (ref-command lisp-indent-line))
(event-distributor/invoke! (ref-variable scheme-mode-hook)))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/search.scm,v 1.148 1991/04/21 00:51:57 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/search.scm,v 1.149 1991/04/23 06:47:09 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
;;;
(declare (usual-integrations))
\f
-;;;; Character Search and Match
-
(let-syntax
((define-forward-search
(macro (name find-next)
(and index
(fix:+ index 1))))
\f
-(define (char-search-forward char start end #!optional case-fold-search)
- (let ((group (mark-group start))
- (start-index (mark-index start))
- (end-index (mark-index end)))
- (if (not (and (eq? group (mark-group end))
- (fix:<= start-index end-index)))
- (error "Marks incorrectly related:" start end))
- (let ((index
- (if (if (default-object? case-fold-search)
- (group-case-fold-search group)
- case-fold-search)
- (group-find-next-char-ci group start-index end-index char)
- (group-find-next-char group start-index end-index char))))
- (and index
- (make-mark group (fix:+ index 1))))))
-
-(define (char-search-backward char start end #!optional case-fold-search)
- (let ((group (mark-group start))
- (start-index (mark-index start))
- (end-index (mark-index end)))
- (if (not (and (eq? group (mark-group end))
- (fix:>= start-index end-index)))
- (error "Marks incorrectly related:" start end))
- (let ((index
- (if (if (default-object? case-fold-search)
- (group-case-fold-search group)
- case-fold-search)
- (group-find-next-char-ci group end-index start-index char)
- (group-find-next-char group end-index start-index char))))
- (and index
- (make-mark group index)))))
-
-(define (char-match-forward char mark #!optional case-fold-search)
- (let ((group (mark-group mark))
- (index (mark-index mark)))
- (and (not (group-end-index? group index))
- (if (if (default-object? case-fold-search)
- (group-case-fold-search group)
- case-fold-search)
- (char-ci=? char (group-right-char group index))
- (char=? char (group-right-char group index))))))
-
-(define (char-match-backward char mark #!optional case-fold-search)
- (let ((group (mark-group mark))
- (index (mark-index mark)))
- (and (not (group-start-index? group index))
- (if (if (default-object? case-fold-search)
- (group-case-fold-search group)
- case-fold-search)
- (char-ci=? char (group-left-char group index))
- (char=? char (group-left-char group index))))))
-
-(define (skip-chars-forward pattern #!optional start end limit?)
- (let ((start (if (default-object? start) (current-point) start)))
- (let ((end (if (default-object? end) (group-end start) end)))
- (let ((limit? (if (default-object? limit?) 'LIMIT limit?)))
- (if (not (mark<= start end))
- (error "SKIP-CHARS-FORWARD: Marks incorrectly related" start end))
- (let ((index
- (group-find-next-char-in-set (mark-group start)
- (mark-index start)
- (mark-index end)
- (re-compile-char-set pattern
- true))))
- (if index
- (make-mark (mark-group start) index)
- (limit-mark-motion limit? end)))))))
-
-(define (skip-chars-backward pattern #!optional start end limit?)
- (let ((start (if (default-object? start) (current-point) start)))
- (let ((end (if (default-object? end) (group-start start) end)))
- (let ((limit? (if (default-object? limit?) 'LIMIT limit?)))
- (if (not (mark>= start end))
- (error "SKIP-CHARS-BACKWARD: Marks incorrectly related" start end))
- (let ((index
- (group-find-previous-char-in-set (mark-group start)
- (mark-index end)
- (mark-index start)
- (re-compile-char-set pattern
- true))))
- (if index
- (make-mark (mark-group start) (fix:+ index 1))
- (limit-mark-motion limit? end)))))))
-\f
-;;;; String Search and Match
-
(define (group-match-substring-forward group start end
string string-start string-end)
(let ((text (group-text group))
(fix:- string-end (fix:- end gap-start)))
index)))))))
\f
-(define (match-forward string mark #!optional case-fold-search)
- (let ((group (mark-group mark))
- (start (mark-index mark))
+(define (char-search-forward char start end #!optional case-fold-search)
+ (let ((group (mark-group start))
+ (start-index (mark-index start))
+ (end-index (mark-index end)))
+ (if (not (and (eq? group (mark-group end))
+ (fix:<= start-index end-index)))
+ (error "Marks incorrectly related:" start end))
+ (let ((index
+ (if (if (default-object? case-fold-search)
+ (group-case-fold-search group)
+ case-fold-search)
+ (group-find-next-char-ci group start-index end-index char)
+ (group-find-next-char group start-index end-index char))))
+ (and index
+ (make-mark group (fix:+ index 1))))))
+
+(define (char-search-backward char start end #!optional case-fold-search)
+ (let ((group (mark-group start))
+ (start-index (mark-index start))
+ (end-index (mark-index end)))
+ (if (not (and (eq? group (mark-group end))
+ (fix:>= start-index end-index)))
+ (error "Marks incorrectly related:" start end))
+ (let ((index
+ (if (if (default-object? case-fold-search)
+ (group-case-fold-search group)
+ case-fold-search)
+ (group-find-previous-char-ci group end-index start-index char)
+ (group-find-previous-char group end-index start-index char))))
+ (and index
+ (make-mark group index)))))
+
+(define-macro (default-end-mark start end)
+ `(IF (DEFAULT-OBJECT? ,end)
+ (GROUP-END ,start)
+ (BEGIN
+ (IF (NOT (MARK<= ,start ,end))
+ (ERROR "Marks incorrectly related:" ,start ,end))
+ ,end)))
+
+(define-macro (default-start-mark start end)
+ `(IF (DEFAULT-OBJECT? ,start)
+ (GROUP-START ,end)
+ (BEGIN
+ (IF (NOT (MARK<= ,start ,end))
+ (ERROR "Marks incorrectly related:" ,start ,end))
+ ,start)))
+
+(define (char-match-forward char start #!optional end case-fold-search)
+ (and (mark< start (default-end-mark start end))
+ (let ((group (mark-group start)))
+ (if (if (default-object? case-fold-search)
+ (group-case-fold-search group)
+ case-fold-search)
+ (char-ci=? char (group-right-char group (mark-index start)))
+ (char=? char (group-right-char group (mark-index start)))))))
+
+(define (char-match-backward char end #!optional start case-fold-search)
+ (and (mark< (default-start-mark start end) end)
+ (let ((group (mark-group end)))
+ (if (if (default-object? case-fold-search)
+ (group-case-fold-search group)
+ case-fold-search)
+ (char-ci=? char (group-left-char group (mark-index end)))
+ (char=? char (group-left-char group (mark-index end)))))))
+\f
+(define (skip-chars-forward pattern #!optional start end limit?)
+ (let ((start (if (default-object? start) (current-point) start))
+ (limit? (if (default-object? limit?) 'LIMIT limit?)))
+ (let ((end (default-end-mark start end)))
+ (let ((index
+ (group-find-next-char-in-set (mark-group start)
+ (mark-index start)
+ (mark-index end)
+ (re-compile-char-set pattern true))))
+ (if index
+ (make-mark (mark-group start) index)
+ (limit-mark-motion limit? end))))))
+
+(define (skip-chars-backward pattern #!optional end start limit?)
+ (let ((end (if (default-object? end) (current-point) end))
+ (limit? (if (default-object? limit?) 'LIMIT limit?)))
+ (let ((start (default-start-mark start end)))
+ (let ((index
+ (group-find-previous-char-in-set (mark-group start)
+ (mark-index start)
+ (mark-index end)
+ (re-compile-char-set pattern
+ true))))
+ (if index
+ (make-mark (mark-group start) (fix:+ index 1))
+ (limit-mark-motion limit? start))))))
+
+(define (match-forward string start #!optional end case-fold-search)
+ (let ((end (default-end-mark start end))
+ (group (mark-group start))
+ (start-index (mark-index start))
(length (string-length string)))
- (let ((end (fix:+ start length)))
- (and (fix:<= end (group-end-index group))
+ (let ((i (fix:+ start-index length)))
+ (and (fix:<= i (mark-index end))
(fix:= (if (if (default-object? case-fold-search)
(group-case-fold-search group)
case-fold-search)
- (group-match-substring-forward-ci group start end
+ (group-match-substring-forward-ci group start-index i
string 0 length)
- (group-match-substring-forward group start end
+ (group-match-substring-forward group start-index i
string 0 length))
- end)
- (make-mark group end)))))
+ i)
+ (make-mark group i)))))
-(define (match-backward string mark #!optional case-fold-search)
- (let ((group (mark-group mark))
- (end (mark-index mark))
+(define (match-backward string end #!optional start case-fold-search)
+ (let ((start (default-start-mark start end))
+ (group (mark-group end))
+ (end-index (mark-index end))
(length (string-length string)))
- (let ((start (fix:- end length)))
- (and (fix:>= start (group-start-index group))
+ (let ((i (fix:- end-index length)))
+ (and (fix:>= i (mark-index start))
(fix:= (if (if (default-object? case-fold-search)
(group-case-fold-search group)
case-fold-search)
- (group-match-substring-backward-ci group start end
+ (group-match-substring-backward-ci group i end-index
string 0 length)
- (group-match-substring-backward group start end
+ (group-match-substring-backward group i end-index
string 0 length))
- start)
- (make-mark group start)))))
\ No newline at end of file
+ i)
+ (make-mark group i)))))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.1 1991/04/21 01:49:14 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.2 1991/04/23 06:47:14 cph Exp $
;;;
;;; Copyright (c) 1991 Massachusetts Institute of Technology
;;;
(let ((point (mark-left-inserting-copy (buffer-start buffer)))
(fill
(lambda (start end)
- (fill-region (make-region start end)
- "\t"
- (ref-variable fill-column)))))
+ (fill-region-as-paragraph start end
+ "\t" (ref-variable fill-column)
+ false))))
(insert-string "To: " point)
(if to
(begin
(lambda (argument)
((ref-command mail-send))
(bury-buffer (current-buffer))
- (if (and (not argument)
+ (if #|
+ (and (not argument)
(not (window-has-no-neighbors? (current-window)))
(eq? (ref-mode-object rmail)
(buffer-major-mode (window-buffer (other-window)))))
+ |#
+ false
(window-delete! (current-window))
(select-buffer (previous-buffer)))))
(skip-chars-backward "\n" (re-match-start 0) start))
(define (mail-match-header-separator start end)
- (if (not (re-search (string-append
- "^"
- (re-quote-string (ref-variable mail-header-separator))
- "$")
- false start end))
+ (if (not (re-search-forward
+ (string-append
+ "^" (re-quote-string (ref-variable mail-header-separator)) "$")
+ start end false))
(editor-error "Can't find mail-header-separator")))
(define (mail-field-end! start end field)
(mail-insert-field end field)))
(define (mail-field-end start end field)
- (and (re-search (string-append "^" field ":[ \t]*") true start end)
+ (and (re-search-forward (string-append "^" field ":[ \t]*") start end true)
(let ((field-start (re-match-end 0)))
- (if (re-search "^[^ \t]" false field-start end)
+ (if (re-search-forward "^[^ \t]" field-start end false)
(skip-chars-backward "\n" (re-match-start 0) field-start)
end))))
(let ((start (mark-left-inserting-copy start))
(end
(mark-left-inserting-copy
- (if (re-search "\n\n" false start end)
+ (if (re-search-forward "\n\n" start end false)
(mark1+ (re-match-start 0))
end)))
(mail-yank-ignored-headers (ref-variable mail-yank-ignored-headers)))
(do ()
- ((not (re-search mail-yank-ignored-headers true start end)))
+ ((not (re-search-forward mail-yank-ignored-headers start end true)))
(move-mark-to! start (re-match-start 0))
- (delete-string start
- (if (re-search "^[^ \t]" false (line-end start 0) end)
- (re-match-start 0)
- end)))
+ (delete-string
+ start
+ (if (re-search-forward "^[^ \t]" (line-end start 0) end false)
+ (re-match-start 0)
+ end)))
(mark-temporary! start)
(mark-temporary! end)))
+
+(define-command mail-fill-yanked-message
+ "Fill the paragraphs of a message yanked into this one.
+Numeric argument means justify as well."
+ "P"
+ (lambda (justify?)
+ (let ((buffer (current-buffer)))
+ (mail-match-header-separator (buffer-start buffer) (buffer-end-buffer))
+ (fill-individual-paragraphs (re-match-end 0)
+ (buffer-end-buffer)
+ (ref-variable fill-column)
+ justify?
+ true))))
\f
(define (sendmail-send-it)
(let ((error-buffer
(let ((header-end (mark-left-inserting-copy (delete-match))))
;; Delete any blank lines in the header.
(do ((start start (replace-match "\n")))
- ((not (re-search "\n\n+" false start header-end))))
+ ((not (re-search-forward "\n\n+" start header-end false))))
(expand-mail-aliases start header-end)
- (if (re-search "^FCC:" true start header-end)
+ (if (re-search-forward "^FCC:" start header-end true)
(mail-do-fcc temp-buffer header-end))
;; If there is a From and no Sender, put in a Sender.
- (if (and (re-search "^From:" true start header-end)
- (not (re-search "^Sender:" true start header-end)))
+ (if (and (re-search-forward "^From:" start header-end true)
+ (not
+ (re-search-forward "^Sender:" start header-end true)))
(begin
(insert-string "\nSender: " header-end)
(insert-string user-name header-end)))
;; Don't send out a blank subject line.
- (if (re-search "^Subject:[ \t]*\n" true start header-end)
+ (if (re-search-forward "^Subject:[ \t]*\n" start header-end true)
(delete-match)))
(apply run-synchronous-process
(make-region start end)
(if error-buffer
(let ((end (buffer-end error-buffer)))
(do ((start (buffer-start error-buffer) (replace-match "; ")))
- ((not (re-search "\n+ *" false start end)))))))))
+ ((not (re-search-forward "\n+ *" start end false)))))))))
(kill-buffer temp-buffer)
(if error-buffer
(let ((errors
;; that "^[>]+From " be quoted in the same transparent way.)
(let ((m (mark-right-inserting-copy (mark+ start 2))))
(do ()
- ((not (re-search "^From " false m end)))
+ ((not (re-search-forward "^From " m end false)))
(move-mark-to! m (re-match-end 0))
(insert-string ">" (re-match-start 0)))
(mark-temporary! m))
(define (digest-fcc-headers start header-end)
(let ((m (mark-right-inserting-copy start)))
(let loop ((pathnames '()))
- (if (re-search "^FCC:[ \t]*\\([^ \t\n]+\\)" true m header-end)
+ (if (re-search-forward "^FCC:[ \t]*\\([^ \t\n]+\\)" m header-end true)
(let ((filename
(extract-string (re-match-start 1) (re-match-end 1))))
(move-mark-to! m (line-start (re-match-start 0) 0))
(mark-temporary! m)
pathnames)))))
-(define-integrable (re-search regexp case-fold-search start end)
- (re-search-buffer-forward (re-compile-pattern regexp case-fold-search)
- case-fold-search
- false
- (mark-group start)
- (mark-index start)
- (mark-index end)))
-
(define (guarantee-mail-aliases)
unspecific)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tparse.scm,v 1.65 1989/04/28 22:54:02 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tparse.scm,v 1.66 1991/04/23 06:47:27 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
\f
;;;; Pages
+(define (%forward-page start end page-delimiter)
+ (if (not (mark<= start end))
+ (error "Marks incorrectly related:" start end))
+ (and (mark< start end)
+ (or (re-search-forward page-delimiter start end)
+ end)))
+
+(define (%backward-page end start page-delimiter)
+ (if (not (mark<= start end))
+ (error "Marks incorrectly related:" start end))
+ (and (mark< start end)
+ (if (re-search-backward page-delimiter (mark-1+ end) start)
+ (re-match-end 0)
+ start)))
+
+(define (%at-page-delimiter? mark page-delimiter)
+ (re-match-forward page-delimiter (line-start mark 0) mark))
+
(define-variable page-delimiter
"Regexp describing line-beginnings that separate pages."
- "^\f")
+ "^\f"
+ string?)
(define (forward-one-page mark)
- (and (not (group-end? mark))
- (or (re-search-forward (ref-variable page-delimiter) mark)
- (group-end mark))))
+ (%forward-page mark
+ (group-end mark)
+ (mark-local-ref mark (ref-variable-object page-delimiter))))
(define (backward-one-page mark)
- (and (not (group-start? mark))
- (if (re-search-backward (ref-variable page-delimiter) (mark-1+ mark))
- (re-match-end 0)
- (group-start mark))))
+ (%backward-page mark
+ (group-start mark)
+ (mark-local-ref mark (ref-variable-object page-delimiter))))
(define (page-start mark)
- (let ((page-delimiter (ref-variable page-delimiter)))
- (or (re-match-forward page-delimiter (line-start mark 0))
- (if (re-search-backward page-delimiter (mark-1+ mark))
- (re-match-end 0)
- (group-start mark)))))
+ (let ((page-delimiter
+ (mark-local-ref mark (ref-variable-object page-delimiter))))
+ (or (%at-page-delimiter? mark page-delimiter)
+ (%backward-page mark (group-start mark) page-delimiter))))
(define forward-page)
(define backward-page)
\f
;;;; Paragraphs
+(define (%forward-paragraph mark end
+ fill-prefix paragraph-start paragraph-separate)
+ (if (not (mark<= mark end))
+ (error "Marks incorrectly related:" mark end))
+ (and (mark< mark end)
+ (let ((paragraph-separate
+ (if fill-prefix
+ (string-append paragraph-separate "\\|^"
+ (re-quote-string fill-prefix) "[ \t]*$")
+ paragraph-separate)))
+
+ (define (skip-separators m)
+ (cond ((mark= m end)
+ false)
+ ((re-match-forward paragraph-separate m end false)
+ (let ((m (line-end m 0)))
+ (and (mark< m end)
+ (skip-separators (mark1+ m)))))
+ (else
+ (let ((m (line-end m 0)))
+ (cond ((mark>= m end) end)
+ (fill-prefix (skip-body-prefix m))
+ (else (skip-body-no-prefix m)))))))
+
+ (define (skip-body-prefix m)
+ (if (mark< m end)
+ (let ((m (mark1+ m)))
+ (if (or (re-match-forward paragraph-separate m end false)
+ (not (match-forward fill-prefix m end false)))
+ m
+ (skip-body-prefix (line-end m 0))))
+ end))
+
+ (define (skip-body-no-prefix m)
+ (if (re-search-forward paragraph-start m end false)
+ (re-match-start 0)
+ end))
+
+ (skip-separators (line-start mark 0)))))
+\f
+(define (%backward-paragraph mark start
+ fill-prefix paragraph-start paragraph-separate)
+ (if (not (mark<= start mark))
+ (error "Marks incorrectly related:" start mark))
+ (and (mark< start mark)
+ (let ((end (group-end mark))
+ (paragraph-separate
+ (if fill-prefix
+ (string-append paragraph-separate "\\|"
+ (re-quote-string fill-prefix) "[ \t]*$")
+ paragraph-separate)))
+
+ (define (skip-separators m)
+ (cond ((mark> start m)
+ false)
+ ((re-match-forward paragraph-separate m end false)
+ (and (mark< start m)
+ (skip-separators (line-start (mark-1+ m) 0))))
+ ((mark= start m)
+ start)
+ (fill-prefix
+ (skip-body-prefix m))
+ (else
+ (skip-body-no-prefix m))))
+
+ (define (skip-body-prefix m)
+ (if (or (re-match-forward paragraph-separate m end false)
+ (not (match-forward fill-prefix m end false)))
+ (adjust-final-position m)
+ (let ((m (line-start (mark-1+ m) 0)))
+ (if (mark< start m)
+ (skip-body-prefix m)
+ start))))
+
+ (define (skip-body-no-prefix m)
+ (let ((m
+ (re-search-backward paragraph-start (line-end m 0) start
+ false)))
+ (if (not m)
+ start
+ (adjust-final-position m))))
+
+ (define (adjust-final-position m)
+ (let ((m
+ (if (re-match-forward paragraph-separate m end false)
+ (mark1+ (line-end m 0))
+ m)))
+ (or (and (mark< start m)
+ (let ((m (mark-1+ m)))
+ (and (line-start? m)
+ m)))
+ m)))
+
+ (skip-separators (line-start (mark-1+ mark) 0)))))
+\f
(define-variable paragraph-start
"Regexp for beginning of a line that starts OR separates paragraphs."
- "^[ \t\n]")
+ "^[ \t\n\f]"
+ string?)
(define-variable paragraph-separate
"Regexp for beginning of a line that separates paragraphs.
-If you change this, you may have to change Paragraph Start also."
- "^[ \t]*$")
+If you change this, you may have to change paragraph-start also."
+ "^[ \t\f]*$"
+ string?)
+(define-variable paragraph-ignore-fill-prefix
+ "True means the paragraph commands are not affected by fill-prefix.
+This is desirable in modes where blank lines are the paragraph delimiters."
+ false
+ boolean?)
+
+(define (forward-one-paragraph mark #!optional end fill-prefix)
+ (%forward-paragraph
+ mark
+ (if (default-object? end)
+ (group-end mark)
+ (begin
+ (if (not (mark<= mark end))
+ (error "Marks incorrectly related:" mark end))
+ end))
+ (if (default-object? fill-prefix)
+ (and (not (mark-local-ref
+ mark
+ (ref-variable-object paragraph-ignore-fill-prefix)))
+ (mark-local-ref mark (ref-variable-object fill-prefix)))
+ fill-prefix)
+ (mark-local-ref mark (ref-variable-object paragraph-start))
+ (mark-local-ref mark (ref-variable-object paragraph-separate))))
+
+(define (backward-one-paragraph mark #!optional start fill-prefix)
+ (%backward-paragraph
+ mark
+ (if (default-object? start)
+ (group-start mark)
+ (begin
+ (if (not (mark<= start mark))
+ (error "Marks incorrectly related:" start mark))
+ start))
+ (if (default-object? fill-prefix)
+ (and (not (mark-local-ref
+ mark
+ (ref-variable-object paragraph-ignore-fill-prefix)))
+ (mark-local-ref mark (ref-variable-object fill-prefix)))
+ fill-prefix)
+ (mark-local-ref mark (ref-variable-object paragraph-start))
+ (mark-local-ref mark (ref-variable-object paragraph-separate))))
-(define (forward-one-paragraph mark)
- (and (not (group-end? mark))
- (let ((end (group-end mark))
- (fill-prefix (ref-variable fill-prefix))
- (page-delimiter (ref-variable page-delimiter))
- (forward-kernel
- (lambda (mark separator? skip-body)
- (if (separator? (line-start mark 0))
- (let ((para-start
- (let skip-separators ((mark mark))
- (let ((lstart (line-start mark 1)))
- (and lstart
- (if (separator? lstart)
- (skip-separators lstart)
- lstart))))))
- (and para-start
- (skip-body para-start)))
- (skip-body mark)))))
- (if (and fill-prefix
- (not (string-null? fill-prefix)))
- (let ((fill-prefix (re-quote-string fill-prefix)))
- (let ((prefix
- (string-append page-delimiter "\\|^" fill-prefix)))
- (let ((start (string-append prefix "[ \t\n]"))
- (separate (string-append prefix "[ \t]*$")))
- (forward-kernel mark
- (lambda (lstart)
- (or (not (re-match-forward fill-prefix lstart))
- (re-match-forward separate lstart)))
- (letrec ((skip-body
- (lambda (mark)
- (let ((lstart (line-start mark 1)))
- (cond ((not lstart) end)
- ((or (not
- (re-match-forward fill-prefix
- lstart))
- (re-match-forward start lstart))
- lstart)
- (else (skip-body lstart)))))))
- skip-body)))))
- (let ((prefix (string-append page-delimiter "\\|")))
- (let ((start
- (string-append prefix (ref-variable paragraph-start)))
- (separate
- (string-append prefix
- (ref-variable paragraph-separate))))
- (forward-kernel mark
- (lambda (mark)
- (re-match-forward separate mark))
- (lambda (mark)
- (if (re-search-forward start (line-end mark 0) end)
- (re-match-start 0)
- end)))))))))
-\f
-(define (backward-one-paragraph mark)
- (and (not (group-start? mark))
- (let ((start (group-start mark))
- (fill-prefix (ref-variable fill-prefix))
- (page-delimiter (ref-variable page-delimiter))
- (backward-kernel
- (lambda (mark separator? skip-body)
- (if (separator? (line-start mark 0))
- (let ((para-start
- (let skip-separators ((mark mark))
- (let ((lstart (line-start mark -1)))
- (and lstart
- (if (separator? lstart)
- (skip-separators lstart)
- lstart))))))
- (and para-start
- (skip-body para-start)))
- (skip-body mark)))))
- (if (and fill-prefix
- (not (string-null? fill-prefix)))
- (let ((fill-prefix (re-quote-string fill-prefix)))
- (let ((prefix
- (string-append page-delimiter "\\|^" fill-prefix)))
- (let ((starter (string-append prefix "[ \t\n]"))
- (separator (string-append prefix "[ \t]*$")))
- (backward-kernel mark
- (lambda (lstart)
- (or (not (re-match-forward fill-prefix lstart))
- (re-match-forward separator lstart)))
- (letrec ((skip-body
- (lambda (mark)
- (let ((lstart (line-start mark -1)))
- (cond ((not lstart) start)
- ((or (not
- (re-match-forward fill-prefix
- lstart))
- (re-match-forward starter
- lstart))
- lstart)
- (else (skip-body lstart)))))))
- skip-body)))))
- (let ((prefix (string-append page-delimiter "\\|")))
- (let ((starter
- (string-append prefix (ref-variable paragraph-start)))
- (separator
- (string-append prefix
- (ref-variable paragraph-separate))))
- (backward-kernel mark
- (lambda (mark)
- (re-match-forward separator mark))
- (lambda (mark)
- (if (re-search-backward starter mark start)
- (re-match-start 0)
- start)))))))))
-\f
(define forward-paragraph)
(define backward-paragraph)
(make-motion-pair forward-one-paragraph backward-one-paragraph
(set! forward-paragraph f)
(set! backward-paragraph b)
unspecific))
-
+\f
(define (paragraph-text-region mark)
(let ((end (or (paragraph-text-end mark) (group-end mark))))
(make-region (or (paragraph-text-start end) (group-start mark)) end)))
(define (paragraph-text-start mark)
(let ((start (backward-one-paragraph mark)))
(and start
- (let ((fill-prefix (ref-variable fill-prefix)))
- (if (and fill-prefix
- (not (string-null? fill-prefix)))
+ (let ((fill-prefix
+ (mark-local-ref mark (ref-variable-object fill-prefix))))
+ (if fill-prefix
(if (match-forward fill-prefix start)
start
(line-start start 1))
(let ((start
- (if (re-match-forward (ref-variable paragraph-separate)
- start)
+ (if (re-match-forward
+ (mark-local-ref
+ mark
+ (ref-variable-object paragraph-separate))
+ start)
(line-start start 1)
start)))
(or (skip-chars-forward " \t\n" start mark false)
(define-variable sentence-end
"Regexp describing the end of a sentence.
All paragraph boundaries also end sentences, regardless."
- "[.?!][]\")]*\\($\\|\t\\| \\)[ \t\n]*")
+ "[.?!][]\"')}]*\\($\\|\t\\| \\)[ \t\n]*"
+ string?)
(define (forward-one-sentence mark)
(let ((end (paragraph-text-end mark)))
(and end
- (let ((mark (re-search-forward (ref-variable sentence-end)
- mark end)))
+ (let ((mark
+ (re-search-forward
+ (mark-local-ref mark (ref-variable-object sentence-end))
+ mark
+ end)))
(if mark
(skip-chars-backward " \t\n" mark (re-match-start 0) false)
end)))))
(define (backward-one-sentence mark)
(let ((start (paragraph-text-start mark)))
(and start
- (if (re-search-backward (string-append (ref-variable sentence-end)
- "[^ \t\n]")
- mark start)
+ (if (re-search-backward
+ (string-append
+ (mark-local-ref mark (ref-variable-object sentence-end))
+ "[^ \t\n]")
+ mark
+ start)
(mark-1+ (re-match-end 0))
start))))
projects / mit-scheme.git / commitdiff