home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / SENTENCE.S < prev    next >
Encoding:
Text File  |  1993-06-15  |  9.7 KB  |  277 lines
  1. ;;;
  2. ;;;    Copyright (c) 1984 Massachusetts Institute of Technology
  3. ;;;
  4. ;;;    This material was developed by the Scheme project at the
  5. ;;;    Massachusetts Institute of Technology, Department of
  6. ;;;    Electrical Engineering and Computer Science.  Permission to
  7. ;;;    copy this software, to redistribute it, and to use it for any
  8. ;;;    purpose is granted, subject to the following restrictions and
  9. ;;;    understandings.
  10. ;;;
  11. ;;;    1. Any copy made of this software must include this copyright
  12. ;;;    notice in full.
  13. ;;;
  14. ;;;    2. Users of this software agree to make their best efforts (a)
  15. ;;;    to return to the MIT Scheme project any improvements or
  16. ;;;    extensions that they make, so that these may be included in
  17. ;;;    future releases; and (b) to inform MIT of noteworthy uses of
  18. ;;;    this software.
  19. ;;;
  20. ;;;    3.  All materials developed as a consequence of the use of
  21. ;;;    this software shall duly acknowledge such use, in accordance
  22. ;;;    with the usual standards of acknowledging credit in academic
  23. ;;;    research.
  24. ;;;
  25. ;;;    4. MIT has made no warrantee or representation that the
  26. ;;;    operation of this software will be error-free, and MIT is
  27. ;;;    under no obligation to provide any services, by way of
  28. ;;;    maintenance, update, or otherwise.
  29. ;;;
  30. ;;;    5.  In conjunction with products arising from the use of this
  31. ;;;    material, there shall be no use of the name of the
  32. ;;;    Massachusetts Institute of Technology nor of any adaptation
  33. ;;;    thereof in any advertising, promotional, or sales literature
  34. ;;;    without prior written consent from MIT in each case.
  35. ;;;
  36.  
  37. ;;;; Sentences
  38.  
  39.  
  40. (define char-set:sentence-terminators
  41.   (make-char-set #\. #\? #\!))
  42.  
  43. (define find-next-sentence-terminator
  44.   (char-set-forward-search char-set:sentence-terminators))
  45.  
  46. (define find-previous-sentence-terminator
  47.   (char-set-backward-search char-set:sentence-terminators))
  48.  
  49. (define char-set:not-closing-chars
  50.   (char-set-invert (make-char-set #\" #\' #\) #\])))
  51.  
  52. (define skip-next-closing-chars
  53.   (char-set-forward-search char-set:not-closing-chars))
  54.  
  55. (define skip-next-whitespace
  56.   (char-set-forward-search char-set:not-whitespace))
  57.  
  58.  
  59. (define (forward-sentence mark n limit?)
  60.   (cond ((positive? n) (%forward-sentence mark n limit?))
  61.     ((negative? n) (%backward-sentence mark (- n) limit?))
  62.     (else mark)))
  63.  
  64. (define (%forward-sentence mark n limit?)
  65.   (define (loop mark n)
  66.     (let ((sent-end (forward-one-sentence mark)))
  67.       (cond ((not sent-end) (limit-mark-motion limit? mark))
  68.         ((= n 1) sent-end)
  69.         (else (loop sent-end (-1+ n))))))
  70.   (loop mark n))
  71.  
  72. (define (forward-one-sentence mark)
  73.   (define (loop mark)
  74.     (let ((this-line-end (line-end mark 0 #F)))
  75.       (or (find-next-sentence-delimiter mark this-line-end)
  76.       (let ((next-line-start (line-start mark 1 #F)))
  77.         (if (or (not next-line-start)
  78.             (paragraph-terminator? next-line-start))
  79.         (horizontal-space-start this-line-end)
  80.         (loop next-line-start))))))
  81.   (cond ((paragraph-delimiter? (line-start mark 0 #F))
  82.      (let ((para-start (skip-next-paragraph-delimiters mark)))
  83.        (and para-start (loop para-start))))
  84.     ((line-end? (horizontal-space-end mark))
  85.      (let ((next-line-start (line-start mark 1 #F)))
  86.        (and next-line-start
  87.         (forward-one-sentence next-line-start))))
  88.     (else (loop mark))))
  89.  
  90. (define (backward-sentence mark n limit?)
  91.   (if (unassigned? limit?) (set! limit? #F))
  92.   (cond ((positive? n) (%backward-sentence mark n limit?))
  93.     ((negative? n) (%forward-sentence mark (- n) limit?))
  94.     (else mark)))
  95.  
  96. (define (%backward-sentence mark n limit?)
  97.   (define (loop mark n)
  98.     (let ((sent-start (backward-one-sentence mark)))
  99.       (cond ((not sent-start) (limit-mark-motion limit? mark))
  100.         ((= n 1) sent-start)
  101.         (else (loop sent-start (-1+ n))))))
  102.   (loop mark n))
  103.  
  104. (define (backward-one-sentence mark)
  105.   (define (find start)
  106.     (define (loop mark)
  107.       (let ((this-line-start (line-start mark 0 #F)))
  108.     (or (find-previous-sentence-delimiter mark start this-line-start)
  109.         (if (paragraph-indentation? this-line-start)
  110.         (horizontal-space-end this-line-start)
  111.         (let ((previous-line-end (line-end mark -1 #F)))
  112.           (if (or (not previous-line-end)
  113.               (paragraph-delimiter? previous-line-end))
  114.               this-line-start
  115.               (loop previous-line-end)))))))
  116.     (loop start))
  117.   (cond ((paragraph-delimiter? (line-start mark 0 #F))
  118.      (let ((para-end (skip-previous-paragraph-delimiters mark)))
  119.        (and para-end
  120.         (find (mark-1+ (horizontal-space-start
  121.                 (line-end para-end 0 #F)) #F)))))
  122.     ((line-start? (horizontal-space-start mark))
  123.      (let ((previous-line-end (line-end mark -1 #F)))
  124.        (and previous-line-end
  125.         (backward-one-sentence previous-line-end))))
  126.     (else (find mark))))
  127.  
  128. (define (find-next-sentence-delimiter start end)        
  129.   (define (loop mark)
  130.     (let ((sent-term (find-next-sentence-terminator mark end #F)))
  131.       (and sent-term
  132.        (let ((sent-end (skip-next-closing-chars (mark1+ sent-term #F)
  133.                             end
  134.                             'LIMIT)))
  135.          (if (sentence-end? sent-end)
  136.          sent-end
  137.          (loop sent-end))))))
  138.   (loop start))
  139.  
  140. (define (find-previous-sentence-delimiter mark start end)
  141.   (define (loop mark)
  142.     (let ((sent-term (find-previous-sentence-terminator mark end #F)))
  143.       (and sent-term
  144.        (let ((sent-end (skip-next-closing-chars sent-term start #F)))
  145.          (or (and sent-end
  146.               (sentence-end? sent-end)
  147.               (skip-next-whitespace sent-end start #F))
  148.          (loop (mark-1+ sent-term #F)))))))
  149.   (loop mark))
  150.  
  151. (define (sentence-end? sent-end)
  152.   (or (line-end? sent-end)
  153.       (and (char= #\Space (mark-right-char sent-end))
  154.        (let ((x (mark1+ sent-end #F)))
  155.          (or (line-end? x)
  156.          (char= #\Space (mark-right-char x)))))))
  157.  
  158.  
  159. ;;; Pages
  160.  
  161. ;;;; Paragraphs
  162.  
  163. (define paragraph-delimiters
  164.   (make-char-set #\.))
  165.  
  166. (define text-justifier-escape-chars
  167.   (make-char-set #\. #\' #\- #\\ #\@))
  168.  
  169. (define (page-mark-next? mark)
  170.   (match-next-strings mark (mark-end mark) page-delimiters))
  171.  
  172. (define (forward-paragraph mark n limit?)
  173.   (cond ((positive? n) (%forward-paragraph mark n limit?))
  174.     ((negative? n) (%backward-paragraph mark (- n) limit?))
  175.     (else mark)))
  176.  
  177. (define (%forward-paragraph mark n limit?)
  178.   (define (loop mark n)
  179.     (let ((para-end (forward-one-paragraph mark)))
  180.       (cond ((not para-end) (limit-mark-motion limit? mark))
  181.         ((= n 1) para-end)
  182.         (else (loop para-end (-1+ n))))))
  183.   (loop mark n))
  184.  
  185. (define (forward-one-paragraph mark)
  186.   (conjunction (not (group-end? mark))
  187.            (if (paragraph-delimiter? (line-start mark 0 #F))
  188.            (let ((para-start (skip-next-paragraph-delimiters mark)))
  189.              (conjunction para-start
  190.                   (skip-next-paragraph-body para-start)))
  191.            (skip-next-paragraph-body mark))))
  192.  
  193. (define (skip-next-paragraph-delimiters mark)
  194.   (let ((this-line-start (line-start mark 1 #F)))
  195.     (conjunction this-line-start
  196.          (if (paragraph-delimiter? this-line-start)
  197.              (skip-next-paragraph-delimiters this-line-start)
  198.              this-line-start))))
  199.  
  200. (define (skip-next-paragraph-body mark)
  201.   (let ((this-line-start (line-start mark 1 #F)))
  202.     (cond ((not this-line-start) (line-end mark 0 #F))
  203.       ((paragraph-terminator? this-line-start) this-line-start)
  204.       (else (skip-next-paragraph-body this-line-start)))))
  205.  
  206. (define (backward-paragraph mark n limit?)
  207.   (cond ((positive? n) (%backward-paragraph mark n limit?))
  208.     ((negative? n) (%forward-paragraph mark (- n) limit?))
  209.     (else mark)))
  210.  
  211. (define (%backward-paragraph mark n limit?)
  212.   (define (loop mark n)
  213.     (let ((para-start (backward-one-paragraph mark)))
  214.       (cond ((not para-start) (limit-mark-motion limit? mark))
  215.         ((= n 1) para-start)
  216.         (else (loop para-start (-1+ n))))))
  217.   (loop mark n))
  218.  
  219. (define (backward-one-paragraph mark)
  220.   (conjunction
  221.    (not (group-start? mark))
  222.    (cond ((conjunction (line-start? mark)
  223.                (paragraph-indentation? mark))
  224.       (let ((previous-line-start (mark-1+ mark #F)))
  225.         (conjunction previous-line-start
  226.              (backward-one-paragraph previous-line-start))))
  227.      ((paragraph-delimiter? (line-start mark 0 #F))
  228.       (let ((para-end (skip-previous-paragraph-delimiters mark)))
  229.         (conjunction para-end
  230.              (skip-previous-paragraph-body para-end))))
  231.      (else
  232.       (skip-previous-paragraph-body (line-start mark 0 #F))))))
  233.  
  234. (define (skip-previous-paragraph-delimiters mark)
  235.   (let ((this-line-start (line-start mark -1 #F)))
  236.     (conjunction this-line-start
  237.          (if (paragraph-delimiter? this-line-start)
  238.              (skip-previous-paragraph-delimiters this-line-start)
  239.              this-line-start))))
  240.  
  241. (define (skip-previous-paragraph-body this-line-start)
  242.   (cond ((paragraph-indentation? this-line-start)
  243.      (let ((previous-line-start (line-start this-line-start -1 #F)))
  244.        (if (conjunction previous-line-start
  245.                 (paragraph-delimiter? previous-line-start))
  246.            previous-line-start
  247.            this-line-start)))
  248.     ((paragraph-delimiter? this-line-start) this-line-start)
  249.     (else
  250.      (let ((previous-line-start (line-start this-line-start -1 #F)))
  251.        (if (not previous-line-start)
  252.            this-line-start
  253.            (skip-previous-paragraph-body previous-line-start))))))
  254.  
  255.  
  256. (define (paragraph-delimiter? this-line-start)
  257.   (disjunction
  258.    (line-blank? this-line-start)
  259.    (if (not *current-mode-scheme?*)
  260.        (conjunction
  261.     (not (group-end? this-line-start))
  262.     (let ((char (mark-right-char this-line-start)))
  263.       (char-set-member? text-justifier-escape-chars char)))
  264.        #F)))
  265.  
  266. (define (paragraph-indentation? this-line-start)
  267.   (and (not *current-mode-scheme?*)
  268.        (not (line-blank? this-line-start))
  269.        (char-blank? (mark-right-char this-line-start))))
  270.  
  271. (define (paragraph-terminator? this-line-start)
  272.   (disjunction (paragraph-delimiter? this-line-start)
  273.            (paragraph-indentation? this-line-start)))
  274.  
  275.  
  276.      
  277.