m13o

2021-03-14 Sun 13:35
同一タグのある記事をまとめるEmacs orgmode

このblogサイトはorg-modeで記述したものをorg-publishでhtml化しているわけですが, headlineに付けているタグの記事をまとめてorg文書化, それをorg-publishでhtmlにするという仕組みを個人的には一定納得いく形にできたので, 今回はその仕組みについて記述します.

私はこのサイトでblogのヘッドラインを書く時に, 以下のルールを設けています.

  • トップレベルヘッドラインはタイトルと記事の公開日, タグのみとする
  • トップレベル以外のヘッドラインにはタグを付けない
  • TODOやPriorityなども公開する記事には付けない
  • 文書の一番最初のヘッドラインのみがトップレベルヘッドライン

そのため, このルールに則ったtagの収集ができれば良い事になります. また, 同一タグをまとめたページに必要となる要素は,

  • タグ名
  • 記事のタイトル
  • 記事の公開日(ソート用)
  • 記事のURL

ですので, まずはこれらの情報を収集する関数と保持する変数を定義します.

(defvar blog-tags-alist nil)
(defun add-to-blog-tags-alist (key title path date)
  "Add path to tags-alist.  `KEY' is alist's key.  `PATH' is key's file path.  `TITLE' is title.  `DATE' is date."
  (let* ((found-alist (assoc key blog-tags-alist))
         (plist `(:title ,title :path ,path :date ,date)))
    (when found-alist
      (setq plist `(,plist ,@(cdr found-alist)))
      (push `(,key ,@plist) blog-tags-alist))
    (unless found-alist
      (push `(,key ,plist) blog-tags-alist))))

blog-tags-alistはtag名をkeyに記事の情報を持つplistをvalueとするalistです. add-to-blog-tags-alistは, 引数に渡されたkeyを元に, title, path, dateをそのkeyに関連付いたplistを構築し, blog-tags-alistに格納します.

このadd-to-blog-tags-alistを呼び出す場所ですが, 当初は以下のように ox-html.elにある org-html–tags をカスタム関数でoverrideして呼び出すようにしていました.

(defun my-org-html--tags (tags info)
  "Override 'org-html--tags'.  `TAGS' is tag list.  `INFO' is plist containting export options."
  (when tags
    (let* ((title (car (plist-get info :title)))
           (output-file (format "%s" (plist-get info :output-file)))
           (date (plist-get (cadar (plist-get info :date)) :raw-value)))
      (dolist (tag tags)
        (add-to-blog-tags-alist tag title (file-name-nondirectory output-file) date))
      (format "<span class=\"tag\">%s</span>"
              (mapconcat
               (lambda (tag)
                 (format "<span class=\"%s\"><a href=\"%s.html\">%s</a></span>"
                         (concat (plist-get info :html-tag-class-prefix)
                                 (org-html-fix-class-name tag))
                         tag
                         tag))
               tags "&#xa0;")))))
(advice-add #'org-html--tags :override #'my-org-html--tags)

これでタグの収集と事前にタグへのリンクをblog記事に仕込めはするのですが, org-html–tags関数は限りなくprivate感漂う関数で, あまり良い方法ではないと思っていたので, 他の方法を探していた処, org-export系は出力時にfilter関数をユーザーが登録できる事を思い出しました.

というわけで, headlineを処理する際のfilterを利用して, tagの収集を行います.

(defun my-html-export-collect-tags-from-headline-filter (headline backend info)
  "The function is flter.  `HEADLINE' is headline.  `BACKEND' is backend.  `INFO' is info."
  (when (org-export-derived-backend-p backend 'html)
    (let* ((beg (next-property-change 0 headline))
           (parent (when beg (plist-get (text-properties-at beg headline) :parent)))
           (tags (when parent (org-element-property :tags parent))))
      (when tags
        (let* ((title (cdr (org-element-property :title parent)))
               (date (plist-get (cadar (plist-get info :date)) :raw-value))
               (output (plist-get info :output-file)))
          (dolist (tag tags)
            (add-to-blog-tags-alist tag (car title) (file-name-nondirectory output) date))))))
  headline)

(add-to-list 'org-export-filter-headline-functions 'my-html-export-collect-tags-from-headline-filter)

若干複雑になってしまったのですが, headlineはテキストプロパティとして渡ってくるようなので, テキストプロパティを走査してタグ情報を探します. それがみつかったら, タイトル, 日付, 出力ファイル名も取得し, alitとして保存します. この処理を行う関数をorg-export-filter-headline-functionsにadd-to-listすれば, org-publish中にfilter関数が呼び出されるようになります.

ただし, このfilter関数ではblog記事のトップレベルヘッドラインにあるタグをリンクに変更する事までは担えないので, 別のfilterを用意します. htmlとして出力する場合, headlineの出力生成時に, org-html-format-headline-functionが呼び出されるのですが, これは関数を保持する変数となっており, ユーザーによる差し替えが想定されています. デフォルトでは org-html-format-headline-default-function が設定されているので, これをカスタム関数に差し替えます.

(defun my-html-format-headline-function (todo todo-type priority text tags info)
  "Default format function for a headline.
See `org-html-format-headline-function' for details."
  (let ((result (org-html-format-headline-default-function todo todo-type priority text tags info)))
    (when tags
      (dolist (tag tags)
        (setq result (replace-regexp-in-string (format "<span\s+class=\"%s\">%s</span>" tag tag)
                                               (format "<span class=\"%s\"><a href=\"%s.html\">%s</a></span>" tag (downcase tag) tag)
                                               result))))
    result))

(setq org-html-format-headline-function #'my-html-format-headline-function)

org-htmlが用意しているdefault関数を呼び出し, その後, tagsがあるなら, 正規表現でマッチする場所にリンク要素のhtmlを差し込むようにします.

さて, tagの収集まではできましたが, 収集したtag毎の一覧記事が生成されていません. それを生成する関数を用意します. 構造としては他のorg文書と同じような形で良さそうなので, トップヘッドラインにタグ名を, 2番目のヘッドライン以降で記事の一覧を記述するようにします.

(defun my-prepare-tags ()
  "Prepare tag site."
  (let* ((keys (sort (remove-duplicates (mapcar (lambda (lst)
                                                  (car lst))
                                                blog-tags-alist)
                                        :test #'string=)
                     #'string<)))
    (dolist (key keys)
      (let* ((plist (assoc-default key blog-tags-alist #'string=))
             (filename (expand-file-name (format "%s.org" (downcase key)) "./tags")))
        (save-current-buffer
          (set-buffer (create-file-buffer filename))
          (erase-buffer)
          (goto-char (point-min))
          (insert (format "#+TITLE: %s\n#+OPTIONS: ^:{}\n"
                          key))
          (insert "* {{{title}}}\n")
          (setq plist (reverse (sort plist (lambda (elem &rest rest)
                                             (time-less-p (date-to-time (plist-get elem :date))
                                                          (date-to-time (plist-get (car rest) :date)))))))
          (dolist (elem plist)
            (insert (format "** %s [[https://m13o.net/%s][%s]]\n"
                            (plist-get elem :date)
                            (plist-get elem :path)
                            (plist-get elem :title))))
          (write-region (point-min) (point-max) filename))))))

これを, blog記事のorg-publishした後で呼び出せば, tagsというディレクトリの中に, タグ毎の記事一覧のorg文書を生成されるようになります.

最後に, このtag毎の記事一覧をhtml化しましょう. org-publish-project-alist にtags用の設定を追記します.

(setq org-publish-project-alist
   '(
     ;; ......
     ("tags"
      :base-directory "./tags"
      :base-extension "org"
      :html-viewport nil
      :publishing-directory "./publish"
      :publishing-function org-html-publish-to-html
      :language "ja"
      :recursive t
      :auto-sitemap nil
      :htmlized-source t
      :with-author nil
      :with-creator nil
      :with-email nil
      :with-date t
      :with-timestamps nil
      :with-toc nil
      :with-title nil
      :section-numbers nil
      )))

他にも必要な設定があれば追加します. これで準備が整ったので,

(org-publish "tags" t nil)

する事でtag毎の記事一覧がhtml出力されるようになりました.

私は一覧の流れを以下のような関数にまとめ,

(defun publish-site ()
  "Publish org file to html."
  (org-publish "website" t nil) ;; blog記事や静的アセットなどを出力
  (my-prepare-tags) ;; tag毎の記事一覧org文書作成
  (org-publish "tags" t nil)) ;; tag毎の記事一覧org文書をhtml化

これをmakeから呼び出すようにして Cloudflare Pagesにアップロードするようにしています.