Changeset 40552 in project


Ignore:
Timestamp:
09/14/21 00:50:21 (9 days ago)
Author:
Jim Ursetto
Message:

4/args: untabify

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/args/trunk/args.scm

    r40551 r40552  
    1 ;; -*- indent-tabs-mode: t -*-
    2 
    31(module args
    4        
    5         (;; Option lists
    6         args:parse
    7         args:help-options
    8         args:ignore-unrecognized-options
    9         args:accept-unrecognized-options
    10         make-args:option
    11         ;; Usage printing
    12         args:usage
    13         args:width
    14         args:separator
    15         args:indent
    16 
    17         args:make-option)
    18 
    19         (import scheme chicken extras)
    20 
    21         (require-extension srfi-1 srfi-13 srfi-37)
     2       
     3        (;; Option lists
     4        args:parse
     5        args:help-options
     6        args:ignore-unrecognized-options
     7        args:accept-unrecognized-options
     8        make-args:option
     9        ;; Usage printing
     10        args:usage
     11        args:width
     12        args:separator
     13        args:indent
     14
     15        args:make-option)
     16
     17        (import scheme chicken extras)
     18
     19        (require-extension srfi-1 srfi-13 srfi-37)
    2220
    2321
     
    207205(define (usage-line o)
    208206  (let ((option-string (commify o))
    209         (kvpad 2)) ; minimum padding between option and docstring, included in args:width
     207        (kvpad 2)) ; minimum padding between option and docstring, included in args:width
    210208    (string-append (spaces (args:indent))
    211209                   (if (> (+ kvpad (string-length option-string))
     
    265263  (lambda (x r c)
    266264    (let ((names     (cadr x))
    267           (arg-data  (caddr x))
    268           (docstring (cadddr x))
    269           (body      (cddddr x))
    270           (%lambda  (r 'lambda))
    271           (%begin   (r 'begin))
    272           (%values  (r 'values))
    273           (%if      (r 'if))
    274           (%and     (r 'and))
    275           (%not      (r 'not))
    276           (%or       (r 'or))    
    277           (%eq?      (r 'eq?))
    278           (%car      (r 'car))
    279           (%cons     (r 'cons))
    280           (%append   (r 'append))
    281           (%map     (r 'map))
    282           (%let     (r 'let))
    283           (fprintf  (r 'fprintf))
    284           (current-error-port    (r 'current-error-port))
    285           (option  (r 'option))
    286           (make-args:option  (r 'make-args:option))
    287           )
     265          (arg-data  (caddr x))
     266          (docstring (cadddr x))
     267          (body      (cddddr x))
     268          (%lambda  (r 'lambda))
     269          (%begin   (r 'begin))
     270          (%values  (r 'values))
     271          (%if      (r 'if))
     272          (%and     (r 'and))
     273          (%not      (r 'not))
     274          (%or       (r 'or))    
     275          (%eq?      (r 'eq?))
     276          (%car      (r 'car))
     277          (%cons     (r 'cons))
     278          (%append   (r 'append))
     279          (%map     (r 'map))
     280          (%let     (r 'let))
     281          (fprintf  (r 'fprintf))
     282          (current-error-port    (r 'current-error-port))
     283          (option  (r 'option))
     284          (make-args:option  (r 'make-args:option))
     285          )
    288286
    289287      (let* ((srfi37-names (map (lambda (name)
    290                                   (let ((str (symbol->string (strip-syntax name))))
    291                                     (if (= (string-length str) 1)
    292                                         (string-ref str 0)
    293                                         str)))
    294                                 names))
    295              (arg-name (if (pair? arg-data) (cadr arg-data) "ARG"))
    296              (arg-type (if (pair? arg-data) (car arg-data) arg-data)))
    297 
    298         `(,make-args:option
    299           (,option ',srfi37-names
    300                   ,(eq? arg-type #:required)
    301                   ,(eq? arg-type #:optional)
    302                   (,%lambda (opt name arg options operands)
    303                     (,%if (,%and (,%not arg) (,%eq? ,arg-type #:required))
    304                         (,%begin
    305                           (,fprintf (,current-error-port)
    306                                    "~A: option ~A requires an argument\n"
    307                                    (,(r 'program-name)) name)
    308                           (,%values options operands))
    309                         (,%let ((arg (,%if (,%or (,%eq? ,arg-type #:required)
    310                                                 (,%eq? ,arg-type #:optional))
    311                                            arg
    312                                            #t))) ;; convert #f to #t when #:none
    313                                ,@body
    314                                (,%values (,%append (,%map (,%lambda (n) (,%cons n arg))
    315                                                           ',names)
    316                                                    options)
    317                                         operands)))))
    318           ;;(values (cons (cons name arg) options) operands)))
    319           ,arg-name
    320           ,docstring)))))
     288                                  (let ((str (symbol->string (strip-syntax name))))
     289                                    (if (= (string-length str) 1)
     290                                        (string-ref str 0)
     291                                        str)))
     292                                names))
     293             (arg-name (if (pair? arg-data) (cadr arg-data) "ARG"))
     294             (arg-type (if (pair? arg-data) (car arg-data) arg-data)))
     295
     296        `(,make-args:option
     297          (,option ',srfi37-names
     298                  ,(eq? arg-type #:required)
     299                  ,(eq? arg-type #:optional)
     300                  (,%lambda (opt name arg options operands)
     301                    (,%if (,%and (,%not arg) (,%eq? ,arg-type #:required))
     302                        (,%begin
     303                          (,fprintf (,current-error-port)
     304                                   "~A: option ~A requires an argument\n"
     305                                   (,(r 'program-name)) name)
     306                          (,%values options operands))
     307                        (,%let ((arg (,%if (,%or (,%eq? ,arg-type #:required)
     308                                                (,%eq? ,arg-type #:optional))
     309                                           arg
     310                                           #t))) ;; convert #f to #t when #:none
     311                               ,@body
     312                               (,%values (,%append (,%map (,%lambda (n) (,%cons n arg))
     313                                                          ',names)
     314                                                   options)
     315                                        operands)))))
     316          ;;(values (cons (cons name arg) options) operands)))
     317          ,arg-name
     318          ,docstring)))))
    321319
    322320)
Note: See TracChangeset for help on using the changeset viewer.