summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--share/txr/stdlib/getopts.tl36
1 files changed, 22 insertions, 14 deletions
diff --git a/share/txr/stdlib/getopts.tl b/share/txr/stdlib/getopts.tl
index a556493d..be6dec4f 100644
--- a/share/txr/stdlib/getopts.tl
+++ b/share/txr/stdlib/getopts.tl
@@ -341,25 +341,33 @@
(put-line ln)))
(put-line))))
-(defmacro define-option-struct (name super . opts)
+
+(defstruct sys:option-base nil
+ in-args
+ out-args
+ (:static slot-hash)
+ (:static opt-desc-list)
+ (:method add-opt (me opt)
+ (slotset me [me.slot-hash (or opt.desc.long opt.desc.short)] opt.arg))
+ (:method getopts (me args)
+ (set me.in-args args me.out-args args)
+ (let ((opr (new sys:opt-processor od-list me.opt-desc-list opts me)))
+ opr.(parse-opts args)))
+ (:method opthelp (me : (stream *stdout*))
+ (opthelp me.opt-desc-list stream)))
+
+(defmacro define-option-struct (name super-spec . opts)
(let* ((slots (mapcar (tb ((short long . rest))
(or long short))
- opts)))
- ^(defstruct ,name ,super
+ opts))
+ (supers (if (and super-spec (atom super-spec))
+ (list super-spec)
+ super-spec)))
+ ^(defstruct ,name (,*supers sys:option-base)
,*slots
- in-args
- out-args
(:static slot-hash #H(() ,*(mapcar [juxt symbol-name identity] slots)))
(:static opt-desc-list ',(mapcar (tb ((short long . rest))
(opt (if short (symbol-name short))
(if long (symbol-name long))
. rest))
- opts))
- (:method add-opt (me opt)
- (slotset me [me.slot-hash (or opt.desc.long opt.desc.short)] opt.arg))
- (:method getopts (me args)
- (set me.in-args args me.out-args args)
- (let ((opr (new sys:opt-processor od-list me.opt-desc-list opts me)))
- opr.(parse-opts args)))
- (:method opthelp (me : (stream *stdout*))
- (opthelp me.opt-desc-list stream)))))
+ opts)))))