added an apropos command

scheme/Makefile.am

@@ -29,7 +29,7 @@ EXTRA_DIST=ikarus.boot.4.prebuilt ikarus.boot.8.prebuilt \
   ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss \
   ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
   ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss \
-  ikarus.symbol-table.ss
+  ikarus.symbol-table.ss ikarus.apropos.ss
  
 all: $(nodist_pkglib_DATA)
 

scheme/Makefile.in

@@ -184,7 +184,7 @@ EXTRA_DIST = ikarus.boot.4.prebuilt ikarus.boot.8.prebuilt \
   ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss \
   ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
   ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss \
-  ikarus.symbol-table.ss
+  ikarus.symbol-table.ss ikarus.apropos.ss
 
 revno = "$(shell sed 's/ .*//' ../.bzr/branch/last-revision 2>/dev/null)"
 sizeofvoidp = $(shell grep SIZEOF_VOID_P ../config.h | sed "s/.*\(.\)/\1/g")

scheme/ikarus.apropos.ss

@@ -0,0 +1,59 @@
+
+(library (ikarus.apropos)
+  (export apropos)
+  (import 
+    (except (ikarus) apropos)
+    (only (psyntax library-manager) library-subst library-name))
+
+  (define (compose f g)
+    (lambda (x) (f (g x))))
+
+  (define (match-maker s1)
+    (let ([n1 (string-length s1)])
+      (lambda (s2)
+        (let ([m (fx- (string-length s2) n1)])
+          (let f ([i2 0])
+            (and (fx<=? i2 m)
+                 (or (let g ([i1 0] [i2 i2])
+                       (or (fx= i1 n1)
+                           (and (char=? (string-ref s1 i1)
+                                        (string-ref s2 i2))
+                                (g (fx+ i1 1) (fx+ i2 1)))))
+                     (f (fx+ i2 1)))))))))
+
+  (define ($apropos-list name who)
+    (let ([name
+           (cond
+             [(string? name) name]
+             [(symbol? name) (symbol->string name)]
+             [else
+              (die who "not a string or symbol" name)])])
+      (let ([libs (installed-libraries)]
+            [matcher 
+             (compose (match-maker name) 
+               (compose symbol->string car))])
+        (fold-right 
+          (lambda (lib rest)
+            (let ([ls (filter matcher (library-subst lib))])
+              (if (null? ls) 
+                  rest
+                  (cons (cons (library-name lib) (map car ls)) rest))))
+          '()
+          (list-sort
+            (lambda (lib1 lib2)
+              (let f ([ls1 (library-name lib1)] [ls2 (library-name lib2)])
+                (and (pair? ls2)
+                     (or (null? ls1)
+                         (let ([s1 (symbol->string (car ls1))]
+                               [s2 (symbol->string (car ls2))])
+                           (or (string<? s1 s2)
+                               (and (string=? s1 s2)
+                                    (f (cdr ls1) (cdr ls2)))))))))
+            (installed-libraries))))))
+
+  (define (apropos name)
+    (for-each 
+      (lambda (x) (printf "~a:\n   ~a\n" (car x) (cdr x)))
+      ($apropos-list name 'apropos))))
+
+

scheme/last-revision

@@ -1 +1 @@
-1728
+1729

scheme/makefile.ss

@@ -97,6 +97,7 @@
     "psyntax.config.ss"
     "psyntax.builders.ss"
     "psyntax.expander.ss"
+    "ikarus.apropos.ss"
     "ikarus.load.ss"
     "ikarus.pretty-print.ss"
     "ikarus.cafe.ss"
@@ -416,6 +417,7 @@
     [wstatus-exit-status                         i]
     [wstatus-received-signal                     i]
     [kill                                        i]
+    [apropos                                     i]
     [installed-libraries                         i]
     [uninstall-library                           i]
     [library-path                                i]