conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

made apropos symbols come out in order (as in symbol<? order)

This commit is contained in:
Abdulaziz Ghuloum 2008-12-27 13:48:49 -05:00
parent 264156f305
commit 2658e6395d
2 changed files with 25 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
scheme/ikarus.apropos.ss
View File

@ -28,28 +28,30 @@
[(symbol? name) (symbol->string name)] [(symbol? name) (symbol->string name)]
[else [else
(die who "not a string or symbol" name)])]) (die who "not a string or symbol" name)])])
(let ([libs (installed-libraries)] (define matcher
[matcher (compose (match-maker name)
(compose (match-maker name) (compose symbol->string car)))
(compose symbol->string car))]) (fold-right
(fold-right (lambda (lib rest)
(lambda (lib rest) (define (symbol<? s1 s2)
(let ([ls (filter matcher (library-subst lib))]) (string<? (symbol->string s1) (symbol->string s2)))
(if (null? ls) (let ([ls (filter matcher (library-subst lib))])
rest (if (null? ls)
(cons (cons (library-name lib) (map car ls)) rest)))) rest
'() (let ([ls (list-sort symbol<? (map car ls))])
(list-sort (cons (cons (library-name lib) ls) rest)))))
(lambda (lib1 lib2) '()
(let f ([ls1 (library-name lib1)] [ls2 (library-name lib2)]) (list-sort
(and (pair? ls2) (lambda (lib1 lib2)
(or (null? ls1) (let f ([ls1 (library-name lib1)] [ls2 (library-name lib2)])
(let ([s1 (symbol->string (car ls1))] (and (pair? ls2)
[s2 (symbol->string (car ls2))]) (or (null? ls1)
(or (string<? s1 s2) (let ([s1 (symbol->string (car ls1))]
(and (string=? s1 s2) [s2 (symbol->string (car ls2))])
(f (cdr ls1) (cdr ls2))))))))) (or (string<? s1 s2)
(installed-libraries)))))) (and (string=? s1 s2)
(f (cdr ls1) (cdr ls2)))))))))
(installed-libraries)))))
(define (apropos name) (define (apropos name)
(for-each (for-each

2
scheme/last-revision
View File

@ -1 +1 @@
1729 1730