Author: hhubner Date: Fri Feb 15 11:40:28 2008 New Revision: 2508
Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp branches/trunk-reorg/bknr/datastore/src/indices/indexed-class.lisp branches/trunk-reorg/bknr/datastore/src/skip-list/skip-list.lisp branches/trunk-reorg/bknr/modules/imagemap/imagemap-handlers.lisp branches/trunk-reorg/bknr/modules/mail/mail.lisp branches/trunk-reorg/bknr/web/src/images/edit-image-handler.lisp branches/trunk-reorg/bknr/web/src/images/image.lisp branches/trunk-reorg/bknr/web/src/packages.lisp branches/trunk-reorg/bknr/web/src/web/template-handler.lisp branches/trunk-reorg/bknr/web/src/web/web-macros.lisp branches/trunk-reorg/bknr/web/src/web/web-utils.lisp Log: Several changes to remove references to *html-stream*, not complete. Minor edits and reformats.
Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp ============================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/object.lisp (original) +++ branches/trunk-reorg/bknr/datastore/src/data/object.lisp Fri Feb 15 11:40:28 2008 @@ -561,7 +561,7 @@ collect keyword and collect value)) - + ;;; create object transaction, should not be called from user code, as we have to give it ;;; a unique id in the initargs. After the object is created, the persistent and the ;;; transient instances are initialized
Modified: branches/trunk-reorg/bknr/datastore/src/indices/indexed-class.lisp ============================================================================== --- branches/trunk-reorg/bknr/datastore/src/indices/indexed-class.lisp (original) +++ branches/trunk-reorg/bknr/datastore/src/indices/indexed-class.lisp Fri Feb 15 11:40:28 2008 @@ -281,8 +281,7 @@
(defvar *indexed-class-override* nil)
-(defmethod slot-value-using-class :before - ((class indexed-class) object slot) +(defmethod slot-value-using-class :before ((class indexed-class) object slot) (when (and (not (eql (slot-definition-name slot) 'destroyed-p)) (object-destroyed-p object) (not *indexed-class-override*))
Modified: branches/trunk-reorg/bknr/datastore/src/skip-list/skip-list.lisp ============================================================================== --- branches/trunk-reorg/bknr/datastore/src/skip-list/skip-list.lisp (original) +++ branches/trunk-reorg/bknr/datastore/src/skip-list/skip-list.lisp Fri Feb 15 11:40:28 2008 @@ -7,7 +7,7 @@ ;;; Pseudo-random number generator from FreeBSD
(defparameter *sl-random-state* - (make-random-state) + (make-random-state t) "Internal status of the random number generator.")
(defun sl-random ()
Modified: branches/trunk-reorg/bknr/modules/imagemap/imagemap-handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/imagemap/imagemap-handlers.lisp (original) +++ branches/trunk-reorg/bknr/modules/imagemap/imagemap-handlers.lisp Fri Feb 15 11:40:28 2008 @@ -77,11 +77,10 @@ (t (html (:p #?"unknown operation $(operation-string)")))) (html ((:form :action (self-url :command "make-polygon")) (if (session-value :map-points) - (progn - (format *html-stream* "~a point~:P collected " - (/ (length (session-value :map-points)) 2)) - (html (cmslink (self-url :command "clear-points") - (:princ "clear"))) + (html + (:princ (format nil "~A point~:P collected " + (/ (length (session-value :map-points)) 2))) + (cmslink (self-url :command "clear-points") (:princ "clear")) (when (< 4 (length (session-value :map-points))) (html " link to url: " ((:input :type "text" :name "url" :width 40)) " " ((:input :type "submit" :value "make polygon")))))
Modified: branches/trunk-reorg/bknr/modules/mail/mail.lisp ============================================================================== --- branches/trunk-reorg/bknr/modules/mail/mail.lisp (original) +++ branches/trunk-reorg/bknr/modules/mail/mail.lisp Fri Feb 15 11:40:28 2008 @@ -43,15 +43,15 @@
(defmacro with-html-output-to-mail ((&rest mail-initargs &key headers &allow-other-keys) &rest body) (let ((new-headers (gensym))) - `(let ((,new-headers (make-headers :content-type "text/html; charset="utf-8"" - :mime-version "1.0"))) - (when ,headers - (setf ,new-headers (append ,new-headers ,headers))) - (make-object 'mail - :headers ,new-headers - ,@(remove-keys '(:headers) mail-initargs) - :body (with-output-to-string (*html-stream*) - (html ,@body)))))) + `(let ((,new-headers (make-headers :content-type "text/html; charset="utf-8"" + :mime-version "1.0"))) + (when ,headers + (setf ,new-headers (append ,new-headers ,headers))) + (make-object 'mail + :headers ,new-headers + ,@(remove-keys '(:headers) mail-initargs) + :body (with-output-to-string (s) + (html-stream s ,@body))))))
;;; converted from macho (by Miles Egan) (defun parse-header-string (headerstr)
Modified: branches/trunk-reorg/bknr/web/src/images/edit-image-handler.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/images/edit-image-handler.lisp (original) +++ branches/trunk-reorg/bknr/web/src/images/edit-image-handler.lisp Fri Feb 15 11:40:28 2008 @@ -126,10 +126,10 @@ (with-bknr-page (:title #?"edit image $(name)") (when remove-keywords (store-object-remove-keywords image 'keywords remove-keywords) - (html (:h2 (format *html-stream* "Removed keywords ~a from image" remove-keywords)))) + (html (:h2 (:princ (format nil "Removed keywords ~a from image" remove-keywords))))) (when add-keywords (store-object-add-keywords image 'keywords add-keywords) - (html (:h2 (format *html-stream* "Added keywords ~a to image" add-keywords)))) + (html (:h2 (:princ (format nil "Added keywords ~a to image" add-keywords))))) (unless (or add-keywords remove-keywords) (html (:h2 "No keywords added or removed"))) (show-image-editor image)))) \ No newline at end of file
Modified: branches/trunk-reorg/bknr/web/src/images/image.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/images/image.lisp (original) +++ branches/trunk-reorg/bknr/web/src/images/image.lisp Fri Feb 15 11:40:28 2008 @@ -115,13 +115,12 @@ :title (store-image-name image) :link browse-url :desc (with-output-to-string (s) - (html-stream - s ((:a :href image-url) - ((:img :src - (concatenate 'string - image-url - "/thumbnail,,320,200") - :align "left"))))) + (html-stream s ((:a :href image-url) + ((:img :src + (concatenate 'string + image-url + "/thumbnail,,320,200") + :align "left"))))) :date (blob-timestamp image))))
;;; import
Modified: branches/trunk-reorg/bknr/web/src/packages.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/packages.lisp (original) +++ branches/trunk-reorg/bknr/web/src/packages.lisp Fri Feb 15 11:40:28 2008 @@ -192,8 +192,7 @@ (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:shadowing-import-from :hunchentoot #:host) (:shadowing-import-from :alexandria #:array-index) - (:export #:*html-stream* - #:*user* + (:export #:*user* #:with-http-request #:with-http-body #:request-variable
Modified: branches/trunk-reorg/bknr/web/src/web/template-handler.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/template-handler.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/template-handler.lisp Fri Feb 15 11:40:28 2008 @@ -265,9 +265,9 @@ (defun send-error-response (handler message &key (response-code +http-internal-server-error+)) (with-http-response (:content-type "text/html; charset=UTF-8" :response response-code) - (with-http-body () + (with-output-to-string (stream) (emit-template handler - *html-stream* + stream (get-cached-template (find-template-pathname handler "user-error") handler) (acons :error-message message (initial-template-environment @@ -316,8 +316,7 @@ (if body (with-http-response (:content-type "text/html; charset=UTF-8" :response +http-ok+) - (with-http-body () - (write-string body *html-stream*))) + body) (error-404)))))
;; XXX documentation-handler sieht interessant aus, unbedingt reparieren
Modified: branches/trunk-reorg/bknr/web/src/web/web-macros.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/web-macros.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/web-macros.lisp Fri Feb 15 11:40:28 2008 @@ -50,11 +50,9 @@ (setf (return-code) ,response) ,@body))
-(defvar *html-stream*) - (defmacro with-http-body ((&key external-format) &body body) - `(with-output-to-string (*html-stream*) - (with-xhtml (*html-stream*) + `(with-output-to-string (stream) + (with-xhtml (stream) ,@body)))
(defmacro with-image-from-uri ((image-variable prefix) &rest body) @@ -83,7 +81,7 @@
(defmacro html-warn (&rest warning) `(progn - (format *html-stream* "<!-- ~a -->~%" (format nil ,@warning)) + (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil ,@warning)))) (warn ,@warning)))
(defmacro cmslink (url &body body)
Modified: branches/trunk-reorg/bknr/web/src/web/web-utils.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/web-utils.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/web-utils.lisp Fri Feb 15 11:40:28 2008 @@ -137,7 +137,6 @@ (defun http-error (response message) (with-bknr-page (:title #?"error: $(message)" :response response) (:princ-safe message)) - (finish-output *html-stream*) (error message))
(defun keywords-from-query-param-list (param &key (remove-empty t)) @@ -190,7 +189,7 @@ #?"/$((or prefix old-prefix))/$(object-id)/$((or command old-command))"))
(defmethod html-link ((object store-object)) - (format *html-stream* "[persistent object with id #~a]" (store-object-id object))) + (html (:princ (format nil "[persistent object with id #~a]" (store-object-id object)))))
(defun text-to-html (string) "Perform simple text to HTML conversion. http urls are replaced by links, internal links to