From: Chris Hanson Date: Thu, 21 Nov 1991 10:38:40 +0000 (+0000) Subject: Change procedures MOVE-THING, MOVE-THING-SAVING-POINT, MARK-THING, and X-Git-Tag: 20090517-FFI~10058 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d47c17debb624974af3d095d80e8ee1b4d997947;p=mit-scheme.git Change procedures MOVE-THING, MOVE-THING-SAVING-POINT, MARK-THING, and KILL-THING to take an additional argument that specifies the limit behavior of the motion procedure. This is needed because these procedures were being used in contexts that required different behavior -- and because they didn't supply it, some of the usages were incorrect. --- diff --git a/v7/src/edwin/lspcom.scm b/v7/src/edwin/lspcom.scm index daf84b71b..8ea65bcde 100644 --- a/v7/src/edwin/lspcom.scm +++ b/v7/src/edwin/lspcom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/lspcom.scm,v 1.155 1991/10/29 13:46:08 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/lspcom.scm,v 1.156 1991/11/21 10:37:20 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology ;;; @@ -53,14 +53,14 @@ With argument, do this that many times." "p" (lambda (argument) - (move-thing forward-sexp argument))) + (move-thing forward-sexp argument 'ERROR))) (define-command backward-sexp "Move backward across one balanced expression. With argument, do this that many times." "p" (lambda (argument) - (move-thing backward-sexp argument))) + (move-thing backward-sexp argument 'ERROR))) (define-command flash-sexp "Flash the char which ends the expression to the right of point. @@ -83,14 +83,14 @@ Shows you where \\[backward-sexp] would go." With argument, kill that many expressions after (or before) the cursor." "p" (lambda (argument) - (kill-thing forward-sexp argument))) + (kill-thing forward-sexp argument 'ERROR))) (define-command backward-kill-sexp "Kill the syntactic expression preceding the cursor. With argument, kill that many expressions before (or after) the cursor." "p" (lambda (argument) - (kill-thing backward-sexp argument))) + (kill-thing backward-sexp argument 'ERROR))) (define-command transpose-sexps "Transpose the sexps before and after point. @@ -103,7 +103,7 @@ See \\[transpose-words], reading 'sexp' for 'word'." "Mark one or more sexps from point." "p" (lambda (argument) - (mark-thing forward-sexp argument))) + (mark-thing forward-sexp argument 'ERROR))) ;;;; List Commands @@ -112,14 +112,14 @@ See \\[transpose-words], reading 'sexp' for 'word'." With argument, do this that many times." "p" (lambda (argument) - (move-thing forward-list argument))) + (move-thing forward-list argument 'ERROR))) (define-command backward-list "Move backward across one balanced group of parentheses. With argument, do this that many times." "p" (lambda (argument) - (move-thing backward-list argument))) + (move-thing backward-list argument 'ERROR))) (define-command down-list "Move forward down one level of parentheses. @@ -127,7 +127,7 @@ With argument, do this that many times. A negative argument means move backward but still go down a level." "p" (lambda (argument) - (move-thing forward-down-list argument))) + (move-thing forward-down-list argument 'ERROR))) (define-command backward-down-list "Move backward down one level of parentheses. @@ -135,7 +135,7 @@ With argument, do this that many times. A negative argument means move forward but still go down a level." "p" (lambda (argument) - (move-thing backward-down-list argument))) + (move-thing backward-down-list argument 'ERROR))) (define-command up-list "Move forward out one level of parentheses. @@ -143,7 +143,7 @@ With argument, do this that many times. A negative argument means move backward but still to a less deep spot." "p" (lambda (argument) - (move-thing forward-up-list argument))) + (move-thing forward-up-list argument 'ERROR))) (define-command backward-up-list "Move backward out one level of parentheses. @@ -151,7 +151,7 @@ With argument, do this that many times. A negative argument means move forward but still to a less deep spot." "p" (lambda (argument) - (move-thing backward-up-list argument))) + (move-thing backward-up-list argument 'ERROR))) ;;;; Definition Commands @@ -160,14 +160,16 @@ A negative argument means move forward but still to a less deep spot." With argument, do this that many times." "p" (lambda (argument) - (move-thing backward-definition-start argument))) + (move-thing backward-definition-start argument 'ERROR))) (define-command end-of-defun "Move forward to next end of defun. An end of a defun is found by moving forward from the beginning of one." "p" (lambda (argument) - (move-thing forward-definition-end (if (zero? argument) 1 argument)))) + (move-thing forward-definition-end + (if (zero? argument) 1 argument) + 'ERROR))) (define-command mark-defun "Put mark at end of defun, point at beginning." @@ -225,9 +227,8 @@ rigidly along with this one." (lisp-indent-sexp mark))) (define-command insert-parentheses - "Insert a pair of matching parentheses, leaving the point after the -open parenthesis. With argument, wrap parentheses around that many -following sexps.)" + "Put parentheses around next ARG sexps. Leave point after open-paren. +No argument is equivalent to zero: just insert () and leave point between." "P" (lambda (argument) (if argument @@ -253,17 +254,14 @@ following sexps.)" (set-current-point! mark)))) (define-command move-past-close-and-reindent - "Move past next right parenthesis, delete indentation before it, and -indent after it." + "Move past next ), delete indentation before it, then indent after it." () (lambda () - (set-current-point! (mark-1+ (forward-up-list (current-point) 1 'limit))) - (let delete-more-indentation ((before-parenthesis (current-point))) - (if (mark= before-parenthesis - (horizontal-space-end (line-start (current-point) 0))) - (begin ((ref-command delete-indentation) #f) - (delete-more-indentation (current-point))))) - (move-thing mark+ 1) + ((ref-command up-list) 1) + ((ref-command backward-char) 1) + (do () ((not (within-indentation? (current-point)))) + ((ref-command delete-indentation) false)) + ((ref-command forward-char) 1) ((ref-command newline-and-indent)))) ;;;; Motion Covers diff --git a/v7/src/edwin/motcom.scm b/v7/src/edwin/motcom.scm index 2912a2a70..3436d0ced 100644 --- a/v7/src/edwin/motcom.scm +++ b/v7/src/edwin/motcom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/motcom.scm,v 1.44 1991/10/04 06:09:24 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/motcom.scm,v 1.45 1991/11/21 10:37:39 cph Exp $ ;;; ;;; Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology ;;; @@ -50,7 +50,7 @@ "Move point to beginning of line." "p" (lambda (argument) - (set-current-point! (line-start (current-point) (-1+ argument) 'LIMIT)))) + (move-thing line-start (- argument 1) 'FAILURE))) (define-command backward-char "Move back one character. @@ -58,13 +58,13 @@ With argument, move that many characters backward. Negative arguments move forward." "p" (lambda (argument) - (move-thing mark- argument))) + (move-thing mark- argument 'FAILURE))) (define-command end-of-line "Move point to end of line." "p" (lambda (argument) - (set-current-point! (line-end (current-point) (-1+ argument) 'LIMIT)))) + (move-thing line-end (- argument 1) 'FAILURE))) (define-command forward-char "Move forward one character. @@ -72,7 +72,7 @@ With argument, move that many characters forward. Negative args move backward." "p" (lambda (argument) - (move-thing mark+ argument))) + (move-thing mark+ argument 'FAILURE))) (define-command beginning-of-buffer "Go to beginning of buffer (leaving mark behind). diff --git a/v7/src/edwin/rmailsum.scm b/v7/src/edwin/rmailsum.scm index d787ef6ab..d4afe1601 100644 --- a/v7/src/edwin/rmailsum.scm +++ b/v7/src/edwin/rmailsum.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmailsum.scm,v 1.15 1991/10/03 19:48:20 bal Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmailsum.scm,v 1.16 1991/11/21 10:38:08 cph Exp $ ;;; ;;; Copyright (c) 1991 Massachusetts Institute of Technology ;;; @@ -220,7 +220,7 @@ RECIPIENTS is a string of names separated by commas." (labels (begin (set-current-point! start) - (move-thing mark+ 3) + (move-thing mark+ 3 'ERROR) (if (and (search-forward ",," start end) (line-end? (current-point))) (let ((point (current-point))) diff --git a/v7/src/edwin/texcom.scm b/v7/src/edwin/texcom.scm index 29d2e8c8b..e9a94ce01 100644 --- a/v7/src/edwin/texcom.scm +++ b/v7/src/edwin/texcom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/texcom.scm,v 1.33 1990/10/03 04:56:08 cph Rel $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/texcom.scm,v 1.34 1991/11/21 10:38:27 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology ;;; @@ -91,31 +91,31 @@ "Move one or more words forward." "p" (lambda (argument) - (move-thing forward-word argument))) + (move-thing forward-word argument 'FAILURE))) (define-command backward-word "Move one or more words backward." "p" (lambda (argument) - (move-thing backward-word argument))) + (move-thing backward-word argument 'FAILURE))) (define-command mark-word "Set mark one or more words from point." "p" (lambda (argument) - (mark-thing forward-word argument))) + (mark-thing forward-word argument 'FAILURE))) (define-command kill-word "Kill one or more words forward." "p" (lambda (argument) - (kill-thing forward-word argument))) + (kill-thing forward-word argument 'FAILURE))) (define-command backward-kill-word "Kill one or more words backward." "p" (lambda (argument) - (kill-thing backward-word argument))) + (kill-thing backward-word argument 'FAILURE))) (define-command transpose-words "Transpose the words before and after the cursor. @@ -194,66 +194,54 @@ treated as a regular expression. Also, every paragraph boundary terminates sentences as well." "p" (lambda (argument) - (move-thing forward-sentence argument))) + (move-thing forward-sentence argument 'FAILURE))) (define-command backward-sentence "Move backward to start of sentence. With arg, do it arg times. See \\[forward-sentence] for more information." "p" (lambda (argument) - (move-thing backward-sentence argument))) - -(define-command mark-sentence - "Put point at beginning and mark at end of sentence. -If you are between sentences, the following sentence is used -unless you are at the end of a paragraph." - () - (lambda () - (let ((end (forward-sentence (current-point) 1 'ERROR))) - (set-current-region! - (make-region (backward-sentence end 1 'ERROR) end))))) + (move-thing backward-sentence argument 'FAILURE))) (define-command kill-sentence - "Kill forward to end of sentence. -Accepts numeric argument of either sign." + "Kill from point to end of sentence. +With arg, repeat, or backward if negative arg." "p" (lambda (argument) - (kill-thing forward-sentence argument))) + (kill-thing forward-sentence argument 'FAILURE))) (define-command backward-kill-sentence - "Kill backward to end of sentence. -Accepts numeric argument of either sign." + "Kill back from point to start of sentence. +With arg, repeat, or forward if negative arg." "p" (lambda (argument) - (kill-thing backward-sentence argument))) + (kill-thing backward-sentence argument 'FAILURE))) ;;;; Paragraphs (define-command forward-paragraph - "Move forward to end of paragraph. -See documentation on \\[backward-paragraph]." + "Move forward to end of paragraph. With arg, do it arg times. +A line which paragraph-start matches either separates paragraphs +\(if paragraph-separate matches it also) or is the first line of a paragraph. +A paragraph end is the beginning of a line which is not part of the paragraph +to which the end of the previous line belongs, or the end of the buffer." "p" (lambda (argument) - (move-thing forward-paragraph argument))) + (move-thing forward-paragraph argument 'FAILURE))) (define-command backward-paragraph - "Move backward to start of paragraph. -Paragraphs are delimited by blank lines or by lines which - start with a delimiter in paragraph-delimiter or page-delimiter . -If there is a fill prefix, any line that doesn't start with it - starts a paragraph. -Lines which start with the any character in text-justifier-escape-chars, - if that character is matched by paragraph-delimiter , - count as blank lines in that they separate paragraphs and - are not part of them." + "Move backward to start of paragraph. With arg, do it arg times. +A paragraph start is the beginning of a line which is a first-line-of-paragraph +or which is ordinary text and follows a paragraph-separating line; except: +if the first real line of a paragraph is preceded by a blank line, +the paragraph starts at that blank line. +See forward-paragraph for more information." "p" (lambda (argument) - (move-thing backward-paragraph argument))) + (move-thing backward-paragraph argument 'FAILURE))) (define-command mark-paragraph - "Put point and mark around this paragraph. -In between paragraphs, puts it around the next one. -See \\[backward-paragraph] for paragraph definition." + "Put point at beginning of this paragraph, mark at end." () (lambda () (let ((end (forward-paragraph (current-point) 1 'ERROR))) diff --git a/v7/src/edwin/things.scm b/v7/src/edwin/things.scm index b7d90e1f8..8d501c2f7 100644 --- a/v7/src/edwin/things.scm +++ b/v7/src/edwin/things.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/things.scm,v 1.82 1991/10/29 13:49:58 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/things.scm,v 1.83 1991/11/21 10:38:40 cph Exp $ ;;; ;;; Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology ;;; @@ -96,19 +96,18 @@ ;;;; Generic Operations -(define (move-thing forward-thing argument) - (set-current-point! (forward-thing (current-point) argument 'FAILURE))) +(define (move-thing forward-thing argument limit?) + (set-current-point! (forward-thing (current-point) argument limit?))) -(define (move-thing-saving-point forward-thing argument) - (let ((mark (current-point))) - (push-current-mark! mark) - (set-current-point! (forward-thing mark argument 'FAILURE)))) +(define (move-thing-saving-point forward-thing argument limit?) + (push-current-mark! (current-point)) + (move-thing forward-thing argument limit?)) -(define (mark-thing forward-thing n) - (push-current-mark! (forward-thing (current-point) n 'ERROR))) +(define (mark-thing forward-thing n limit?) + (push-current-mark! (forward-thing (current-point) n limit?))) -(define (kill-thing forward-thing n) - (kill-region (forward-thing (current-point) n 'ERROR))) +(define (kill-thing forward-thing n limit?) + (kill-region (forward-thing (current-point) n limit?))) (define (transpose-things forward-thing n) (define (forward-once i)