home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / PARENS.S < prev    next >
Encoding:
Text File  |  1993-08-21  |  4.4 KB  |  119 lines
  1.  
  2. ;;;
  3. ;;;     Copyright (c) 1985 Massachusetts Institute of Technology
  4. ;;;
  5. ;;;     This material was developed by the Scheme project at the
  6. ;;;     Massachusetts Institute of Technology, Department of
  7. ;;;     Electrical Engineering and Computer Science.  Permission to
  8. ;;;     copy this software, to redistribute it, and to use it for any
  9. ;;;     purpose is granted, subject to the following restrictions and
  10. ;;;     understandings.
  11. ;;;
  12. ;;;     1. Any copy made of this software must include this copyright
  13. ;;;     notice in full.
  14. ;;;
  15. ;;;     2. Users of this software agree to make their best efforts (a)
  16. ;;;     to return to the MIT Scheme project any improvements or
  17. ;;;     extensions that they make, so that these may be included in
  18. ;;;     future releases; and (b) to inform MIT of noteworthy uses of
  19. ;;;     this software.
  20. ;;;
  21. ;;;     3.  All materials developed as a consequence of the use of
  22. ;;;     this software shall duly acknowledge such use, in accordance
  23. ;;;     with the usual standards of acknowledging credit in academic
  24. ;;;     research.
  25. ;;;
  26. ;;;     4. MIT has made no warrantee or representation that the
  27. ;;;     operation of this software will be error-free, and MIT is
  28. ;;;     under no obligation to provide any services, by way of
  29. ;;;     maintenance, update, or otherwise.
  30. ;;;
  31. ;;;     5.  In conjunction with products arising from the use of this
  32. ;;;     material, there shall be no use of the name of the
  33. ;;;     Massachusetts Institute of Technology nor of any adaptation
  34. ;;;     thereof in any advertising, promotional, or sales literature
  35. ;;;     without prior written consent from MIT in each case.
  36. ;;;
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38. ;;;
  39. ;;;     Modified by Texas Instruments Inc 8/15/85
  40. ;;;
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42.  
  43. (define (backward-one-list start end)
  44.   (backward-sexp:top start end 0))
  45.  
  46. (define backward-sexp:top
  47.   (lambda (start end depth)
  48.     (letrec
  49.       ((backward-sexp:top
  50.          (lambda (start end depth)
  51.            (and (mark> start end)
  52.                 (search-backward start end depth))))
  53.  
  54.        (search-backward
  55.          (lambda (start end depth)
  56.            (let ((mark (find-previous-char-in-set start end sexp-delims)))
  57.              (and mark
  58.                   (cond
  59.                    ((char=? (mark-left-char mark)   ;;; (
  60.                             #\) )
  61.                     (list-backward-close (mark-1+ mark #F) end depth))
  62.                    (else
  63.                     (if (and (<> depth 1)
  64.                              (terminate? mark))
  65.                         #F
  66.                         (list-backward-open (mark-1+ mark #F)
  67.                                             end depth))))))))
  68.       (terminate?
  69.         (lambda (mark)
  70.           (and (= 1 (mark-position mark))
  71.                (let ((m (line-start mark -1 #F)))
  72.                  (and m
  73.                       (line-blank? m))))))
  74.  
  75.       (list-backward-close
  76.         (lambda (start end depth)
  77.           (if (= depth -1)
  78.               start
  79.               (backward-sexp:top start end (1+ depth)))))
  80.  
  81.       (list-backward-open
  82.         (lambda (start end depth)
  83.           (and (> depth 0)
  84.                (if (= depth 1)
  85.                    start
  86.                    (backward-sexp:top start end (-1+ depth)))))))
  87.     (backward-sexp:top start end depth))))
  88.  
  89. (define with-reverse-attributes
  90.   (let ((reverse-attr 112)
  91.         (display-matching-paren
  92.           (lambda (old)
  93.             (let ((x (%reify-port buffer-screen screen:cursor-x))
  94.                   (y (%reify-port buffer-screen screen:cursor-y)))
  95.               (princ #\( buffer-screen)           ;;;;)
  96.               (delay-input 50 buffer-screen)
  97.               (%reify-port! buffer-screen 7 old)
  98.               (%reify-port! buffer-screen screen:cursor-x x)
  99.               (%reify-port! buffer-screen screen:cursor-y y)
  100.               (princ #\( buffer-screen)))))            ;;;;;)
  101.   (lambda ()
  102.     (let ((old (%reify-port buffer-screen 7)))
  103.       (update-display! (current-window))
  104.       (%reify-port! buffer-screen 7 reverse-attr)
  105.       (display-matching-paren old)))))
  106.  
  107.  
  108. (define delay-input
  109.   (let ((delay-time 1000))
  110.   (lambda (n screen)
  111.     ((rec loop
  112.       (lambda (n)
  113.         (if (char-ready? screen)
  114.             #T
  115.             (if (zero? n)
  116.                 #F
  117.                 (loop (-1+ n)))))) delay-time))))
  118.  
  119.