From d3afa54144748685d12c159407194e03538e98de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 24 Aug 2020 20:34:11 +0200 Subject: Move util modules into calp module.. --- module/util/options.scm | 48 ------------------------------------------------ 1 file changed, 48 deletions(-) delete mode 100644 module/util/options.scm (limited to 'module/util/options.scm') diff --git a/module/util/options.scm b/module/util/options.scm deleted file mode 100644 index a4c780bc..00000000 --- a/module/util/options.scm +++ /dev/null @@ -1,48 +0,0 @@ -(define-module (util options) - :use-module (util) - :use-module (srfi srfi-1) -) - -;; option-assoc → getopt-valid option-assoc -(define-public (getopt-opt options) - (map (lambda (optline) - (cons (car optline) - (map (lambda (opt-field) - (cons (car opt-field) - (cond [(and (eq? 'value (car opt-field)) - (symbol? (cadr opt-field))) - '(optional)] - [else (cdr opt-field)]))) - (lset-intersection (lambda (a b) (eqv? b (car a))) - (cdr optline) - '(single-char required? value predicate))))) - options)) - - - - -;; (name (key value) ...) → sxml -(define (fmt-help option-line) - (let ((name (car option-line)) - (args (cdr option-line))) - (let ((valuefmt (case (and=> (assoc-ref args 'value) car) - [(#t) '(" " (i value))] - [(#f) '()] - [else => (lambda (s) `(" [" (i ,s) "]"))]))) - `(*TOP* (b "--" ,name) ,@valuefmt - ,@(awhen (assoc-ref args 'single-char) - `("," (ws) - (b "-" ,(car it)) - ,@valuefmt)) - (br) - ,@(awhen (assoc-ref args 'description) - `((blockquote ,@it) - (br))))))) - -(use-modules (text markup)) - -(define-public (format-arg-help options) - (sxml->ansi-text (cons '*TOP* (map sxml->ansi-text (map fmt-help options))))) - -(define*-public (print-arg-help options optional: (port (current-error-port))) - (display (format-arg-help options) port)) -- cgit v1.2.3