mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

inline format:out into format

Browse source 
* module/ice-9/format.scm (format): Inline format:out into the body.
This commit is contained in:
Andy Wingo 2010-12-18 12:42:50 +01:00
parent 098e6fc63f
commit d55066ddc3
1 changed files with 31 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

71
module/ice-9/format.scm
View file

@ -30,7 +30,6 @@
;;; ;;;
(define-module (ice-9 format) (define-module (ice-9 format)
#:use-module (ice-9 and-let-star)
#:autoload (ice-9 pretty-print) (pretty-print truncated-print) #:autoload (ice-9 pretty-print) (pretty-print truncated-print)
#:replace (format)) #:replace (format))
@ -125,25 +124,6 @@
(define format:error-save #f) (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 (define format:parameter-characters
'(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\')) '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\'))
@ -1606,26 +1586,37 @@
(if (not (string? format-string)) (if (not (string? format-string))
(error "format: expected a string for format string" format-string)) (error "format: expected a string for format string" format-string))
(cond (set! format:port
((or (and (boolean? destination) ; port output (cond
destination) ((not destination) (open-output-string))
(output-port? destination)) ((boolean? destination) (current-output-port)) ; boolean but not false
(format:out (cond ((output-port? destination) destination)
((boolean? destination) (current-output-port)) ((number? destination)
((output-port? destination) destination) (issue-deprecation-warning
((number? destination) (current-error-port))) "Passing a number to format as the port is deprecated."
format-string format-args)) "Pass (current-error-port) instead.")
((number? destination) (current-error-port))
(issue-deprecation-warning (else
"Passing a number to format as the port is deprecated." (format:error "bad destination `~a'" destination))))
"Pass (current-error-port) instead.")
(format:out (current-error-port) format-string format-args)) (and=> (port-column format:port)
((and (boolean? destination) ; string output (lambda (col) (set! format:output-col col)))
(not destination))
(call-with-output-string (let ((arg-pos (format:format-work format-string format-args))
(lambda (port) (format:out port format-string format-args)))) (arg-len (length format-args)))
(else (cond
(format:error "bad destination `~a'" destination)))) ((> 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 (begin-deprecated
(set! format (set! format