From bknr at bknr.net Fri Aug 1 04:41:27 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 06:41:27 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/src/json.lisp Message-ID: Revision: 3714 Author: hans URL: http://bknr.net/trac/changeset/3714 Re-rename stream->output-stream U trunk/projects/quickhoney/src/json.lisp Modified: trunk/projects/quickhoney/src/json.lisp =================================================================== --- trunk/projects/quickhoney/src/json.lisp 2008-07-31 22:25:05 UTC (rev 3713) +++ trunk/projects/quickhoney/src/json.lisp 2008-08-01 04:41:26 UTC (rev 3714) @@ -3,18 +3,18 @@ (defvar *json-output*) (defclass json-output-stream () - ((stream :reader stream - :initarg :stream) + ((output-stream :reader output-stream + :initarg :output-stream) (stack :accessor stack :initform nil))) (defun next-aggregate-element () (if (car (stack *json-output*)) - (princ (car (stack *json-output*)) (stream *json-output*)) + (princ (car (stack *json-output*)) (output-stream *json-output*)) (setf (car (stack *json-output*)) #\,))) (defmacro with-json-output ((stream) &body body) - `(let ((*json-output* (make-instance 'json-output-stream :stream ,stream))) + `(let ((*json-output* (make-instance 'json-output-stream :output-stream ,stream))) , at body)) (defmacro with-json-output-to-string (() &body body) @@ -26,12 +26,12 @@ `(progn (when (stack *json-output*) (next-aggregate-element)) - (princ ,begin-char (stream *json-output*)) + (princ ,begin-char (output-stream *json-output*)) (push nil (stack *json-output*)) (prog1 (progn , at body) (pop (stack *json-output*)) - (princ ,end-char (stream *json-output*))))) + (princ ,end-char (output-stream *json-output*))))) (defmacro with-json-array (() &body body) `(with-json-aggregate (#\[ #\]) @@ -43,18 +43,18 @@ (defun encode-array-element (object) (next-aggregate-element) - (json:encode-json object (stream *json-output*))) + (json:encode-json object (output-stream *json-output*))) (defun encode-object-element (key value) (next-aggregate-element) - (json:encode-json key (stream *json-output*)) - (princ #\: (stream *json-output*)) - (json:encode-json value (stream *json-output*))) + (json:encode-json key (output-stream *json-output*)) + (princ #\: (output-stream *json-output*)) + (json:encode-json value (output-stream *json-output*))) (defmacro with-object-element ((key) &body body) `(progn (next-aggregate-element) - (json:encode-json ,key (stream *json-output*)) + (json:encode-json ,key (output-stream *json-output*)) (setf (car (stack *json-output*)) #\:) (unwind-protect (progn , at body) @@ -62,6 +62,6 @@ (defmacro with-json-response (() &body body) `(with-http-response (:content-type "application/json") - (with-json-output-to-string () - (with-json-object () - , at body)))) + (with-json-output-to-string () + (with-json-object () + , at body)))) From bknr at bknr.net Fri Aug 1 06:19:07 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 08:19:07 +0200 Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/packages.lisp Message-ID: Revision: 3715 Author: hans URL: http://bknr.net/trac/changeset/3715 Don't export *CATCH-ERRORS-P* anymore. U trunk/thirdparty/hunchentoot/packages.lisp Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2008-08-01 04:41:26 UTC (rev 3714) +++ trunk/thirdparty/hunchentoot/packages.lisp 2008-08-01 06:19:07 UTC (rev 3715) @@ -39,7 +39,6 @@ #+:lispworks (:import-from :lw "WITH-UNIQUE-NAMES" "WHEN-LET") (:export "*APPROVED-RETURN-CODES*" - "*CATCH-ERRORS-P*" #+:lispworks "*CLEANUP-FUNCTION*" #+:lispworks From bknr at bknr.net Fri Aug 1 06:57:30 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 08:57:30 +0200 Subject: [bknr-cvs] hans changed trunk/ Message-ID: Revision: 3716 Author: hans URL: http://bknr.net/trac/changeset/3716 more news work. make owned-object have only one instead of multiple owners. U trunk/bknr/modules/album/album.lisp U trunk/bknr/web/src/images/image.lisp U trunk/bknr/web/src/packages.lisp U trunk/bknr/web/src/rss/rss.lisp U trunk/bknr/web/src/sysclasses/user.lisp U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/quickhoney.asd U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/bknr/modules/album/album.lisp =================================================================== --- trunk/bknr/modules/album/album.lisp 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/bknr/modules/album/album.lisp 2008-08-01 06:57:30 UTC (rev 3716) @@ -6,7 +6,7 @@ (let* ((user (find-user username)) (images (when user (remove-if-not #'(lambda (image) - (member user (owned-object-owners image))) + (eq user (owned-object-owner image))) (get-keyword-store-images (make-keyword-from-string album)))))) (html (:ul (dolist (image images) Modified: trunk/bknr/web/src/images/image.lisp =================================================================== --- trunk/bknr/web/src/images/image.lisp 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/bknr/web/src/images/image.lisp 2008-08-01 06:57:30 UTC (rev 3716) @@ -123,7 +123,7 @@ ;; xxx not tx safe. (let ((store-image (apply #'make-object class-name - :owners (list user) + :owner user :timestamp (get-universal-time) :name name :type (make-keyword-from-string type) Modified: trunk/bknr/web/src/packages.lisp =================================================================== --- trunk/bknr/web/src/packages.lisp 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/bknr/web/src/packages.lisp 2008-08-01 06:57:30 UTC (rev 3716) @@ -136,7 +136,7 @@ #:set-user-last-login #:owned-object - #:owned-object-owners + #:owned-object-owner #:store-objects-owned-by #:store-object-owners Modified: trunk/bknr/web/src/rss/rss.lisp =================================================================== --- trunk/bknr/web/src/rss/rss.lisp 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/bknr/web/src/rss/rss.lisp 2008-08-01 06:57:30 UTC (rev 3716) @@ -179,7 +179,7 @@ (: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)))) + (push item (slot-value channel 'items))) (:method ((channel string) item) (aif (find-rss-channel channel) (add-item it item) Modified: trunk/bknr/web/src/sysclasses/user.lisp =================================================================== --- trunk/bknr/web/src/sysclasses/user.lisp 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/bknr/web/src/sysclasses/user.lisp 2008-08-01 06:57:30 UTC (rev 3716) @@ -190,24 +190,23 @@ ;;; owned objects (define-persistent-class owned-object (store-object) - ((owners :update :initform nil - :index-type hash-list-index - :index-reader store-object-owners))) + ((owner :update :initform nil + :index-type hash-index + :index-reader store-object-owner))) -(deftransaction owned-object-remove-owner (object owner) - (setf (owned-object-owners object) - (remove owner (owned-object-owners object)))) +(defmethod convert-slot-value-while-restoring ((object owned-object) (slot-name (eql 'owners)) owners) + (when owners + (unless (= 1 (length owners)) + (warn "object ~A has more than one owner ~S, using first" object owners)) + (setf (slot-value object 'owner) (car owners)))) -(deftransaction owned-object-add-owner (object owner) - (pushnew owner (owned-object-owners object))) - (defgeneric user-owns-object-p (user object)) -(defmethod user-owns-object-p ((user user) object) +(defmethod user-owns-object-p ((user user) (object t)) nil) (defmethod user-owns-object-p ((user user) (object owned-object)) - (member user (owned-object-owners object))) + (eq user (owned-object-owner object))) (define-persistent-class message-event (event) ((from :read :initform nil) Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-08-01 06:57:30 UTC (rev 3716) @@ -136,7 +136,7 @@ (cl-smtp:with-smtp-mail (smtp "localhost" "webserver at quickhoney.com" (remove-duplicates (mapcar #'user-email - (or (owned-object-owners image) + (or (owned-object-owner image) (list (find-user "n") (find-user "p")))))) (cl-mime:print-mime smtp @@ -438,13 +438,18 @@ (:method ((item t)) ; do nothing ) + (: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))) (:method ((image quickhoney-image)) (let ((vectorp (member :vector (store-image-keywords image)))) - (encode-object-element "uploader" (if vectorp "Peter" "Nana")) (encode-object-element "category" (if vectorp "vector" "pixel")) - (encode-object-element "subcategory" "unknown") - (encode-object-element "date" (format-date-time (rss-item-pub-date image) :vms-style t :show-time nil)) - (encode-object-element "name" (store-image-name image))))) + (encode-object-element "subcategory" "unknown"))) + (:method ((item quickhoney-news-item)) + (encode-object-element "title" (quickhoney-news-item-title item)) + (encode-object-element "text" (quickhoney-news-item-text item)))) (defmethod handle-object ((handler json-news-handler) (channel rss-channel)) (with-json-response () Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-08-01 06:57:30 UTC (rev 3716) @@ -33,7 +33,7 @@ (:file "layout" :depends-on ("config")) (:file "imageproc" :depends-on ("config")) (:file "json" :depends-on ("packages")) - (:file "handlers" :depends-on ("json" "layout" "config" "image")) + (:file "handlers" :depends-on ("json" "layout" "config" "image" "news")) (:file "tags" :depends-on ("image")) (:file "webserver" :depends-on ("handlers")) (:file "daily" :depends-on ("config")) Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-01 06:19:07 UTC (rev 3715) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-01 06:57:30 UTC (rev 3716) @@ -246,7 +246,7 @@ IMG({ src: "/image/" + item.name + '/cutout-button,,' + color + ',98,4'}), DIV(null, H1(null, item.name), - item.date, ' by ', item.uploader, ' | ', + item.date, ' by ', item.owner, ' | ', A({ href: '/index#' + item.category + '/' + item.subcategory + '/' + item.image_name }, 'permalink'), BR(), item.description)), @@ -461,7 +461,7 @@ function() { footer_hide(); loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(load_news_archive, alert); - // load_news(); + loadJSONDoc('/json-news/quickhoney').addCallbacks(load_news, alert); }); pages['shop'] From bknr at bknr.net Fri Aug 1 10:14:17 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 12:14:17 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/flexi-streams/ Message-ID: Revision: 3717 Author: edi URL: http://bknr.net/trac/changeset/3717 Update to 1.0.5 U trunk/thirdparty/flexi-streams/CHANGELOG U trunk/thirdparty/flexi-streams/doc/index.html U trunk/thirdparty/flexi-streams/flexi-streams.asd U trunk/thirdparty/flexi-streams/test/packages.lisp Modified: trunk/thirdparty/flexi-streams/CHANGELOG =================================================================== --- trunk/thirdparty/flexi-streams/CHANGELOG 2008-08-01 06:57:30 UTC (rev 3716) +++ trunk/thirdparty/flexi-streams/CHANGELOG 2008-08-01 10:14:17 UTC (rev 3717) @@ -1,3 +1,7 @@ +Version 1.0.5 +2008-08-01 +Export RUN-ALL-TESTS instead of RUN-TESTS (caught by Nick Allen) + Version 1.0.4 2008-07-25 Cosmetic surgery on test suite Modified: trunk/thirdparty/flexi-streams/doc/index.html =================================================================== --- trunk/thirdparty/flexi-streams/doc/index.html 2008-08-01 06:57:30 UTC (rev 3716) +++ trunk/thirdparty/flexi-streams/doc/index.html 2008-08-01 10:14:17 UTC (rev 3717) @@ -229,7 +229,7 @@

FLEXI-STREAMS together with this documentation can be downloaded from http://weitz.de/files/flexi-streams.tar.gz. The -current version is 1.0.4. +current version is 1.0.5.

Before you install FLEXI-STREAMS you first need to install the -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.123 2008/07/25 09:57:00 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.124 2008/08/01 10:12:41 edi Exp $

BACK TO MY HOMEPAGE Modified: trunk/thirdparty/flexi-streams/flexi-streams.asd =================================================================== --- trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-08-01 06:57:30 UTC (rev 3716) +++ trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-08-01 10:14:17 UTC (rev 3717) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.76 2008/07/25 09:56:58 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.77 2008/08/01 10:12:40 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -35,7 +35,7 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "1.0.4" + :version "1.0.5" :serial t :components ((:file "packages") (:file "mapping") Modified: trunk/thirdparty/flexi-streams/test/packages.lisp =================================================================== --- trunk/thirdparty/flexi-streams/test/packages.lisp 2008-08-01 06:57:30 UTC (rev 3716) +++ trunk/thirdparty/flexi-streams/test/packages.lisp 2008-08-01 10:14:17 UTC (rev 3717) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.6 2008/05/17 16:38:26 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/packages.lisp,v 1.8 2008/08/01 10:12:43 edi Exp $ ;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved. @@ -36,4 +36,4 @@ :with-rebinding :char* :normalize-external-format) - (:export :run-tests)) + (:export :run-all-tests)) From bknr at bknr.net Fri Aug 1 10:14:42 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 12:14:42 +0200 Subject: [bknr-cvs] edi changed tags/thirdparty/flexi-streams-1.0.5/ Message-ID: Revision: 3718 Author: edi URL: http://bknr.net/trac/changeset/3718 Tag version 1.0.5 of flexi-streams A tags/thirdparty/flexi-streams-1.0.5/ Copied: tags/thirdparty/flexi-streams-1.0.5 (from rev 3717, trunk/thirdparty/flexi-streams) From bknr at bknr.net Fri Aug 1 12:08:44 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 14:08:44 +0200 Subject: [bknr-cvs] ksprotte changed trunk/bknr/web/src/web/web- Message-ID: Revision: 3719 Author: ksprotte URL: http://bknr.net/trac/changeset/3719 whitespace cleanup and a tiny bit of refactoring in bknr web U trunk/bknr/web/src/web/web-macros.lisp U trunk/bknr/web/src/web/web-utils.lisp Modified: trunk/bknr/web/src/web/web-macros.lisp =================================================================== --- trunk/bknr/web/src/web/web-macros.lisp 2008-08-01 10:14:42 UTC (rev 3718) +++ trunk/bknr/web/src/web/web-macros.lisp 2008-08-01 12:08:44 UTC (rev 3719) @@ -13,81 +13,83 @@ (defmacro with-bknr-page ((&rest args) &body body) `(show-page-with-error-handlers (lambda () (html , at body)) , at args)) -(defmacro with-cookies ((&rest names) &rest body) +(defmacro with-cookies ((&rest names) &body body) `(let ,(mapcar #'(lambda (name) - `(,name (cookie-in ,(symbol-name name)))) - names) - , at body)) + `(,name (cookie-in ,(symbol-name name)))) + names) + , at body)) -(defmacro with-query-params ((&rest params) &rest body) +(defmacro with-query-params ((&rest params) &body body) (let ((vars (loop for param in params - when (and (symbolp param) - (not (null param))) - collect (list param `(query-param ,(string-downcase (symbol-name param)))) - when (consp param) - collect (list (car param) - `(or (parameter ,(string-downcase (symbol-name (car param)))) - ,(second param)))))) + when (and (symbolp param) + (not (null param))) + collect (list param `(query-param ,(string-downcase (symbol-name param)))) + when (consp param) + collect (list (car param) + `(or (parameter ,(string-downcase (symbol-name (car param)))) + ,(second param)))))) (if vars - `(let ,vars - , at body) - (first body)))) + `(let ,vars + , at body) + (first body)))) (defmacro form-case (&rest cases) `(cond - ,@(mapcar #'(lambda (c) - (if (eql (car c) t) - `(t ,@(cdr c)) - `((parameter ,(symbol-name (car c))) - (with-query-params (,@(cadr c)) - ,@(cddr c))))) - cases))) + ,@(mapcar #'(lambda (c) + (if (eql (car c) t) + `(t ,@(cdr c)) + `((parameter ,(symbol-name (car c))) + (with-query-params (,@(cadr c)) + ,@(cddr c))))) + cases))) -(defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &rest body) +(defmacro with-http-response ((&key (content-type "text/html") (response +http-ok+)) &body body) `(progn - (setf (content-type) ,content-type) - (setf (return-code) ,response) - , at body)) + (setf (content-type) ,content-type) + (setf (return-code) ,response) + , at body)) (defmacro with-http-body ((&key external-format) &body body) + (when external-format + (warn "EXTERNAL-FORMAT is ignored in WITH-HTTP-BODY")) `(with-output-to-string (stream) - (with-xhtml (stream) - , at body))) + (with-xhtml (stream) + , at body))) -(defmacro with-image-from-uri ((image-variable prefix) &rest body) +(defmacro with-image-from-uri ((image-variable prefix) &body body) `(multiple-value-bind - (match strings) - (scan-to-strings (format nil "/~a/([0-9]+)(|/.*)$" ,prefix) (script-name*)) - (unless match - (http-error +http-bad-request+ "bad request - missing image path or loid")) - (let ((,image-variable (store-object-with-id (parse-integer (elt strings 0))))) - (unless ,image-variable - (http-error +http-not-found+ "image not found")) - , at body))) + (match strings) + (scan-to-strings (format nil "/~a/([0-9]+)(|/.*)$" ,prefix) (script-name*)) + (unless match + (http-error +http-bad-request+ "bad request - missing image path or loid")) + (let ((,image-variable (store-object-with-id (parse-integer (elt strings 0))))) + (unless ,image-variable + (http-error +http-not-found+ "image not found")) + , at body))) -(defmacro define-bknr-tag (name (&rest args) &rest body) +(defmacro define-bknr-tag (name (&rest args) &body body) `(prog1 - (defun ,name (, at args) - , at body) - (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name)))) + (defun ,name (, at args) + , at body) + (register-tag-function ,(package-name *package*) ,(symbol-name name) (fdefinition ',name)))) (defmacro html-text-input (variable size &optional maxsize) - `((:input :type "text" - :size ,(format nil "~a" size) - :maxsize ,(format nil "~a" (or maxsize size)) - :name ,(symbol-name variable) - :value ,(or variable "")))) + `((:input :type "text" + :size ,(format nil "~a" size) + :maxsize ,(format nil "~a" (or maxsize size)) + :name ,(symbol-name variable) + :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 "~%" (format nil , at warning)))) - (warn , at warning))) + (html (:princ-safe (format nil "~%" (format nil , at warning)))) + (warn , at warning))) (defmacro cmslink (url &body body) `(html ((:a :class "cmslink" :href (website-make-path *website* ,url)) - , at body))) + , at body))) (defvar *xml-sink*) @@ -96,7 +98,7 @@ `(with-http-response (:content-type ,content-type) (with-query-params (download) (when download - (setf (hunchentoot:header-out :content-disposition) + (setf (hunchentoot:header-out :content-disposition) (format nil "attachment; filename=~A" download)))) (with-output-to-string (s) (let ((*xml-sink* (cxml:make-character-stream-sink s :canonical nil))) Modified: trunk/bknr/web/src/web/web-utils.lisp =================================================================== --- trunk/bknr/web/src/web/web-utils.lisp 2008-08-01 10:14:42 UTC (rev 3718) +++ trunk/bknr/web/src/web/web-utils.lisp 2008-08-01 12:08:44 UTC (rev 3719) @@ -18,7 +18,7 @@ (defun redirect-uri (uri) (make-instance 'uri :path (uri-path uri) - :query (uri-query uri))) + :query (uri-query uri))) (defun request-uploaded-files () "Return a list of UPLOAD structures describing the file uploads in the request." @@ -27,7 +27,8 @@ (let ((uploads (remove-if-not #'listp (post-parameters*) :key #'cdr)) retval) (dolist (upload-info uploads) (destructuring-bind (name pathname original-filename content-type) upload-info - (push (make-upload :name name :pathname pathname :original-filename original-filename :content-type content-type) retval))) + (push (make-upload :name name :pathname pathname :original-filename original-filename + :content-type content-type) retval))) (nreverse retval)))) (aux-request-value 'uploaded-files)) @@ -36,12 +37,13 @@ (defmacro with-image-from-upload ((image upload &rest args) &body body) `(with-image-from-file (,image (upload-pathname ,upload) - (make-keyword-from-string (pathname-type (upload-original-filename ,upload))) , at args) - , at body)) + (make-keyword-from-string (pathname-type (upload-original-filename ,upload))) + , at args) + , at body)) (defmacro with-image-from-upload* ((upload &rest args) &body body) `(with-image-from-upload (cl-gd:*default-image* ,upload , at args) - , at body)) + , at body)) (defmethod bknr.images:import-image ((upload upload) &rest args &key &allow-other-keys) (apply #'bknr.images:import-image (upload-pathname upload) @@ -56,12 +58,12 @@ macro after the request body has been executed." (unless (aux-request-value 'bknr-parsed-parameters) (setf (aux-request-value 'bknr-parsed-parameters) - (remove-if (lambda (value) - "Remove empty strings (reported as NIL) and uploaded files" - (or (equal value "") - (listp value))) - (query-params) - :key #'cdr))) + (remove-if (lambda (value) + "Remove empty strings (reported as NIL) and uploaded files" + (or (equal value "") + (listp value))) + (query-params) + :key #'cdr))) (aux-request-value 'bknr-parsed-parameters)) (defun query-params (&key (get t) (post t)) @@ -85,8 +87,8 @@ (defun request-variables () (loop for key being the hash-keys of *req-var-hash* - collect key - collect (request-variable key))) + collect key + collect (request-variable key))) (defun http-error (response message) (with-bknr-page (:title #?"error: $(message)" :response response) @@ -95,19 +97,19 @@ (defun keywords-from-query-param-list (param &key (remove-empty t)) (let ((keywords (mapcar #'(lambda (s) - (make-keyword-from-string (string-trim '(#\Space #\Tab #\Newline) s))) - param))) + (make-keyword-from-string (string-trim '(#\Space #\Tab #\Newline) s))) + param))) (if remove-empty - (remove-if #'(lambda (x) (eq x :||)) keywords) - keywords))) + (remove-if #'(lambda (x) (eq x :||)) keywords) + keywords))) (defun html-quote (string) (regex-replace-all "([&<>])" string #'(lambda (target-string start end match-start &rest args) - (declare (ignore start end args)) - (ecase (elt target-string match-start) - (#\& "&") - (#\< "<") - (#\> ">"))))) + (declare (ignore start end args)) + (ecase (elt target-string match-start) + (#\& "&") + (#\< "<") + (#\> ">"))))) (defun parse-url () (values-list (cddr (mapcar #'url-decode (split "/" (script-name*)))))) @@ -119,16 +121,16 @@ (defun parse-date-field (name) (let ((timespec (mapcar #'(lambda (var) (parse-integer - (query-param (concatenate 'string name "-" var)) - :junk-allowed t)) - '("minute" "hour" "day" "month" "year")))) + (query-param (concatenate 'string name "-" var)) + :junk-allowed t)) + '("minute" "hour" "day" "month" "year")))) (unless (car timespec) (rplaca timespec 0)) (unless (cadr timespec) (rplaca (cdr timespec) 0)) (if (every #'identity timespec) - (apply #'encode-universal-time 0 timespec) - nil))) + (apply #'encode-universal-time 0 timespec) + nil))) (defun bknr-url-path (handler) "Returns the Path of the request under the handler prefix" @@ -137,7 +139,7 @@ (defun self-url (&key command prefix) (destructuring-bind - (empty old-prefix object-id &rest old-command) + (empty old-prefix object-id &rest old-command) (split "/" (script-name*)) (declare (ignore empty)) #?"/$((or prefix old-prefix))/$(object-id)/$((or command old-command))")) @@ -149,53 +151,53 @@ "Perform simple text to HTML conversion. http urls are replaced by links, internal links to images become image tags." (setf string (regex-replace-all - #?r"bknr:([0-9A-Za-z$-_.+!*'()]+)" string - #'(lambda (target-string start end match-start match-end reg-starts reg-ends) - (declare (ignore start end match-start match-end)) - (let ((url (subseq target-string (aref reg-starts 0) (aref reg-ends 0)))) - (regex-replace-all "URL" (if (all-matches "^/image" url) - "" - "URL") - url))))) + #?r"bknr:([0-9A-Za-z$-_.+!*'()]+)" string + #'(lambda (target-string start end match-start match-end reg-starts reg-ends) + (declare (ignore start end match-start match-end)) + (let ((url (subseq target-string (aref reg-starts 0) (aref reg-ends 0)))) + (regex-replace-all "URL" (if (all-matches "^/image" url) + "" + "URL") + url))))) (setf string (regex-replace-all - #?r"(http://[0-9A-Za-z$-_.+!*'()]+)" string - #'(lambda (target-string start end match-start match-end &rest args) - (declare (ignore start end args)) - (let ((url (subseq target-string match-start match-end))) - (regex-replace-all "URL" (if (all-matches "(?i)\\.(gif|jpe?g|png)$" url) - "" - "URL") - url))))) + #?r"(http://[0-9A-Za-z$-_.+!*'()]+)" string + #'(lambda (target-string start end match-start match-end &rest args) + (declare (ignore start end args)) + (let ((url (subseq target-string match-start match-end))) + (regex-replace-all "URL" (if (all-matches "(?i)\\.(gif|jpe?g|png)$" url) + "" + "URL") + url))))) (setf string (regex-replace-all "[\\r\\n]" string "
")) string) (defun make-wiki-hrefs (string) (regex-replace-all #?r"\[(.+?)\]" string - #'(lambda (target-string start end match-start match-end - reg-starts reg-ends) - (declare (ignore start end match-start match-end)) - (let ((keyword (subseq target-string - (svref reg-starts 0) - (svref reg-ends 0)))) - (format nil "~a" - keyword - keyword))))) + #'(lambda (target-string start end match-start match-end + reg-starts reg-ends) + (declare (ignore start end match-start match-end)) + (let ((keyword (subseq target-string + (svref reg-starts 0) + (svref reg-ends 0)))) + (format nil "~a" + keyword + keyword))))) (defmacro bknr-handler-case (body &rest handler-forms) `(if *bknr-debug* - ,body - (handler-case - ,body - , at handler-forms))) + ,body + (handler-case + ,body + , at handler-forms))) (defun emit-element-attributes (attributes) (loop for (key value) on attributes by #'cddr - do (progn - (princ " ") - (princ (string-downcase (symbol-name key))) - (princ "=\"") - (princ value) - (princ "\"")))) + do (progn + (princ " ") + (princ (string-downcase (symbol-name key))) + (princ "=\"") + (princ value) + (princ "\"")))) (defun emit-html (&rest forms) (let ((element (car forms))) @@ -205,7 +207,7 @@ ;; (:foo ...) or ((:foo ...) ...) (cons (if (consp (car element)) (handle-tag (caar element) (cdar element) (cdr element)) ; ((:foo ...) ...) - (handle-tag (car element) nil (cdr element)))) ; (:foo ...) + (handle-tag (car element) nil (cdr element)))) ; (:foo ...) ;; "foo" (string (princ element)))) (when (cdr forms) @@ -221,15 +223,15 @@ (when attributes (emit-element-attributes attributes)) (if body - ;; emit tag body - (progn - (princ ">") - (apply #'emit-html body) - (princ "")) - ;; empty body, close tag immediately - (princ " />")))) + ;; emit tag body + (progn + (princ ">") + (apply #'emit-html body) + (princ "")) + ;; empty body, close tag immediately + (princ " />")))) (defun encode-urlencoded (string) -(regex-replace-all #?r"\+" (url-encode string) "%20")) + (regex-replace-all #?r"\+" (url-encode string) "%20")) From bknr at bknr.net Fri Aug 1 12:50:18 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 14:50:18 +0200 Subject: [bknr-cvs] ksprotte changed trunk/bknr/web/src/web/web- Message-ID: Revision: 3720 Author: ksprotte URL: http://bknr.net/trac/changeset/3720 BKNR web: QUERY-PARAM and WITH-QUERY-PARAMS now support conversion from the value string to an optionally specified type. U trunk/bknr/web/src/web/web-macros.lisp U trunk/bknr/web/src/web/web-utils.lisp Modified: trunk/bknr/web/src/web/web-macros.lisp =================================================================== --- trunk/bknr/web/src/web/web-macros.lisp 2008-08-01 12:08:44 UTC (rev 3719) +++ trunk/bknr/web/src/web/web-macros.lisp 2008-08-01 12:50:18 UTC (rev 3720) @@ -19,20 +19,31 @@ names) , at body)) -(defmacro with-query-params ((&rest params) &body body) - (let ((vars (loop for param in params - when (and (symbolp param) - (not (null param))) - collect (list param `(query-param ,(string-downcase (symbol-name param)))) - when (consp param) - collect (list (car param) - `(or (parameter ,(string-downcase (symbol-name (car param)))) - ,(second param)))))) - (if vars - `(let ,vars - , at body) - (first body)))) +(defmacro with-query-params ((&rest parameters) &body body) + "PARAMETERS is a list of parameter-specifiers. A parameter-specifier +has the form (VARIABLE &OPTIONAL DEFAULT-VALUE TYPE) or can be a +single VARIABLE. +If the TYPE is specified, the value is converted like in +HUNCHENTOOT:DEFINE-EASY-HANDLER when PARAMETER-TYPE is given. + +With respect to the conversion of an empty string, there is a subtle +difference between the TYPE specified as STRING and the TYPE left +unspecified. In the former case, the converted value will still be an +empty string, while in the latter VARIABLE will be bound to NIL." + (flet ((parameter-binding (parameter-specifier) + (destructuring-bind (variable &optional default-value type) + (ensure-list parameter-specifier) + (let ((query-param-form (if type + `(query-param ,(string-downcase variable) :type ',type) + `(query-param ,(string-downcase variable))))) + `(,variable + ,(if default-value + `(or ,query-param-form ,default-value) + query-param-form)))))) + `(let ,(mapcar #'parameter-binding parameters) + , at body))) + (defmacro form-case (&rest cases) `(cond ,@(mapcar #'(lambda (c) Modified: trunk/bknr/web/src/web/web-utils.lisp =================================================================== --- trunk/bknr/web/src/web/web-utils.lisp 2008-08-01 12:08:44 UTC (rev 3719) +++ trunk/bknr/web/src/web/web-utils.lisp 2008-08-01 12:50:18 UTC (rev 3720) @@ -70,10 +70,12 @@ (append (when get (get-parameters*)) (when post (post-parameters*)))) -(defun query-param (param-name &key (get t) (post t)) +(defun query-param (param-name &key (get t) (post t) type) (let ((value (cdr (assoc param-name (query-params :get get :post post) :test #'string-equal)))) - (unless (equal value "") - value))) + (if type + (hunchentoot::convert-parameter value type) + (unless (equal value "") + value)))) (defun query-param-list (param-name &key (get t) (post t)) (assoc-values param-name (query-params :get get :post post) From bknr at bknr.net Fri Aug 1 15:02:03 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 17:02:03 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/upgrade-stuff/import.lisp Message-ID: Revision: 3721 Author: hans URL: http://bknr.net/trac/changeset/3721 Import more pictures U trunk/projects/quickhoney/upgrade-stuff/import.lisp Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp =================================================================== --- trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-08-01 12:50:18 UTC (rev 3720) +++ trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-08-01 15:02:03 UTC (rev 3721) @@ -1,19 +1,32 @@ (in-package :quickhoney) +(defun replace-image (pathname) + (handler-case + (let ((old (store-image-with-name (pathname-name pathname)))) + (when old + (format t "deleting ~A~%" old) + (delete-object old)) + (import-image pathname)) + (error (e) + (format t "~&; error importing ~S: ~A~%" pathname e)))) + (dolist (name '(#p"type-news.png" #p"type-pixel.png" #p"type-shop.png" #p"type-vector.png")) (import-image name :keywords '(:type))) -(dolist (name '(#P"overlay-close.gif" - #P"hey.gif" - #P"buy.gif" #P"buy-top.gif" #P"buy-print.gif" #P"buy-file.gif" #P"buy-t-shirt.gif" - #P"buy-right-line.gif" - #P"t-shirt-sample-background.gif" - #P"print-sample.jpg" - #P"button-bottom.gif" - #P"add-to-cart.gif" #P"checkout.gif")) - (handler-case - (import-image name) - (error (e) - (format t "~&; error importing ~S: ~A~%" name e)))) +(dolist (pathname '(#P"overlay-close.gif" + #P"hey.gif" + #P"buy.gif" #P"buy-top.gif" #P"buy-print.gif" #P"buy-file.gif" #P"buy-t-shirt.gif" + #P"buy-right-line.gif" + #P"t-shirt-sample-background.gif" + #P"print-sample.jpg" + #P"button-bottom.gif" + #P"add-to-cart.gif" #P"checkout.gif" + #P"pixel.png" #P"pixel-selected.png" #P"pixel-unselected.png" #P"pixel-hover.png" + #P"vector.png" #P"vector-selected.png" #P"vector-unselected.png" #P"vector-hover.png" + #P"news.png" #P"news-selected.png" #P"news-unselected.png" #P"news-hover.png" + #P"shop.png" #P"shop-selected.png" #P"shop-unselected.png" #P"shop-hover.png" + #P"contact.png" #P"contact-selected.png" #P"contact-unselected.png" #P"contact-hover.png" + #P"quickhoney.png")) + (replace-image pathname)) (import-image #p"news-sep.gif") \ No newline at end of file From bknr at bknr.net Fri Aug 1 15:43:33 2008 From: bknr at bknr.net (BKNR Commits) Date: Fri, 01 Aug 2008 17:43:33 +0200 Subject: [bknr-cvs] ksprotte changed trunk/projects/bos/ Message-ID: Revision: 3722 Author: ksprotte URL: http://bknr.net/trac/changeset/3722 checkpoint U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/m2/poi.lisp U trunk/projects/bos/web/poi-handlers.lisp Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-08-01 15:02:03 UTC (rev 3721) +++ trunk/projects/bos/m2/packages.lisp 2008-08-01 15:43:33 UTC (rev 3722) @@ -224,6 +224,7 @@ #:poi-icon #:poi-media #:make-poi + #:update-poi #:poi-complete #:poi-center-x #:poi-center-y Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-08-01 15:02:03 UTC (rev 3721) +++ trunk/projects/bos/m2/poi.lisp 2008-08-01 15:43:33 UTC (rev 3722) @@ -102,6 +102,16 @@ (defmethod destroy-object :before ((poi poi)) (mapc #'delete-object (poi-media poi))) +(deftransaction update-poi (poi &key published icon area) + (check-type published boolean) + (check-type area list) + (setf (poi-published poi) published) + (when icon + (setf (poi-icon poi) icon)) + (when area + (setf (poi-area poi) area)) + poi) + (defmethod poi-complete ((poi poi) language) (and (every #'(lambda (slot-name) (slot-string poi slot-name language nil)) '(title subtitle description)) (poi-area poi) Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-08-01 15:02:03 UTC (rev 3721) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-08-01 15:43:33 UTC (rev 3722) @@ -70,7 +70,8 @@ ((:table :border "1") (:tr (:td "name") (:td (:princ-safe (poi-name poi)) - (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) "view"))) + " " + (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) "[view]"))) (:tr (:td "published") (:td (checkbox-field "published" "published" :checked (poi-published poi)))) (:tr (:td "title") @@ -90,11 +91,15 @@ (html (:princ-safe (format nil "~D/~D " (first (poi-area poi)) (second (poi-area poi))))) (cmslink (format nil "map-browser/~A/~A?chosen-url=~A" (first (poi-area poi)) (second (poi-area poi)) - (encode-urlencoded (format nil "~A?action=save&" (hunchentoot:request-uri*)))) + (encode-urlencoded (format nil "~A?action=save&~:[~;published=on~]" + (hunchentoot:request-uri*) + (poi-published poi)))) "[relocate]")) (t (cmslink (format nil "map-browser/?chosen-url=~A" - (encode-urlencoded (format nil "~A?action=save&" (hunchentoot:request-uri*)))) + (encode-urlencoded (format nil "~A?action=save&~:[~;published=on~]" + (hunchentoot:request-uri*) + (poi-published poi)))) "[choose]"))))) (:tr (:td "icon") (:td (icon-chooser "icon" (poi-icon poi)))) @@ -104,8 +109,10 @@ (:tr (loop for image in (poi-sat-images poi) for index upfrom 0 - do (html (:td ((:a :href (format nil "/edit-poi-medium/~a?poi=~A" (store-object-id image) (store-object-id poi))) - ((:img :border "0" :src (format nil "/image/~a/thumbnail,,55,55" (store-object-id image))))) + do (html (:td ((:a :href (format nil "/edit-poi-medium/~a?poi=~A" + (store-object-id image) (store-object-id poi))) + ((:img :border "0" :src (format nil "/image/~a/thumbnail,,55,55" + (store-object-id image))))) :br (if (zerop index) (html ((:img :src "/images/trans.gif" :width "16"))) @@ -124,41 +131,46 @@ :br (cmslink (format nil "edit-poi-medium/?poi=~A" (store-object-id poi)) "[new]"))))) (:tr (:td (submit-button "save" "save") - (submit-button "delete" "delete" :confirm "Really delete the POI?")))) - ;; ;;;;;;;;;;;;;;;; - (:h2 "Upload new medium") - ((:form :method "post" :action "/edit-poi-medium" :enctype "multipart/form-data") - (:table (:tr (:td "Type") - (:td (select-box "medium-type" (mapcar #'(lambda (class-name) (string-downcase (symbol-name class-name))) - (class-subclasses (find-class 'poi-medium))) - :default "poi-image"))) - (:tr - (:td "File") - (:td ((:input :type "file" :name "image-file"))) - (:tr ((:td :colspan "2") (submit-button "upload" "upload")))))) - (:h2 "Attached POI media") - ((:table :border "1") - (dolist (medium (poi-media poi)) - (html (:tr (:td (:princ-safe (medium-pretty-type-string medium))) - (:td (:table (medium-handler-preview medium :small t) - (:tr (:td) - (:td (cmslink (format nil "/edit-poi-medium/~D?poi=~D" - (store-object-id medium) (store-object-id poi)) "edit"))))))))))))) + (submit-button "delete" "delete" :confirm "Really delete the POI?"))))) + (:h2 "Upload new medium") + ((:form :method "post" :action "/edit-poi-medium" :enctype "multipart/form-data") + (:table + ((:input :type "hidden" :name "poi" :value (store-object-id poi))) + (:tr (:td "Type") + (:td (select-box "new-medium-type" (mapcar #'(lambda (class-name) (string-downcase class-name)) + (class-subclasses (find-class 'poi-medium))) + :default "poi-image"))) + (:tr + (:td "File") + (:td ((:input :type "file" :name "image-file"))) + (:tr ((:td :colspan "2") (submit-button "upload" "upload")))))) + (:h2 "Attached POI media") + ((:table :border "1") + (dolist (medium (poi-media poi)) + (html (:tr (:td (:princ-safe (medium-pretty-type-string medium))) + (:td (:table (medium-handler-preview medium :small t) + (:tr (:td) + (:td (cmslink (format nil "/edit-poi-medium/~D?poi=~D" + (store-object-id medium) (store-object-id poi)) + "edit")))))))))))) (defmethod handle-object-form ((handler edit-poi-handler) (action (eql :save)) (poi poi)) - (with-query-params (published title subtitle description language x y icon movie) + (with-query-params ((published nil boolean) + title subtitle description language + (x nil integer) + (y nil integer) + icon) + (prin1 (list :published published :title title :subtitle subtitle :x x :y y :icon icon)) (unless language (setq language (request-language))) - (let ((args (list :title title - :published published - :subtitle subtitle - :description description - :icon icon))) - (when (and x y) - (setq args (append args (list :area (list (parse-integer x) (parse-integer y)))))) - (when movie - (setq args (append args (list :movies (list movie))))) - (apply #'update-poi poi language args)) + (update-textual-attributes poi language + :title title + :subtitle subtitle + :description description) + (update-poi poi + :published published + :area (when (and x y) (list x y)) + :icon icon) (with-bos-cms-page (:title "POI has been updated") (html (:h2 "Your changes have been saved") "You may " (cmslink (edit-object-url poi) "continue editing the POI") ".")))) @@ -333,26 +345,24 @@ "You may " (cmslink (edit-object-url poi) "continue editing the POI")))) (defmethod handle-object-form ((handler edit-poi-medium-handler) (action (eql :upload)) medium) - (with-query-params (poi) - (setq poi (find-store-object (parse-integer poi) :class 'poi)) + (with-query-params ((poi nil integer) + new-medium-type) + (setq poi (find-store-object poi :class 'poi)) (let ((upload (request-uploaded-file "image-file"))) (unless upload (error "no file uploaded in upload handler")) (bknr.web:with-image-from-upload* (upload) (unless (and (eql (cl-gd:image-width) *poi-image-width*) - (eql (cl-gd:image-height) *poi-image-height*)) - (with-bos-cms-page (:title "Invalid image size") - (:h2 "Invalid image size") - (:p "The image needs to be " - (:princ-safe *poi-image-width*) " pixels wide and " - (:princ-safe *poi-image-height*) " pixels high. Your uploaded image is " - (:princ-safe (cl-gd:image-width)) " pixels wide and " - (:princ-safe (cl-gd:image-height)) " pixels high. Please use an image editor " - "to resize the image and upload it again.") - (:p (cmslink (edit-object-url poi) "Back to POI"))) - (return-from handle-object-form t))) + (eql (cl-gd:image-height) *poi-image-height*)) + (error "Invalid image size. The image needs to be ~D pixels wide and ~D pixels high. Your uploaded ~ + image is ~D pixels wide and ~D pixels high. Please use an image editor to resize the image ~ + and upload it again." + *poi-image-width* *poi-image-height* + (cl-gd:image-width) (cl-gd:image-height)))) (let ((new-medium (import-image upload - :class-name (type-of medium) + :class-name (if medium + (type-of medium) + (intern (string-upcase new-medium-type))) :initargs `(:poi ,poi)))) (when medium (delete-object medium)) From bknr at bknr.net Sat Aug 2 22:32:42 2008 From: bknr at bknr.net (BKNR Commits) Date: Sun, 03 Aug 2008 00:32:42 +0200 Subject: [bknr-cvs] hans changed trunk/ Message-ID: Revision: 3723 Author: hans URL: http://bknr.net/trac/changeset/3723 Make news work better. Add news article display (not yet finished). Fix action box show/hide animation. U trunk/bknr/web/src/web/handlers.lisp U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/imageproc.lisp U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/quickhoney/website/static/styles.css U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/bknr/web/src/web/handlers.lisp =================================================================== --- trunk/bknr/web/src/web/handlers.lisp 2008-08-01 15:43:33 UTC (rev 3722) +++ trunk/bknr/web/src/web/handlers.lisp 2008-08-02 22:32:42 UTC (rev 3723) @@ -3,7 +3,6 @@ (enable-interpol-syntax) (defvar *bknr-debug* nil) -(defvar *website* nil) (defvar *website-modules* (make-hash-table :test #'equal)) Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-08-01 15:43:33 UTC (rev 3722) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-08-02 22:32:42 UTC (rev 3723) @@ -444,10 +444,13 @@ (encode-object-element "date" (format-date-time (blob-timestamp image) :vms-style t :show-time nil)) (encode-object-element "name" (store-image-name image))) (:method ((image quickhoney-image)) - (let ((vectorp (member :vector (store-image-keywords image)))) - (encode-object-element "category" (if vectorp "vector" "pixel")) - (encode-object-element "subcategory" "unknown"))) + (encode-object-element "type" "upload") + (with-object-element ("keywords") + (with-json-array () + (dolist (keyword (store-image-keywords image)) + (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)))) Modified: trunk/projects/quickhoney/src/imageproc.lisp =================================================================== --- trunk/projects/quickhoney/src/imageproc.lisp 2008-08-01 15:43:33 UTC (rev 3722) +++ trunk/projects/quickhoney/src/imageproc.lisp 2008-08-02 22:32:42 UTC (rev 3723) @@ -30,25 +30,27 @@ (nreverse coords))) (defun corner-image (&key (image *default-image*) - (radius (/ (max (image-width image) (image-height image)) 40))) + (radius (/ (max (image-width image) (image-height image)) 40)) + corner-color) (with-default-image (image) - (setf (save-alpha-p) t) - (let ((transparent-color (if (true-color-p) #x7f000000 + (unless corner-color + (setf (save-alpha-p) t + corner-color (if (true-color-p) #x7f000000 (or (transparent-color) (allocate-color 255 255 255 :alpha 127) - (error "can't allocate transparent color for button"))))) - (setf (transparent-color) transparent-color) - (let ((coords (corner-cutout-coords (image-width) (image-height) radius))) - (destructuring-bind (x-tx y-tx) (car coords) - (do-rows (y) - (do-pixels-in-row (x) - (when (and (eql x x-tx) - (eql y y-tx)) - (setf (raw-pixel) transparent-color) - (when (cdr coords) - (setf coords (cdr coords) - x-tx (caar coords) - y-tx (cadar coords))))))))))) + (error "can't allocate transparent color for button"))) + (transparent-color) corner-color)) + (let ((coords (corner-cutout-coords (image-width) (image-height) radius))) + (destructuring-bind (x-tx y-tx) (car coords) + (do-rows (y) + (do-pixels-in-row (x) + (when (and (eql x x-tx) + (eql y y-tx)) + (setf (raw-pixel) corner-color) + (when (cdr coords) + (setf coords (cdr coords) + x-tx (caar coords) + y-tx (cadar coords)))))))))) (define-imageproc-handler cutout-button (input-image &optional keyword (background-color "ffffff") (button-size "208") (radius "8")) (declare (ignore background-color)) @@ -87,4 +89,24 @@ (round (/ (- (image-height input-image) height) 2)) 0 0 width height) - thumbnail-image))) \ No newline at end of file + thumbnail-image))) + +(defparameter +news-image-width+ 428 + "Width of news images") +(defparameter +news-image-corner-radius+ 8 + "Corner radius for news images") + +(define-imageproc-handler news-article-cutout (input-image) + (let* ((image-height (floor (* +news-image-width+ + (/ (image-height input-image) (image-width input-image))))) + (output-image (create-image +news-image-width+ image-height t))) + (copy-image input-image output-image + 0 0 + 0 0 + +news-image-width+ image-height + :resize t :resample t + :dest-width +news-image-width+ :dest-height image-height) + (corner-image :image output-image + :radius +news-image-corner-radius+ + :corner-color (allocate-color 255 255 255 :image output-image)) + output-image)) \ No newline at end of file Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-01 15:43:33 UTC (rev 3722) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-02 22:32:42 UTC (rev 3723) @@ -1,5 +1,9 @@ // -*- Java -*- +/* configuration */ + +var max_news_items = 50; /* maximum number of news items to display */ + /* directory definitions */ var directory_button = []; @@ -223,7 +227,8 @@ var year = this.href.match(/#news\/(\d+)/)[1]; map(function (element) { if (element.href) { - ((element.href.match(/#news\/(\d+)/)[1] == year) ? addElementClass : removeElementClass)(element, 'active'); + ((element.href.match(/#news\/(\d+)/)[1] == year) ? addElementClass : removeElementClass) + (element, 'active'); } }, this.parentNode.childNodes); return true; @@ -236,22 +241,62 @@ return true; } +function intersection(a, b) +{ + var result = []; + map(function (value) { + if (findValue(b, value) != -1) { + result.push(value); + } + }, a); + return result; +} + +function make_upload_item(item) +{ + item.category = (findValue(item.keywords, 'pixel') == -1) ? 'vector' : 'pixel'; + item.subcategory = intersection(item.keywords, directory_button[item.category])[0]; + var color = (item.category == 'pixel') ? 'ff00ff' : '00ccff'; + var image_link = '/index#' + item.category + '/' + item.subcategory + '/' + item.name; + return DIV({ 'class': 'newsentry autonews news_' + item.category }, + A({ href: image_link }, + IMG({ src: "/image/" + item.name + '/cutout-button,,' + color + ',98,4'})), + DIV(null, + H1(null, item.name), + item.date, ' by ', item.owner, ' | ', + A({ href: image_link }, 'permalink'), + BR(), + item.description)); +} + +function make_news_item(item) +{ + return DIV({ 'class': 'newsentry' }, + IMG({ src: "/image/" + item.name + '/news-article-cutout'}), + DIV(null, + H1(null, item.title), + item.date, ' by ', item.owner, ' | ', + A({ href: '#' }, 'permalink'), + BR(), + item.text)); +} + function load_news(data) { - log('load news: ' + data.items.length); - replaceChildNodes('newsentries', - map(function (item) { - var color = (item.category == 'pixel') ? 'ff00ff' : '00ccff'; - return [ DIV({ 'class': 'newsentry autonews news_' + item.category }, - IMG({ src: "/image/" + item.name + '/cutout-button,,' + color + ',98,4'}), - DIV(null, - H1(null, item.name), - item.date, ' by ', item.owner, ' | ', - A({ href: '/index#' + item.category + '/' + item.subcategory + '/' + item.image_name }, 'permalink'), - BR(), - item.description)), - DIV({ 'class': 'news_sep' }) ]; - }, data.items)); + try { + if (data.items.length > max_news_items) { + data.items.length = max_news_items; + } + replaceChildNodes('newsentries', + map(function (item) { + return [ ((item.type == 'upload') ? make_upload_item : make_news_item)(item), + DIV({ 'class': 'news_sep' }) ]; + }, data.items)); + $('archive-navigation').style.visibility = 'inherit'; + } + catch (e) { + log('error displaying news: ' + e); + } } function load_news_archive(data) @@ -261,7 +306,6 @@ alert('no archive data found'); } var currentYear; - var active = true; replaceChildNodes('archive-navigation', SPAN({ 'class': 'title' }, 'Archive'), BR(), map(function (entry) { @@ -269,15 +313,12 @@ var month = entry[1]; var result = []; if (year != currentYear) { - if (currentYear) { - active = false; - } currentYear = year; var link = A({ href: '#news/' + year, 'class': 'year' }, year, BR()); link.onclick = select_archive_year; result.push(link); } - var link = A({ href: '#news/' + year + '/' + month, 'class': 'month ' + (active ? ' active' : '')}, + var link = A({ href: '#news/' + year + '/' + month, 'class': 'month '}, month_names[month - 1], BR()); link.onclick = select_archive_month; result.push(link); @@ -460,6 +501,8 @@ '30be01', function() { footer_hide(); + replaceChildNodes('newsentries'); + $('archive-navigation').style.visibility = 'hidden'; loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(load_news_archive, alert); loadJSONDoc('/json-news/quickhoney').addCallbacks(load_news, alert); }); @@ -529,6 +572,8 @@ $('menu').className = pagename; document.body.className = pagename; + overlay_remove(); + // Update globals current_directory = pagename; current_subdirectory = null; @@ -826,6 +871,7 @@ var current_page_index = position_to_page(query_position); make_pages_navbar(); + overlay_remove(); var page = query_result_pages[current_page_index]; var thumbnail_html = ''; @@ -885,6 +931,7 @@ debug('display_image index ' + index); footer_hide(); + overlay_remove(); display_path(); make_images_navbar(); make_image_action_buttons(); @@ -998,7 +1045,7 @@ { method: 'POST', headers: {"Content-Type":"application/x-www-form-urlencoded"}, sendContent: queryString({ from: $('hey_from').value, text: $('hey_text').value }) }) - .addCallback(hide_overlay); + .addCallback(overlay_remove); make_overlay('send-comment', 'Sending your comment', 300); return false; } @@ -1146,8 +1193,9 @@ document.location.href = document.location.href.replace(/\/image-browse.*/, "index#"); } -function hide_overlay() +function overlay_remove() { + replaceChildNodes('overlay'); $('overlay').style.visibility = 'hidden'; return false; } @@ -1168,7 +1216,7 @@ id: 'close', width: 13, height: 13})); overlay.style.width = width + 'px'; $('close').style.left = (width - 23) + 'px'; - $('close').onclick = hide_overlay; + $('close').onclick = overlay_remove; var elements = []; for (var i = 3; i < arguments.length; i++) { elements.push(arguments[i]); @@ -1368,13 +1416,15 @@ appendChildNodes('image_action_buttons', IMG({ id: 'buy-top', src: recolored_image_path('buy-top'), width: 90, height: 1})); } appendChildNodes('image_action_buttons', IMG({ id: 'buy-right-line', src: recolored_image_path('buy-right-line'), width: 1, height: height})); - var animator = new YAHOO.util.Anim('image_action_buttons', {}, .3, + var animator = new YAHOO.util.Anim('image_action_buttons', {}, 0.3, YAHOO.util.Easing.easeBoth); $('image_action_buttons').onmouseover = function () { + animator.stop(); animator.attributes = { width: { to: 127 }, left: { to: 518 } }; animator.animate(); } $('image_action_buttons').onmouseout = function () { + animator.stop(); animator.attributes = { width: { to: 60 }, left: { to: 584 } }; animator.animate(); } Modified: trunk/projects/quickhoney/website/static/styles.css =================================================================== --- trunk/projects/quickhoney/website/static/styles.css 2008-08-01 15:43:33 UTC (rev 3722) +++ trunk/projects/quickhoney/website/static/styles.css 2008-08-02 22:32:42 UTC (rev 3723) @@ -431,10 +431,17 @@ .newsentry { width: 428px; - height: 108px; position: relative; } +.autonews { + height: 108px; +} + +.autonews img { + padding: 0px; +} + .newsentry img { position: absolute; top: 5px; left: 5px; @@ -632,4 +639,4 @@ .archive span.title, .archive a.year { font-size: 1.5em; } .archive a.month.active { display: block; } .archive a.month { display: none; } -.archive { padding-left: 1em; } \ No newline at end of file +.archive { padding-left: 1em; } Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-08-01 15:43:33 UTC (rev 3722) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-08-02 22:32:42 UTC (rev 3723) @@ -134,23 +134,6 @@ -

- -
-

Jan and Ella

- March 8th, 2008 by Peter | permalink
- description -
-
-
-
-
- -
- March 8th, 2008 by Peter | permalink
- description -
-
From bknr at bknr.net Mon Aug 4 00:12:51 2008 From: bknr at bknr.net (BKNR Commits) Date: Mon, 04 Aug 2008 02:12:51 +0200 Subject: [bknr-cvs] hans changed trunk/bknr/web/src/bknr.web.asd Message-ID: Revision: 3724 Author: hans URL: http://bknr.net/trac/changeset/3724 Fix dependency for frontend module. U trunk/bknr/web/src/bknr.web.asd Modified: trunk/bknr/web/src/bknr.web.asd =================================================================== --- trunk/bknr/web/src/bknr.web.asd 2008-08-02 22:32:42 UTC (rev 3723) +++ trunk/bknr/web/src/bknr.web.asd 2008-08-04 00:12:51 UTC (rev 3724) @@ -98,7 +98,7 @@ :depends-on ("sysclasses" "packages")) (:module "frontend" - :depends-on ("packages") + :depends-on ("packages" "web") :serial t :components ((:file "frontend-config") (:file "frontend"))) From bknr at bknr.net Thu Aug 7 12:54:38 2008 From: bknr at bknr.net (BKNR Commits) Date: Thu, 07 Aug 2008 14:54:38 +0200 Subject: [bknr-cvs] hans changed trunk/thirdparty/usocket/ Message-ID: Revision: 3725 Author: hans URL: http://bknr.net/trac/changeset/3725 Update to 0.4.x branch from usocket svn to let the buildbot try it out. U trunk/thirdparty/usocket/Makefile U trunk/thirdparty/usocket/README U trunk/thirdparty/usocket/TODO U trunk/thirdparty/usocket/backend/allegro.lisp U trunk/thirdparty/usocket/backend/armedbear.lisp U trunk/thirdparty/usocket/backend/clisp.lisp U trunk/thirdparty/usocket/backend/cmucl.lisp U trunk/thirdparty/usocket/backend/lispworks.lisp U trunk/thirdparty/usocket/backend/openmcl.lisp U trunk/thirdparty/usocket/backend/sbcl.lisp U trunk/thirdparty/usocket/backend/scl.lisp U trunk/thirdparty/usocket/condition.lisp U trunk/thirdparty/usocket/package.lisp U trunk/thirdparty/usocket/test/package.lisp U trunk/thirdparty/usocket/test/test-usocket.lisp U trunk/thirdparty/usocket/test/usocket-test.asd U trunk/thirdparty/usocket/usocket.asd U trunk/thirdparty/usocket/usocket.lisp Change set too large, please see URL above From bknr at bknr.net Thu Aug 7 13:03:09 2008 From: bknr at bknr.net (BKNR Commits) Date: Thu, 07 Aug 2008 15:03:09 +0200 Subject: [bknr-cvs] hans changed trunk/thirdparty/usocket/ Message-ID: Revision: 3726 Author: hans URL: http://bknr.net/trac/changeset/3726 back out usocket 0.4.x merge, openmcl backend is broken U trunk/thirdparty/usocket/Makefile U trunk/thirdparty/usocket/README U trunk/thirdparty/usocket/TODO U trunk/thirdparty/usocket/backend/allegro.lisp U trunk/thirdparty/usocket/backend/armedbear.lisp U trunk/thirdparty/usocket/backend/clisp.lisp U trunk/thirdparty/usocket/backend/cmucl.lisp U trunk/thirdparty/usocket/backend/lispworks.lisp U trunk/thirdparty/usocket/backend/openmcl.lisp U trunk/thirdparty/usocket/backend/sbcl.lisp U trunk/thirdparty/usocket/backend/scl.lisp U trunk/thirdparty/usocket/condition.lisp U trunk/thirdparty/usocket/package.lisp U trunk/thirdparty/usocket/test/package.lisp U trunk/thirdparty/usocket/test/test-usocket.lisp U trunk/thirdparty/usocket/test/usocket-test.asd U trunk/thirdparty/usocket/usocket.asd U trunk/thirdparty/usocket/usocket.lisp Change set too large, please see URL above From bknr at bknr.net Thu Aug 7 19:30:29 2008 From: bknr at bknr.net (BKNR Commits) Date: Thu, 07 Aug 2008 21:30:29 +0200 Subject: [bknr-cvs] hans changed trunk/thirdparty/usocket/ Message-ID: Revision: 3727 Author: hans URL: http://bknr.net/trac/changeset/3727 retry with fixed usocket-0.4.x U trunk/thirdparty/usocket/Makefile U trunk/thirdparty/usocket/README U trunk/thirdparty/usocket/TODO U trunk/thirdparty/usocket/backend/allegro.lisp U trunk/thirdparty/usocket/backend/armedbear.lisp U trunk/thirdparty/usocket/backend/clisp.lisp U trunk/thirdparty/usocket/backend/cmucl.lisp U trunk/thirdparty/usocket/backend/lispworks.lisp U trunk/thirdparty/usocket/backend/openmcl.lisp U trunk/thirdparty/usocket/backend/sbcl.lisp U trunk/thirdparty/usocket/backend/scl.lisp U trunk/thirdparty/usocket/condition.lisp U trunk/thirdparty/usocket/package.lisp U trunk/thirdparty/usocket/test/package.lisp U trunk/thirdparty/usocket/test/test-usocket.lisp U trunk/thirdparty/usocket/test/usocket-test.asd U trunk/thirdparty/usocket/usocket.asd U trunk/thirdparty/usocket/usocket.lisp Change set too large, please see URL above From bknr at bknr.net Thu Aug 7 20:06:50 2008 From: bknr at bknr.net (BKNR Commits) Date: Thu, 07 Aug 2008 22:06:50 +0200 Subject: [bknr-cvs] hans changed trunk/thirdparty/usocket/ Message-ID: Revision: 3728 Author: hans URL: http://bknr.net/trac/changeset/3728 revert out usocket update again as it breaks buildbot tests on sbcl U trunk/thirdparty/usocket/Makefile U trunk/thirdparty/usocket/README U trunk/thirdparty/usocket/TODO U trunk/thirdparty/usocket/backend/allegro.lisp U trunk/thirdparty/usocket/backend/armedbear.lisp U trunk/thirdparty/usocket/backend/clisp.lisp U trunk/thirdparty/usocket/backend/cmucl.lisp U trunk/thirdparty/usocket/backend/lispworks.lisp U trunk/thirdparty/usocket/backend/openmcl.lisp U trunk/thirdparty/usocket/backend/sbcl.lisp U trunk/thirdparty/usocket/backend/scl.lisp U trunk/thirdparty/usocket/condition.lisp U trunk/thirdparty/usocket/package.lisp U trunk/thirdparty/usocket/test/package.lisp U trunk/thirdparty/usocket/test/test-usocket.lisp U trunk/thirdparty/usocket/test/usocket-test.asd U trunk/thirdparty/usocket/usocket.asd U trunk/thirdparty/usocket/usocket.lisp Change set too large, please see URL above From bknr at bknr.net Tue Aug 19 11:49:23 2008 From: bknr at bknr.net (BKNR Commits) Date: Tue, 19 Aug 2008 13:49:23 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/ Message-ID: Revision: 3729 Author: edi URL: http://bknr.net/trac/changeset/3729 Fix generation of user-agent header U trunk/thirdparty/drakma/CHANGELOG.txt U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/CHANGELOG.txt =================================================================== --- trunk/thirdparty/drakma/CHANGELOG.txt 2008-08-07 20:06:50 UTC (rev 3728) +++ trunk/thirdparty/drakma/CHANGELOG.txt 2008-08-19 11:49:23 UTC (rev 3729) @@ -1,4 +1,5 @@ Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) +Fix generation of user agent header (bug caught by Chaitanya Gupta) Version 0.11.5 2008-03-21 Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2008-08-07 20:06:50 UTC (rev 3728) +++ trunk/thirdparty/drakma/request.lisp 2008-08-19 11:49:23 UTC (rev 3729) @@ -514,7 +514,7 @@ (string-upcase protocol)) (write-header "Host" "~A~@[:~A~]" (uri-host uri) (non-default-port uri)) (when user-agent - (write-header "User-Agent" (user-agent-string user-agent))) + (write-header "User-Agent" "~A" (user-agent-string user-agent))) (when basic-authorization (write-header "Authorization" "Basic ~A" (base64:string-to-base64-string From bknr at bknr.net Fri Aug 22 23:09:49 2008 From: bknr at bknr.net (BKNR Commits) Date: Sat, 23 Aug 2008 01:09:49 +0200 Subject: [bknr-cvs] hans changed trunk/bknr/web/src/ Message-ID: Revision: 3730 Author: hans URL: http://bknr.net/trac/changeset/3730 Minor tweaks for QuickHoney 2.0 U trunk/bknr/web/src/rss/rss.lisp U trunk/bknr/web/src/sysclasses/user.lisp Modified: trunk/bknr/web/src/rss/rss.lisp =================================================================== --- trunk/bknr/web/src/rss/rss.lisp 2008-08-19 11:49:23 UTC (rev 3729) +++ trunk/bknr/web/src/rss/rss.lisp 2008-08-22 23:09:48 UTC (rev 3730) @@ -63,7 +63,7 @@ (defmethod prepare-for-snapshot ((channel rss-channel)) "When snapshotting, remove items from CHANNEL that are destroyed." (setf (slot-value channel 'items) - (remove-if #'object-destroyed-p (rss-channel-items channel)))) + (remove-if #'object-destroyed-p (slot-value channel 'items)))) ;; Mixin for items Modified: trunk/bknr/web/src/sysclasses/user.lisp =================================================================== --- trunk/bknr/web/src/sysclasses/user.lisp 2008-08-19 11:49:23 UTC (rev 3729) +++ trunk/bknr/web/src/sysclasses/user.lisp 2008-08-22 23:09:48 UTC (rev 3730) @@ -83,7 +83,8 @@ (set-smb-password (user-login user) plaintext-password))) (defmethod admin-p ((user user)) - (user-has-flag user :admin)) + (when (user-has-flag user :admin) + t)) (defmethod user-mail-error-p ((user user)) (and (slot-boundp user 'mail-error) From bknr at bknr.net Fri Aug 22 23:14:51 2008 From: bknr at bknr.net (BKNR Commits) Date: Sat, 23 Aug 2008 01:14:51 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/ Message-ID: Revision: 3731 Author: hans URL: http://bknr.net/trac/changeset/3731 QuickHoney v2.0 - Supports deep links and back button, RSS feed with uploaded images. Refactored to use innerHTML sparingly, use absolute positioning in fewer places, reduce number of server interactions, be smarter about recoloring menu items. Not yet completely done, but gone a long way towards the new release. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/image.lisp U trunk/projects/quickhoney/src/imageproc.lisp U trunk/projects/quickhoney/src/layout.lisp U trunk/projects/quickhoney/src/make-core.lisp U trunk/projects/quickhoney/src/news.lisp U trunk/projects/quickhoney/src/tags.lisp U trunk/projects/quickhoney/src/webserver.lisp U trunk/projects/quickhoney/upgrade-stuff/import.lisp A trunk/projects/quickhoney/upgrade-stuff/quickhoney-black.png A trunk/projects/quickhoney/upgrade-stuff/t-shirt-sample.gif U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/quickhoney/website/static/styles.css U trunk/projects/quickhoney/website/templates/image-full.xml U trunk/projects/quickhoney/website/templates/index.xml Change set too large, please see URL above From bknr at bknr.net Mon Aug 25 01:24:05 2008 From: bknr at bknr.net (BKNR Commits) Date: Mon, 25 Aug 2008 03:24:05 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/ Message-ID: Revision: 3732 Author: hans URL: http://bknr.net/trac/changeset/3732 Improve button display dynamics. Correct some element positions. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/quickhoney/website/static/styles.css U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-08-22 23:14:51 UTC (rev 3731) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-08-25 01:24:05 UTC (rev 3732) @@ -459,7 +459,9 @@ (: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 "text" (quickhoney-news-item-text item)) + (encode-object-element "width" (store-image-width item)) + (encode-object-element "height" (store-image-height item)))) (defmethod handle-object ((handler json-news-handler) (channel rss-channel)) (with-json-response () Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-22 23:14:51 UTC (rev 3731) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-25 01:24:05 UTC (rev 3732) @@ -6,6 +6,8 @@ /* directory definitions */ +var home_buttons = ['pixel', 'vector', 'news', 'shop']; + var subcategories = { pixel: ['birdview', 'parts', 'icons', 'editorial', 'animation', 'smallworld'], vector: ['portraits', 'celebrities', 'blackwhite', 'icons', 'editorial', 'nudes'] @@ -231,7 +233,7 @@ return result; } -function make_upload_item(item) +function make_upload_item(item, revealer) { item.category = (findValue(item.keywords, 'pixel') == -1) ? 'vector' : 'pixel'; item.subcategory = intersection(item.keywords, subcategories[item.category])[0]; @@ -240,10 +242,10 @@ onclick: function () { jump_to(item.category + '/' + item.subcategory + '/' + item.name) } }; return DIV({ 'class': 'newsentry autonews news_' + item.category }, A(link_dest, - IMG({ src: "/image/" + item.name + '/cutout-button,,' + color + ',98,98,4,' + item.category, - style: 'visibility: hidden', - width: 98, height: 98, - onload: 'reveal_image(this)' })), + revealer.IMG({ src: "/image/" + item.name + '/cutout-button,,' + color + ',98,98,4,' + item.category, + style: 'visibility: hidden', + width: 98, height: 98, + onload: 'reveal_image(this)' })), DIV(null, H1(null, item.name), item.date, ' by ', item.owner, ' | ', @@ -252,12 +254,12 @@ item.description)); } -function make_news_item(item) +function make_news_item(item, revealer) { return DIV({ 'class': 'newsentry' }, - IMG({ src: "/image/" + item.name + '/news-article-cutout', - style: 'visibility: hidden', - onload: 'reveal_image(this)' }), + revealer.IMG({ src: "/image/" + item.name + '/news-article-cutout', + style: 'visibility: hidden', + onload: 'reveal_image(this)' }), DIV(null, H1(null, item.title), item.date, ' by ', item.owner, ' | ', @@ -269,12 +271,13 @@ function load_news(data) { try { + var revealer = new ImageGroupRevealer(function () { hide_cue(); $('newsentries').style.visibility = 'inherit' }); if (data.items.length > max_news_items) { data.items.length = max_news_items; } replaceChildNodes('newsentries', map(function (item) { - return [ ((item.type == 'upload') ? make_upload_item : make_news_item)(item), + return [ ((item.type == 'upload') ? make_upload_item : make_news_item)(item, revealer), DIV({ 'class': 'news_sep' }) ]; }, data.items)); $('archive-navigation').style.visibility = 'inherit'; @@ -303,7 +306,8 @@ } if (month || !year) { - replaceChildNodes('newsentries'); + show_cue('loading news'); + $('newsentries').style.visibility = 'hidden'; loadJSONDoc('/json-news/quickhoney' + (month ? ('?month=' + subpath) : '')) .addCallbacks(load_news, alert); } @@ -351,7 +355,6 @@ var query_result = []; var query_result_pages = []; var query_position = 0; -var wait_count = 0; var reload_query = false; function display_query_result() { @@ -377,15 +380,30 @@ display_path(); } -function check_query_result() { +var display_cue = false; +var wait_count = 0; - if (query_result.length == 0) { - wait_count++; - $("cue").innerHTML = 'query database ' + "-\\|/".charAt(wait_count % 4); - setTimeout("check_query_result()", 250); +function animate_cue() { + + if (display_cue) { + $("cue").innerHTML = display_cue + ' ' + "-\\|/".charAt(wait_count++ % 4); + setTimeout("animate_cue()", 100); } } +function show_cue(text) { + $("cue").style.visibility = 'visible'; + $('footer').style.visibility = 'hidden'; + display_cue = text; + animate_cue(); +} + +function hide_cue() { + $("cue").style.visibility = 'hidden'; + $('footer').style.visibility = 'inherit'; + display_cue = false; +} + var db_cache = {}; function process_query_result(key, json_result) { @@ -408,9 +426,8 @@ } debug('got ', query_result.length.toString(), ' images'); - $("cue").style.visibility = 'hidden'; display_query_result(); - wait_count = 0; + hide_cue(); } function query_imagedb(directory, subdirectory, force) { @@ -429,12 +446,9 @@ process_query_result(key, db_cache[key]); } else { - $("cue").style.visibility = 'visible'; - + show_cue('querying database'); loadJSONDoc("/json-image-query/" + key) .addCallbacks(partial(process_query_result, key), alert); - - check_query_result(); } } @@ -446,7 +460,7 @@ } var pages = { - home: new Page('953cfd'), + home: new Page('953cfd', function() { current_directory = 'home'; shuffle_button_images() }), pixel: new Page('ff00ff', partial(directory, 'pixel')), vector: new Page('00ccff', @@ -624,13 +638,16 @@ function shuffle_button_images(category) { if (!category || category == current_directory) { try { + $('home_pixel').animator.reset(); map(function (directory) { var id = 'home_' + directory; $(id).style.visibility = 'hidden'; $(id).src = random_button_image('home', directory, 318, 208, directory); - }, ['pixel', 'vector', 'news', 'shop']); + }, home_buttons); if (subcategories[current_directory]) { + $('button0').animator.reset(); + var buttons_loaded = 0; var i = 0; map(function (subdirectory_name) { var id = 'button' + i++; @@ -646,12 +663,57 @@ } } +function ImageLoadAnimator (images) { + + this.images = images; + this.reset = function () { + show_cue('loading images'); + this.revealer && this.revealer.cancel(); + this.loaded = 0; + } + + function reveal_images(animator, images, n) { + try { + $(images[n]).style.visibility = 'inherit'; + if (++n != images.length) { + animator.revealer = callLater(0.1, reveal_images, animator, images, n); + } else { + animator.loaded = 0; + } + } + catch (e) { alert(e.message); } + } + + this.imageLoaded = function () { + if (++this.loaded == this.images.length) { + hide_cue(); + reveal_images(this, this.images, 0); + } + } + var animator = this; + map(function (image) { + $(image).animator = animator; + $(image).reveal = function (image) { image.animator.imageLoaded() } + }, images); +} + +function seq(start, end) { + var retval = []; + for (var i = start; i < end; i++) { + retval.push(i); + } + return retval; +} + function load_button_images() { map(function (button) { button.style.visibility = 'hidden'; }, getElementsByTagAndClassName('img', 'button-image')); + new ImageLoadAnimator(map(partial(operator['add'], 'button'), seq(0, 6))); + new ImageLoadAnimator(map(partial(operator['add'], 'home_'), home_buttons)); + loadJSONDoc('/json-buttons' + '/home/pixel,vector,news,shop' + '/pixel/' + subcategories['pixel'].join(',') @@ -811,7 +873,12 @@ } function reveal_image(image) { - image.style.visibility = 'inherit'; + /* log('reveal_image ' + image.src + ' reveal ' + image.reveal); */ + if (image.reveal) { + image.reveal(image); + } else { + image.style.visibility = 'inherit'; + } } function display_thumbnail_page() { @@ -1093,9 +1160,11 @@ load_button_images(); loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(initialize_news_archive, alert); - - jump_to(((document.location.href + "#").split("#")[1]) || "home"); + if (!document.location.href.match(/#/)) { + document.location.href += '#home'; + } + poll_path(); } @@ -1334,9 +1403,40 @@ return '/image/' + name + '/color,ff00ff,' + pages[current_directory].link_color; } -function make_image_action_button(name, action, height) +function IMG$(obj) { + obj.style = 'visibility: hidden'; + obj.onload = 'reveal_image(this)'; + return IMG(obj); +} + +function ImageGroupRevealer (done_callback) { + + this.images = []; + this.loaded = 0; + this.done_callback = done_callback; + + this.IMG = function(obj) { + var image = IMG$(obj); + image.revealer = this; + image.reveal = function (image) { image.revealer.imageLoaded() } + this.images.push(image); + return image; + } + this.imageLoaded = function () { + if (++this.loaded == this.images.length) { + if (this.done_callback) { + this.done_callback(); + } + map(function (image) { + image.style.visibility = 'inherit'; + }, this.images); + } + } +} + +function make_image_action_button(name, action, height, revealer) { - var div = DIV(null, IMG({ src: recolored_image_path(name), width: 127, height: height })); + var div = DIV(null, revealer.IMG({ src: recolored_image_path(name), width: 127, height: height })); div.onclick = function() { action(); return false; }; return div; } @@ -1346,20 +1446,21 @@ var buttons = []; var buyable = false; var height = 23; + var revealer = new ImageGroupRevealer(); map(function (keyword) { if (current_image.keywords[keyword]) { buyable = true; height += 22; - buttons.push(make_image_action_button(keyword, partial(make_buy_form, keyword), 22)); + buttons.push(make_image_action_button(keyword, partial(make_buy_form, keyword), 22, revealer)); } }, ['buy-file', 'buy-print', 'buy-t-shirt']); - buttons.push(make_image_action_button('hey', make_hey_form, 23)); + buttons.push(make_image_action_button('hey', make_hey_form, 23, revealer)); replaceChildNodes('image_action_buttons', buttons); if (buyable) { - appendChildNodes('image_action_buttons', IMG({ id: 'buy', src: recolored_image_path('buy'), width: 37, height: 22})); - appendChildNodes('image_action_buttons', IMG({ id: 'buy-top', src: recolored_image_path('buy-top'), width: 90, height: 1})); + appendChildNodes('image_action_buttons', revealer.IMG({ id: 'buy', src: recolored_image_path('buy'), width: 37, height: 22})); + appendChildNodes('image_action_buttons', revealer.IMG({ id: 'buy-top', src: recolored_image_path('buy-top'), width: 90, height: 1})); } - appendChildNodes('image_action_buttons', IMG({ id: 'buy-right-line', src: recolored_image_path('buy-right-line'), width: 1, height: height})); + appendChildNodes('image_action_buttons', revealer.IMG({ id: 'buy-right-line', src: recolored_image_path('buy-right-line'), width: 1, height: height})); var animator = new YAHOO.util.Anim('image_action_buttons', {}, 0.3, YAHOO.util.Easing.easeBoth); $('image_action_buttons').onmouseover = function () { Modified: trunk/projects/quickhoney/website/static/styles.css =================================================================== --- trunk/projects/quickhoney/website/static/styles.css 2008-08-22 23:14:51 UTC (rev 3731) +++ trunk/projects/quickhoney/website/static/styles.css 2008-08-25 01:24:05 UTC (rev 3732) @@ -308,7 +308,7 @@ a.home_button { visibility: inherit; - margin: 0px 12px 0px 0px; + margin: 0px 7px 0px 0px; border-width: 0px; } @@ -318,14 +318,14 @@ } #home div { - padding-bottom: 12px; + padding-bottom: 10px; } /* directory */ a.button { visibility: inherit; - margin: 0px 12px 0px 0px; + margin: 0px 7px 0px 0px; border-width: 0px; } @@ -335,7 +335,7 @@ } #directory div { - padding-bottom: 12px; + padding-bottom: 10px; } /* footer */ @@ -348,15 +348,15 @@ /* cue bar */ -p#cue { +#cue { position: absolute; visibility: hidden; left: 0px; top: 0px; - width: 120px; text-align: left; color: white; background-color: red; + padding: 0em 0.5em 0em 0.5em; } /* iframes for javascript loading */ @@ -584,14 +584,14 @@ } #overlay td.t-shirt-sample { - width: 188px; + width: 196px; height: 132px; background-image: url(/image/t-shirt-sample-background); background-repeat: no-repeat; } #overlay img#t-shirt-sample { - padding-left: 43px; + padding-left: 44px; padding-top: 16px; } @@ -602,9 +602,9 @@ visibility: hidden; } -.archive span.title, .archive a.year { font-size: 1.5em; } +.archive span.title, .archive a.year { font-size: 1.5em; margin-bottom: 1em; } .archive a.month.active { display: block; } -.archive a.month { display: none; } +.archive a.month { display: none; padding: 0px 5px 2px 5px; margin-top: 2px; } #archive-navigation.m1 a.m1 { color: #fff; background-color: #30be01; } #archive-navigation.m2 a.m2 { color: #fff; background-color: #30be01; } #archive-navigation.m3 a.m3 { color: #fff; background-color: #30be01; } Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-08-22 23:14:51 UTC (rev 3731) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-08-25 01:24:05 UTC (rev 3732) @@ -388,9 +388,9 @@

-

+

query database -

+
From bknr at bknr.net Tue Aug 26 00:43:53 2008 From: bknr at bknr.net (BKNR Commits) Date: Tue, 26 Aug 2008 02:43:53 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/flexi-streams/ Message-ID: Revision: 3733 Author: edi URL: http://bknr.net/trac/changeset/3733 Update to 1.0.6 U trunk/thirdparty/flexi-streams/CHANGELOG U trunk/thirdparty/flexi-streams/decode.lisp U trunk/thirdparty/flexi-streams/doc/index.html U trunk/thirdparty/flexi-streams/flexi-streams.asd Modified: trunk/thirdparty/flexi-streams/CHANGELOG =================================================================== --- trunk/thirdparty/flexi-streams/CHANGELOG 2008-08-25 01:24:05 UTC (rev 3732) +++ trunk/thirdparty/flexi-streams/CHANGELOG 2008-08-26 00:43:52 UTC (rev 3733) @@ -1,3 +1,7 @@ +Version 1.0.6 +2008-08-25 +Don't use a reserve if we can't rewind the stream (Drakma bug report by Stas Boukarev) + Version 1.0.5 2008-08-01 Export RUN-ALL-TESTS instead of RUN-TESTS (caught by Nick Allen) Modified: trunk/thirdparty/flexi-streams/decode.lisp =================================================================== --- trunk/thirdparty/flexi-streams/decode.lisp 2008-08-25 01:24:05 UTC (rev 3732) +++ trunk/thirdparty/flexi-streams/decode.lisp 2008-08-26 00:43:52 UTC (rev 3733) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.33 2008/05/30 09:04:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.34 2008/08/26 00:38:06 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -73,7 +73,7 @@ "Non-hygienic utility macro which defines methods for READ-SEQUENCE* and OCTETS-TO-STRING* for the class FORMAT-CLASS. BODY is described in the docstring of DEFINE-CHAR-ENCODERS but can additionally contain -a form (UNGET
) which has to be replaced by the correct code to +a form \(UNGET ) which has to be replaced by the correct code to `unread' the octets for the character designated by ." (let* ((body `((block char-decoder (locally @@ -101,8 +101,8 @@ ;; performance-wise to make RESERVE significantly bigger ;; (and thus put potentially a lot more octets into ;; OCTET-STACK), especially for UTF-8 - (reserve (cond ((not (floatp factor)) 0) - ((not can-rewind-p) (* 2 integer-factor)) + (reserve (cond ((or (not (floatp factor)) + (not can-rewind-p)) 0) (t (ceiling (* (- factor integer-factor) (- end start))))))) (declare (fixnum buffer-pos buffer-end index integer-factor reserve) (boolean can-rewind-p)) Modified: trunk/thirdparty/flexi-streams/doc/index.html =================================================================== --- trunk/thirdparty/flexi-streams/doc/index.html 2008-08-25 01:24:05 UTC (rev 3732) +++ trunk/thirdparty/flexi-streams/doc/index.html 2008-08-26 00:43:52 UTC (rev 3733) @@ -229,7 +229,7 @@

FLEXI-STREAMS together with this documentation can be downloaded from http://weitz.de/files/flexi-streams.tar.gz. The -current version is 1.0.5. +current version is 1.0.6.

Before you install FLEXI-STREAMS you first need to install the -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.124 2008/08/01 10:12:41 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.125 2008/08/26 00:38:08 edi Exp $

BACK TO MY HOMEPAGE Modified: trunk/thirdparty/flexi-streams/flexi-streams.asd =================================================================== --- trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-08-25 01:24:05 UTC (rev 3732) +++ trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-08-26 00:43:52 UTC (rev 3733) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.77 2008/08/01 10:12:40 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.78 2008/08/26 00:38:06 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -35,7 +35,7 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "1.0.5" + :version "1.0.6" :serial t :components ((:file "packages") (:file "mapping") From bknr at bknr.net Tue Aug 26 00:44:15 2008 From: bknr at bknr.net (BKNR Commits) Date: Tue, 26 Aug 2008 02:44:15 +0200 Subject: [bknr-cvs] edi changed tags/thirdparty/flexi-streams-1.0.6/ Message-ID: Revision: 3734 Author: edi URL: http://bknr.net/trac/changeset/3734 Tag 1.0.6 A tags/thirdparty/flexi-streams-1.0.6/ Copied: tags/thirdparty/flexi-streams-1.0.6 (from rev 3733, trunk/thirdparty/flexi-streams) From bknr at bknr.net Tue Aug 26 11:01:26 2008 From: bknr at bknr.net (BKNR Commits) Date: Tue, 26 Aug 2008 13:01:26 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/flexi-streams/ Message-ID: Revision: 3735 Author: edi URL: http://bknr.net/trac/changeset/3735 Update to 1.0.7 U trunk/thirdparty/flexi-streams/CHANGELOG U trunk/thirdparty/flexi-streams/decode.lisp U trunk/thirdparty/flexi-streams/doc/index.html U trunk/thirdparty/flexi-streams/flexi-streams.asd Modified: trunk/thirdparty/flexi-streams/CHANGELOG =================================================================== --- trunk/thirdparty/flexi-streams/CHANGELOG 2008-08-26 00:44:15 UTC (rev 3734) +++ trunk/thirdparty/flexi-streams/CHANGELOG 2008-08-26 11:01:26 UTC (rev 3735) @@ -1,3 +1,7 @@ +Version 1.0.7 +2008-08-26 +Don't read a second time if the first READ-SEQUENCE already reached EOF (Drakma bug report by Stas Boukarev) + Version 1.0.6 2008-08-25 Don't use a reserve if we can't rewind the stream (Drakma bug report by Stas Boukarev) Modified: trunk/thirdparty/flexi-streams/decode.lisp =================================================================== --- trunk/thirdparty/flexi-streams/decode.lisp 2008-08-26 00:44:15 UTC (rev 3734) +++ trunk/thirdparty/flexi-streams/decode.lisp 2008-08-26 11:01:26 UTC (rev 3735) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.34 2008/08/26 00:38:06 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.35 2008/08/26 10:59:22 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -92,6 +92,7 @@ (buffer-pos 0) (buffer-end 0) (index start) + donep ;; whether we will later be able to rewind the stream if ;; needed (to get rid of unused octets in the buffer) (can-rewind-p (maybe-rewind stream 0)) @@ -120,6 +121,8 @@ (fill-buffer (end) "Tries to fill the buffer from BUFFER-POS to END and returns NIL if the buffer doesn't contain any new data." + (when donep + (return-from fill-buffer nil)) ;; put data from octet stack into buffer if there is any (loop (when (>= buffer-pos end) @@ -132,6 +135,9 @@ (setq buffer-end (read-sequence buffer stream :start buffer-pos :end end)) + ;; we reached EOF, so we remember this + (when (< buffer-end end) + (setq donep t)) ;; BUFFER-POS is only greater than zero if the buffer ;; already contains unread data from the octet stack ;; (see below), so we test for ZEROP here and do /not/ Modified: trunk/thirdparty/flexi-streams/doc/index.html =================================================================== --- trunk/thirdparty/flexi-streams/doc/index.html 2008-08-26 00:44:15 UTC (rev 3734) +++ trunk/thirdparty/flexi-streams/doc/index.html 2008-08-26 11:01:26 UTC (rev 3735) @@ -229,7 +229,7 @@

FLEXI-STREAMS together with this documentation can be downloaded from http://weitz.de/files/flexi-streams.tar.gz. The -current version is 1.0.6. +current version is 1.0.7.

Before you install FLEXI-STREAMS you first need to install the -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.125 2008/08/26 00:38:08 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.126 2008/08/26 10:59:24 edi Exp $

BACK TO MY HOMEPAGE Modified: trunk/thirdparty/flexi-streams/flexi-streams.asd =================================================================== --- trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-08-26 00:44:15 UTC (rev 3734) +++ trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-08-26 11:01:26 UTC (rev 3735) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.78 2008/08/26 00:38:06 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.79 2008/08/26 10:59:22 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -35,7 +35,7 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "1.0.6" + :version "1.0.7" :serial t :components ((:file "packages") (:file "mapping") From bknr at bknr.net Tue Aug 26 11:01:47 2008 From: bknr at bknr.net (BKNR Commits) Date: Tue, 26 Aug 2008 13:01:47 +0200 Subject: [bknr-cvs] edi changed tags/thirdparty/flexi-streams-1.0.7/ Message-ID: Revision: 3736 Author: edi URL: http://bknr.net/trac/changeset/3736 Tag it A tags/thirdparty/flexi-streams-1.0.7/ Copied: tags/thirdparty/flexi-streams-1.0.7 (from rev 3735, trunk/thirdparty/flexi-streams) From bknr at bknr.net Tue Aug 26 18:55:35 2008 From: bknr at bknr.net (BKNR Commits) Date: Tue, 26 Aug 2008 20:55:35 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/website/ Message-ID: Revision: 3737 Author: hans URL: http://bknr.net/trac/changeset/3737 Partially revive the CMS Correct menuu row positioning Make home buttons quadratic again U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/quickhoney/website/static/styles.css U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-26 11:01:47 UTC (rev 3736) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-26 18:55:34 UTC (rev 3737) @@ -73,10 +73,10 @@ function login_complete(json_result) { - logged_in = json_result.admin; - log('login_complete, admin: ' + json_result.admin + ' login: ' + json_result.login); + logged_in = json_result.admin; + if (logged_in) { replaceChildNodes("username", json_result.login); $("login_status").style.visibility = 'visible'; @@ -124,21 +124,14 @@ function send_login() { - loadJSONDoc("/json-login?__username=" - + document.login_form.username.value - + "&__password=" - + document.login_form.password.value) - .addCallbacks(login_complete, alert); - - show_cms_window(); - return false; } function send_logout() { logged_in = false; - window.frames['login_iframe'].window.location.replace('/logout'); + loadJSONDoc("/logout") + .addCallbacks(function () {}, alert); show_cms_window("login_form"); } @@ -394,8 +387,12 @@ function show_cue(text) { $("cue").style.visibility = 'visible'; $('footer').style.visibility = 'hidden'; - display_cue = text; - animate_cue(); + if (display_cue) { + display_cue = text; + } else { + display_cue = text; + animate_cue(); + } } function hide_cue() { @@ -642,7 +639,7 @@ map(function (directory) { var id = 'home_' + directory; $(id).style.visibility = 'hidden'; - $(id).src = random_button_image('home', directory, 318, 208, directory); + $(id).src = random_button_image('home', directory, 318, 318, directory); }, home_buttons); if (subcategories[current_directory]) { @@ -1159,6 +1156,7 @@ } load_button_images(); + loadJSONDoc("/json-login").addCallbacks(login_complete, alert); loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(initialize_news_archive, alert); if (!document.location.href.match(/#/)) { Modified: trunk/projects/quickhoney/website/static/styles.css =================================================================== --- trunk/projects/quickhoney/website/static/styles.css 2008-08-26 11:01:47 UTC (rev 3736) +++ trunk/projects/quickhoney/website/static/styles.css 2008-08-26 18:55:34 UTC (rev 3737) @@ -148,6 +148,13 @@ .autonews a { color: #30be01; } +#m_home { top: 30px; left: 36px; } +#m_pixel { top: 36px; left: 250px; } +#m_vector { top: 36px; left: 331px; } +#m_news { top: 36px; left: 423px; } +#m_shop { top: 36px; left: 508px; } +#m_contact { top: 36px; left: 584px; } + #menu img.selected { visibility: hidden; z-index: 110; @@ -156,7 +163,6 @@ #menu a { position: absolute; padding: 0px; - top: 36px; border-width: 0px; } @@ -167,17 +173,6 @@ border-width: 0px; } -#m_quickhoney { - top: 28px; - left: 36px; -} - -#m_pixel { left: 250px; } -#m_vector { left: 331px; } -#m_news { left: 423px; } -#m_shop { left: 508px; } -#m_contact { left: 584px; } - /* path / version */ #path-and-version { @@ -314,7 +309,7 @@ a.home_button img { width: 318px; - height: 208px; + height: 318px; } #home div { Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-08-26 11:01:47 UTC (rev 3736) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-08-26 18:55:34 UTC (rev 3737) @@ -60,21 +60,21 @@

From bknr at bknr.net Wed Aug 27 01:13:34 2008 From: bknr at bknr.net (BKNR Commits) Date: Wed, 27 Aug 2008 03:13:34 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/website/static/javascript.js Message-ID: Revision: 3738 Author: hans URL: http://bknr.net/trac/changeset/3738 Fix button reloading for Safari, which does not call onload when an image src is set to the same image as the one already loaded into the img element. U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-26 18:55:34 UTC (rev 3737) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 01:13:34 UTC (rev 3738) @@ -639,7 +639,7 @@ map(function (directory) { var id = 'home_' + directory; $(id).style.visibility = 'hidden'; - $(id).src = random_button_image('home', directory, 318, 318, directory); + $(id).replace(random_button_image('home', directory, 318, 318, directory)); }, home_buttons); if (subcategories[current_directory]) { @@ -649,7 +649,7 @@ map(function (subdirectory_name) { var id = 'button' + i++; $(id).style.visibility = 'hidden'; - $(id).src = random_button_image(current_directory, subdirectory_name, 208, 208, current_directory); + $(id).replace(random_button_image(current_directory, subdirectory_name, 208, 208, current_directory)); $(id).parentNode.href = '#' + current_directory + '/' + subdirectory_name; }, subcategories[current_directory]); } @@ -690,7 +690,14 @@ var animator = this; map(function (image) { $(image).animator = animator; - $(image).reveal = function (image) { image.animator.imageLoaded() } + $(image).reveal = function () { this.animator.imageLoaded() } + $(image).replace = function (path) { + if (this.src.match(path + '$')) { + this.reveal(); + } else { + this.src = path; + } + } }, images); } From bknr at bknr.net Wed Aug 27 02:08:00 2008 From: bknr at bknr.net (BKNR Commits) Date: Wed, 27 Aug 2008 04:08:00 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/ Message-ID: Revision: 3739 Author: hans URL: http://bknr.net/trac/changeset/3739 Make news entries wider, change archive rendering to suit Nana's taste. U trunk/projects/quickhoney/src/imageproc.lisp U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/quickhoney/website/static/styles.css Modified: trunk/projects/quickhoney/src/imageproc.lisp =================================================================== --- trunk/projects/quickhoney/src/imageproc.lisp 2008-08-27 01:13:34 UTC (rev 3738) +++ trunk/projects/quickhoney/src/imageproc.lisp 2008-08-27 02:08:00 UTC (rev 3739) @@ -107,7 +107,7 @@ width height) thumbnail-image))) -(defparameter +news-image-width+ 428 +(defparameter +news-image-width+ 486 "Width of news images") (defparameter +news-image-corner-radius+ 8 "Corner radius for news images") Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 01:13:34 UTC (rev 3738) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 02:08:00 UTC (rev 3739) @@ -288,10 +288,8 @@ log('news year ' + year + ' month ' + month); map(function (element) { - if (element.href) { - ((element.href.match(/#news\/(\d+)/)[1] == year) ? addElementClass : removeElementClass) - (element, 'active'); - } + ((element.year == year && (month || element.month)) ? addElementClass : removeElementClass) + (element, 'active'); }, $('archive-navigation').childNodes); for (i = 1; i <= 12; i++) { @@ -315,19 +313,23 @@ var currentYear; var activeYear = document.location.href.replace(/.*news\/(\d+).*/, "$1"); replaceChildNodes('archive-navigation', - SPAN({ 'class': 'title' }, 'Archive'), BR(), map(function (entry) { var year = entry[0]; var month = entry[1]; var result = []; if (year != currentYear) { currentYear = year; - var link = A({ href: '#news/' + year, 'class': 'year' }, year, BR()); + var link = A({ href: '#news/' + year, + 'class': 'year' + (year == activeYear ? ' active' : '') }, + year, BR()); + link.year = year; result.push(link); } var link = A({ href: '#news/' + year + '/' + month, 'class': 'month ' + 'm' + month + (year == activeYear ? ' active' : '')}, month_names[month - 1], BR()); + link.month = month; + link.year = year; result.push(link); return result; }, data.months)); Modified: trunk/projects/quickhoney/website/static/styles.css =================================================================== --- trunk/projects/quickhoney/website/static/styles.css 2008-08-27 01:13:34 UTC (rev 3738) +++ trunk/projects/quickhoney/website/static/styles.css 2008-08-27 02:08:00 UTC (rev 3739) @@ -382,11 +382,11 @@ /* news styles */ #newsentries { - width: 428px; + width: 486px; } .newsentry { - width: 428px; + width: 486px; } .autonews { @@ -417,7 +417,7 @@ .news_vector { background-color: #00ccff; } .news_pixel { background-color: #ff00ff; } .autonews a { color: white } -div.news_sep { width: 428px; height: 17px; background-image: url(/image/news-sep); } +div.news_sep { width: 486px; height: 17px; background-image: url(/image/news-sep); } /* cms styles */ @@ -597,19 +597,21 @@ visibility: hidden; } -.archive span.title, .archive a.year { font-size: 1.5em; margin-bottom: 1em; } +.archive span.title { font-size: 1.2em; padding-bottom: 5px; } +.archive a.year { font-size: 1.2em; padding-bottom: 2em; } +.archive a.year.active { color: #000; } .archive a.month.active { display: block; } -.archive a.month { display: none; padding: 0px 5px 2px 5px; margin-top: 2px; } -#archive-navigation.m1 a.m1 { color: #fff; background-color: #30be01; } -#archive-navigation.m2 a.m2 { color: #fff; background-color: #30be01; } -#archive-navigation.m3 a.m3 { color: #fff; background-color: #30be01; } -#archive-navigation.m4 a.m4 { color: #fff; background-color: #30be01; } -#archive-navigation.m5 a.m5 { color: #fff; background-color: #30be01; } -#archive-navigation.m6 a.m6 { color: #fff; background-color: #30be01; } -#archive-navigation.m7 a.m7 { color: #fff; background-color: #30be01; } -#archive-navigation.m8 a.m8 { color: #fff; background-color: #30be01; } -#archive-navigation.m9 a.m9 { color: #fff; background-color: #30be01; } -#archive-navigation.m10 a.m10 { color: #fff; background-color: #30be01; } -#archive-navigation.m11 a.m11 { color: #fff; background-color: #30be01; } -#archive-navigation.m12 a.m12 { color: #fff; background-color: #30be01; } +.archive a.month { display: none; padding: 0px 5px 2px 5px; margin-top: 2px; font-size: 0.8em; } +#archive-navigation.m1 a.m1 { color: #000; } +#archive-navigation.m2 a.m2 { color: #000; } +#archive-navigation.m3 a.m3 { color: #000; } +#archive-navigation.m4 a.m4 { color: #000; } +#archive-navigation.m5 a.m5 { color: #000; } +#archive-navigation.m6 a.m6 { color: #000; } +#archive-navigation.m7 a.m7 { color: #000; } +#archive-navigation.m8 a.m8 { color: #000; } +#archive-navigation.m9 a.m9 { color: #000; } +#archive-navigation.m10 a.m10 { color: #000; } +#archive-navigation.m11 a.m11 { color: #000; } +#archive-navigation.m12 a.m12 { color: #000; } .archive { padding-left: 1em; } From bknr at bknr.net Wed Aug 27 02:38:29 2008 From: bknr at bknr.net (BKNR Commits) Date: Wed, 27 Aug 2008 04:38:29 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/website/static/javascript.js Message-ID: Revision: 3740 Author: hans URL: http://bknr.net/trac/changeset/3740 Repair deep linking, add function to determine scroll position (not yet used). U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 02:08:00 UTC (rev 3739) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 02:38:29 UTC (rev 3740) @@ -20,7 +20,6 @@ /* logged_in - will be set when the user has CMS access */ var logged_in; -var wants_cms = false; /* current colors */ @@ -81,15 +80,7 @@ replaceChildNodes("username", json_result.login); $("login_status").style.visibility = 'visible'; show_cms_window(); - } else { - if (wants_cms && (document.login_form.username.value || document.login_form.password.value)) { - $("login_form").style.visibility = 'hidden'; - $("login_failure").style.visibility = 'visible'; - setTimeout("show_login();", 2000); - } } - - show_page('home'); } /* CMS functionality */ @@ -226,6 +217,20 @@ return result; } +function getScrollXY() { + if (typeof (window.pageYOffset) == 'number') { + // Netscape compliant + return { x: window.pageXOffset, y: window.pageYOffset }; + } else if (document.body && ( document.body.scrollLeft || document.body.scrollTop)) { + // DOM compliant + return { x: document.body.scrollLeft, y: document.body.scrollTop }; + } else if (document.documentElement && (document.documentElement.scrollLeft || document.documentElement.scrollTop)) { + // IE standards compliant mode + return { x: document.documentElement.scrollLeft, y: document.documentElement.scrollTop }; + } else { + return { x: 0, y: 0 }; + } +} function make_upload_item(item, revealer) { item.category = (findValue(item.keywords, 'pixel') == -1) ? 'vector' : 'pixel'; From bknr at bknr.net Wed Aug 27 02:40:48 2008 From: bknr at bknr.net (BKNR Commits) Date: Wed, 27 Aug 2008 04:40:48 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/website/static/styles.css Message-ID: Revision: 3741 Author: hans URL: http://bknr.net/trac/changeset/3741 Update news layout, fix news archive navigation styling. U trunk/projects/quickhoney/website/static/styles.css Modified: trunk/projects/quickhoney/website/static/styles.css =================================================================== --- trunk/projects/quickhoney/website/static/styles.css 2008-08-27 02:38:29 UTC (rev 3740) +++ trunk/projects/quickhoney/website/static/styles.css 2008-08-27 02:40:48 UTC (rev 3741) @@ -597,8 +597,7 @@ visibility: hidden; } -.archive span.title { font-size: 1.2em; padding-bottom: 5px; } -.archive a.year { font-size: 1.2em; padding-bottom: 2em; } +.archive a.year { font-size: 1.2em; margin: 2px 0px 2px 0px; } .archive a.year.active { color: #000; } .archive a.month.active { display: block; } .archive a.month { display: none; padding: 0px 5px 2px 5px; margin-top: 2px; font-size: 0.8em; } From bknr at bknr.net Wed Aug 27 10:13:01 2008 From: bknr at bknr.net (BKNR Commits) Date: Wed, 27 Aug 2008 12:13:01 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/drakma/request.lisp Message-ID: Revision: 3742 Author: edi URL: http://bknr.net/trac/changeset/3742 Read content as binary if length is known Also, read trailers from the right stream U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2008-08-27 02:40:48 UTC (rev 3741) +++ trunk/thirdparty/drakma/request.lisp 2008-08-27 10:13:01 UTC (rev 3742) @@ -143,34 +143,35 @@ #+:lispworks 'lw:simple-char #-:lispworks 'character 'octet)) (chunkedp (chunked-stream-input-chunking-p (flexi-stream-stream stream)))) - #+:clisp - (setf (flexi-stream-element-type stream) element-type) - (multiple-value-prog1 - (values (cond ((eql content-length 0) (if textp "" nil)) - (content-length - (when chunkedp - ;; see RFC 2616, section 4.4 - (error "Got Content-Length header although input chunking is on.")) - (let ((result (make-array content-length - :element-type element-type - :fill-pointer t))) - (setf (fill-pointer result) - (read-sequence result stream)) - result)) - ((or chunkedp must-close) - ;; no content length, read until EOF (or end of chunking) - (let ((buffer (make-array +buffer-size+ - :element-type element-type)) - (result (make-array 0 - :element-type element-type - :adjustable t))) - (loop for index = 0 then (+ index pos) - for pos = (read-sequence buffer stream) - do (adjust-array result (+ index pos)) - (replace result buffer :start1 index :end2 pos) - while (= pos +buffer-size+)) - result))) - (chunked-input-stream-trailers stream))))) + (values (cond ((eql content-length 0) nil) + (content-length + (when chunkedp + ;; see RFC 2616, section 4.4 + (error "Got Content-Length header although input chunking is on.")) + (setf (flexi-stream-element-type stream) 'octet) + (let ((result (make-array content-length :element-type 'octet))) + #+:clisp + (setf (flexi-stream-element-type stream) 'octet) + (read-sequence result stream) + (when textp + (setf result + (octets-to-string result :external-format (flexi-stream-external-format stream)) + #+:clisp #+:clisp + (flexi-stream-element-type stream) element-type)) + result)) + ((or chunkedp must-close) + ;; no content length, read until EOF (or end of chunking) + #+:clisp + (setf (flexi-stream-element-type stream) element-type) + (let ((buffer (make-array +buffer-size+ :element-type element-type)) + (result (make-array 0 :element-type element-type :adjustable t))) + (loop for index = 0 then (+ index pos) + for pos = (read-sequence buffer stream) + do (adjust-array result (+ index pos)) + (replace result buffer :start1 index :end2 pos) + while (= pos +buffer-size+)) + result))) + (chunked-input-stream-trailers (flexi-stream-stream stream))))) (defun http-request (uri &rest args &key (protocol :http/1.1) From bknr at bknr.net Wed Aug 27 17:27:40 2008 From: bknr at bknr.net (BKNR Commits) Date: Wed, 27 Aug 2008 19:27:40 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/website/ Message-ID: Revision: 3743 Author: hans URL: http://bknr.net/trac/changeset/3743 implement drop shadows for overlay windows U trunk/projects/quickhoney/website/static/javascript.js A trunk/projects/quickhoney/website/static/shadow-grid.gif A trunk/projects/quickhoney/website/static/shadow.png A trunk/projects/quickhoney/website/static/ydsf.css U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 10:13:01 UTC (rev 3742) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 17:27:40 UTC (rev 3743) @@ -1233,10 +1233,14 @@ var overlay = $('overlay'); overlay.style.top = '144px'; overlay.className = current_directory; + var inner = DIV({ 'class': 'inner', style: 'background: white'}, + H1(null, title), + IMG({ src: '/image/overlay-close/color,000000,' + pages[current_directory].link_color, + id: 'close', width: 13, height: 13}), + BR()); replaceChildNodes(overlay, - H1(null, title), - IMG({ src: '/image/overlay-close/color,000000,' + pages[current_directory].link_color, - id: 'close', width: 13, height: 13})); + DIV({ 'class': 'ydsf' }, + inner)); overlay.style.width = width + 'px'; $('close').style.left = (width - 23) + 'px'; $('close').onclick = overlay_remove; @@ -1244,7 +1248,7 @@ for (var i = 3; i < arguments.length; i++) { elements.push(arguments[i]); } - appendChildNodes(overlay, DIV({id: id}, elements)); + appendChildNodes(inner, DIV({id: id}, elements)); overlay.style.visibility = 'inherit'; } Added: trunk/projects/quickhoney/website/static/shadow-grid.gif =================================================================== (Binary files differ) Property changes on: trunk/projects/quickhoney/website/static/shadow-grid.gif ___________________________________________________________________ Name: svn:executable + * Name: svn:mime-type + application/octet-stream Added: trunk/projects/quickhoney/website/static/shadow.png =================================================================== (Binary files differ) Property changes on: trunk/projects/quickhoney/website/static/shadow.png ___________________________________________________________________ Name: svn:executable + * Name: svn:mime-type + application/octet-stream Added: trunk/projects/quickhoney/website/static/ydsf.css =================================================================== --- trunk/projects/quickhoney/website/static/ydsf.css (rev 0) +++ trunk/projects/quickhoney/website/static/ydsf.css 2008-08-27 17:27:40 UTC (rev 3743) @@ -0,0 +1,92 @@ +/* + yDSF (ydnar Drop-Shadow-Fu) + ydnar at sixapart.com - http://www.sixapart.com +*/ + +.ydsf { + display: block; + position: relative; + margin: 4px -4px -4px 4px; + background: url(shadow-grid.gif) repeat; +} + +/* ie6 ignores this selector */ +html>body .ydsf { + margin: 10px -10px -10px 10px; + background: url(shadow.png) right bottom no-repeat; +} + +/* shadow corners */ +.ydsf:before, +.ydsf:after { + content: " "; + display: block; + width: 10px; + height: 10px; + background: inherit; +} + +.ydsf:before { + position: absolute; + top: 0; + right: 0; + margin: -10px 0 0 auto; + background-position: right top; +} + +.ydsf:after { + margin: -10px 0 0 -10px; + background-position: left bottom; +} + +.ydsf .inner { + display: block; + position: relative; + overflow: hidden; /* prevents margin leakage from child elements */ + left: -4px; + top: -4px; +} + +/* ie6 ignores this selector */ +html>body .ydsf .inner { + left: -10px; + top: -10px; + margin: 0; +} + + +/* helper classes (not YDSF related) */ + +.demo-ydsf { + position: relative; + border: 1px solid #999; + padding: 10px; + background: #fff url(gradient.jpg) left top repeat-x; +} + +.clear { + clear: both; + overflow: hidden; + width: 1px; + height: 1px; + margin: 0 -1px -1px 0; + border: 0; + padding: 0; + font-size: 0; + line-height: 0; +} + +.left { + float: left; + display: inline; /* fixes ie double margin-left bug */ +} + +.right { float: right; } + +.note { + width: 200px; + border: 1px solid #666; + padding: 10px; + background: #ffc; + color: #333; +} Property changes on: trunk/projects/quickhoney/website/static/ydsf.css ___________________________________________________________________ Name: svn:executable + * Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-08-27 10:13:01 UTC (rev 3742) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-08-27 17:27:40 UTC (rev 3743) @@ -9,6 +9,7 @@ + From bknr at bknr.net Wed Aug 27 23:57:40 2008 From: bknr at bknr.net (BKNR Commits) Date: Thu, 28 Aug 2008 01:57:40 +0200 Subject: [bknr-cvs] hans changed trunk/projects/quickhoney/ Message-ID: Revision: 3744 Author: hans URL: http://bknr.net/trac/changeset/3744 Reimplement login and logout, now a separate page is used to log in. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/news.lisp U trunk/projects/quickhoney/src/tags.lisp U trunk/projects/quickhoney/src/webserver.lisp U trunk/projects/quickhoney/website/static/javascript.js A trunk/projects/quickhoney/website/static/login.css U trunk/projects/quickhoney/website/templates/index.xml A trunk/projects/quickhoney/website/templates/login.xml Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-08-27 17:27:40 UTC (rev 3743) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-08-27 23:57:40 UTC (rev 3744) @@ -92,8 +92,19 @@ (defmethod handle ((handler json-login-handler)) (with-json-response () (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))))) +(defclass json-logout-handler (page-handler) + ()) + +(defmethod handle ((handler json-logout-handler)) + (setf (session-value 'bknr-session) nil) + (with-json-response () + (encode-object-element "logged_out" t))) + (defclass json-clients-handler (page-handler) ()) Modified: trunk/projects/quickhoney/src/news.lisp =================================================================== --- trunk/projects/quickhoney/src/news.lisp 2008-08-27 17:27:40 UTC (rev 3743) +++ trunk/projects/quickhoney/src/news.lisp 2008-08-27 23:57:40 UTC (rev 3744) @@ -13,10 +13,9 @@ (html-stream s ((:div :class (format nil "newsentry news_~(~A~)" category)) - ((:img :src (format nil "http://~A/image/~A/cutout-button,,~A,98,98,4" + ((:img :src (format nil "http://~A/image/~A" (website-host) - (store-object-id image) - (if is-vector "00ccff" "ff00ff"))) + (store-object-id image))) (:div (:h1 (:princ (store-image-name image))) (:princ (format nil "~A by ~A | " Modified: trunk/projects/quickhoney/src/tags.lisp =================================================================== --- trunk/projects/quickhoney/src/tags.lisp 2008-08-27 17:27:40 UTC (rev 3743) +++ trunk/projects/quickhoney/src/tags.lisp 2008-08-27 23:57:40 UTC (rev 3744) @@ -37,4 +37,14 @@ (define-bknr-tag first-image-link () (html ((:a :href #?"/image-browse/$((bknr.images:store-image-name (first (bknr.datastore:class-instances 'quickhoney-image))))") - (emit-tag-children)))) \ No newline at end of file + (emit-tag-children)))) + +(define-bknr-tag login-status () + (cond + ((bknr.web::admin-p (bknr-session-user)) + (redirect "/index")) + ((and (bknr.web::anonymous-p (bknr-session-user)) + (query-param "__username")) + (html (:h1 "Login failed, please try again"))) + (t + (html (:h1 "Please login"))))) \ No newline at end of file Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-08-27 17:27:40 UTC (rev 3743) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-08-27 23:57:40 UTC (rev 3744) @@ -23,6 +23,7 @@ ("/animation" animation-handler) ("/json-image-query" json-image-query-handler) ("/json-login" json-login-handler) + ("/json-logout" json-logout-handler) ("/json-clients" json-clients-handler) ("/json-buttons" json-buttons-handler) ("/json-edit-image" json-edit-image-handler) Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 17:27:40 UTC (rev 3743) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-08-27 23:57:40 UTC (rev 3744) @@ -59,21 +59,12 @@ debug('debug window cleared'); } -/* login */ +/* login status */ -function show_login() { - $("login_failure").style.visibility = 'hidden'; - $("login_form").style.visibility = 'visible'; -} +function login_status(json_result) { -function hide_status() { - $("login_status").style.visibility = 'hidden'; -} + log('login_status, admin: ' + json_result.admin + ' login: ' + json_result.login); -function login_complete(json_result) { - - log('login_complete, admin: ' + json_result.admin + ' login: ' + json_result.login); - logged_in = json_result.admin; if (logged_in) { @@ -96,6 +87,7 @@ var elements = $("cms").childNodes; if (logged_in) { + for (var i = 0; i < elements.length; i++) { if (elements[i].id) { elements[i].style.visibility = (elements[i].id == name) ? "visible" : "hidden"; @@ -103,13 +95,13 @@ } $("login_status").style.visibility = 'visible'; + } else { for (var i = 0; i < elements.length; i++) { if (elements[i].id) { elements[i].style.visibility = "hidden"; } } - $("login_form").style.visibility = 'visible'; } } @@ -121,10 +113,9 @@ function send_logout() { logged_in = false; - loadJSONDoc("/logout") + show_cms_window(); + loadJSONDoc("/json-logout") .addCallbacks(function () {}, alert); - - show_cms_window("login_form"); } /* image editing */ @@ -1170,7 +1161,7 @@ } load_button_images(); - loadJSONDoc("/json-login").addCallbacks(login_complete, alert); + loadJSONDoc("/json-login").addCallbacks(login_status, alert); loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(initialize_news_archive, alert); if (!document.location.href.match(/#/)) { @@ -1489,4 +1480,20 @@ animator.attributes = { width: { to: 60 }, left: { to: 624 } }; animator.animate(); } -} \ No newline at end of file +} + +/* login stuff */ + +function init_login () { + $('username').focus(); + $('login_form').style.display = 'block'; +} + +function do_login () { + + $('login_form').style.display = 'none'; + $('logging-in').style.display = 'block'; + + return true; +} + Added: trunk/projects/quickhoney/website/static/login.css =================================================================== --- trunk/projects/quickhoney/website/static/login.css (rev 0) +++ trunk/projects/quickhoney/website/static/login.css 2008-08-27 23:57:40 UTC (rev 3744) @@ -0,0 +1,4 @@ +body { margin: 2em } +table { margin-bottom: 1em } +.label { padding-right: 1em } +h1 { margin: 1em 0em 2em 0em } \ No newline at end of file Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-08-27 17:27:40 UTC (rev 3743) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-08-27 23:57:40 UTC (rev 3744) @@ -358,23 +358,6 @@

-
- - Login
- Username
-
- Password
-

- login - - -
- -
- Login failed
- Please check your user name and password. -
-

You are logged in as

logout

Added: trunk/projects/quickhoney/website/templates/login.xml =================================================================== --- trunk/projects/quickhoney/website/templates/login.xml (rev 0) +++ trunk/projects/quickhoney/website/templates/login.xml 2008-08-27 23:57:40 UTC (rev 3744) @@ -0,0 +1,46 @@ + + + + + + + + + QuickHoney CMS Login + + + + + + +