orgweb/articles/project.el

(require 'ox-publish)
(require 'cl-lib)
(require 'ox-rss)

(load "../common.el")

(cl-defstruct orgweb:post filename title date tags contents draft)

(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-draft ()
  (save-excursion
    (goto-char (point-min))
    (org-forward-heading-same-level 1)
    (org-entry-get (point) "DRAFT")))

(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))
                         :draft (orgweb-get-draft))))))
                (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)
            (unless (orgweb:post-draft 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)
            (unless (orgweb:post-draft 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"
         :preparation-function orgweb-prepare
         :base-directory "_build/"
         :publishing-directory "../_publish/articles/"
         :recursive t
         :base-extension "org"
         :publishing-function org-html-publish-to-html
         :section-numbers nil
         :with-toc nil
         :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 "/")
        ("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")))