Changeset 38877 in project


Ignore:
Timestamp:
08/22/20 22:19:18 (2 months ago)
Author:
Kon Lovett
Message:

make help an arg

Location:
release/5/apropos/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/apropos-csi.scm

    r38625 r38877  
    2020(import (chicken io))
    2121(import (chicken port))
    22 (import (only (srfi 1) cons* reverse!))
     22(import (only (srfi 1) first cons* reverse!))
    2323;Warning: the following extensions are not currently installed: chicken.csi
    2424(import (only (chicken csi) toplevel-command))
     
    5858  (csi-help
    5959    ",a PATT ARG..."
    60     "Apropos of PATT with ARG from ?, mac, ci, sort nam|mod|typ|#f, split nam|mod|#f"))
     60    "Apropos of PATT with ARG from help, mac, ci, sort nam|mod|typ|#f, split nam|mod|#f"))
    6161
    6262(define-constant HELP-TEXT
     
    7676  '<atom>         interpret `<atom>` as an irregex.
    7777
    78  Use "?" as a PATT to list symbols containing a `?`.
    79 
    8078Arguments:
    8179
     80 help              This message
    8281 macros            Include macro bound symbols
    8382 ci | case-insensitive
     
    126125
    127126(define (parse-csi-apropos-arguments iargs)
    128   ;look at every argument
    129   (let loop ((args iargs) (oargs '()))
    130     ;
    131     (define (restargs next optarg?)
    132       (cond
    133         ((null? next)
    134           '() )
    135         (optarg?
    136           (cdr next))
    137         (else
    138           next ) ) )
    139     ;
    140     (define (arg-next kwd init #!optional optarg?)
     127  (let* (
     128    (1st (and (not (zero? (length iargs))) (first iargs)))
     129    (rest (if 1st (cdr iargs) '())) )
     130    (let loop ((args rest) (oargs `(,1st)))
    141131      ;
    142       (define (thisargs next kwd init optarg?)
     132      (define (restargs next optarg?)
    143133        (cond
    144134          ((null? next)
    145             (cons* init kwd oargs))
     135            '() )
    146136          (optarg?
    147             (cons* (optarg? (car next)) kwd oargs))
     137            (cdr next))
    148138          (else
    149             (cons* init kwd oargs) ) ) )
     139            next ) ) )
    150140      ;
    151       (let* (
    152         (next (cdr args))
    153         (args (restargs next optarg?))
    154         (oargs (thisargs next kwd init optarg?) ) )
     141      (define (arg-next kwd init #!optional optarg?)
    155142        ;
    156         (loop args oargs) ) )
    157     ;
    158     (if (null? args)
    159       ; original ordering
    160       (reverse! oargs)
    161       ;csi-apropos-syntax => keyword-apropos-syntax
    162       (let ((arg (car args)))
    163         (case arg
     143        (define (thisargs next kwd init optarg?)
     144          (cond
     145            ((null? next)
     146              (cons* init kwd oargs))
     147            (optarg?
     148              (cons* (optarg? (car next)) kwd oargs))
     149            (else
     150              (cons* init kwd oargs) ) ) )
     151        ;
     152        (let* (
     153          (next (cdr args))
     154          (args (restargs next optarg?))
     155          (oargs (thisargs next kwd init optarg?) ) )
    164156          ;
    165           ((krl)
    166             (loop
    167               (restargs (cons* 'all (cdr args)) #f)
    168               (cons* #:module #:sort oargs)))
    169           ;
    170           ((all)
    171             (loop
    172               (restargs (cdr args) #f)
    173               (cons* #t #:case-insensitive? #t #:macros? oargs)))
    174           ;
    175           ((imp imported)
    176             (arg-next #:imported? #t))
    177           ;
    178           ((mac macros)
    179             (arg-next #:macros? #t))
    180           ;
    181           ((ci case-insensitive)
    182             (arg-next #:case-insensitive? #t))
    183           ;
    184           ((internal)
    185             (arg-next #:internal? #t))
    186           ;
    187           ((raw)
    188             (arg-next #:raw? #t))
    189           ;
    190           ((base)
    191             (arg-next #:base (apropos-default-base) (cut check-apropos-number-base ',a <>)))
    192           ;
    193           ((sort)
    194             (arg-next #:sort #:type (cut interp-sort-arg ',a <>)))
    195           ;
    196           ((split)
    197             (arg-next #:split #f (cut interp-split-arg ',a <>)))
    198           ;
    199           ((?)
    200             (loop '() '()))
    201           ;
    202           (else
    203             (loop (cdr args) (cons arg oargs)) ) ) ) ) ) )
     157          (loop args oargs) ) )
     158      ;
     159      (if (null? args)
     160        ; original ordering
     161        (reverse! oargs)
     162        ;csi-apropos-syntax => keyword-apropos-syntax
     163        (let ((arg (car args)))
     164          (case arg
     165            ;
     166            ((krl)
     167              (loop
     168                (restargs (cons* 'all (cdr args)) #f)
     169                (cons* #:module #:sort oargs)))
     170            ;
     171            ((all)
     172              (loop
     173                (restargs (cdr args) #f)
     174                (cons* #t #:case-insensitive? #t #:macros? oargs)))
     175            ;
     176            ((imp imported)
     177              (arg-next #:imported? #t))
     178            ;
     179            ((mac macros)
     180              (arg-next #:macros? #t))
     181            ;
     182            ((ci case-insensitive)
     183              (arg-next #:case-insensitive? #t))
     184            ;
     185            ((internal)
     186              (arg-next #:internal? #t))
     187            ;
     188            ((raw)
     189              (arg-next #:raw? #t))
     190            ;
     191            ((base)
     192              (arg-next #:base (apropos-default-base) (cut check-apropos-number-base ',a <>)))
     193            ;
     194            ((sort)
     195              (arg-next #:sort #:type (cut interp-sort-arg ',a <>)))
     196            ;
     197            ((split)
     198              (arg-next #:split #f (cut interp-split-arg ',a <>)))
     199            ;
     200            ((help)
     201              (loop '() '()))
     202            ;
     203            (else
     204              (loop (cdr args) (cons arg oargs)) ) ) ) )  ) ) )
    204205
    205206(define (csi-apropos-command)
  • release/5/apropos/trunk/apropos.egg

    r38628 r38877  
    22;;;; Kon Lovett, Jul '18
    33
    4 ;BUG? (inline-file) w/o any define-inline causes error for non-existent apropos.inline
    5 
    64((synopsis "CHICKEN apropos")
    7  (version "3.5.1")
     5 (version "3.6.0")
    86 (category misc)
    97 (author "[[kon lovett]]")
    108 (license "BSD")
    119 (dependencies
    12   (srfi-1 "0.1")
    13   (srfi-13 "0.1")
    14         (check-errors "3.1.0")
     10  srfi-1
     11  srfi-13
     12        check-errors
    1513        (string-utils "2.1.1")
    1614        (symbol-utils "2.0.2"))
Note: See TracChangeset for help on using the changeset viewer.