From 429c80253e6afa094349859b6c542a0eb67fe8ec Mon Sep 17 00:00:00 2001
From: clinton <clinton@unknownlamer.org>
Date: Sat, 27 Sep 2008 19:29:10 +0000
Subject: [PATCH] Initialize Repository

---
 books.lisp            |  79 ++++++++++++++
 rss.lisp              | 240 ++++++++++++++++++++++++++++++++++++++++++
 templates/footer.html |  31 ++++++
 templates/header.html |  29 +++++
 update-rss-binary     |   3 +
 update.sh             |  19 ++++
 6 files changed, 401 insertions(+)
 create mode 100644 books.lisp
 create mode 100644 rss.lisp
 create mode 100644 templates/footer.html
 create mode 100644 templates/header.html
 create mode 100644 update-rss-binary
 create mode 100644 update.sh

diff --git a/books.lisp b/books.lisp
new file mode 100644
index 0000000..b7c537f
--- /dev/null
+++ b/books.lisp
@@ -0,0 +1,79 @@
+;; (((author name as symbols)
+;;   "description"
+;;   ("book name" :fiction-or-nonfiction rating/10 "description")))
+
+(asdf:oos 'asdf:load-op :split-sequence)
+
+(in-package :cl-user)
+
+(defparameter *book-pathname*
+  #p"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")
+
+(defparameter *muse-pathname*
+  #p"/home/clinton/html/muse/site/unknownlamer.org-repo/Book List.muse")
+
+;; need to collapse whitespace in descriptions
+
+;; (defun collapse-whitespace (string)
+;;   (format nil "~{~A ~}"
+;; 	  (split-sequence:split-sequence-if
+;; 	   (lambda (char) (member char '(#\space #\newline))) string
+;; 	   :remove-empty-subseqs t)))
+
+(defun collapse-whitespace (string)
+  string)
+
+
+(defun print-book-entry (book &optional (stream t))
+  (labels ((ratings-stars (rating)
+	     (labels ((stars (rating)
+			(if (> rating 0)
+			    (make-string rating :initial-element #\bullet)
+			    nil)))
+	       (when rating
+		 (format nil "<class name=\"rating-good\">~A</class>~@[<class name=\"rating-bad\">~A</class>~] (~A)"
+			 (stars rating) (stars (- 10 rating)) rating)))))
+    (destructuring-bind (title fiction? rating description)
+	book
+      (format stream "** ~A~%~%~@[*Rating:* ~A / ~]*~A*~%~%~A~%~%"
+	      title
+	      (ratings-stars rating)
+	      (case fiction?
+		(:fiction "Fiction")
+		(:nonfiction "Nonfiction"))
+	      (collapse-whitespace description)))))
+
+(defun print-author-entry (entry &optional (stream t))
+  (destructuring-bind (author description &rest books)
+      entry
+    (format stream "* ~{~A ~}~%~%~A~%~%"
+	    author (collapse-whitespace description))
+    (mapc (lambda (book) (print-book-entry book stream)) books)))
+
+(defun print-book-database (all-books &optional (stream t))
+  (format stream "#title A Not So Fancy Listing of Books~%~%")
+  (mapc (lambda (author) (print-author-entry author stream))
+	all-books))
+
+(defun print-sorted-book-database (all-books &optional (stream t))
+  (print-book-database (sort (copy-list all-books)
+			     (lambda (name-1 name-2)
+			       ;; obviously fails to sort properly
+			       ;; when two authors have the same last
+			       ;; name
+			       (string< (symbol-name name-1)
+					(symbol-name name-2)))
+			     :key (lambda (entry) (car (last (car entry)))))
+		       stream))
+
+(defun dump-muse-books-file (&optional (muse-path *muse-pathname*)
+			               (book-path *book-pathname*))
+  (with-open-file (muse-stream muse-path
+			       :direction :output
+			       :element-type 'extended-char
+			       :if-exists :overwrite
+			       :if-does-not-exist :create)
+    (print-sorted-book-database
+     (with-open-file (book-stream book-path :element-type 'extended-char)
+       (read book-stream))
+     muse-stream)))
\ No newline at end of file
diff --git a/rss.lisp b/rss.lisp
new file mode 100644
index 0000000..00e44e1
--- /dev/null
+++ b/rss.lisp
@@ -0,0 +1,240 @@
+(if (not (find-package :swank))
+    (asdf:oos 'asdf:load-op :swank))
+
+(mapc (lambda (system) (asdf:oos 'asdf:load-op system))
+      '(:cxml :cxml-stp :arnesi :cl-ppcre 
+	:xml-emitter :local-time :cl-fad :split-sequence))
+
+(defpackage :org.unknownlamer.rss-feed
+  (:nicknames :ul-rss)
+  (:use :cl :xml-emitter)
+  (:import-from :arnesi :if-bind :when-bind :escape-as-uri :curry :compose)
+  (:import-from :split-sequence :split-sequence)
+  (:export :darcs->feed :run))
+
+(in-package :org.unknownlamer.rss-feed)
+
+(defparameter *repo-path*
+  (make-pathname
+   :directory "afs/hcoop.net/user/c/cl/clinton/darcs/unknownlamer.org"))
+
+(defparameter *rss-path*
+  (make-pathname
+   :directory "afs/hcoop.net/user/c/cl/clinton/feeds/rss"
+   :name "site-updates"))
+
+(defparameter *muse-file-scanner*
+    (ppcre:create-scanner "(.+)\\.muse"))
+
+(defparameter *special-files*
+  '(("book-list.lisp" . "Book List")))
+
+;;; Parse darcs xml changelog
+
+;;; structure
+;; (changelog
+;;  (patch
+;;   :author :date :local_date
+;;   (name PATCH-NAME)
+;;   (comment PATCH-COMMENT)
+;;   (summary
+;;    (add_file FILE-NAME)
+;;    (modify_file FILE-NAME
+;; 		(removed_lines :num)
+;; 		(added_lines :num)))))
+
+(defun darcs-changes->stp (stream)
+  (cxml:parse-stream
+   stream
+   (cxml:make-whitespace-normalizer (stp:make-builder))))
+
+(defun find-child-named (child-name parent-node)
+  (stp:find-child-if (lambda (node)
+		       (and (typep node 'stp:element)
+			    (string= (stp:local-name node) child-name)))
+		     parent-node))
+
+(defun filter-children-by-name (child-name parent-node)
+  (stp:filter-children (lambda (node)
+			 (and (typep node 'stp:element)
+			      (string= (stp:local-name node) child-name)))
+		       parent-node))
+
+(defun darcs-stp->parsed-list (document)
+  ;; What must be done: load darcs changes xml, iterate over patches,
+  ;; generate a simpler structure storing (NAME ID DATE COMMENT CHANGES)
+  ;; where COMMENT may be nil and CHANGES is another list of sublists
+  ;; ((ADDED ...) (CHANGED ...)). Deletions may be ignored for now.
+  (map 'list
+       (lambda (patch)
+	 (list (stp:string-value (find-child-named "name" patch))
+	       (stp:attribute-value patch "date")
+	       (stp:attribute-value patch "hash")
+	       (when-bind comment (find-child-named "comment" patch)
+		 (stp:string-value comment))
+	       (let ((summary (find-child-named "summary" patch)))
+		 (list
+		  (cons :added
+			(map 'list
+			     (compose (curry #'string-trim
+							   '(#\space #\newline))
+					     #'stp:string-value)
+			     (filter-children-by-name "add_file" summary)))
+		  (cons :changed
+			(map 'list
+			     (compose (curry #'string-trim
+							   '(#\space #\newline))
+					     #'stp:string-value)
+			     (filter-children-by-name "modify_file" summary)))))))
+       (filter-children-by-name "patch"
+			      (stp:first-child document))))
+
+;;; Parsed changelog accessors
+
+(defun patch-name (patch)
+  (first patch))
+
+(defun patch-date (patch)
+  (second patch))
+
+(defun patch-hash (patch)
+  (third patch))
+
+(defun patch-comment (patch)
+  (fourth patch))
+
+(defun patch-added-files (patch)
+  (cdr (first (fifth patch))))
+
+(defun patch-changed-files (patch)
+  (cdr (second (fifth patch))))
+
+;;; Feed generation
+
+(defun muse-path->html-url (potential-muse-path)
+  ;; When generating the RSS only *.muse files should have links and
+  ;; these should be translated to the corresponding html
+  (when-bind basename (or (ppcre:register-groups-bind (basename)
+			      (*muse-file-scanner* potential-muse-path)
+			    basename)
+			  (cdar (member potential-muse-path *special-files*
+				       :key #'car :test #'string=)))
+    (format nil "http://unknownlamer.org/muse/~A.html"
+	    (escape-as-uri basename))))
+
+(defun darcs-time->local-time (timestring)
+  ;; YYYYMMDDHHMMSS UTC
+  (local-time:universal-to-timestamp 
+   (encode-universal-time (parse-integer timestring :start 12 :end 14)
+			  (parse-integer timestring :start 10 :end 12)
+			  (parse-integer timestring :start 8 :end 10)
+			  (parse-integer timestring :start 6 :end 8)
+			  (parse-integer timestring :start 4 :end 6)
+			  (parse-integer timestring :start 0 :end 4)
+			  0)))
+
+(defun darcs-time->pubdate (darcs-time)
+  ;; this seems to be correct but at least liferea is taking my time
+  ;; and substracting the tz offset from it ... what the fuck
+  (let ((local-time (darcs-time->local-time darcs-time)))
+    (local-time:format-timestring
+     nil local-time
+     :format '(:short-weekday ", "
+	       (:day 2) #\space :short-month #\space (:year 4) #\space
+	       (:hour 2) #\: (:min 2) #\: (:sec 2) #\space :timezone))))
+
+(defun darcs-hash->guid (hash)
+  (format
+   nil
+   "http://unknownlamer.org/darcsweb/browse?r=unknownlamer.org;a=commit;h=~A"
+   hash))
+
+(defun file-link (file)
+  (with-tag ("li")
+    (with-tag ("p")
+      (if-bind muse-url (muse-path->html-url file)
+	(simple-tag "a" file `(("href" ,muse-url)))
+	(xml-out file)))))
+
+(defun generate-entry-html (patch)
+  (with-output-to-string (string-stream)
+    ;; EVIL, but ... I don't feel like modifying the xml-emitter lib
+    (let ((xml-emitter::*xml-output-stream* string-stream))
+      (when-bind comment (patch-comment patch)
+	(with-tag ("p")
+	  (xml-out comment)))
+      (when-bind added-files (patch-added-files patch)
+	(simple-tag "h2" "New Files")
+	(with-tag ("ul")
+	  (dolist (file added-files)
+	    (file-link file))))
+      (when-bind changed-files (patch-changed-files patch)
+	(simple-tag "h2" "Modified Files")
+	(with-tag ("ul")
+	  (dolist (file changed-files)
+	    (file-link file)))))))
+
+(defun generate-feed (entries stream)
+  (with-rss2 (stream :encoding "UTF-8")
+    (rss-channel-header "The Home of Your Friendly Neighborhood Terrorist"
+			"http://unknownlamer.org"
+			:description "Updates to Clinton Ebadi's personal website")
+    (dolist (entry entries)
+      (rss-item (patch-name entry)
+		:description (generate-entry-html entry)
+		:guid (darcs-hash->guid (patch-hash entry)) ; fix guid
+		:pubdate (darcs-time->pubdate (patch-date entry))))))
+
+;;; Call darcs
+
+(defun darcs-changelog-stream ()
+  (let ((files (append
+		(let ((dirlist (fad:list-directory
+				*repo-path*))
+		      (wild-path (make-pathname :type "muse")))
+		  (mapcan (lambda (path)
+			    (if (pathname-match-p path wild-path)
+				(list path)))
+			  dirlist))
+		(mapcar (lambda (file)
+			  ;; note: assumes only one . in the filename
+			  ;; (this is true ... for now)
+			  (let ((split-file (split-sequence #\. (car file))))
+			    (merge-pathnames 
+			     (make-pathname :name (first split-file)
+					    :type (second split-file))
+			     *repo-path*)))
+			*special-files*))))
+    (sb-ext:process-output
+     (sb-ext:run-program "darcs"
+			 `("changes" "--xml" "--summary"
+				     ,(format nil "--repodir=~A" *repo-path*)
+				     "--only-to-files" ,@(mapcar
+							  #'namestring files))
+			 :search t
+			 :output :stream
+			 :wait t))))
+
+
+;;; Public Interface
+
+(defun firstn (n list)
+  ;; yeah yeah really shitty whatever
+  (loop for i from 0 to n collect (nth i list)))
+
+(defun stream->feed (input-stream output-stream)
+  (generate-feed
+   (firstn 15
+	   (darcs-stp->parsed-list (darcs-changes->stp input-stream)))
+   output-stream))
+
+(defun darcs->feed ()
+  (with-open-file (rss-out *rss-path*
+			   :direction :output
+			   :if-exists :supersede
+			   :if-does-not-exist :create)
+    (stream->feed (darcs-changelog-stream) rss-out)))
+
+(defun run ()
+  (darcs->feed)
+  (sb-ext:quit))
\ No newline at end of file
diff --git a/templates/footer.html b/templates/footer.html
new file mode 100644
index 0000000..e16077a
--- /dev/null
+++ b/templates/footer.html
@@ -0,0 +1,31 @@
+  <!-- Page published by Emacs Muse ends here -->
+
+  <p class="cke-buttons">
+    <!-- validating badges, any browser, etc -->
+    <a href="http://validator.w3.org/check/referer"><img
+	src="http://www.w3.org/Icons/valid-xhtml10"
+	alt="Valid XHTML 1.0!" /></a>
+    
+    <a href="http://www.anybrowser.org/campaign/"><img
+	src="img/buttons/w3c_ab.png" alt="[ Viewable With Any Browser
+	]" /></a>
+
+    <a href="http://www.debian.org/"><img
+	src="img/buttons/debian.png" alt="[ Powered by Debian ]" /></a>
+    
+    <a href="http://hcoop.net/">
+      <img src="img/buttons/hcoop.png" 
+	alt="[ Hosted by HCoop]" />
+    </a>
+
+    <a href="http://www.fsf.org/register_form?referrer=114">
+      <img src="img/buttons/fsf_member.png"
+	alt="[ FSF Associate Member ]" />
+    </a>
+  </p>
+
+<p class="cke-footer"><lisp>(cke-muse-randomsig-signature)</lisp></p>
+<p class="cke-timestamp">Last Modified:
+    <lisp>(muse-publishing-directive "date")</lisp></p>
+  </body>
+</html>
\ No newline at end of file
diff --git a/templates/header.html b/templates/header.html
new file mode 100644
index 0000000..54c1f31
--- /dev/null
+++ b/templates/header.html
@@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="<lisp>(muse-html-encoding)</lisp>" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+  <head>
+    <title><lisp>
+  (concat (muse-publishing-directive "title")
+          (let ((author (muse-publishing-directive "author")))
+            (if (not (string= author (user-full-name)))
+                (concat " (by " author ")"))))</lisp></title>
+    <meta name="generator" content="muse.el" />
+    <meta http-equiv="<lisp>muse-html-meta-http-equiv</lisp>"
+          content="<lisp>muse-html-meta-content-type</lisp>" />
+    <link href="http://feeds.unknownlamer.org/rss/site-updates" 
+          rel="alternate" type="application/rss+xml" title="Updates Feed" />
+
+<lisp>
+      (muse-style-element :style-sheet muse-publishing-current-style)
+    </lisp>
+  </head>
+  <body>
+    <h1><lisp>
+  (concat (muse-publishing-directive "title")
+          (let ((author (muse-publishing-directive "author")))
+            (if (not (string= author (user-full-name)))
+                (concat " (by " author ")"))))</lisp></h1>
+   <lisp>(muse-html-insert-contents 3)</lisp>
+
+<!-- Page published by Emacs Muse begins here -->
\ No newline at end of file
diff --git a/update-rss-binary b/update-rss-binary
new file mode 100644
index 0000000..eb69929
--- /dev/null
+++ b/update-rss-binary
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+sbcl --load rss.lisp --eval "(save-lisp-and-die \"update-site-rss\" :executable t :toplevel #'ul-rss:run)"
\ No newline at end of file
diff --git a/update.sh b/update.sh
new file mode 100644
index 0000000..01f90ad
--- /dev/null
+++ b/update.sh
@@ -0,0 +1,19 @@
+#!/bin/sh
+
+#(cd src/unknownlamer.org && darcs add *.muse; darcs whatsnew && darcs record --all)
+
+(cd site/unknownlamer.org-repo && darcs pull)
+
+clisp -i ./books.lisp -x '(dump-muse-books-file)'
+
+if [ "$1" = "--force" ]; then
+    emacsclient --eval '(muse-project-publish "unknownlamer.org-clean" t)'
+else
+    emacsclient --eval '(muse-project-publish "unknownlamer.org-clean")'
+fi
+
+cd site/unknownlamer.org
+darcs pull ../unknownlamer.org-repo
+find . -name \* -print0 | xargs -0 darcs add
+darcs record --all
+darcs push /afs/hcoop.net/user/c/cl/clinton/public_html/unknownlamer.org/www/muse
\ No newline at end of file
-- 
2.20.1