From bknr at bknr.net Mon Apr 17 04:34:04 2006 From: bknr at bknr.net (bknr at bknr.net) Date: Mon, 17 Apr 2006 00:34:04 -0400 (EDT) Subject: [bknr-cvs] r1943 - trunk/bknr/src/images Message-ID: <20060417043404.2A9922608C@common-lisp.net> Author: troussanov Date: 2006-04-17 00:34:03 -0400 (Mon, 17 Apr 2006) New Revision: 1943 Modified: trunk/bknr/src/images/image-tags.lisp Log: Fix the use of indeces in subseq calls. SBCL signals an error SB-KERNEL:BOUNDING-INDICES-BAD-ERROR. CMUCL does not implement the range checks as specified in: The ANSI Standard, writeup for Issue SUBSEQ-OUT-OF-BOUNDS:IS-AN-ERROR Modified: trunk/bknr/src/images/image-tags.lisp =================================================================== --- trunk/bknr/src/images/image-tags.lisp 2006-03-28 13:22:02 UTC (rev 1942) +++ trunk/bknr/src/images/image-tags.lisp 2006-04-17 04:34:03 UTC (rev 1943) @@ -129,8 +129,13 @@ :value "Unselect all images" :onClick "check(this,'image-id',false);")) ((:table :class "images") - (loop for image-row on images by #'(lambda (seq) (subseq seq 5)) - do (html (:tr (loop for image in (subseq image-row 0 5) + (loop for image-row on images by #'(lambda (seq) + (if (> (length seq) 5) + (subseq seq 5) + nil)) + do (html (:tr (loop for image in (if (> (length image-row) 5) + (subseq image-row 0 5) + image-row) for image-id = (store-object-id image) for image-name = (store-image-name image) do (html ((:td) From bknr at bknr.net Mon Apr 17 04:45:40 2006 From: bknr at bknr.net (bknr at bknr.net) Date: Mon, 17 Apr 2006 00:45:40 -0400 (EDT) Subject: [bknr-cvs] r1944 - in trunk/bknr/src: web xhtmlgen Message-ID: <20060417044540.92DB524002@common-lisp.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)