Changeset 38877 in project
- Timestamp:
- 08/22/20 22:19:18 (6 months ago)
- Location:
- release/5/apropos/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/apropos/trunk/apropos-csi.scm
r38625 r38877 20 20 (import (chicken io)) 21 21 (import (chicken port)) 22 (import (only (srfi 1) cons* reverse!))22 (import (only (srfi 1) first cons* reverse!)) 23 23 ;Warning: the following extensions are not currently installed: chicken.csi 24 24 (import (only (chicken csi) toplevel-command)) … … 58 58 (csi-help 59 59 ",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")) 61 61 62 62 (define-constant HELP-TEXT … … 76 76 '<atom> interpret `<atom>` as an irregex. 77 77 78 Use "?" as a PATT to list symbols containing a `?`.79 80 78 Arguments: 81 79 80 help This message 82 81 macros Include macro bound symbols 83 82 ci | case-insensitive … … 126 125 127 126 (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))) 141 131 ; 142 (define ( thisargs next kwd init optarg?)132 (define (restargs next optarg?) 143 133 (cond 144 134 ((null? next) 145 (cons* init kwd oargs))135 '() ) 146 136 (optarg? 147 (c ons* (optarg? (car next)) kwd oargs))137 (cdr next)) 148 138 (else 149 (cons* init kwd oargs)) ) )139 next ) ) ) 150 140 ; 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?) 155 142 ; 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?) ) ) 164 156 ; 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)) ) ) ) ) ) ) ) 204 205 205 206 (define (csi-apropos-command) -
release/5/apropos/trunk/apropos.egg
r38628 r38877 2 2 ;;;; Kon Lovett, Jul '18 3 3 4 ;BUG? (inline-file) w/o any define-inline causes error for non-existent apropos.inline5 6 4 ((synopsis "CHICKEN apropos") 7 (version "3. 5.1")5 (version "3.6.0") 8 6 (category misc) 9 7 (author "[[kon lovett]]") 10 8 (license "BSD") 11 9 (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 15 13 (string-utils "2.1.1") 16 14 (symbol-utils "2.0.2"))
Note: See TracChangeset
for help on using the changeset viewer.