Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22690

Modified Files: format.lisp Log Message: Added an imbecile format-float, for ~F.

Date: Thu Jul 29 09:21:39 2004 Author: ffjeld

Index: movitz/losp/muerte/format.lisp diff -u movitz/losp/muerte/format.lisp:1.5 movitz/losp/muerte/format.lisp:1.6 --- movitz/losp/muerte/format.lisp:1.5 Thu May 20 10:47:24 2004 +++ movitz/losp/muerte/format.lisp Thu Jul 29 09:21:39 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Sat Mar 23 01:18:36 2002 ;;;; -;;;; $Id: format.lisp,v 1.5 2004/05/20 17:47:24 ffjeld Exp $ +;;;; $Id: format.lisp,v 1.6 2004/07/29 16:21:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -59,6 +59,22 @@ (*print-readably* nil)) (write x))))

+(defun format-float (x &optional at-sign-p colon-p w d k overflowchar padchar) + (declare (ignore w k overflowchar padchar at-sign-p colon-p)) + (multiple-value-bind (integer-part decimal-part) + (truncate x) + (write-integer integer-part *standard-output* 10 t) + (do ((remainder decimal-part) + (i 0 (1+ i))) + ((if (not d) + (or (and (plusp i) (zerop decimal-part)) + (>= i 16)) + (= i d))) + (multiple-value-bind (next-digit next-remainder) + (truncate (* 10 remainder)) + (setf remainder next-remainder) + (write-integer next-digit *standard-output* 10 nil))))) + (defun find-directive (string i directive &optional recursive-skip-start (recursive-skip-end directive)) "Return position of <directive> in <string>, starting search at <i>. Also return @@ -142,6 +158,7 @@ (nreverse prefix-parameters))) (#\X (format-integer (pop args) 16 at-sign-p colon-p (nreverse prefix-parameters))) + (#\F (apply 'format-float (pop args) at-sign-p colon-p (nreverse prefix-parameters))) (#\C (if colon-p (let ((c (pop args))) (write-string (or (char-name c) c))) @@ -292,3 +309,4 @@ end-loop) (values i args)))

+