Fix argument order for SUBSTRING?. Reformat.
authorChris Hanson <org/chris-hanson/cph>
Tue, 6 Jul 1999 15:08:44 +0000 (15:08 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 6 Jul 1999 15:08:44 +0000 (15:08 +0000)
v7/src/runtime/apropos.scm

index 1682523469a3771574de76cc8b93e3262489d38b..9000190ec385b521d468571ea78954b28fe1533b 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: apropos.scm,v 1.3 1999/01/02 06:11:34 cph Exp $
+$Id: apropos.scm,v 1.4 1999/07/06 15:08:44 cph Exp $
 
 Copyright (c) 1993, 1999 Massachusetts Institute of Technology
 
@@ -22,59 +22,55 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ;;;; Apropos command
 ;;; package: (runtime apropos)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (declare (usual-integrations))
 \f
 (define (apropos text #!optional package/env search-parents?)
   (let* ((env
-         (cond ((default-object? package/env)   (nearest-repl/environment))
-               ((eq? package/env #t)            (nearest-repl/environment))
-               (else                            (->environment package/env))))
+         (if (or (default-object? package/env) (eq? #t package/env))
+             (nearest-repl/environment)
+             (->environment package/env)))
         (search-parents?
-         (or (default-object? package/env)
-             (and (not (default-object? search-parents?))
-                  search-parents?))))
+         (cond ((default-object? package/env) #t)
+               ((default-object? search-parents?) #f)
+               (else search-parents?))))
     (aproposer text env search-parents?
               apropos-describe-env apropos-describe)))
 
-
 (define (apropos-list text #!optional package/env search-parents?)
   (let* ((env
-         (cond ((default-object? package/env)   (nearest-repl/environment))
-               ((eq? package/env #t)            (nearest-repl/environment))
-               (else                            (->environment package/env))))
+         (if (or (default-object? package/env) (eq? #t package/env))
+             (nearest-repl/environment)
+             (->environment package/env)))
         (search-parents?
-         (or (default-object? package/env)
-             (and (not (default-object? search-parents?))
-                  search-parents?))))
+         (cond ((default-object? package/env) #t)
+               ((default-object? search-parents?) #f)
+               (else search-parents?))))
     (let ((names '()))
-      (define (add-name name env)
-       env
-       (set! names (cons name names))
-       unspecific)
-      (aproposer text env search-parents? (lambda (env) env) add-name)
+      (aproposer text env search-parents?
+                (lambda (env) env)
+                (lambda (name env)
+                  env
+                  (set! names (cons name names))
+                  unspecific))
       names)))
 
-
 (define (aproposer text env search-parents? process-env process-symbol)
-  (let*  ((text   (if (symbol? text) (symbol-name text) text)))
+  (let ((text (if (symbol? text) (symbol-name text) text)))
     (process-env env)
     (for-each (lambda (symbol)
-               (if (substring? text (symbol-name symbol))
+               (if (substring? (symbol-name symbol) text)
                    (process-symbol symbol env)))
              (sort (environment-bound-names env) symbol<?))
     (if (and search-parents? (environment-has-parent? env))
        (aproposer text (environment-parent env) search-parents?
                   process-env process-symbol))))
 
-
 (define (apropos-describe symbol env)
   env
   (newline)
-  (display symbol))
+  (write symbol))
 
 (define (apropos-describe-env env)
   (let ((package (environment->package env)))
     (newline)
-    (display (or package env))))
\ No newline at end of file
+    (write (or package env))))
\ No newline at end of file