home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / TRANSPOS.S < prev    next >
Encoding:
Text File  |  1993-06-15  |  2.8 KB  |  73 lines
  1. ;;;
  2. ;;;    Copyright (c) 1985 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. ;;;
  38. ;;;     Modified by Texas Instruments Inc 8/15/85
  39. ;;;
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.  
  42. (define (twiddle-characters m1 m2)
  43.   (let ((m* (mark-left-inserting m2)))
  44.     (region-insert! m* (region-extract! (make-region (mark-1+ m1 'ERROR) m1)))
  45.     (set-current-point! m*)))
  46.  
  47. (define (%edwin-transpose-characters argument)
  48.   (cond ((conjunction (= argument 1) (line-end? (current-point)))
  49.      (twiddle-characters (mark-1+ (current-point) 'ERROR)
  50.                  (current-point)))
  51.     ((positive? argument)
  52.      (twiddle-characters (current-point)
  53.                  (mark+ (current-point) argument 'ERROR)))
  54.     ((negative? argument)
  55.      (twiddle-characters (current-point)
  56.                  (mark- (current-point) (1+ (- argument)) 'ERROR)))
  57.     (else
  58.      (let ((m1 (mark-right-inserting (current-point)))
  59.            (m2 (mark-right-inserting (current-mark))))
  60.        (let ((r1 (region-extract!
  61.               (make-region (current-point)
  62.                    (mark1+ (current-point) 'ERROR))))
  63.          (r2 (region-extract!
  64.               (make-region (current-mark)
  65.                    (mark1+ (current-mark) 'ERROR)))))
  66.          (region-insert! m1 r2)
  67.          (region-insert! m2 r1))
  68.        (set-current-point! m1)
  69.        (set-current-mark! m2)))))
  70.  
  71.  
  72.  
  73.