From 3cf69eb739c58fcb33b5085c638ed8499ca8a878 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 6 Jul 1999 15:08:44 +0000 Subject: [PATCH] Fix argument order for SUBSTRING?. Reformat. --- v7/src/runtime/apropos.scm | 50 ++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/v7/src/runtime/apropos.scm b/v7/src/runtime/apropos.scm index 168252346..9000190ec 100644 --- a/v7/src/runtime/apropos.scm +++ b/v7/src/runtime/apropos.scm @@ -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)) (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) symbolpackage env))) (newline) - (display (or package env)))) \ No newline at end of file + (write (or package env)))) \ No newline at end of file -- 2.25.1