[bknr-cvs] r1944 - in trunk/bknr/src: web xhtmlgen

[bknr at bknr.net]

Author: troussanov
Date: 2006-04-17 00:45:39 -0400 (Mon, 17 Apr 2006)
New Revision: 1944

Modified:
   trunk/bknr/src/web/handlers.lisp
   trunk/bknr/src/web/templates.lisp
   trunk/bknr/src/web/user-handlers.lisp
   trunk/bknr/src/web/web-macros.lisp
   trunk/bknr/src/web/web-utils.lisp
   trunk/bknr/src/xhtmlgen/xhtmlgen.lisp
Log:
Additional SBCL related fixes (may be temporary) for sink flushing problems. 


Modified: trunk/bknr/src/web/handlers.lisp
===================================================================
--- trunk/bknr/src/web/handlers.lisp	2006-04-17 04:34:03 UTC (rev 1943)
+++ trunk/bknr/src/web/handlers.lisp	2006-04-17 04:45:39 UTC (rev 1944)
@@ -211,6 +211,9 @@
 				    (if (or (admin-p *user*)
 					    *bknr-debug*)
 					(html (:pre (:princ-safe e)
+						    #+sbcl
+						    ((:font :size "-3")
+						     (sb-debug:backtrace 30 *html-stream*))
 						    #+cmu
 						    ((:font :size "-3")
 						     (debug:backtrace 30 *html-stream*))))

Modified: trunk/bknr/src/web/templates.lisp
===================================================================
--- trunk/bknr/src/web/templates.lisp	2006-04-17 04:34:03 UTC (rev 1943)
+++ trunk/bknr/src/web/templates.lisp	2006-04-17 04:45:39 UTC (rev 1944)
@@ -108,7 +108,7 @@
   (let* ((*template-expander* expander)
          (*template-env* env)
          (sink (cxml:make-character-stream-sink stream :canonical nil))
-         (*html-sink* (cxml:make-recoder sink #'cxml::utf8-string-to-rod)))
+         (*html-sink* (cxml:make-recoder sink #-sbcl #'cxml::utf8-string-to-rod #+sbcl #'cxml::string-rod)))
     (if (node-attribute node "suppress-xml-headers")
 	(emit-template-node node)
 	(progn

Modified: trunk/bknr/src/web/user-handlers.lisp
===================================================================
--- trunk/bknr/src/web/user-handlers.lisp	2006-04-17 04:34:03 UTC (rev 1943)
+++ trunk/bknr/src/web/user-handlers.lisp	2006-04-17 04:45:39 UTC (rev 1944)
@@ -180,4 +180,4 @@
 (define-bknr-webserver-module user
     ("/user" user-handler)
   ("/login" login-handler)
-  ("/logout" logout-handler))
\ No newline at end of file
+  ("/logout" logout-handler))

Modified: trunk/bknr/src/web/web-macros.lisp
===================================================================
--- trunk/bknr/src/web/web-macros.lisp	2006-04-17 04:34:03 UTC (rev 1943)
+++ trunk/bknr/src/web/web-macros.lisp	2006-04-17 04:45:39 UTC (rev 1944)
@@ -120,7 +120,7 @@
 	    (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response response)
 	      (with-http-body (req *ent*)
 		(princ body *html-stream*))))
-	(serious-condition (c)
+	(serious-condition (c) 
 	  (with-bknr-http-response (req :content-type "text/html; charset=UTF-8" :response *response-internal-server-error*)
 	    (with-http-body (req *ent*)
 	      (funcall show-error-page c)))))))

Modified: trunk/bknr/src/web/web-utils.lisp
===================================================================
--- trunk/bknr/src/web/web-utils.lisp	2006-04-17 04:34:03 UTC (rev 1943)
+++ trunk/bknr/src/web/web-utils.lisp	2006-04-17 04:45:39 UTC (rev 1944)
@@ -266,4 +266,4 @@
 	(princ " />"))))
 
 (defun encode-urlencoded (string)
-  (regex-replace-all #?r"\+" (net.aserve::encode-form-urlencoded string) "%20"))
\ No newline at end of file
+  (regex-replace-all #?r"\+" (net.aserve::encode-form-urlencoded string) "%20"))

Modified: trunk/bknr/src/xhtmlgen/xhtmlgen.lisp
===================================================================
--- trunk/bknr/src/xhtmlgen/xhtmlgen.lisp	2006-04-17 04:34:03 UTC (rev 1943)
+++ trunk/bknr/src/xhtmlgen/xhtmlgen.lisp	2006-04-17 04:45:39 UTC (rev 1944)
@@ -56,6 +56,10 @@
 (defun make-sink-for-latin1-strings (stream)
   (cxml:make-recoder (cxml:make-character-stream-sink stream :canonical nil :indentation 3)
 		     #'cxml::string-rod))
+#+rune-is-character
+(defun make-sink-for-character-strings (stream)
+  (cxml:make-recoder (cxml:make-character-stream-sink stream :canonical nil :indentation 3)
+		     #'cxml::string-rod))
 
 #-rune-is-character
 (defvar *make-sink-for-internal-strings-fn* #'make-sink-for-utf8-strings)
@@ -70,23 +74,29 @@
     (:latin-1 (setf *make-sink-for-internal-strings-fn* #'make-sink-for-latin1-strings))
     (:utf-8 (setf *make-sink-for-internal-strings-fn* #'make-sink-for-utf8-strings))))
 
+#+sbcl
+;temporary, until we fix sbcl flush problem
+(defun flush-sink (recoder)
+  (runes::flush-ystream (cxml::sink-ystream (cxml::chained-handler recoder))))
+
+
 (defmacro html (&rest forms &environment env)
   ;; just emit html to the current stream
   `(let ((*html-sink* (if (boundp '*html-sink*)
 			  *html-sink*
 			  #+rune-is-character
-			  (cxml:make-character-stream-sink net.html.generator:*html-stream* :canonical nil :indentation 3)
+			  (make-sink-for-character-strings net.html.generator:*html-stream*)
 			  #-rune-is-character
 			  (make-sink-for-internal-strings net.html.generator:*html-stream*))))
-    ,(process-html-forms forms env)))
+    ,(process-html-forms forms env) #+sbcl (flush-sink *html-sink*)))
 
 (defmacro html-stream (stream &rest forms &environment env)
   `(let ((*html-sink*
 	  #+rune-is-character
-	  (cxml:make-character-stream-sink ,stream :canonical nil :indentation 3)
+	  (make-sink-for-character-strings ,stream)
 	  #-rune-is-character
 	  (make-sink-for-internal-strings ,stream)))
-    ,(process-html-forms forms env)))
+    ,(process-html-forms forms env) #+sbcl (flush-sink *html-sink*)))
 
 (defun get-process (form)
   (let ((ent (gethash form *html-process-table*)))
@@ -164,7 +174,7 @@
 	       #-sbcl
 	       (cxml::write-rune (char-code c) s)
 	       #+sbcl
-	       (cxml::write-rune c s))
+	       (cxml::write-rune c (cxml::sink-ystream s)))
 	 str)))
 
 (defun princ-http (val)