[bknr-cvs] hans changed trunk/
BKNR Commits
bknr at bknr.net
Wed Nov 12 11:19:32 UTC 2008
Revision: 4040
Author: hans
URL: http://bknr.net/trac/changeset/4040
Fixes to make Quickhoney work with yason.
Yason fixes to bknr-web.
Make clixdoc compile.
U trunk/bknr/web/src/web/web-utils.lisp
U trunk/libraries/clixdoc/clixdoc.asd
U trunk/libraries/clixdoc/edi-docutil.lisp
U trunk/libraries/clixdoc/make-doc.lisp
U trunk/projects/quickhoney/src/handlers.lisp
Modified: trunk/bknr/web/src/web/web-utils.lisp
===================================================================
--- trunk/bknr/web/src/web/web-utils.lisp 2008-11-12 11:00:57 UTC (rev 4039)
+++ trunk/bknr/web/src/web/web-utils.lisp 2008-11-12 11:19:32 UTC (rev 4040)
@@ -240,6 +240,6 @@
(defmacro with-json-response (() &body body)
`(with-http-response (:content-type "application/json")
- (with-output-to-string ()
+ (json:with-output-to-string* ()
(json:with-object ()
, at body))))
\ No newline at end of file
Modified: trunk/libraries/clixdoc/clixdoc.asd
===================================================================
--- trunk/libraries/clixdoc/clixdoc.asd 2008-11-12 11:00:57 UTC (rev 4039)
+++ trunk/libraries/clixdoc/clixdoc.asd 2008-11-12 11:19:32 UTC (rev 4040)
@@ -3,7 +3,6 @@
:depends-on (:cxml :swank :cl-ppcre)
:serial t
:components ((:file "packages")
- (:file "specials")
(:file "edi-docutil")
(:file "check-doc")
(:file "make-doc")))
\ No newline at end of file
Modified: trunk/libraries/clixdoc/edi-docutil.lisp
===================================================================
--- trunk/libraries/clixdoc/edi-docutil.lisp 2008-11-12 11:00:57 UTC (rev 4039)
+++ trunk/libraries/clixdoc/edi-docutil.lisp 2008-11-12 11:19:32 UTC (rev 4040)
@@ -32,6 +32,11 @@
(in-package "CLIXDOC")
+(defvar *maybe-skip-methods-p* nil
+ "This is the default value for the :MAYBE-SKIP-METHODS-P keyword
+argument of CREATE-TEMPLATE and its initial value is NIL. It is also
+used internally.")
+
;;; For the purpose of this file, an "entry" is a list of four or five
;;; symbols - a name, a keyword for the kind of the entry, a lambda
;;; list (for functions and macros), a documentation string, and
Modified: trunk/libraries/clixdoc/make-doc.lisp
===================================================================
--- trunk/libraries/clixdoc/make-doc.lisp 2008-11-12 11:00:57 UTC (rev 4039)
+++ trunk/libraries/clixdoc/make-doc.lisp 2008-11-12 11:19:32 UTC (rev 4040)
@@ -1,7 +1,8 @@
(in-package "CLIXDOC")
+#+(or)
(defun make-doc (package &optional (output *standard-output*))
(with-xml-output (make-character-stream-sink *output*)
(with-namespace ("clix" "http://bknr.net/clixdoc")
- (with-namespace (
\ No newline at end of file
+ (with-namespace ()))))
\ No newline at end of file
Modified: trunk/projects/quickhoney/src/handlers.lisp
===================================================================
--- trunk/projects/quickhoney/src/handlers.lisp 2008-11-12 11:00:57 UTC (rev 4039)
+++ trunk/projects/quickhoney/src/handlers.lisp 2008-11-12 11:19:32 UTC (rev 4040)
@@ -45,34 +45,39 @@
()
(:default-initargs :query-function #'store-image-with-name))
+(defmethod json:encode ((object symbol) stream)
+ (json:encode (string-downcase (symbol-name object))
+ stream))
+
(defmethod image-to-json ((image quickhoney-image))
(json:with-object ()
- (encode-object-element "class" (string-downcase (cl-ppcre:regex-replace "^QUICKHONEY-"
- (symbol-name (class-name (class-of image)))
- "")))
- (encode-object-element "name" (store-image-name image))
+ (json:encode-object-element "class"
+ (string-downcase (cl-ppcre:regex-replace "^QUICKHONEY-"
+ (symbol-name (class-name (class-of image)))
+ "")))
+ (json:encode-object-element "name" (store-image-name image))
(when (quickhoney-image-category image)
- (encode-object-element "category" (quickhoney-image-category image))
+ (json:encode-object-element "category" (quickhoney-image-category image))
(when (quickhoney-image-subcategory image)
- (encode-object-element "subcategory" (quickhoney-image-subcategory image))))
- (encode-object-element "id" (store-object-id image))
- (encode-object-element "type" (image-content-type (blob-mime-type image)))
- (encode-object-element "width" (store-image-width image))
- (encode-object-element "height" (store-image-height image))
- (encode-object-element "client" (or (quickhoney-image-client image) ""))
+ (json:encode-object-element "subcategory" (quickhoney-image-subcategory image))))
+ (json:encode-object-element "id" (store-object-id image))
+ (json:encode-object-element "type" (image-content-type (blob-mime-type image)))
+ (json:encode-object-element "width" (store-image-width image))
+ (json:encode-object-element "height" (store-image-height image))
+ (json:encode-object-element "client" (or (quickhoney-image-client image) ""))
(when (typep image 'quickhoney-animation-image)
- (encode-object-element "animation_type"
+ (json:encode-object-element "animation_type"
(image-content-type (blob-mime-type (quickhoney-animation-image-animation image)))))
(when (quickhoney-image-spider-keywords image)
- (encode-object-element "spider_keywords" (quickhoney-image-spider-keywords image)))
- (with-object-element ("keywords")
+ (json:encode-object-element "spider_keywords" (quickhoney-image-spider-keywords image)))
+ (json:with-object-element ("keywords")
(json:with-object ()
(dolist (keyword (intersection *editable-keywords* (store-image-keywords image)))
- (encode-object-element (string-downcase (symbol-name keyword)) t))))))
+ (json:encode-object-element (string-downcase (symbol-name keyword)) t))))))
(defmethod handle-object ((handler json-image-info-handler) image)
- (json:with-response ()
- (with-object-element ("image")
+ (with-json-response ()
+ (json:with-object-element ("image")
(image-to-json image))))
(defclass json-image-query-handler (object-handler quickhoney-image-dependent-handler)
@@ -91,14 +96,14 @@
(json:with-array ()
(dolist (row (page-rows page))
(json:with-array ()
- (encode-array-element (row-cell-width row))
- (encode-array-element (row-cell-height row))
+ (json:encode-array-element (row-cell-width row))
+ (json:encode-array-element (row-cell-height row))
(dolist (image (row-images row))
(image-to-json image))))))))
(defmethod handle-object ((handler json-image-query-handler) images)
- (json:with-response ()
- (with-object-element ("queryResult")
+ (with-json-response ()
+ (json:with-object-element ("queryResult")
(with-query-params (layout)
(layout-to-json (make-instance (case (make-keyword-from-string layout)
(:smallworld 'quickhoney-name-layout)
@@ -109,40 +114,40 @@
())
(defmethod handle ((handler json-login-handler))
- (json:with-response ()
- (encode-object-element "admin" (admin-p (bknr-session-user)))
+ (with-json-response ()
+ (json:encode-object-element "admin" (admin-p (bknr-session-user)))
(when (and (anonymous-p (bknr-session-user))
(query-param "__username"))
- (encode-object-element "login_failed" t))
- (encode-object-element "login" (user-login (bknr-session-user)))))
+ (json:encode-object-element "login_failed" t))
+ (json:encode-object-element "login" (user-login (bknr-session-user)))))
(defclass json-logout-handler (page-handler)
())
(defmethod handle ((handler json-logout-handler))
(setf (session-value 'bknr-session) nil)
- (json:with-response ()
- (encode-object-element "logged_out" t)))
+ (with-json-response ()
+ (json:encode-object-element "logged_out" t)))
(defclass json-clients-handler (page-handler)
())
(defmethod handle ((handler json-clients-handler))
- (json:with-response ()
- (with-object-element ("clients")
+ (with-json-response ()
+ (json:with-object-element ("clients")
(json:with-array ()
(dolist (client (sort (remove "" (all-clients) :test #'equal)
#'string-lessp))
- (encode-array-element client))))))
+ (json:encode-array-element client))))))
(defclass json-edit-image-handler (admin-only-handler edit-object-handler)
()
(:default-initargs :object-class 'quickhoney-image))
(defmethod handle-object-form ((handler json-edit-image-handler) action image)
- (json:with-response ()
- (encode-object-element "result" "error")
- (encode-object-element "message" (format nil "; invalid action ~A or invalid object ~A~%" action image))))
+ (with-json-response ()
+ (json:encode-object-element "result" "error")
+ (json:encode-object-element "message" (format nil "; invalid action ~A or invalid object ~A~%" action image))))
(defun image-keywords-from-request-parameters ()
(let (retval)
@@ -159,14 +164,14 @@
(store-image-keywords image) (append (set-difference (store-image-keywords image) *editable-keywords*)
(image-keywords-from-request-parameters)))))
(setf *last-image-upload-timestamp* (get-universal-time))
- (json:with-response ()
- (encode-object-element "result" "edited")))
+ (with-json-response ()
+ (json:encode-object-element "result" "edited")))
(defmethod handle-object-form ((handler json-edit-image-handler) (action (eql :delete)) (image quickhoney-image))
(delete-object image)
(setf *last-image-upload-timestamp* (get-universal-time))
- (json:with-response ()
- (encode-object-element "result" "deleted")))
+ (with-json-response ()
+ (json:encode-object-element "result" "deleted")))
(defclass json-edit-news-item-handler (json-edit-image-handler)
()
@@ -178,8 +183,8 @@
(setf (quickhoney-news-item-title item) title
(quickhoney-news-item-text item) text)))
(setf *last-image-upload-timestamp* (get-universal-time))
- (json:with-response ()
- (encode-object-element "result" "edited")))
+ (with-json-response ()
+ (json:encode-object-element "result" "edited")))
(defclass digg-image-handler (object-handler)
()
@@ -264,13 +269,13 @@
collect image)))))
(defmethod handle ((handler json-buttons-handler))
- (json:with-response ()
- (with-object-element ("buttons")
+ (with-json-response ()
+ (json:with-object-element ("buttons")
(json:with-object ()
(loop
for (category subcategories-string) on (decoded-handler-path handler) by #'cddr
do (dolist (subcategory (split "," subcategories-string))
- (with-object-element ((format nil "~(~A/~A~)" category subcategory))
+ (json:with-object-element ((format nil "~(~A/~A~)" category subcategory))
(json:with-array ()
;; For each subcategory, an array of buttons is
;; generated. The first element of the array is
@@ -286,10 +291,10 @@
(or (preproduced-buttons category subcategory)
(newest-images category subcategory)
(warn "No images for ~A ~A found" category subcategory))
- (encode-array-element type)
+ (json:encode-array-element type)
(dolist (image (or images
(list (store-image-with-name "button-dummy"))))
- (encode-array-element (store-object-id image)))))))))))))
+ (json:encode-array-element (store-object-id image)))))))))))))
(defclass upload-image-handler (admin-only-handler prefix-handler)
())
@@ -536,30 +541,30 @@
; do nothing
)
(:method :before ((item store-object))
- (encode-object-element "id" (store-object-id item)))
+ (json:encode-object-element "id" (store-object-id item)))
(:method :before ((image quickhoney-image))
(when (owned-object-owner image)
- (encode-object-element "owner" (user-login (owned-object-owner image))))
- (encode-object-element "date" (format-date-time (blob-timestamp image) :vms-style t :show-time nil))
- (encode-object-element "name" (store-image-name image)))
+ (json:encode-object-element "owner" (user-login (owned-object-owner image))))
+ (json:encode-object-element "date" (format-date-time (blob-timestamp image) :vms-style t :show-time nil))
+ (json:encode-object-element "name" (store-image-name image)))
(:method ((image quickhoney-image))
- (encode-object-element "type" "upload")
- (encode-object-element "category" (quickhoney-image-category image))
- (encode-object-element "subcategory" (quickhoney-image-subcategory image))
- (with-object-element ("keywords")
+ (json:encode-object-element "type" "upload")
+ (json:encode-object-element "category" (quickhoney-image-category image))
+ (json:encode-object-element "subcategory" (quickhoney-image-subcategory image))
+ (json:with-object-element ("keywords")
(json:with-array ()
(dolist (keyword (store-image-keywords image))
- (encode-array-element (string-downcase (symbol-name keyword)))))))
+ (json:encode-array-element (string-downcase (symbol-name keyword)))))))
(:method ((item quickhoney-news-item))
- (encode-object-element "type" "news")
- (encode-object-element "title" (quickhoney-news-item-title item))
- (encode-object-element "text" (quickhoney-news-item-text item))
- (encode-object-element "width" (store-image-width item))
- (encode-object-element "height" (store-image-height item))))
+ (json:encode-object-element "type" "news")
+ (json:encode-object-element "title" (quickhoney-news-item-title item))
+ (json:encode-object-element "text" (quickhoney-news-item-text item))
+ (json:encode-object-element "width" (store-image-width item))
+ (json:encode-object-element "height" (store-image-height item))))
(defun json-encode-news-items (items)
- (json:with-response ()
- (with-object-element ("items")
+ (with-json-response ()
+ (json:with-object-element ("items")
(json:with-array ()
(dolist (item items)
(json:with-object ()
@@ -576,8 +581,8 @@
(:default-initargs :object-class 'rss-channel :query-function #'find-rss-channel))
(defmethod handle-object ((handler json-news-archive-handler) (channel rss-channel))
- (json:with-response ()
- (with-object-element ("months")
+ (with-json-response ()
+ (json:with-object-element ("months")
(json:with-array ()
(dolist (month (sort (rss-channel-archived-months channel)
(lambda (a b)
@@ -585,8 +590,8 @@
(> (second a) (second b))
(> (first a) (first b))))))
(json:with-array ()
- (encode-array-element (first month))
- (encode-array-element (second month))))))))
+ (json:encode-array-element (first month))
+ (json:encode-array-element (second month))))))))
(defclass shutdown-handler (admin-only-handler page-handler)
())
More information about the Bknr-cvs
mailing list