[Wisp-cvs] wisp/src/builtin builtin.wisp,1.212,1.213 stdenv.wisp,1.373,1.374

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv17355/src/builtin

Modified Files:
	builtin.wisp stdenv.wisp 
Log Message:
Introduced |my-options|.

Index: builtin.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/builtin.wisp,v
retrieving revision 1.212
retrieving revision 1.213
diff -u -d -r1.212 -r1.213
--- builtin.wisp	7 Sep 2002 21:59:26 -0000	1.212
+++ builtin.wisp	20 Sep 2002 18:35:44 -0000	1.213
@@ -629,4 +629,29 @@
       (dict?   (alist->dict (loop (dict->alist s))))
       (else s))))
 
+(defmacro (my-options decl arglist . body)
+  (my vars '()
+    (my code '()
+      (for-each (lambda (decl)
+                  (cond
+                    ((keyword? decl)
+                      (my var (string->symbol "$[decl]?"[1 ...])
+                        (if (keyword? var)
+                          (raise 'option-declaration? decl))
+                        (cons! vars var)
+                        (cons! code `(,decl (set! ,var #t)))))
+                    (else (raise 'option-declaration? decl))))
+       decl)
+      `(let ,(map (cut list <> #f) vars)
+         (my .l (hide* ,vars ,arglist)
+           (while (not (null-list? .l))
+             (case (car .l)
+               ,@(map (lambda (code-item)
+                        `((,(car code-item)) (hide .l
+                                               ,@(cdr code-item))))
+                      code)
+               (else (raise 'unknown-option (car .l))))
+             (cdr! .l)))
+         ,@body))))
+
 ; vim: lispwords+=,local

Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.373
retrieving revision 1.374
diff -u -d -r1.373 -r1.374
--- stdenv.wisp	19 Sep 2002 02:43:39 -0000	1.373
+++ stdenv.wisp	20 Sep 2002 18:35:44 -0000	1.374
@@ -12,26 +12,26 @@
        (cons 'list
          (map (lambda (x) `(cons ',x ,x))
            '(* + - / /= < << <= <box> <c16string> <class> <macro>
-             <old-file> <old-port> <output-buffered-port>
-             <record-type> <u8vector> <vector> =
-             > >= >> abs acons! address-of alist->dict alist-copy
-             analyse and append append-reverse apply assert
-             assert-object-type assoc assq assv atom? aux big-integer?
-             bind bit? boolean? box-empty! box-empty? box-ref box?
-             broketed? builtin-modules c16string? c8string? caaaar
-             caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar
-             caddar cadddr caddr cadr call-with-in/out-files
-             call-with-input-file call-with-output-file car car! car*
-             cardinal? case catch cdaaar cdaadr cdaar cdadar cdaddr
-             cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr
-             cdr cdr! cdr* ceiling cfmakeraw char->control-char
-             char->integer char-and char-bit-clear char-bit-set
-             char-bit-toggle char-bit? char-decimal? char-digit?
-             char-downcase char-hexadecimal? char-letter-modifier?
-             char-letter? char-lower-case? char-mirrored?
-             char-number-letter? char-octal? char-or char-order
-             char-punctuation-close? char-punctuation-connector?
-             char-punctuation-dash? char-punctuation-final-quote?
+             <old-file> <old-port> <output-buffered-port> <record-type>
+             <u8vector> <vector> = > >= >> abs acons! address-of
+             alist->dict alist-copy analyse and append append-reverse
+             apply assert assert-object-type assoc assq assv atom? aux
+             big-integer? bind bit? boolean? box-empty! box-empty?
+             box-ref box? broketed? builtin-modules c16string?
+             c8string? caaaar caaadr caaar caadar caaddr caadr caar
+             cadaar cadadr cadar caddar cadddr caddr cadr
+             call-with-in/out-files call-with-input-file
+             call-with-output-file car car! car* cardinal? case catch
+             cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr
+             cddar cdddar cddddr cdddr cddr cdr cdr! cdr* ceiling
+             cfmakeraw char->control-char char->integer char-and
+             char-bit-clear char-bit-set char-bit-toggle char-bit?
+             char-decimal? char-digit? char-downcase char-hexadecimal?
+             char-letter-modifier? char-letter? char-lower-case?
+             char-mirrored? char-number-letter? char-octal? char-or
+             char-order char-punctuation-close?
+             char-punctuation-connector? char-punctuation-dash?
+             char-punctuation-final-quote?
              char-punctuation-initial-quote? char-punctuation-open?
              char-punctuation? char-ready? char-symbol-currency?
              char-symbol-math? char-symbol-starter? char-symbol?
@@ -63,8 +63,8 @@
              make-c8string make-class make-counter make-dict
              make-instance make-record-type make-string make-vector map
              meaning member memq memv metacode modify-bit module
-             module-ref modulo my-port native? negative? new newline
-             ninth not null-list? null? number->string number?
+             module-ref modulo my-options my-port native? negative? new
+             newline ninth not null-list? null? number->string number?
              numerator nybble? nyp? odd? open-input-file
              open-output-file opt or order->dict output-mode
              output-port? pack-be-integer pack-le-integer