Automatically generate blog structure from org files

6 files changed, 118 insertions, 74 deletions

diff --git a/articles/.gitignore b/articles/.gitignore
new file mode 100644
index 0000000..b8103a1
--- /dev/null
+++ b/articles/.gitignore
@@ -0,0 +1 @@
+shortlist.org
diff --git a/articles/_build/.gitignore b/articles/_build/.gitignore
new file mode 100644
index 0000000..d6b7ef3
--- /dev/null
+++ b/articles/_build/.gitignore
@@ -0,0 +1,2 @@
+*
+!.gitignore
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")))
diff --git a/blog.org b/blog.org
deleted file mode 100644
index 3975273..0000000
--- a/blog.org
+++ /dev/null
@@ -1,52 +0,0 @@
-#+TITLE:
-#+OPTIONS: toc:nil
-#+STARTUP: showall
-#+HTML_LINK_UP: ./
-#+RSS_EXTENSION: rss
-
-# * Python mixins                                        :python:coding:
-#   :PROPERTIES:
-#   :PUBDATE:  <2013-11-10 Sun 15:35>
-#   :RSS_PERMALINK: articles/python-mixins.html
-#   :END:
-#   A little explanation of one of the things that I think make Mixins
-#   in Python an interesting idea.
-
-#   [[file:articles/python-mixins.org][Read]]
-
-* Mounting music dir before MPD                   :systemd:mpd:config:
-  :PROPERTIES:
-  :RSS_PERMALINK: articles/mounting_music_dir_before_mpd.html
-  :PUBDATE:  <2013-11-24 Sun 14:03>
-  :END:
-  I use an NFS drive to store my music files, which I don't mount by
-  default (to keep startup fast). It was a pain to have to mount the
-  drive manually each time before starting MPD. [[file:articles/mounting_music_dir_before_mpd.org][Read]]
-
-* rlwrapping sbcl                                  :sbcl:lisp:utility:
-  :PROPERTIES:
-  :RSS_PERMALINK: articles/rlwrapping_sbcl.html
-  :PUBDATE:  <2013-10-06 13:02>
-  :END:
-  A useful addition to SBCL. [[file:articles/rlwrapping_sbcl.org][Read]]
-
-* C-d to close eshell                      :eshell:emacs:elisp:config:
-  :PROPERTIES:
-  :PUBDATE:  <2013-08-17 2:25>
-  :RSS_PERMALINK: articles/c-d_to_close_eshell.html
-  :END:
-  A little trick to improve your eshell experience. [[file:articles/c-d_to_close_eshell.org][Read]]
-
-* Some quick git diff tips           :org:lisp:hy:elisp:scheme:config:
-  :PROPERTIES:
-  :RSS_PERMALINK: articles/some_quick_git_diff_tips.html
-  :PUBDATE:  <2013-08-11 0:54>
-  :END:
-  Making git see more diff. [[file:articles/some_quick_git_diff_tips.org][Read]]
-
-* Notstumpwm                                    :notion:wm:lua:config:
-  :PROPERTIES:
-  :RSS_PERMALINK: articles/notstumpwm.html
-  :PUBDATE:  <2013-05-24 0:10>
-  :END:
-  Pretending Notion is (like) stumpwm. [[file:articles/notstumpwm.org][Read]]
diff --git a/index.org b/index.org
index 085f415..872fc4e 100644
--- a/index.org
+++ b/index.org
@@ -7,17 +7,7 @@
 
   Some thoughts I may have had, and was foolish enough to write down.
 
-  #+BEGIN_SRC emacs-lisp :exports results :results value raw
-    (apply
-     #'concat
-     (with-current-buffer (find-file-noselect "blog.org")
-       (org-map-entries
-        (lambda ()
-          (format "* [[file:%s][%s]] %s\n"
-                  (org-entry-get (point) "RSS_PERMALINK")
-                  (nth 4 (org-heading-components))
-                  (org-entry-get (point) "PUBDATE"))))))
-  #+END_SRC
+#+INCLUDE: articles/shortlist.org
 
 * Projects
 
diff --git a/project.el b/project.el
index 8f9cbc6..0d8c194 100644
--- a/project.el
+++ b/project.el
@@ -162,11 +162,4 @@
          :table-of-contents 1
          :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-home "https://ryuslash.org")
-        ("rss"
-         :base-directory "./"
-         :publishing-directory "_publish/"
-         :base-extension ""
-         :publishing-function org-rss-publish-to-rss
-         :include ("blog.org")
          :html-link-home "https://ryuslash.org")))