[bknr-cvs] hans changed trunk/

BKNR Commits bknr at bknr.net
Tue Jul 29 22:25:41 UTC 2008


Revision: 3683
Author: hans
URL: http://bknr.net/trac/changeset/3683

Checkpoint Quickhoney.
Added archive to RSS feed class.

U   trunk/bknr/modules/text/blog.lisp
U   trunk/bknr/web/src/packages.lisp
U   trunk/bknr/web/src/rss/rss.lisp
U   trunk/projects/quickhoney/src/image.lisp
U   trunk/projects/quickhoney/src/packages.lisp
A   trunk/projects/quickhoney/src/twitter.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/modules/text/blog.lisp
===================================================================
--- trunk/bknr/modules/text/blog.lisp	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/bknr/modules/text/blog.lisp	2008-07-29 22:25:41 UTC (rev 3683)
@@ -16,7 +16,7 @@
    (articles :update :initform nil)
    (owners :update :initform nil)))
 
-(defmethod rss-channel-items ((blog blog))
+(defmethod rss-channel-items ((blog blog) &key)
   (blog-articles blog))
 
 (defmethod print-object ((object blog) stream)

Modified: trunk/bknr/web/src/packages.lisp
===================================================================
--- trunk/bknr/web/src/packages.lisp	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/bknr/web/src/packages.lisp	2008-07-29 22:25:41 UTC (rev 3683)
@@ -33,6 +33,8 @@
 	   #:rss-channel-image
 	   #:rss-channel-textinput
 	   #:rss-channel-items
+           #:rss-channel-archive
+           #:rss-channel-archived-months
 	   #:rss-channel-xml
 
 	   ;; item

Modified: trunk/bknr/web/src/rss/rss.lisp
===================================================================
--- trunk/bknr/web/src/rss/rss.lisp	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/bknr/web/src/rss/rss.lisp	2008-07-29 22:25:41 UTC (rev 3683)
@@ -21,8 +21,10 @@
    (path :update :initform nil)
    (description :update :initform nil)
    (last-update :update :initform (get-universal-time))
-   (max-item-age :update :initform (* 4 7 24 60 60))
-   (items :update :initform nil))
+   (max-item-age :update
+                 :initform 28
+                 :documentation "default maximum item age in days")
+   (items :none :initform nil))
   (:documentation "RSS-CHANNEL models one rss channel.  Items are
 added to a channel by deriving other persistent classes from the mixin
 class RSS-ITEM.  When an object of such a derived class is created, it
@@ -60,7 +62,8 @@
 
 (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))))
+  (setf (slot-value channel 'items)
+        (remove-if #'object-destroyed-p (rss-channel-items channel))))
 
 ;; Mixin for items
 
@@ -108,16 +111,42 @@
                                        (rss-channel-items channel)))
             (rss-item-xml item)))))))
 
-(defgeneric rss-channel-items (channel)
+(defun days-from-query-parameter ()
+  (when (boundp 'hunchentoot:*request*)
+    (let ((days-string (bknr.web:query-param "days")))
+      (when days-string
+        (parse-integer days-string)))))
+
+(defun rss-channel-archive (channel)
+  "Return the channel archive consisting of lists of lists ((MONTH YEAR) ITEM...)"
+  (group-on (rss-channel-items channel)
+            :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)))))
+
+(defgeneric rss-channel-items (channel &key)
   (:documentation "Return all non-expired items in channel.")
-  (:method ((channel rss-channel))
-    (let ((days (when (boundp 'hunchentoot:*request*) (bknr.web:query-param "days"))))
-      (let ((expiry-time (- (get-universal-time) (if days
-                                                     (* 60 60 25 (parse-integer days))
-                                                     (rss-channel-max-item-age channel)))))
-        (remove-if (lambda (item) (or (object-destroyed-p item)
-                                      (< (rss-item-pub-date item) expiry-time)))
-                   (slot-value channel 'items))))))
+  (:method ((channel rss-channel) &key days month)
+    (cond
+      (month
+       (cdr (find month (rss-channel-archive channel) :test #'equal)))
+      (t
+       (let* ((days (or days
+                        (days-from-query-parameter)
+                        (rss-channel-max-item-age channel)))
+              (expiry-time (- (get-universal-time) (* 60 60 25 days))))
+         (remove-if (lambda (item) (or (object-destroyed-p item)
+                                       (< (rss-item-pub-date item) expiry-time)))
+                    (slot-value channel 'items)))))))
+
+(defgeneric rss-channel-archived-months (channel)
+  (:documentation "Return a list of lists (MONTH YEAR) for which the
+  CHANNEL has archived entries.")
+  (:method (channel)
+    (mapcar #'car (rss-channel-archive channel))))
   
 (deftransaction rss-channel-cleanup (channel)
   "Remove expired items from the items list.  Can be used to reduce

Modified: trunk/projects/quickhoney/src/image.lisp
===================================================================
--- trunk/projects/quickhoney/src/image.lisp	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/projects/quickhoney/src/image.lisp	2008-07-29 22:25:41 UTC (rev 3683)
@@ -100,7 +100,7 @@
   ()
   (:metaclass persistent-class))
 
-(defmethod rss-channel-items ((channel quickhoney-rss-channel))
+(defmethod rss-channel-items ((channel quickhoney-rss-channel) &key)
   (remove-if (lambda (item)
                (and (typep item 'quickhoney-image)
                     (quickhoney-image-explicit item)))

Modified: trunk/projects/quickhoney/src/packages.lisp
===================================================================
--- trunk/projects/quickhoney/src/packages.lisp	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/projects/quickhoney/src/packages.lisp	2008-07-29 22:25:41 UTC (rev 3683)
@@ -63,4 +63,8 @@
            #:response-error))
 
 (defpackage :paypal-test
-  (:use :cl))
\ No newline at end of file
+  (:use :cl))
+
+(defpackage :twitter
+  (:use :cl)
+  (:export #:update-status))
\ No newline at end of file

Added: trunk/projects/quickhoney/src/twitter.lisp
===================================================================
--- trunk/projects/quickhoney/src/twitter.lisp	                        (rev 0)
+++ trunk/projects/quickhoney/src/twitter.lisp	2008-07-29 22:25:41 UTC (rev 3683)
@@ -0,0 +1,12 @@
+(in-package :twitter)
+
+(defparameter *authorization* '("QuickHoneyTest" "autotwitter")
+  "Authorization (USER PASSWORD) to use to identify to twitter")
+
+(defun update-status (status-string)
+  (babel:octets-to-string
+   (drakma:http-request "http://twitter.com/statuses/update.xml"
+                       :method :post
+                       :content (format nil "status=~A" status-string)
+                       :content-type "application/x-www-form-urlencoded"
+                       :basic-authorization *authorization*)))
\ No newline at end of file

Modified: trunk/projects/quickhoney/website/static/javascript.js
===================================================================
--- trunk/projects/quickhoney/website/static/javascript.js	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/projects/quickhoney/website/static/javascript.js	2008-07-29 22:25:41 UTC (rev 3683)
@@ -23,10 +23,6 @@
 
 /* current colors */
 
-var foreground_color = '000000';
-var background_color = 'ffffff';
-var link_color;
-
 /* ie 5 / mac compatibility routine */
 
 function push(array, item) {
@@ -215,49 +211,15 @@
         this.products.push(product);
         $('checkout').style.visibility = 'visible';
     }
-}
+};
 
 /* news */
 
-function loadXMLDoc(fname)
+function load_news()
 {
-    var xmlDoc;
-
-    // code for IE
-    if (window.ActiveXObject) {
-        xmlDoc = new ActiveXObject("Microsoft.XMLDOM");
-    }
-    else if (document.implementation 
-             && document.implementation.createDocument) {
-        // code for Mozilla, Firefox, Opera, etc.
-        xmlDoc = document.implementation.createDocument("","",null);
-    } else {
-        alert('Your browser cannot handle this script');
-    }
-    xmlDoc.async = false;
-    xmlDoc.load(fname);
-
-    return xmlDoc;
+    
 }
 
-function xstlTransformDocumentToElement(document, stylesheet, elementId)
-{
-    xml = loadXMLDoc(document);
-    xsl = loadXMLDoc(stylesheet);
-    if (window.ActiveXObject) {
-        // code for IE
-        ex = xml.transformNode(xsl);
-        document.getElementById(elementId).innerHTML = ex;
-    } else if (document.implementation 
-               && document.implementation.createDocument) {
-        // code for Mozilla, Firefox, Opera, etc.
-        xsltProcessor = new XSLTProcessor();
-        xsltProcessor.importStylesheet(xsl);
-        resultDocument = xsltProcessor.transformToFragment(xml,document);
-        document.getElementById(elementId).appendChild(resultDocument);
-    }
-}
-
 /* image database */
 
 var current_directory;
@@ -386,15 +348,15 @@
 
 var pages = [];
 
-function Page(elements, colors, action) {
+function Page(elements, link_color, action) {
     this.elements = elements;
-    this.colors = colors;
+    this.link_color = link_color;
     this.action = action;
 }
 
 pages['home']
     = new Page(['home_page'],
-	       ['000000', 'ffffff', '953cfd'],
+	       '953cfd',
 	       function() {
 		   footer_down();
 
@@ -410,7 +372,7 @@
 
 pages['pixel']
     = new Page(['directory_page'],
-	       ['000000', 'ffffff', 'ff00ff'],
+	       'ff00ff',
 	       function() {
 		   footer_up();
 		   directory('pixel');
@@ -418,7 +380,7 @@
 
 pages['vector']
     = new Page(['directory_page'],
-	       ['000000', 'ffffff', '00ccff'],
+	       '00ccff',
 	       function() {
 		   footer_up();
 		   directory('vector');
@@ -426,21 +388,22 @@
 
 pages['news']
     = new Page(['news_page'],
-	       ['000000', 'ffffff', '30be01'],
+	       '30be01',
 	       function() {
 		   footer_hide();
+                   load_news();
 	       });
 
 pages['shop']
     = new Page(['results'],
-	       ['000000', 'ffffff', '0054ff'],
+	       '0054ff',
 	       function() {
 		   footer_hide();
 	       });
 
 pages['cart']
     = new Page(['cart_page'],
-	       ['000000', 'ffffff', '0054ff'],
+	       '0054ff',
 	       function() {
                    show_shopping_cart();
 		   footer_hide();
@@ -448,7 +411,7 @@
 
 pages['contact']
     = new Page(['contact_page'],
-	       ['000000', 'ffffff', 'ffa200'],
+	       'ffa200',
 	       function() {
 		   footer_hide();
 
@@ -459,17 +422,6 @@
 		   current_directory = 'contact';
 	       });
 
-function change_colors(pagename, colors) {
-
-    foreground_color = colors[0];
-    background_color = colors[1];
-    link_color = colors[2];
-
-    // change text colors
-    $("body").style.backgroundColor = "#" + background_color;
-    $("body").style.color = "#" + foreground_color;
-}
-
 function display_cms_window() {
 
     if (logged_in) {
@@ -504,7 +456,6 @@
     debug('show_page ' + pagename);
 
     // Activate the menu by coloring the buttons correctly
-    change_colors(pagename, page.colors);
     $('menu').className = pagename;
     document.body.className = pagename;
 
@@ -820,7 +771,7 @@
 		+ current_directory + '/' + current_subdirectory + '/' + image.name
 		+ '" onclick="display_image(' + "'" + image.position + "'" + ');">'
 		+ '<img class="inherited_image" width="' + cell_width + '" height="' + cell_height + '" '
-		+ ' src="/image/' + image.name + '/cell,' + background_color + ',' + cell_width + ',' + cell_height + ',8" '
+		+ ' src="/image/' + image.name + '/cell,ffffff,' + cell_width + ',' + cell_height + ',8" '
 		+ ' onload="reveal_image(this);" />'
 		+ '</a>';
 	}
@@ -1143,7 +1094,7 @@
     overlay.className = current_directory;
     replaceChildNodes(overlay,
                       H1(null, title),
-                      IMG({ src: '/image/overlay-close/color,000000,' + pages[current_directory].colors[2],
+                      IMG({ src: '/image/overlay-close/color,000000,' + pages[current_directory].link_color,
                                   id: 'close', width: 13, height: 13}));
     overlay.style.width = width + 'px';
     $('close').style.left = (width - 23) + 'px';
@@ -1318,7 +1269,7 @@
 
 function recolored_image_path(name)
 {
-    return '/image/' + name + '/color,ff00ff,' + pages[current_directory].colors[2];
+    return '/image/' + name + '/color,ff00ff,' + pages[current_directory].link_color;
 }
 
 function make_image_action_button(name, action, height)

Modified: trunk/projects/quickhoney/website/static/styles.css
===================================================================
--- trunk/projects/quickhoney/website/static/styles.css	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/projects/quickhoney/website/static/styles.css	2008-07-29 22:25:41 UTC (rev 3683)
@@ -109,6 +109,8 @@
 #menu.contact a#m_contact img.selected { visibility: visible }
 #menu.contact a#m_contact img.unselected { visibility: hidden }
 
+.autonews a { color: #30be01; }
+
 #menu img.selected {
 	visibility: hidden;
         z-index: 110;
@@ -431,16 +433,18 @@
 	width: 428px;
 	height: 108px;
 	position: relative;
-	}
+}
 
 .newsentry img {
 	position: absolute;
 	top: 5px; left: 5px;
-	}
+}
+
 .newsentry div {
 	position: absolute;
 	top: 5px; left: 118px;
-	}
+}
+
 .newsentry h1 {
 	margin: 0px 0px 2px 0px;
 	font-size: 120%;
@@ -450,8 +454,7 @@
 
 .news_vector { background-color: #00ccff; }
 .news_pixel { background-color: #ff00ff; }
-.news_pixel a { background-color: #ff00ff; }
-
+.autonews a { color: white }
 div.news_sep { width: 428px; height: 17px; background-image: url(/image/news-sep); }
 
 /* cms styles */

Modified: trunk/projects/quickhoney/website/templates/index.xml
===================================================================
--- trunk/projects/quickhoney/website/templates/index.xml	2008-07-29 20:25:57 UTC (rev 3682)
+++ trunk/projects/quickhoney/website/templates/index.xml	2008-07-29 22:25:41 UTC (rev 3683)
@@ -131,7 +131,7 @@
       
       <div id="news_page">
         <p id="news_content">
-          <div class="newsentry news_vector">
+          <div class="newsentry news_vector autonews">
             <img src="/image/TSG_Platforms_web/cutout-button,,00ccff,98,4"/>
             <div>
               <h1>Jan and Ella</h1>
@@ -141,7 +141,7 @@
           </div>
           <div class="news_sep"> </div>
           <br/>
-          <div class="newsentry news_pixel">
+          <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/>




More information about the Bknr-cvs mailing list