From 520da7b85a75029830702e4e5923a0eb263c73be Mon Sep 17 00:00:00 2001
From: Tom Willemse
Date: Sun, 30 Mar 2014 23:39:39 +0200
Subject: Automatically generate blog structure from org files

---
 articles/project.el | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 114 insertions(+), 4 deletions(-)

(limited to 'articles/project.el')

diff --git a/articles/project.el b/articles/project.el
index eb1e89a..10c3354 100644
--- a/articles/project.el
+++ b/articles/project.el
@@ -1,13 +1,116 @@
 (require 'ox-publish)
+(require 'cl-lib)
+(require 'ox-rss)
 
 (load "../common.el")
 
-(setq org-publish-use-timestamps-flag t
+(cl-defstruct orgweb:post filename title date tags contents)
+
+(defun orgweb-get-permalink (entry)
+  (let ((entry-date (org-date-to-gregorian (orgweb:post-date entry))))
+    (format "%s/%s/%s/%s.html" (nth 2 entry-date) (nth 0 entry-date)
+            (nth 1 entry-date) (file-name-sans-extension
+                                (file-name-nondirectory
+                                 (orgweb:post-filename entry))))))
+
+(defun orgweb-get-date ()
+  (save-excursion
+    (goto-char (point-min))
+    (org-forward-heading-same-level 1)
+    (org-entry-get (point) "PUBDATE")))
+
+(defun orgweb-get-title ()
+  (save-excursion
+    (goto-char (point-min))
+    (org-forward-heading-same-level 1)
+    (nth 4 (org-heading-components))))
+
+(defun orgweb-get-tags ()
+  (save-excursion
+    (goto-char (point-min))
+    (when (org-forward-heading-same-level 1)
+      (org-get-tags))))
+
+(defun orgweb-get-entries ()
+  (delq nil
+        (mapcar (lambda (orgfile)
+                  (with-temp-buffer
+                    (insert-file-contents orgfile)
+                    (org-mode)
+                    (let ((date (orgweb-get-date)))
+                      (when date
+                        (make-orgweb:post
+                         :filename orgfile
+                         :title (orgweb-get-title)
+                         :date date
+                         :tags (orgweb-get-tags)
+                         :contents (buffer-substring-no-properties
+                                    (point-min) (point-max)))))))
+                (directory-files "/home/slash/projects/orgweb/articles"
+                                 t "^[^.].*\\.org$"))))
+
+(defun orgweb-get-sorted-entries ()
+  (sort (orgweb-get-entries)
+        (lambda (a b)
+          (not (string< (orgweb:post-date a) (orgweb:post-date b))))))
+
+(defun orgweb-link (entry &optional prefix)
+  (format "[[file:%s%s][%s]]" (or prefix "") (orgweb-get-permalink entry)
+          (orgweb:post-title entry)))
+
+(defun orgweb-shortlist (entries)
+  (with-temp-buffer
+    (mapc (lambda (entry)
+            (insert "* " (orgweb-link entry "articles/") " "
+                    (orgweb:post-date entry) "\n"))
+          entries)
+    (write-file "shortlist.org")))
+
+(defun orgweb-list (entries)
+  (with-temp-buffer
+    (insert "#+TITLE:\n#+OPTIONS: toc:nil\n\n")
+    (mapc (lambda (entry)
+            (insert
+             (with-temp-buffer
+               (insert (orgweb:post-contents entry))
+               (org-mode)
+               (goto-char (point-min))
+               (org-forward-heading-same-level 1)
+               (org-set-property "RSS_PERMALINK"
+                                 (concat "articles/" (orgweb-get-permalink entry)))
+               (let ((heading-start (point)))
+                 (forward-paragraph)
+                 (newline)
+                 (insert (format "[[file:%s][Read more]]"
+                                 (orgweb-get-permalink entry)))
+                 (buffer-substring-no-properties
+                  heading-start (point))))
+             "\n\n")
+            (let* ((gdate (org-date-to-gregorian
+                           (orgweb:post-date entry)))
+                   (date-tree (format "_build/%s/%s/%s"
+                                      (nth 2 gdate)
+                                      (nth 0 gdate)
+                                      (nth 1 gdate))))
+              (mkdir date-tree :with-parents)
+              (copy-file (orgweb:post-filename entry) date-tree t)))
+          entries)
+    (write-file "_build/index.org")))
+
+(defun orgweb-prepare ()
+  (let ((entries (delete nil (cl-subseq (orgweb-get-sorted-entries) 0 6))))
+    (mkdir "_build" :without-error)
+    (orgweb-shortlist entries)
+    (orgweb-list entries)))
+
+(setq org-publish-use-timestamps-flag nil
+      org-rss-extension "rss"
       org-publish-project-alist
       '(("blog"
-         :base-directory "./"
+         :preparation-function orgweb-prepare
+         :base-directory "_build/"
          :publishing-directory "../_publish/articles/"
-         :recursive nil
+         :recursive t
          :base-extension "org"
          :publishing-function org-html-publish-to-html
          :section-numbers nil
@@ -15,4 +118,11 @@
          :html-doctype "<!DOCTYPE html>"
          :html-head "<link rel=\"stylesheet\" media=\"screen\" href=\"http://openfontlibrary.org/face/cosmic-sans-neue-mono\" type=\"text/css\" />\n<link href=\"https://ryuslash.org/org.css\" type=\"text/css\" rel=\"stylesheet\" />"
          :html-link-up "../blog.html"
-         :html-link-home "/")))
+         :html-link-home "/")
+        ("rss"
+         :base-directory "_build/"
+         :publishing-directory "../_publish/articles/"
+         :base-extension ""
+         :publishing-function org-rss-publish-to-rss
+         :include ("index.org")
+         :html-link-home "https://ryuslash.org")))
-- 
cgit v1.2.3-54-g00ecf