From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Sat, 6 Apr 1991 06:51:33 +0000 (+0000)
Subject: Define student-pp that understands old-style arguments.
X-Git-Tag: 20090517-FFI~10773
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=76d15326c435677db7674a02692a2296224a51a2;p=mit-scheme.git

Define student-pp that understands old-style arguments.
---

diff --git a/v7/src/sicp/compat.scm b/v7/src/sicp/compat.scm
index a4f6342fe..a575d8f41 100644
--- a/v7/src/sicp/compat.scm
+++ b/v7/src/sicp/compat.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sicp/compat.scm,v 1.2 1990/11/14 14:57:44 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sicp/compat.scm,v 1.3 1991/04/06 06:51:33 jinx Exp $
 
 Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -164,4 +164,35 @@ MIT in each case. |#
   (let ((input (read)))
     (if (eq? input 'abort)
 	(cmdl-interrupt/abort-nearest)
-	input)))
\ No newline at end of file
+	input)))
+
+(define (student-pp object . args)
+  (define (supply what old new)
+    (if (eq? old 'NOT-SUPPLIED)
+	new
+	(error "pp: Overspecified option"
+	       (list what old new))))
+
+  (define (parse-args args port as-code?)
+    (cond ((null? args)
+	   (let ((port 
+		  (if (eq? port 'NOT-SUPPLIED)
+		      (current-output-port)
+		      port)))
+	     (if (eq? as-code? 'NOT-SUPPLIED)
+		 (pp object port)
+		 (pp object port as-code?))))
+	  ((eq? (car args) 'AS-CODE)
+	   (parse-args (cdr args)
+		       port
+		       (supply 'AS-CODE as-code? true)))
+	  ((output-port? (car args))
+	   (parse-args (cdr args)
+		       (supply 'PORT port (car args))
+		       as-code?))
+	  (else
+	   (error "pp: Unknown option" (car args)))))		       
+
+  (if (null? args)
+      (pp object)
+      (parse-args args 'NOT-SUPPLIED 'NOT-SUPPLIED)))
\ No newline at end of file