Changeset 40549 in project


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

5/args: untabify

File:
1 edited

Legend:

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

    r40548 r40549  
    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
     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
    2018          scheme
    2119          (chicken base)
     
    213211(define (usage-line o)
    214212  (let ((option-string (commify o))
    215         (kvpad 2)) ; minimum padding between option and docstring, included in args:width
     213        (kvpad 2)) ; minimum padding between option and docstring, included in args:width
    216214    (string-append (spaces (args:indent))
    217215                   (if (> (+ kvpad (string-length option-string))
     
    272270  (lambda (x r c)
    273271    (let ((names     (cadr x))
    274           (arg-data  (caddr x))
    275           (docstring (cadddr x))
    276           (body      (cddddr x))
    277           (%lambda  (r 'lambda))
    278           (%begin   (r 'begin))
    279           (%values  (r 'values))
    280           (%if      (r 'if))
    281           (%and     (r 'and))
    282           (%not      (r 'not))
    283           (%or       (r 'or))    
    284           (%eq?      (r 'eq?))
    285           (%car      (r 'car))
    286           (%cons     (r 'cons))
    287           (%append   (r 'append))
    288           (%map     (r 'map))
    289           (%let     (r 'let))
    290           (fprintf  (r 'fprintf))
    291           (current-error-port    (r 'current-error-port))
    292           (option  (r 'option))
    293           (make-args:option  (r 'make-args:option))
    294           )
     272          (arg-data  (caddr x))
     273          (docstring (cadddr x))
     274          (body      (cddddr x))
     275          (%lambda  (r 'lambda))
     276          (%begin   (r 'begin))
     277          (%values  (r 'values))
     278          (%if      (r 'if))
     279          (%and     (r 'and))
     280          (%not      (r 'not))
     281          (%or       (r 'or))    
     282          (%eq?      (r 'eq?))
     283          (%car      (r 'car))
     284          (%cons     (r 'cons))
     285          (%append   (r 'append))
     286          (%map     (r 'map))
     287          (%let     (r 'let))
     288          (fprintf  (r 'fprintf))
     289          (current-error-port    (r 'current-error-port))
     290          (option  (r 'option))
     291          (make-args:option  (r 'make-args:option))
     292          )
    295293
    296294      (let* ((srfi37-names (map (lambda (name)
    297                                   (let ((str (symbol->string (strip-syntax name))))
    298                                     (if (= (string-length str) 1)
    299                                         (string-ref str 0)
    300                                         str)))
    301                                 names))
    302              (arg-name (if (pair? arg-data) (cadr arg-data) "ARG"))
    303              (arg-type (if (pair? arg-data) (car arg-data) arg-data)))
    304 
    305         `(,make-args:option
    306           (,option ',srfi37-names
    307                   ,(eq? arg-type #:required)
    308                   ,(eq? arg-type #:optional)
    309                   (,%lambda (opt name arg options operands)
    310                     (,%if (,%and (,%not arg) (,%eq? ,arg-type #:required))
    311                         (,%begin
    312                           (,fprintf (,current-error-port)
    313                                    "~A: option ~A requires an argument\n"
    314                                    (,(r 'program-name)) name)
    315                           (,%values options operands))
    316                         (,%let ((arg (,%if (,%or (,%eq? ,arg-type #:required)
    317                                                 (,%eq? ,arg-type #:optional))
    318                                            arg
    319                                            #t))) ;; convert #f to #t when #:none
    320                                ,@body
    321                                (,%values (,%append (,%map (,%lambda (n) (,%cons n arg))
    322                                                           ',names)
    323                                                    options)
    324                                         operands)))))
    325           ;;(values (cons (cons name arg) options) operands)))
    326           ,arg-name
    327           ,docstring))))))
     295                                  (let ((str (symbol->string (strip-syntax name))))
     296                                    (if (= (string-length str) 1)
     297                                        (string-ref str 0)
     298                                        str)))
     299                                names))
     300             (arg-name (if (pair? arg-data) (cadr arg-data) "ARG"))
     301             (arg-type (if (pair? arg-data) (car arg-data) arg-data)))
     302
     303        `(,make-args:option
     304          (,option ',srfi37-names
     305                  ,(eq? arg-type #:required)
     306                  ,(eq? arg-type #:optional)
     307                  (,%lambda (opt name arg options operands)
     308                    (,%if (,%and (,%not arg) (,%eq? ,arg-type #:required))
     309                        (,%begin
     310                          (,fprintf (,current-error-port)
     311                                   "~A: option ~A requires an argument\n"
     312                                   (,(r 'program-name)) name)
     313                          (,%values options operands))
     314                        (,%let ((arg (,%if (,%or (,%eq? ,arg-type #:required)
     315                                                (,%eq? ,arg-type #:optional))
     316                                           arg
     317                                           #t))) ;; convert #f to #t when #:none
     318                               ,@body
     319                               (,%values (,%append (,%map (,%lambda (n) (,%cons n arg))
     320                                                          ',names)
     321                                                   options)
     322                                        operands)))))
     323          ;;(values (cons (cons name arg) options) operands)))
     324          ,arg-name
     325          ,docstring))))))
    328326
    329327)
Note: See TracChangeset for help on using the changeset viewer.