From: Raimon Grau <raimonster@gmail.com>
Date: Thu, 25 Apr 2013 22:28:44 +0000 (+0200)
Subject: fist stab at format
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ee796a9047c9f920ee6ca4071e10baf96e917de8;p=jscl.git

fist stab at format
---

diff --git a/src/print.lisp b/src/print.lisp
index cc6c16c..f4cd1bb 100644
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -1,4 +1,4 @@
-;;; print.lisp --- 
+;;; print.lisp ---
 
 ;; Copyright (C) 2012, 2013 David Vazquez
 ;; Copyright (C) 2012 Raimon Grau
@@ -69,3 +69,33 @@
 (defun print (x)
   (write-line (prin1-to-string x))
   x)
+
+#+jscl
+(progn
+  (defun format (destination fmt &rest args)
+    (let ((len (length fmt))
+	  (i 0)
+	  (res "")
+	  (arguments args))
+      (cl:%while (< i len)
+		 (let ((c (char fmt i)))
+		   (if (char= c #\~)
+		       (let ((next (char fmt (incf i))))
+			 (if (char= next #\~)
+			     (progn (setq res (cl:concat res "~"))
+				    (incf i))
+			     (progn
+			       (format-special next (car arguments))
+			       (setq arguments (cdr arguments)))))
+		       (progn
+			 (setq res (cl:concat res (cl:char-to-string c)))))
+		   (incf i)))
+      (if destination
+	  (progn
+	    (write-string res)
+	    nil)
+	  res)))
+
+
+  (defun format-special (chr arg)
+    chr))
diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 1167cfb..ba9b129 100644
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -54,7 +54,7 @@
           define-symbol-macro defmacro defparameter defun defvar
           digit-char digit-char-p disassemble do do* documentation
           dolist dotimes ecase eq eql equal error eval every export expt
-          fdefinition find-package find-symbol first flet fourth fset
+          fdefinition find-package find-symbol first flet format fourth fset
           funcall function functionp gensym get-setf-expansion
           get-universal-time go identity if in-package incf integerp
           intern keywordp labels lambda last length let let* list