Changeset 15633 in project


Ignore:
Timestamp:
08/29/09 09:44:45 (10 years ago)
Author:
Ivan Raikov
Message:

bug fixes in getopt-long

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/getopt-long/getopt-long.scm

    r15627 r15633  
    382382
    383383(define (check-long-option str)
    384   (string=? (substring str 0 2) "--"))
     384  (and (> (string-length str) 1)
     385       (string=? (substring str 0 2) "--")))
    385386
    386387(define (check-short-option str)
    387   (string=? (substring str 0 1) "-"))
     388  (and (positive? (string-length str))
     389       (string=? (substring str 0 1) "-")))
    388390
    389391(define long-option-name-cs
     
    412414
    413415(define (long-option-value lst)
    414   (let loop ((lst lst)  (ax (list)))
    415     (cond ((null? lst)  (list (list->string (reverse ax)) lst))
    416           ((and (char? (car lst))
    417                 (char-set-contains? long-option-value-cs
    418                                    (car lst))
    419                 (car lst)) =>
    420                 (lambda (c)
    421                   (loop (cdr lst) (cons c ax))))
    422 
    423           (else (error 'long-option-value
    424                        "invalid list " lst)))))
     416  (if (null? lst) (list #f lst)
     417      (let loop ((lst lst)  (ax (list)))
     418        (cond ((null? lst) 
     419               (pair? ax) (list (list->string (reverse ax)) lst))
     420             
     421              ((and (char? (car lst))
     422                    (char-set-contains? long-option-value-cs
     423                                        (car lst))
     424                    (car lst)) =>
     425                    (lambda (c)
     426                      (loop (cdr lst) (cons c ax))))
     427             
     428              (else (error 'long-option-value
     429                           "invalid list " lst))))))
    425430
    426431
     
    432437                         ((v ())    (long-option-value nrst))
    433438                         ((next v)
    434                           (or (and v (list next v))
    435                               (and (not (check-long-option (car next)))
    436                                    (not (check-short-option (car next)))
    437                                    (list (cdr next) (car next))))))
     439                          (begin
     440                            (or (and v (list next v))
     441                                (and (not (check-long-option (car next)))
     442                                     (not (check-short-option (car next)))
     443                                     (list (cdr next) (car next)))
     444                                (list next #f)))))
     445
    438446              (cond ((alist-ref (string->symbol n) (car specs)) =>
    439447                     (lambda (spec)
     
    459467                         (error 'long-option? "option requires value " n))
    460468                       
    461                         ((and (not v) (value-policy-optional?
    462                                        (option-spec-value spec)))
     469                        ((and (not v) (option-spec-value spec)
     470                              (value-policy-optional?
     471                               (option-spec-value spec)))
    463472                         (list next (cons (option-spec-name spec) #t)))
    464473                       
     
    476485
    477486(define (short-option-names lst)
    478   (let loop ((lst lst)  (ax (list)))
    479     (cond ((null? lst)  (list ax lst))
    480 
    481           ((and (char? (car lst))
    482                 (char-set-contains? short-option-name-cs
    483                                    (car lst))
    484                 (car lst)) =>
    485                 (lambda (c)
    486                   (loop (cdr lst) (cons c ax))))
    487 
    488           (else (error 'long-option-name
    489                        "invalid list " lst)))))
     487  (if (null? lst) (list #f lst)
     488      (let loop ((lst lst)  (ax (list)))
     489        (cond ((null? lst)  (list ax lst))
     490
     491              ((and (char? (car lst))
     492                    (char-set-contains? short-option-name-cs
     493                                        (car lst))
     494                    (car lst)) =>
     495                    (lambda (c)
     496                      (loop (cdr lst) (cons c ax))))
     497             
     498              (else (error 'long-option-name
     499                           "invalid list " lst))))))
    490500
    491501(define (short-options? specs a next)
Note: See TracChangeset for help on using the changeset viewer.