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 () ,@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) ())