home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / ARGRED.S < prev    next >
Encoding:
Text File  |  1993-08-21  |  7.4 KB  |  259 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. ;;;; Command Argument Reader
  43.  
  44. ;; Public
  45. (define (with-command-argument-reader thunk)
  46.   (fluid-let ((*magnitude* '())
  47.           (*negative?* '())
  48.           (*multiplier-exponent* '())
  49.           (*autoargument-mode?* '()))
  50.     (thunk)))
  51.  
  52. ;; Public
  53. (define (reset-command-argument-reader!)
  54.   ;; Call this at the beginning of a command cycle.
  55.   (set-fluid! *magnitude* #F)
  56.   (set-fluid! *negative?* #F)
  57.   (set-fluid! *multiplier-exponent* 0)
  58.   (set-fluid! *autoargument-mode?* #F))
  59.  
  60. ;; Public
  61. (define (command-argument-prompt)
  62.   (let ((prefix (if (autoargument-mode?) "Autoarg" "Arg"))
  63.     (value (command-argument-value)))
  64.     (cond (value (string-append prefix " " (obj->string value)))
  65.       ((command-argument-negative?) (string-append prefix " -"))
  66.       (else ""))))
  67.  
  68. ;; Public
  69. (define (command-argument-negative?)
  70.   (fluid *negative?*))
  71.  
  72. ;; Public
  73. (define (command-argument-value)
  74.   ;; This returns the numeric value of the argument, or #F if none.
  75.   (let ((m (command-argument-magnitude))
  76.     (s (command-argument-multiplier-exponent)))
  77.     (and (or m (not (zero? s)))
  78.      ((if (command-argument-negative?) - identity-procedure)
  79.       (* (or m 1)
  80.          (integer-expt (command-argument-multiplier-base) s))))))
  81.  
  82. ;; Public
  83. (define (command-argument-magnitude)
  84.   (fluid *magnitude*))
  85.  
  86. ;; Public
  87. (define (command-argument-multiplier-exponent)
  88.   (fluid *multiplier-exponent*))
  89.  
  90. ;; Public
  91. (define (command-argument-multiplier-base)
  92.   *multiplier-base*)
  93.  
  94. ;; Public
  95. (define (autoargument-mode?)
  96.   (fluid *autoargument-mode?*))
  97.  
  98. ;;;; Value
  99. (define integer-expt
  100.   (lambda (b e)
  101.      (if (zero? e)
  102.      1
  103.      (* b (integer-expt b (sub1 e))))))
  104.  
  105.  
  106. ;;;; Description
  107. ;;;
  108. ;;; 1.  The reader keeps track of:
  109. ;;;
  110. ;;; [] The MAGNITUDE of the argument.  If there are no digits, the
  111. ;;;    magnitude is #F.
  112. ;;; [] The SIGN of the argument.
  113. ;;; [] The MULTIPLIER-EXPONENT, which is the number of C-U's typed.
  114. ;;; [] Whether or not "Autoargument mode" is in effect.  In autoarg
  115. ;;;    mode, ordinary digits are interpreted as part of the argument;
  116. ;;;    normally they are self-insering.
  117. ;;;
  118. ;;; 2.  It has the following (alterable) parameters:
  119. ;;;
  120. ;;; [] RADIX, which is between 2 and 36 inclusive. (default: 10)
  121. ;;; [] MULTIPLIER-BASE, a non-negative integer. (default: 4)
  122. ;;;
  123. ;;; 3.  From these, it can compute:
  124. ;;;
  125. ;;; [] VALUE = (* MAGNITUDE MULTIPLIER-EXPONENT MULTIPLIER-BASE).
  126. ;;;    If the magnitude is #F, then the value is too.
  127.  
  128. ;;;; Primitives
  129.  
  130. ;; Public
  131. ;(define (with-command-argument-reader thunk)
  132.  
  133. ;; Public
  134. ;(define (reset-command-argument-reader!)
  135.  
  136. ;; Public
  137. (define (update-argument-prompt!)
  138.   (set-command-prompt! (command-argument-prompt)))
  139.  
  140. ;; Public
  141. ;(define (command-argument-prompt)
  142.  
  143. ;;;; Argument Number
  144.  
  145. (define *radix*)
  146.  
  147. ;; Public
  148. (define (command-argument-accumulate-digit! digit-char)
  149.   (maybe-reset-multiplier-exponent!)
  150.   (let ((digit (or (char->digit digit-char *radix*)
  151.            (error "Not a valid digit" digit-char))))
  152.     (set-fluid! *magnitude*
  153.       (if (not (fluid *magnitude*))
  154.           digit
  155.           (+ digit (* *radix* (fluid *magnitude*)))))))
  156.  
  157. ;; Public
  158. (define (set-command-argument-radix! n)
  159.   (if (not (and (integer? n) (<= 2 n) (<= n 36)))
  160.       (error "Radix must be an integer between 2 and 36, inclusive" n))
  161.   (set! *radix* n))
  162.  
  163. ;; Public
  164. (define (command-argument-negate!)
  165.   (maybe-reset-multiplier-exponent!)
  166.   (set-fluid! *negative?* (not (fluid *negative?*))))
  167.  
  168. ;; Public
  169. ;(define (command-argument-magnitude)
  170.  
  171. ;; Public
  172. (define (command-argument-radix)
  173.   *radix*)
  174.  
  175. ;; Public
  176. ;(define (command-argument-negative?)
  177.  
  178. ;; **** Kludge ****
  179. (set-command-argument-radix! 10)
  180.  
  181. ;;;; Argument Multiplier
  182.  
  183.  
  184. (define *multiplier-base*)
  185.  
  186. ;; Public
  187. (define (command-argument-increment-multiplier-exponent!)
  188.   (set-fluid! *multiplier-exponent* (1+ (fluid *multiplier-exponent*))))
  189.  
  190. (define (maybe-reset-multiplier-exponent!)
  191.   (if (and (not (fluid *magnitude*))
  192.        (= (fluid *multiplier-exponent*) 1))
  193.       (set-fluid! *multiplier-exponent* 0)))
  194.  
  195. ;; Public
  196. ;(define (command-argument-multiplier-exponent)
  197.  
  198. ;; Public
  199. ;(define (command-argument-multiplier-base)
  200.  
  201. ;; Public
  202. (define (set-command-argument-multiplier-base! n)
  203.   (if (not (and (integer? n) (not (negative? n))))
  204.       (error "Multiplier Base" n "must be a non-negative integer."))
  205.   (set! *multiplier-base* n))
  206.  
  207. ;; **** Kludge ****
  208. (set-command-argument-multiplier-base! 4)
  209.  
  210. ;;;; Autoargument Mode
  211.  
  212. ;; Public
  213. (define (enter-autoargument-mode!)
  214.   (set-fluid! *autoargument-mode?* #T))
  215.  
  216. ;; *** Is this needed? ***
  217. ;;(define (exit-autoargument-mode!)
  218. ;;  (set-fluid! *autoargument-mode?* #F))
  219.  
  220. ;; Public
  221. ;(define (autoargument-mode?)
  222.  
  223.  
  224. ;;;; Value
  225. ;(define integer-expt
  226.  
  227. ;; Public
  228. ;(define (command-argument-value)
  229.  
  230. ;; Public
  231. (define (command-argument-multiplier-only?)
  232.   (and (not (fluid *magnitude*))
  233.        (not (zero? (fluid *multiplier-exponent*)))
  234.        (fluid *multiplier-exponent*)))
  235.  
  236. ;; Public
  237. (define (command-argument-negative-only?)
  238.   (and (not (fluid *magnitude*))
  239.        (zero? (fluid *multiplier-exponent*))
  240.        (fluid *negative?*)))
  241.  
  242. ;; Public
  243. (define (command-argument-beginning?)
  244.   (and (not (fluid *magnitude*))
  245.        (not (fluid *negative?*))
  246.        (< (fluid *multiplier-exponent*) 2)))
  247.  
  248. (define (%edwin-autoargument argument)
  249.   (let ((char (char-base (current-command-char))))
  250.     (if (eq? char #\-)
  251.          (if (command-argument-beginning?)
  252.         (begin (enter-autoargument-mode!)
  253.            (^r-negative-argument-command argument))
  254.         (insert-chars char argument (current-point)))
  255.     (begin (enter-autoargument-mode!)
  256.            (^r-argument-digit-command argument)))))
  257.  
  258.  
  259.