[bknr-cvs] r2508 - in branches/trunk-reorg/bknr: datastore/src/data datastore/src/indices datastore/src/skip-list modules/imagemap modules/mail web/src web/src/images web/src/web
hhubner at common-lisp.net
hhubner at common-lisp.net
Fri Feb 15 16:40:33 UTC 2008
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 , at 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 , at 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)
, at 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)
, at 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 , at warning))
+ (html (:princ-safe (format nil "<!-- ~a -->~%" (format nil , at warning))))
(warn , at 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
More information about the Bknr-cvs
mailing list