[bknr-cvs] hans changed trunk/
BKNR Commits
bknr at bknr.net
Thu Jul 31 22:25:05 UTC 2008
Revision: 3713
Author: hans
URL: http://bknr.net/trac/changeset/3713
News start working.
U trunk/bknr/web/src/rss/rss.lisp
U trunk/projects/quickhoney/src/handlers.lisp
A trunk/projects/quickhoney/src/json.lisp
U trunk/projects/quickhoney/src/quickhoney.asd
U trunk/projects/quickhoney/src/webserver.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/rss/rss.lisp
===================================================================
--- trunk/bknr/web/src/rss/rss.lisp 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/bknr/web/src/rss/rss.lisp 2008-07-31 22:25:05 UTC (rev 3713)
@@ -121,35 +121,37 @@
(when (boundp 'hunchentoot:*request*)
(let ((month-string (bknr.web:query-param "month")))
(when month-string
- (mapcar #'parse-integer (cl-ppcre:split "([-/]|(?<=..))" month-string :limit 2))))))
+ (mapcar #'parse-integer (cl-ppcre:split "([-/]|(?<=....))" month-string :limit 2))))))
(defun rss-channel-archive (channel)
"Return the channel archive consisting of lists of lists ((MONTH YEAR) ITEM...)"
- (group-on (rss-channel-items channel)
+ (group-on (rss-channel-items channel :all t)
:test #'equal
:key (lambda (item)
(multiple-value-bind (seconds minutes hours day month year)
(decode-universal-time (rss-item-pub-date item))
(declare (ignore seconds minutes hours day))
- (list month year)))))
+ (list year month)))))
(defgeneric rss-channel-items (channel &key)
(:documentation "Return all non-expired items in channel.")
- (:method ((channel rss-channel) &key days month count)
+ (:method ((channel rss-channel) &key days month count all)
(unless month
(setf month (month-from-query-parameter)))
(unless days
(setf days (or (days-from-query-parameter)
(rss-channel-max-item-age channel))))
- (let ((items (if month
- (cdr (find month (rss-channel-archive channel) :test #'equal))
- (let ((expiry-time (- (get-universal-time) (* 60 60 24 days))))
- (remove-if (lambda (item) (or (object-destroyed-p item)
- (< (rss-item-pub-date item) expiry-time)))
- (slot-value channel 'items))))))
- (if count
- (subseq items 0 (min count (length items)))
- items))))
+ (if all
+ (remove-if #'object-destroyed-p (slot-value channel 'items))
+ (let ((items (if month
+ (cdr (find month (rss-channel-archive channel) :test #'equal :key #'car))
+ (let ((expiry-time (- (get-universal-time) (* 60 60 24 days))))
+ (remove-if (lambda (item) (or (object-destroyed-p item)
+ (< (rss-item-pub-date item) expiry-time)))
+ (slot-value channel 'items))))))
+ (if count
+ (subseq items 0 (min count (length items)))
+ items)))))
(defgeneric rss-channel-archived-months (channel)
(:documentation "Return a list of lists (MONTH YEAR) for which the
Modified: trunk/projects/quickhoney/src/handlers.lisp
===================================================================
--- trunk/projects/quickhoney/src/handlers.lisp 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/projects/quickhoney/src/handlers.lisp 2008-07-31 22:25:05 UTC (rev 3713)
@@ -426,67 +426,46 @@
(:p (:princ-safe (apply #'format nil (simple-condition-format-control e) (simple-condition-format-arguments e))))
(:p ((:a :href "javascript:window.close()") "ok"))))))))))))
-(defclass news-json-handler (object-handler)
+(defclass rss-channel-handler (object-handler)
()
(:default-initargs :object-class 'rss-channel :query-function #'find-rss-channel))
-(defvar *json-output*)
+(defclass json-news-handler (rss-channel-handler)
+ ())
-(defclass json-output-stream ()
- ((output-stream :reader output-stream
- :initarg :output-stream)
- (stack :accessor stack
- :initform nil)))
-(defun next-aggregate-element ()
- (if (car (stack *json-output*))
- (princ #\, (output-stream *json-output*))
- (setf (car (stack *json-output*)) t)))
+(defgeneric json-encode-news-item (item)
+ (:method ((item t))
+ ; do nothing
+ )
+ (: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)))))
-(defmacro with-json-output ((stream) &body body)
- `(let ((*json-output* (make-instance 'json-output-stream :output-stream ,stream)))
- , at body))
-
-(defmacro with-json-output-to-string (() &body body)
- `(with-output-to-string (s)
- (with-json-output (s)
- , at body)))
-
-(defmacro with-json-aggregate ((begin-char end-char) &body body)
- `(progn
- (when (stack *json-output*)
- (next-aggregate-element))
- (princ ,begin-char (output-stream *json-output*))
- (push nil (stack *json-output*))
- (prog1
- (progn , at body)
- (pop (stack *json-output*))
- (princ ,end-char (output-stream *json-output*)))))
-
-(defmacro with-json-array (() &body body)
- `(with-json-aggregate (#\[ #\])
- , at body))
-
-(defmacro with-json-object (() &body body)
- `(with-json-aggregate (#\{ #\})
- , at body))
-
-(defun encode-array-element (object)
- (next-aggregate-element)
- (json:encode-json object (output-stream *json-output*)))
-
-(defun encode-object-element (key value)
- (next-aggregate-element)
- (json:encode-json key (output-stream *json-output*))
- (princ #\: (output-stream *json-output*))
- (json:encode-json value (output-stream *json-output*)))
-
-(defmethod handle-object ((handler news-json-handler) (channel rss-channel))
- (with-http-response (:content-type "application/json")
- (with-json-output-to-string ()
+(defmethod handle-object ((handler json-news-handler) (channel rss-channel))
+ (with-json-response ()
+ (with-object-element ("items")
(with-json-array ()
(dolist (item (rss-channel-items channel))
(with-json-object ()
- (encode-object-element "pubDate" (format-date-time (rss-item-pub-date item) :vms-style t))
- (encode-object-element "title" (rss-item-title item))
- (encode-object-element "description" (rss-item-description item))))))))
+ (json-encode-news-item item)))))))
+
+(defclass json-news-archive-handler (rss-channel-handler)
+ ())
+
+(defmethod handle-object ((handler json-news-archive-handler) (channel rss-channel))
+ (with-json-response ()
+ (with-object-element ("months")
+ (with-json-array ()
+ (dolist (month (sort (rss-channel-archived-months channel)
+ (lambda (a b)
+ (if (= (first a) (first b))
+ (> (second a) (second b))
+ (> (first a) (first b))))))
+ (with-json-array ()
+ (encode-array-element (first month))
+ (encode-array-element (second month))))))))
\ No newline at end of file
Added: trunk/projects/quickhoney/src/json.lisp
===================================================================
--- trunk/projects/quickhoney/src/json.lisp (rev 0)
+++ trunk/projects/quickhoney/src/json.lisp 2008-07-31 22:25:05 UTC (rev 3713)
@@ -0,0 +1,67 @@
+(in-package :quickhoney)
+
+(defvar *json-output*)
+
+(defclass json-output-stream ()
+ ((stream :reader stream
+ :initarg :stream)
+ (stack :accessor stack
+ :initform nil)))
+
+(defun next-aggregate-element ()
+ (if (car (stack *json-output*))
+ (princ (car (stack *json-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)))
+ , at body))
+
+(defmacro with-json-output-to-string (() &body body)
+ `(with-output-to-string (s)
+ (with-json-output (s)
+ , at body)))
+
+(defmacro with-json-aggregate ((begin-char end-char) &body body)
+ `(progn
+ (when (stack *json-output*)
+ (next-aggregate-element))
+ (princ ,begin-char (stream *json-output*))
+ (push nil (stack *json-output*))
+ (prog1
+ (progn , at body)
+ (pop (stack *json-output*))
+ (princ ,end-char (stream *json-output*)))))
+
+(defmacro with-json-array (() &body body)
+ `(with-json-aggregate (#\[ #\])
+ , at body))
+
+(defmacro with-json-object (() &body body)
+ `(with-json-aggregate (#\{ #\})
+ , at body))
+
+(defun encode-array-element (object)
+ (next-aggregate-element)
+ (json:encode-json object (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*)))
+
+(defmacro with-object-element ((key) &body body)
+ `(progn
+ (next-aggregate-element)
+ (json:encode-json ,key (stream *json-output*))
+ (setf (car (stack *json-output*)) #\:)
+ (unwind-protect
+ (progn , at body)
+ (setf (car (stack *json-output*)) #\,))))
+
+(defmacro with-json-response (() &body body)
+ `(with-http-response (:content-type "application/json")
+ (with-json-output-to-string ()
+ (with-json-object ()
+ , at body))))
Modified: trunk/projects/quickhoney/src/quickhoney.asd
===================================================================
--- trunk/projects/quickhoney/src/quickhoney.asd 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/projects/quickhoney/src/quickhoney.asd 2008-07-31 22:25:05 UTC (rev 3713)
@@ -32,7 +32,8 @@
(:file "news" :depends-on ("image"))
(:file "layout" :depends-on ("config"))
(:file "imageproc" :depends-on ("config"))
- (:file "handlers" :depends-on ("layout" "config" "image"))
+ (:file "json" :depends-on ("packages"))
+ (:file "handlers" :depends-on ("json" "layout" "config" "image"))
(:file "tags" :depends-on ("image"))
(:file "webserver" :depends-on ("handlers"))
(:file "daily" :depends-on ("config"))
Modified: trunk/projects/quickhoney/src/webserver.lisp
===================================================================
--- trunk/projects/quickhoney/src/webserver.lisp 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/projects/quickhoney/src/webserver.lisp 2008-07-31 22:25:05 UTC (rev 3713)
@@ -33,7 +33,8 @@
("/admin" admin-handler)
("/upload-news" upload-news-handler)
("/digg-image" digg-image-handler)
- ("/news-json" news-json-handler)
+ ("/json-news-archive" json-news-archive-handler)
+ ("/json-news" json-news-handler)
("/" template-handler
:default-template "frontpage"
:destination ,(namestring (merge-pathnames "templates/" *website-directory*))
Modified: trunk/projects/quickhoney/website/static/javascript.js
===================================================================
--- trunk/projects/quickhoney/website/static/javascript.js 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/projects/quickhoney/website/static/javascript.js 2008-07-31 22:25:05 UTC (rev 3713)
@@ -215,11 +215,80 @@
/* news */
-function load_news()
+var month_names = [ 'January', 'February', 'March', 'April', 'May', 'June',
+ 'July', 'August', 'September', 'October', 'November', 'December' ];
+
+function select_archive_year()
{
-
+ 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');
+ }
+ }, this.parentNode.childNodes);
+ return true;
}
+function select_archive_month()
+{
+ var month = this.href.match(/#news\/(\d+\/\d+)/)[1];
+ loadJSONDoc('/json-news/quickhoney?month=' + month).addCallbacks(load_news, alert);
+ return true;
+}
+
+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.uploader, ' | ',
+ A({ href: '/index#' + item.category + '/' + item.subcategory + '/' + item.image_name }, 'permalink'),
+ BR(),
+ item.description)),
+ DIV({ 'class': 'news_sep' }) ];
+ }, data.items));
+}
+
+function load_news_archive(data)
+{
+ try {
+ if (!data.months) {
+ alert('no archive data found');
+ }
+ var currentYear;
+ var active = true;
+ replaceChildNodes('archive-navigation',
+ SPAN({ 'class': 'title' }, 'Archive'), BR(),
+ map(function (entry) {
+ var year = entry[0];
+ 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' : '')},
+ month_names[month - 1], BR());
+ link.onclick = select_archive_month;
+ result.push(link);
+ return result;
+ }, data.months));
+ }
+ catch (e) {
+ log('error while processing archive data: ' + e);
+ }
+}
+
/* image database */
var current_directory;
@@ -391,7 +460,8 @@
'30be01',
function() {
footer_hide();
- load_news();
+ loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(load_news_archive, alert);
+ // load_news();
});
pages['shop']
Modified: trunk/projects/quickhoney/website/static/styles.css
===================================================================
--- trunk/projects/quickhoney/website/static/styles.css 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/projects/quickhoney/website/static/styles.css 2008-07-31 22:25:05 UTC (rev 3713)
@@ -627,4 +627,9 @@
top: 0px;
left: 585px;
visibility: hidden;
-}
\ No newline at end of file
+}
+
+.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
Modified: trunk/projects/quickhoney/website/templates/index.xml
===================================================================
--- trunk/projects/quickhoney/website/templates/index.xml 2008-07-31 16:31:28 UTC (rev 3712)
+++ trunk/projects/quickhoney/website/templates/index.xml 2008-07-31 22:25:05 UTC (rev 3713)
@@ -130,25 +130,33 @@
</div>
<div id="news_page">
- <p id="news_content">
- <div class="newsentry news_vector autonews">
- <img src="/image/TSG_Platforms_web/cutout-button,,00ccff,98,4"/>
- <div>
- <h1>Jan and Ella</h1>
- March 8th, 2008 by Peter | <a href="foo">permalink</a><br/>
- description
- </div>
- </div>
- <div class="news_sep"> </div>
- <br/>
- <div class="newsentry news_pixel autonews">
- <img src="/image/TSG_Platforms_web/cutout-button,,00ccff,98,4"/>
- <div>
- March 8th, 2008 by Peter | <a href="foo">permalink</a><br/>
- description
- </div>
- </div>
- </p>
+ <table border="0">
+ <tbody>
+ <tr>
+ <td valign="top" id="newsentries">
+ <div class="newsentry news_vector autonews">
+ <img src="/image/TSG_Platforms_web/cutout-button,,00ccff,98,4"/>
+ <div>
+ <h1>Jan and Ella</h1>
+ March 8th, 2008 by Peter | <a href="foo">permalink</a><br/>
+ description
+ </div>
+ </div>
+ <div class="news_sep"> </div>
+ <br/>
+ <div class="newsentry news_pixel autonews">
+ <img src="/image/TSG_Platforms_web/cutout-button,,00ccff,98,4"/>
+ <div>
+ March 8th, 2008 by Peter | <a href="foo">permalink</a><br/>
+ description
+ </div>
+ </div>
+ </td>
+ <td class="archive" id="archive-navigation" valign="top">
+ </td>
+ </tr>
+ </tbody>
+ </table>
</div>
<div id="cart_page">
More information about the Bknr-cvs
mailing list