inline format:out into format
authorAndy Wingo <wingo@pobox.com>
Sat, 18 Dec 2010 11:42:50 +0000 (12:42 +0100)
committerAndy Wingo <wingo@pobox.com>
Sat, 18 Dec 2010 11:42:50 +0000 (12:42 +0100)
* module/ice-9/format.scm (format): Inline format:out into the body.

module/ice-9/format.scm

index 27a7f45..5e3d18b 100644 (file)
@@ -30,7 +30,6 @@
 ;;;
 
 (define-module (ice-9 format)
-  #:use-module (ice-9 and-let-star)
   #:autoload (ice-9 pretty-print) (pretty-print truncated-print)
   #:replace (format))
 
              
   (define format:error-save #f)
 
-  (define (format:out port fmt args)     ; the output handler for a port
-    (set! format:port port)              ; global port for
-                                       ; output routines
-    (set! format:case-conversion #f)   ; modifier case
-                                       ; conversion procedure
-    (set! format:flush-output #f)       ; ~! reset
-    (and-let* ((col (port-column port))) ; get current column from port
-              (set! format:output-col col))
-    (let ((arg-pos (format:format-work fmt args))
-          (arg-len (length args)))
-      (cond
-       ((> arg-pos arg-len)
-        (set! format:arg-pos (+ arg-len 1))
-        (display format:arg-pos)
-        (format:error "~a missing argument~:p" (- arg-pos arg-len)))
-       (else
-        (if format:flush-output (force-output port))
-        #t))))
-
   (define format:parameter-characters
     '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\'))
 
   (if (not (string? format-string))
       (error "format: expected a string for format string" format-string))
 
-  (cond
-   ((or (and (boolean? destination)     ; port output
-             destination)
-        (output-port? destination))
-    (format:out (cond
-                 ((boolean? destination) (current-output-port))
-                 ((output-port? destination) destination)
-                 ((number? destination) (current-error-port)))
-                format-string format-args))
-   ((number? destination)
-    (issue-deprecation-warning
-     "Passing a number to format as the port is deprecated."
-     "Pass (current-error-port) instead.")
-    (format:out (current-error-port) format-string format-args))
-   ((and (boolean? destination)         ; string output
-         (not destination))
-    (call-with-output-string
-     (lambda (port) (format:out port format-string format-args))))
-   (else
-    (format:error "bad destination `~a'" destination))))
+  (set! format:port
+        (cond
+         ((not destination) (open-output-string))
+         ((boolean? destination) (current-output-port)) ; boolean but not false
+         ((output-port? destination) destination)
+         ((number? destination)
+          (issue-deprecation-warning
+           "Passing a number to format as the port is deprecated."
+           "Pass (current-error-port) instead.")
+          (current-error-port))
+         (else
+          (format:error "bad destination `~a'" destination))))
+  
+  (and=> (port-column format:port)
+         (lambda (col) (set! format:output-col col)))
+
+  (let ((arg-pos (format:format-work format-string format-args))
+        (arg-len (length format-args)))
+    (cond
+     ((> arg-pos arg-len)
+      (set! format:arg-pos (+ arg-len 1))
+      (display format:arg-pos)
+      (format:error "~a missing argument~:p" (- arg-pos arg-len)))
+     (else
+      (if format:flush-output
+          (force-output format:port))
+      (if destination
+          #t
+          (let ((str (get-output-string format:port)))
+            (close-port format:port)
+            str))))))
 
 (begin-deprecated
  (set! format