- Timestamp:
- 04/17/20 23:12:25 (10 months ago)
- Location:
- release/5/apropos/trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/apropos/trunk/apropos-api.scm
r38624 r38625 37 37 (import (chicken sort)) 38 38 (import (chicken type)) 39 (import (only (srfi 1) any reverse! append! last-pair delete-duplicates!))39 (import (only (srfi 1) any reverse! append! last-pair)) 40 40 (import (only (srfi 13) 41 41 string-index string-join string-trim-both … … 59 59 60 60 ;FIXME invalid compile-time value for named constant `KRL-OPTIONS' 61 (define KRL-OPTIONS '( 62 #:sort #:module #:case-insensitive? #t #:macros? #t)) 61 (define KRL-OPTIONS '(#:sort #:module #:case-insensitive? #t #:macros? #t)) 63 62 64 63 (define *tab-width* 2) … … 170 169 ;; 171 170 172 #; ;UNSUPPORTED 173 (define (system-environment? obj) 174 (or (##sys#environment? obj) (sys::macro-environment? obj)) ) 171 ; 172 (define (system-current-symbol? sym) 173 ;must check full identifier name, so cdr 174 (not (null? (search-list-environment-symbols (cut eq? sym <>) (system-current-environment) cdr))) ) 175 175 176 176 ;; Environment Search 177 177 178 (define (*apropos-list/macro-environment loc matcher macenv) 179 (search-macro-environment-symbols matcher macenv) ) 180 181 (define (*apropos-list/environment loc matcher env) 182 (search-system-environment-symbols 183 (lambda (sym) 184 (and 185 (global-symbol-bound? sym) 186 (matcher sym))) 187 env) ) 188 189 ;; 178 (define (*apropos-list/macro-environment loc match? macenv) 179 (search-macro-environment-symbols match? macenv) ) 180 181 (define (*apropos-list/environment loc match? env) 182 (search-system-environment-symbols match? env) ) 183 184 ;; 185 186 (define (delete-duplicates!/sorted ols #!optional (eql? equal?)) 187 ;(assert (sorted? ols eql?)) 188 (let loop ((ls ols)) 189 (let ((nxt (and (not (null? ls)) (cdr ls)))) 190 (if (or (not nxt) (null? nxt)) 191 ols 192 (if (eql? (car ls) (car nxt)) 193 (begin 194 (set-cdr! ls (cdr nxt)) 195 (loop ls) ) 196 (loop nxt) ) ) ) ) ) 190 197 191 198 ; => (envsyms . macenvsyms) 192 (define (*apropos-list loc match er envmacenv)199 (define (*apropos-list loc match/env? env match/macenv? macenv) 193 200 (append! 194 (*apropos-list/environment loc match erenv)201 (*apropos-list/environment loc match/env? env) 195 202 (if macenv 196 203 ;FIXME why macro symbol dups? 197 (delete-duplicates! (*apropos-list/macro-environment loc matcher macenv) eq?) 204 (let ((syms (*apropos-list/macro-environment loc match/macenv? macenv))) 205 (import (only (chicken sort) sort!)) 206 (delete-duplicates!/sorted (sort! syms symbol-printname<?) eq?) ) 198 207 '())) ) 199 208 … … 345 354 (define (parse-arguments-and-match loc patt iargs) 346 355 (let-values ( 347 ((env macenv case-insensitive? base raw? split internal?) (parse-rest-arguments loc iargs))) 356 ((env macenv case-insensitive? base raw? split internal? imported?) (parse-rest-arguments loc iargs))) 357 (when (and internal? imported?) (error loc "cannot be both internal & imported")) 348 358 (let* ( 349 359 (patt (check-search-pattern loc (fixup-pattern-argument patt base) 'pattern)) 350 360 (force-regexp? #f) 351 (matcher (make-apropos-matcher loc patt case-insensitive? split force-regexp? internal?)) 352 (als (*apropos-list loc matcher env macenv)) ) 361 (match? (make-apropos-matcher loc patt case-insensitive? split force-regexp? internal?)) 362 (include? (if imported? system-current-symbol? global-symbol-bound?)) 363 (als (*apropos-list loc (lambda (sym) (and (include? sym) (match? sym))) env match? macenv)) ) 353 364 (values als macenv raw?) ) ) ) 354 365 ;; … … 365 376 (split #f) 366 377 (base (apropos-default-base)) 378 (imported? #f) 367 379 (1st-arg? #t) ) 368 380 ; … … 370 382 (if (null? args) 371 383 ;seen 'em all 372 (values env macenv case-insensitive? base raw? split internal? )384 (values env macenv case-insensitive? base raw? split internal? imported?) 373 385 ;process potential arg 374 386 (let ((arg (car args))) 375 387 ;keyword argument? 376 388 (cond 389 ; 390 ((eq? #:imported? arg) 391 (set! imported? (cadr args)) 392 (loop (cddr args)) ) 377 393 ; 378 394 ((eq? #:split arg) … … 668 684 669 685 (define (information-kind=? info1 info2) 670 (symbol-printname=? 671 (information-kind info1) 672 (information-kind info2)) ) 686 (symbol-printname=? (information-kind info1) (information-kind info2)) ) 673 687 674 688 (define (information-kind<? info1 info2) 675 (symbol-printname<? 676 (information-kind info1) 677 (information-kind info2)) ) 689 (symbol-printname<? (information-kind info1) (information-kind info2)) ) 678 690 679 691 (define (information<? info1 info2 #!optional (sort-key #:name)) … … 688 700 (lessp 689 701 (case sort-key 690 ((#:name #:module) 691 (cut information-identifier<? <> <> sort-key) ) 692 ((#:type) 693 (cut information<? <> <> #:name) ) 694 (else 695 #f ) ) ) 702 ((#:name #:module) (cut information-identifier<? <> <> sort-key)) 703 ((#:type) information<?) 704 (else #f ) ) ) 696 705 (ails 697 706 (*make-information-list syms macenv raw?) ) ) -
release/5/apropos/trunk/apropos-csi.scm
r38527 r38625 88 88 Pattern match component; optional when last argument 89 89 (also see the '(_ . _) pattern) 90 imp | imported Only imported identifiers, otherwise global symbols 90 91 all Means `ci mac` 91 92 krl Means `all sort mod` … … 172 173 (cons* #t #:case-insensitive? #t #:macros? oargs))) 173 174 ; 175 ((imp imported) 176 (arg-next #:imported? #t)) 177 ; 174 178 ((mac macros) 175 179 (arg-next #:macros? #t)) -
release/5/apropos/trunk/apropos.egg
r38624 r38625 5 5 6 6 ((synopsis "CHICKEN apropos") 7 (version "3. 4.1")7 (version "3.5.0") 8 8 (category misc) 9 9 (author "[[kon lovett]]") -
release/5/apropos/trunk/symbol-environment-access.scm
r38624 r38625 57 57 ;; 58 58 59 (: search-list-environment-symbols ((* -> boolean) (list-of (pair symbol *)) --> list))59 (: search-list-environment-symbols ((* -> boolean) (list-of (pair symbol *)) #!optional (pair -> *) --> list)) 60 60 ; 61 (define (search-list-environment-symbols test? env )62 (define (cons-if-symbol syms cell) (cons-if test? ( carcell) syms))61 (define (search-list-environment-symbols test? env #!optional (itemref car)) 62 (define (cons-if-symbol syms cell) (cons-if test? (itemref cell) syms)) 63 63 (foldl cons-if-symbol '() env) ) 64 64
Note: See TracChangeset
for help on using the changeset viewer.