[bknr-cvs] r2522 - in branches/trunk-reorg/bknr/web/src: . images rss web
hhubner at common-lisp.net
hhubner at common-lisp.net
Sun Feb 17 19:25:59 UTC 2008
Author: hhubner
Date: Sun Feb 17 14:25:56 2008
New Revision: 2522
Removed:
branches/trunk-reorg/bknr/web/src/rss/parse-atom.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-rss091.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-rss10.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-rss20.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-xml.lisp
branches/trunk-reorg/bknr/web/src/rss/test.lisp
Modified:
branches/trunk-reorg/bknr/web/src/bknr-web.asd
branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp
branches/trunk-reorg/bknr/web/src/images/image.lisp
branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp
branches/trunk-reorg/bknr/web/src/packages.lisp
branches/trunk-reorg/bknr/web/src/rss/rss.lisp
branches/trunk-reorg/bknr/web/src/web/handlers.lisp
branches/trunk-reorg/bknr/web/src/web/menu.lisp
branches/trunk-reorg/bknr/web/src/web/site.lisp
branches/trunk-reorg/bknr/web/src/web/tags.lisp
branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
branches/trunk-reorg/bknr/web/src/web/web-macros.lisp
Log:
Docstrings.
Cleaning up: The old RSS parsing code is now gone, as it was not used and
did not work any more.
HANDLER-MATCHES renamed to HANDLER-MATCHES-P
Modified: branches/trunk-reorg/bknr/web/src/bknr-web.asd
==============================================================================
--- branches/trunk-reorg/bknr/web/src/bknr-web.asd (original)
+++ branches/trunk-reorg/bknr/web/src/bknr-web.asd Sun Feb 17 14:25:56 2008
@@ -49,16 +49,7 @@
:depends-on ("hyperspec")))
:depends-on ("packages"))
- (:module "rss" :components ((:file "rss")
- (:file "parse-xml")
- (:file "parse-rss10"
- :depends-on ("parse-xml" "rss"))
- (:file "parse-rss091"
- :depends-on ("parse-xml" "rss"))
- (:file "parse-atom"
- :depends-on ("parse-xml" "rss"))
- (:file "parse-rss20"
- :depends-on ("parse-xml" "rss")))
+ (:module "rss" :components ((:file "rss"))
:depends-on ("packages"))
(:module "web" :components ((:file "site")
Modified: branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp Sun Feb 17 14:25:56 2008
@@ -10,12 +10,13 @@
(setf (header-out :cache-control) (format nil "max-age=~A" max-age)))
(unless (zerop date)
(setf (header-out :last-modified) (rfc-1123-date date)))
- (with-http-body ()
+ (let ((stream (send-headers)))
+ (setf (flex:flexi-stream-element-type stream) 'flex:octet)
(setf (save-alpha-p :image image) t)
(if (member image-format '(:jpg :jpeg))
- (write-image-to-stream *html-stream* image-format :image image :quality quality)
- (write-image-to-stream *html-stream* image-format :image image))
- (finish-output *html-stream*))))
+ (write-image-to-stream stream image-format :image image :quality quality)
+ (write-image-to-stream stream image-format :image image))
+ (finish-output stream))))
(defmethod store-image-xml-info ((image store-image))
(cxml:with-element "image"
@@ -52,9 +53,6 @@
(defmethod object-list-handler-title ((handler image-page-handler) object)
"bknr images")
-(defmethod object-list-handler-rss-link ((handler image-page-handler) object)
- "/image-rss")
-
(defmethod object-list-handler-get-objects ((handler image-page-handler) object)
(all-store-images))
@@ -65,7 +63,6 @@
(defmethod handle-object ((handler image-page-handler) images)
(let ((results (make-keyword-results (object-list-handler-get-objects handler images))))
(with-bknr-page (:title (object-list-handler-title handler images))
- (cmslink (object-list-handler-rss-link handler images) "rss")
(image-page results))))
(defclass upload-image-handler (form-handler)
@@ -114,10 +111,6 @@
(defmethod object-list-handler-title ((handler image-keyword-handler) keyword)
(format nil "bknr keyword images: ~a" keyword))
-(defmethod object-list-handler-rss-link ((handler image-keyword-handler) keyword)
- (format nil "/keyword-rss/~A"
- (string-downcase (symbol-name keyword))))
-
(defclass image-union-handler (image-page-handler keywords-handler)
())
@@ -127,9 +120,6 @@
(defmethod object-list-handler-title ((handler image-union-handler) keywords)
(format nil "bknr union images: ~a" keywords))
-(defmethod object-list-handler-rss-link ((handler image-union-handler) keywords)
- (format nil "/union-rss/~A" (parse-url)))
-
(defclass image-intersection-handler (image-page-handler keywords-handler)
())
@@ -139,43 +129,6 @@
(defmethod object-list-handler-title ((handler image-intersection-handler) keywords)
(format nil "bknr intersection images: ~a" keywords))
-(defmethod object-list-handler-rss-link ((handler image-intersection-handler) keywords)
- (format nil "/intersection-rss/~A" (parse-url)))
-
-;;; rss image feeds
-#|
-(defclass rss-image-handler (object-rss-handler image-page-handler)
- ())
-
-(defmethod create-object-rss-feed ((handler rss-image-handler) object)
- (let* ((url (website-url (page-handler-site handler)))
- (image-items (mapcar #'(lambda (image)
- (store-image-to-rss-item image :url url))
- (subseq (sort (object-list-handler-get-objects handler object)
- #'> :key #'blob-timestamp)
- 0 20))))
- (if image-items
- (make-instance 'rss-feed
- :channel (make-instance
- 'rss-channel
- :about (render-uri url nil)
- :title (object-list-handler-title handler object)
- :link (render-uri url nil)
- :items (mapcar #'rss-item-link image-items))
- :items image-items)
- (make-instance 'rss-feed :channel (make-instance 'rss-channel
- :about "no such keyword"
- :title "no such keyword")))))
-
-(defclass rss-image-keyword-handler (rss-image-handler image-keyword-handler)
- ())
-
-(defclass rss-image-union-handler (rss-image-handler image-union-handler)
- ())
-
-(defclass rss-image-intersection-handler (rss-image-handler image-intersection-handler)
- ())
-|#
(defclass xml-image-browser-handler (image-handler xml-object-handler)
())
@@ -203,12 +156,6 @@
("/image-keyword" image-keyword-handler)
("/image-union" image-union-handler)
("/image-intersection" image-intersection-handler)
- #|
- ("/rss-image" rss-image-handler)
- ("/rss-image-keyword" rss-image-keyword-handler)
- ("/rss-image-union" rss-image-union-handler)
- ("/rss-image-intersection" rss-image-intersection-handler)
- |#
("/image" imageproc-handler)
("/image-import" image-import-handler)
("/session-image" session-image-handler)
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 Sun Feb 17 14:25:56 2008
@@ -103,26 +103,6 @@
(store-image-with-name image-id)))
(keyword (store-image-with-name (string-downcase (symbol-name image-id))))))
-(defmethod store-image-to-rss-item ((image store-image) &key (url (parse-uri "")))
- (let ((image-url (render-uri (merge-uris (parse-uri (format nil "/image/~a"
- (store-object-id image)))
- url) nil))
- (browse-url (render-uri (merge-uris (parse-uri (format nil "/browse-image/~A"
- (store-object-id image)))
- url) nil)) )
- (make-instance 'rss-item
- :about browse-url
- :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")))))
- :date (blob-timestamp image))))
-
;;; import
(defun import-image (pathname &key name user keywords directory (keywords-from-dir t) (class-name 'store-image) initargs)
"Create blob from given file"
Modified: branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp Sun Feb 17 14:25:56 2008
@@ -34,9 +34,7 @@
(when (and (true-color-p working-image)
(not (true-color-p input-image)))
(true-color-to-palette :dither t :image working-image :colors-wanted 256))
- (let ((stream (send-headers)))
- (setf (flex:flexi-stream-element-type stream) 'flex:octet)
- (write-image-to-stream stream (image-type-keyword image) :image working-image))
+ (emit-image-to-browser working-image (image-type-keyword image))
(unless (eq working-image input-image)
(destroy-image working-image)))))
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 Sun Feb 17 14:25:56 2008
@@ -20,17 +20,8 @@
(defpackage :bknr.rss
(:use :cl :cl-user :cl-ppcre :bknr.utils :bknr.xml :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml)
- (:export #:xml-escape
- #:*img-src-scanner*
- #:*a-href-scanner*
- #:*link-href-scanner*
- #:replace-relative-links
- #:make-absolute-url
-
- #:rss-to-xml
- #:merge-feeds
+ (:export ;; channel
- ;; channel
#:rss-channel
#:find-rss-channel
#:make-rss-channel
@@ -44,13 +35,6 @@
#:rss-channel-items
#:rss-channel-xml
- ;; image
- #:rss-image
- #:rss-image-about
- #:rss-image-title
- #:rss-image-url
- #:rss-image-link
-
;; item
#:rss-item
#:rss-item-channel
@@ -65,22 +49,7 @@
#:rss-item-enclosure
#:rss-item-guid
#:rss-item-source
- #:rss-item-encoded-content
-
- ;; textinput
- #:rss-textinput
- #:rss-textinput-about
- #:rss-textinput-title
- #:rss-textinput-desc
- #:rss-textinput-link
- #:rss-textinput-name
-
- #:parse-rss091-feed
- #:parse-rss10-feed
- #:parse-rss20-feed
- #:parse-atom-feed
-
- #:*base-url*))
+ #:rss-item-encoded-content))
(defpackage :bknr.events
(:use :cl
@@ -292,13 +261,12 @@
#:website-session-info
#:website-base-href
#:website-make-path
- #:website-rss-feed-url
#:host
#:publish-site
#:publish-handler
#:unpublish
- #:handler-matches
+ #:handler-matches-p
#:handle-object
#:handle-object-form
#:handle-form
@@ -357,7 +325,6 @@
#:object-list-handler
#:object-list-handler-get-objects
#:object-list-handler-title
- #:object-list-handler-rss-link
#:object-list-handler-show-object-xml
#:object-date-list-handler
#:object-date-list-handler-grouped-objects
Modified: branches/trunk-reorg/bknr/web/src/rss/rss.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/rss/rss.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/rss/rss.lisp Sun Feb 17 14:25:56 2008
@@ -4,33 +4,7 @@
;; This package aids in the automatic generation of RSS channels.
-;; Class rss-channel models one rss channel. Items are added to a
-;; channel by deriving other persistent classes from the (mixin) class
-;; rss-item. When an object of such a derived class is created, it is
-;; automatically added to its RSS channel. Likewise, it is
-;; automatically deleted from the channel when it is deleted.
-
-;; The channel that an item is put into is defined by the generic
-;; function rss-item-channel which needs to be specialized for each
-;; item class. The default method of this generic function specifies
-;; nil as channel, which results in the creation of a warning message
-;; when an object of this class is created.
-
-;; The rss-item-channel method may return the channel either as a
-;; string or as a channel object.
-
-;; Subclasses of rss-item should provide methods for some of the
-;; generic functions (rss-item-channel rss-item-title rss-item-link
-;; rss-item-description rss-item-author rss-item-category
-;; rss-item-comments rss-item-enclosure rss-item-guid
-;; rss-item-source). These functions are called when the RSS file for
-;; the channel is generated and provide the
-
-;; One rss-item can only be in one channel.
-
-;; The channel object has more required elements than the standard
-;; specifies in order to make the generated feed documents more widely
-;; accepted.
+;; See the documentation to class RSS-CHANNEL for an overview.
;;; Paul Graham, On Lisp, p191
(defmacro aif (test-form then-form &optional else-form)
@@ -48,17 +22,46 @@
(description :update)
(last-update :update :initform (get-universal-time))
(max-item-age :update :initform (* 4 7 3600))
- (items :update :initform nil)))
+ (items :update :initform nil))
+ (:documentation "RSS-CHANNEL models one rss channel. Items are
+added to a channel by deriving other persistent classes from the mixin
+class RSS-ITEM. When an object of such a derived class is created, it
+is automatically added to its RSS channel. Likewise, it is
+automatically deleted from the channel when it is deleted.
+
+The channel that an item is put into is defined by the generic
+function RSS-ITEM-CHANNEL which needs to be specialized for each item
+class. The default method of this generic function specifies nil as
+channel, which results in the creation of a warning message when an
+object of this class is created.
+
+The RSS-ITEM-CHANNEL method may return the channel either as a string
+or as a channel object.
+
+Subclasses of RSS-ITEM should provide methods for some of the generic
+functions (RSS-ITEM-CHANNEL RSS-ITEM-TITLE RSS-ITEM-LINK
+RSS-ITEM-DESCRIPTION RSS-ITEM-AUTHOR RSS-ITEM-CATEGORY
+RSS-ITEM-COMMENTS RSS-ITEM-ENCLOSURE RSS-ITEM-GUID RSS-ITEM-SOURCE).
+These functions are called when the RSS file for the channel is
+generated and provide the content in the RSS items.
+
+One RSS-ITEM can only be in one channel, which is a restriction that
+may eventually be removed.
+
+The channel object has more required elements than specified by the
+standard in order to make the generated feed documents more widely
+accepted."))
(defmethod prepare-for-snapshot ((channel rss-channel))
+ "When snapshotting, remove items from CHANNEL that are destroyed."
(setf (rss-channel-items channel) (remove-if #'object-destroyed-p (rss-channel-items channel))))
;; Mixin for items
(define-persistent-class rss-item ()
- ())
-
-(defgeneric rss-item-pub-date (item))
+ ()
+ (:documentation "Mixin class for RSS items. See documentation for
+class RSS-CHANNEL for an overview."))
(defun make-rss-channel (name title description link &rest args)
(apply #'make-object 'rss-channel :name name :title title :description description :link link args))
@@ -85,42 +88,41 @@
(rss-channel-items channel)))
(rss-item-xml item))))))
-(defmethod rss-channel-items ((channel rss-channel))
- "Return all non-expired items in channel."
- (let ((expiry-time (- (get-universal-time) (rss-channel-max-item-age channel))))
- (remove-if (lambda (item) (or (object-destroyed-p item)
- (< (rss-item-pub-date item) expiry-time)))
- (slot-value channel 'items))))
+(defgeneric rss-channel-items (channel)
+ (:documentation "Return all non-expired items in channel.")
+ (:method ((channel rss-channel))
+ (let ((expiry-time (- (get-universal-time) (rss-channel-max-item-age channel))))
+ (remove-if (lambda (item) (or (object-destroyed-p item)
+ (< (rss-item-pub-date item) expiry-time)))
+ (slot-value channel 'items)))))
(deftransaction rss-channel-cleanup (channel)
"Remove expired items from the items list. Can be used to reduce
the memory footprint of very high volume channels."
(setf (slot-value channel 'items) (rss-channel-items channel)))
-;; Internal helper functions to find a channel
-
-(defmethod remove-item ((channel rss-channel) item)
- "Remove item from channel. May only be called within transaction context."
- (setf (slot-value channel 'items) (remove item (rss-channel-items channel))))
-
-(defmethod remove-item ((channel string) item)
- (aif (find-rss-channel channel)
- (remove-item it item)))
-
-(defmethod remove-item ((channel (eql nil)) item)
- (warn "no RSS channel defined for item ~A" item))
-
-(defmethod add-item ((channel rss-channel) item)
- "Add item to channel. May only be called within transaction context."
- (setf (slot-value channel 'items) (cons item (rss-channel-items channel))))
-
-(defmethod add-item ((channel string) item)
- (aif (find-rss-channel channel)
- (add-item it item)
- (warn "can't find RSS channel ~A to add newly created item ~A to" channel item)))
-
-(defmethod add-item ((channel (eql nil)) item)
- (warn "no RSS channel defined for item ~A" item))
+(defgeneric remove-item (channel item)
+ (:documentation "Remove ITEM from CHANNEL. May only be called
+within transaction context.")
+ (:method ((channel rss-channel) item)
+ (setf (slot-value channel 'items) (remove item (rss-channel-items channel))))
+ (:method ((channel string) item)
+ (aif (find-rss-channel channel)
+ (remove-item it item)))
+ (:method ((channel (eql nil)) item)
+ (warn "no RSS channel defined for item ~A" item)))
+
+(defgeneric add-item (channel item)
+ (:documentation "Add ITEM to CHANNEL. May only be called within
+transaction context.")
+ (:method ((channel rss-channel) item)
+ (setf (slot-value channel 'items) (cons item (rss-channel-items channel))))
+ (:method ((channel string) item)
+ (aif (find-rss-channel channel)
+ (add-item it item)
+ (warn "can't find RSS channel ~A to add newly created item ~A to" channel item)))
+ (:method ((channel (eql nil)) item)
+ (warn "no RSS channel defined for item ~A" item)))
(defmethod initialize-persistent-instance :after ((rss-item rss-item))
(add-item (rss-item-channel rss-item) rss-item))
@@ -129,12 +131,14 @@
(remove-item (rss-item-channel rss-item) rss-item))
(defun item-slot-element (item slot-name)
+ "Cheapo helper function to map from a pseudo slot name to an accessor."
(let ((accessor (find-symbol (format nil "RSS-ITEM-~A" slot-name) (find-package :bknr.rss))))
(aif (funcall accessor item)
(with-element (string-downcase (symbol-name slot-name))
(text it)))))
(defun rss-item-xml (item)
+ "Generate RSS XML for ITEM using CXML's unparse functionality."
(with-element "item"
(dolist (slot '(title link author category comments enclosure source))
(item-slot-element item slot))
@@ -154,27 +158,41 @@
;; All items present on an RSS stream can implement the access
;; methods below.
-(defmethod rss-item-published (item)
- t)
+(defgeneric rss-item-pub-date (item)
+ (:documentation "The default implementation for the publication date
+delivers the current system date/time as publication date.")
+ (:method (item)
+ (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item))
+ (get-universal-time)))
-(defmethod rss-item-pub-date (item)
- "The default implementation for the publication date delivers the
-current system date/time as publication date."
- (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item))
- (get-universal-time))
-
-(defmethod rss-item-channel (item))
-(defmethod rss-item-title (item))
-(defmethod rss-item-link (item))
-(defmethod rss-item-description (item))
-(defmethod rss-item-author (item))
-(defmethod rss-item-category (item))
-(defmethod rss-item-comments (item))
-(defmethod rss-item-enclosure (item))
-(defmethod rss-item-guid (item))
-(defmethod rss-item-source (item))
-(defgeneric rss-item-encoded-content (item)
- (:documentation "Return the content for ITEM in encoded (usually HTML) form as string.")
+(defgeneric rss-item-published (item)
+ (:documentation "Return non-nil if the ITEM is published.
+Non-published items are not put into generated XML by
+RSS-CHANNEL-XML.")
(:method (item)
- (declare (ignore item))
- nil))
+ t))
+
+(defmacro define-rss-item-field (field-name
+ &key
+ (documentation (format nil "Return the ~(~A~) of the ITEM as a string" field-name))
+ mandatory)
+ `(defgeneric ,(intern (format nil "RSS-ITEM-~A" field-name)) (item)
+ (:documentation ,(format nil "~A~@[ (optional)~]"
+ documentation (not mandatory)))
+ ,@(unless mandatory
+ '((:method (item) nil)))))
+
+(define-rss-item-field channel
+ :documentation "Return the channel that the ITEM is published in."
+ :mandatory t)
+(define-rss-item-field title)
+(define-rss-item-field link)
+(define-rss-item-field description)
+(define-rss-item-field author)
+(define-rss-item-field category)
+(define-rss-item-field comments)
+(define-rss-item-field enclosure)
+(define-rss-item-field guid)
+(define-rss-item-field source)
+(define-rss-item-field encoded-content
+ :documentation "Return the content for ITEM in encoded (usually HTML) form as string.")
Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Sun Feb 17 14:25:56 2008
@@ -503,13 +503,13 @@
(defgeneric object-date-list-handler-grouped-objects (handler object))
-(defmethod object-date-list-handler-date ((handler object-date-list-handler)
- object)
- (with-query-params (date)
- (get-daytime (if date
- (or (parse-integer date :junk-allowed t)
- (get-universal-time))
- (get-universal-time)))))
+(defgeneric object-date-list-handler-date (handler object)
+ (:method ((handler object-date-list-handler) object)
+ (with-query-params (date)
+ (get-daytime (if date
+ (or (parse-integer date :junk-allowed t)
+ (get-universal-time))
+ (get-universal-time))))))
(defclass admin-only-handler ()
())
Modified: branches/trunk-reorg/bknr/web/src/web/menu.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/menu.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/menu.lisp Sun Feb 17 14:25:56 2008
@@ -44,6 +44,7 @@
(let* ((menu (bknr.impex:parse-xml-file
#+cmu (ext:unix-namestring (merge-pathnames config *default-pathname-defaults*))
#+sbcl (sb-int:unix-namestring (merge-pathnames config *default-pathname-defaults*))
+ #-(or cmu sbcl) (namestring (probe-file (merge-pathnames config *default-pathname-defaults*)))
*menu-def-classes*)))
(html
((:div :class container-class)
Modified: branches/trunk-reorg/bknr/web/src/web/site.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/site.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/site.lisp Sun Feb 17 14:25:56 2008
@@ -5,6 +5,6 @@
(defparameter *thumbnail-max-width* 108)
(defparameter *thumbnail-max-height* 54)
-;; default billboard to show on home page
-(defparameter *default-billboard* "main")
+(defparameter *default-billboard* "main"
+ "default billboard to show on home page")
Modified: branches/trunk-reorg/bknr/web/src/web/tags.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/tags.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/tags.lisp Sun Feb 17 14:25:56 2008
@@ -61,6 +61,7 @@
(html ((:input :type "checkbox" :name name) (:princ-safe value)))))
(define-bknr-tag date-field (name &key date (show-time t))
+ "Generate a date entry widget using HTML <select> elements."
(unless date
(setf date (get-universal-time)))
(multiple-value-bind (sec min hour day month year)
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 Sun Feb 17 14:25:56 2008
@@ -300,7 +300,7 @@
(defmacro with-error-handlers ((handler) &body body)
`(invoke-with-error-handlers (lambda () , at body) ,handler))
-(defmethod handler-matches ((handler template-handler))
+(defmethod handler-matches-p ((handler template-handler))
(handler-case
(find-template-pathname handler (script-name))
(template-not-found (c)
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 Sun Feb 17 14:25:56 2008
@@ -80,6 +80,8 @@
:value ,(or variable ""))))
(defmacro html-warn (&rest warning)
+ "Generate a warning on the console and write the warning into the
+currently generated XHTML output as a comment."
`(progn
(html (:princ-safe (format nil "<!-- ~a -->~%" (format nil , at warning))))
(warn , at warning)))
More information about the Bknr-cvs
mailing list