publish-common.el (12130B)
1 ;;; publish-common.el --- Commons code for www publishing projects -*- lexical-binding: t; -*- 2 ;; Author: Vincent Demeester <vincent@sbr.pm> 3 4 ;;; Commentary: 5 ;; 6 ;;; Code: 7 ;; load org 8 (require 'org) 9 (require 'dash) 10 ;; load org export functions 11 (require 'ox-publish) 12 (require 'ox-rss) 13 (require 'ox-html) 14 ;; load org link functions 15 (require 'ol-man) 16 (require 'ol-git-link) 17 ;; Those are mine 18 (require 'ol-github) 19 (require 'ol-gitlab) 20 (require 'org-attach) 21 ;; load additional libraries 22 (require 'go-mode) 23 (require 'css-mode) 24 (require 'yaml-mode) 25 (require 'nix-mode) 26 27 (require 's) 28 29 (setq org-export-use-babel nil) 30 (setq org-link-abbrev-alist '(("att" . org-attach-expand-link))) 31 32 ;; setting to nil, avoids "Author: x" at the bottom 33 (setq org-export-with-section-numbers nil 34 org-export-with-smart-quotes t 35 org-export-with-toc nil) 36 37 (defvar sbr-date-format "%b %d, %Y") 38 39 (setq org-html-divs '((preamble "header" "top") 40 (content "main" "content") 41 (postamble "footer" "postamble")) 42 org-html-container-element "section" 43 org-html-metadata-timestamp-format sbr-date-format 44 org-html-checkbox-type 'unicode 45 org-html-html5-fancy t 46 org-html-doctype "html5" 47 org-html-htmlize-output-type 'css 48 org-html-htmlize-font-prefix "org-" 49 org-src-fontify-natively t 50 org-html-coding-system 'utf-8-unix) 51 52 (defun sbr/org-export-format-drawer (name content) 53 "HTML export of drawer with NAME and CONTENT. 54 name is the name of the drawer, that will be used as class. 55 content is the content of the drawer" 56 (format "<div class='drawer %s'>\n<h6>%s</h6>\n%s</div>" 57 (downcase name) 58 (capitalize name) 59 content)) 60 (setq org-html-format-drawer-function 'sbr/org-export-format-drawer) 61 62 (defun read-file (filePath) 63 "Return FILEPATH's file content." 64 (with-temp-buffer 65 (insert-file-contents filePath) 66 (buffer-string))) 67 68 (defvar sbr-website-html-head 69 "<link rel='icon' type='image/x-icon' href='/images/favicon.ico'/> 70 <meta name='viewport' content='width=device-width, initial-scale=1'> 71 <link rel='stylesheet' href='/css/new.css' type='text/css'/> 72 <link rel='stylesheet' href='/css/syntax.css' type='text/css'/> 73 <link href='/index.xml' rel='alternate' type='application/rss+xml' title='Vincent Demeester' />") 74 75 (defun sbr-website-html-preamble (plist) 76 "PLIST: An entry." 77 ;; Skip adding subtitle to the post if :KEYWORDS don't have 'post' has a 78 ;; keyword 79 (when (string-match-p "post" (format "%s" (plist-get plist :keywords))) 80 (plist-put plist 81 :subtitle (format "Published on %s by %s." 82 (org-export-get-date plist sbr-date-format) 83 (car (plist-get plist :author))))) 84 85 ;; Below content will be added anyways 86 "<nav> 87 <img src=\"/images/favicon.ico\" id=\"sitelogo\"/> <a href='/'>home</a> / 88 <a href='/posts/'>posts</a> (<a href='/index.xml'>rss</a>) / 89 <a href='/articles/'>articles</a> / 90 <a href='https://dl.sbr.pm/'>files</a> / 91 <a href='/about/'>about</a></li> 92 </nav>") 93 94 (defvar sbr-website-html-postamble 95 "<footer> 96 <span class='questions'>Questions, comments ? Please use my <a href=\"https://lists.sr.ht/~vdemeester/public-inbox\">public inbox</a> by sending a plain-text email to <a href=\"mailto:~vdemeester/public-inbox@lists.sr.ht\">~vdemeester/public-inbox@lists.sr.ht</a>.</span> 97 <span class='opinions'>Opinions stated here are my own and do not express the views of my employer, spouse, children, pets, neighbors, secret crushes, favorite authors, or anyone else who is not me. And maybe not even me, depending on how old this is.</span> 98 <span class='copyright'> 99 Content and design by Vincent Demeester 100 (<a rel='licence' href='http://creativecommons.org/licenses/by-nc-sa/3.0/'>Some rights reserved</a>) 101 </span><br /> 102 <span class='engine'> 103 Powered by <a href='https://www.gnu.org/software/emacs/'>Gnu Emacs</a> and <a href='https://orgmode.org'>orgmode</a> 104 </span> 105 </footer>") 106 (defvar site-attachments 107 (regexp-opt '("jpg" "jpeg" "gif" "png" "svg" 108 "ico" "cur" "css" "js" "woff" "html" "pdf" "otf")) 109 "File types that are published as static files.") 110 111 (defun sbr/org-sitemap-format-entry (entry style project) 112 "Format posts with author and published data in the index page. 113 114 ENTRY: file-name 115 STYLE: 116 PROJECT: `posts in this case." 117 (cond ((not (directory-name-p entry)) 118 (format "%s — [[file:%s][%s]] 119 :PROPERTIES: 120 :PUBDATE: [%s] 121 :END:" 122 (format-time-string "%Y-%m-%d" 123 (org-publish-find-date entry project)) 124 entry 125 (org-publish-find-title entry project) 126 (format-time-string "%Y-%m-%d" 127 (org-publish-find-date entry project)))) 128 ((eq style 'tree) (file-name-nondirectory (directory-file-name entry))) 129 (t entry))) 130 131 (defun sbr/org-publish-sitemap (title list) 132 "" 133 (concat "#+TITLE: " title "\n\n" 134 (org-list-to-subtree list))) 135 136 (defun sbr/org-get-first-paragraph (file) 137 "Get string content of first paragraph of file." 138 (ignore-errors 139 (with-temp-buffer 140 (insert-file-contents file) 141 (goto-char (point-min)) 142 (show-all) 143 (let ((first-begin (progn 144 (org-forward-heading-same-level 1) 145 (next-line) 146 (point))) 147 (first-end (progn 148 (org-next-visible-heading 1) 149 (point)))) 150 (buffer-substring first-begin first-end))))) 151 152 (defun sbr/org-rss-publish-to-rss (plist filename pub-dir) 153 "Prepare rss.org file before exporting." 154 (let* ((postsdir (plist-get plist :base-directory))) 155 (with-current-buffer (find-file filename) 156 (erase-buffer) 157 (insert "#+TITLE: Posts\n") 158 (insert "#+AUTHOR: Vincent Demeester\n") 159 (insert "#+OPTIONS: toc:nil\n") 160 (let* ((files-all 161 (reverse (directory-files "." nil 162 "[0-9-]+.*\\.org$"))) 163 (files (seq-subseq files-all 0 (min (length files-all) 30)))) 164 (message (format "foo: %s" filename)) 165 (dolist (post files) 166 (let* ((post-file post) 167 (post-title (org-publish-find-title post-file plist)) 168 (preview-str (sbr/org-get-first-paragraph post-file)) 169 (date (replace-regexp-in-string 170 "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)-.*" 171 "\\1" post))) 172 (insert (concat "* [[file:" postsdir "/" post "][" post-title "]]\n\n")) 173 (org-set-property "ID" post) 174 (org-set-property "RSS_TITLE" post-title) 175 ;; ox-rss prepends html-link-home to permalink 176 (org-set-property "RSS_PERMALINK" 177 (concat postsdir "/" 178 (file-name-sans-extension post) 179 ".html")) 180 (org-set-property 181 "PUBDATE" 182 (format-time-string 183 "<%Y-%m-%d %a %H:%M>" 184 (org-time-string-to-time 185 (replace-regexp-in-string 186 "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)-.*" 187 "\\1" post)))) 188 (insert preview-str) 189 (newline 1) 190 (insert (concat "[[file:" postsdir "/" post "][(Read more)]]\n\n")))) 191 (save-buffer)))) 192 (let ((user-mail-address "t") 193 (org-export-with-broken-links t) 194 (org-rss-use-entry-url-as-guid nil)) 195 (org-rss-publish-to-rss plist filename pub-dir))) 196 197 (advice-add #'org-export-get-reference :override #'unpackaged/org-export-get-reference) 198 199 (defun unpackaged/org-export-get-reference (datum info) 200 "Like `org-export-get-reference', except uses heading titles instead of random numbers." 201 (let ((cache (plist-get info :internal-references))) 202 (or (car (rassq datum cache)) 203 (let* ((crossrefs (plist-get info :crossrefs)) 204 (cells (org-export-search-cells datum)) 205 ;; Preserve any pre-existing association between 206 ;; a search cell and a reference, i.e., when some 207 ;; previously published document referenced a location 208 ;; within current file (see 209 ;; `org-publish-resolve-external-link'). 210 ;; 211 ;; However, there is no guarantee that search cells are 212 ;; unique, e.g., there might be duplicate custom ID or 213 ;; two headings with the same title in the file. 214 ;; 215 ;; As a consequence, before re-using any reference to 216 ;; an element or object, we check that it doesn't refer 217 ;; to a previous element or object. 218 (new (or (cl-some 219 (lambda (cell) 220 (let ((stored (cdr (assoc cell crossrefs)))) 221 (when stored 222 (let ((old (org-export-format-reference stored))) 223 (and (not (assoc old cache)) stored))))) 224 cells) 225 (when (org-element-property :raw-value datum) 226 ;; Heading with a title 227 (unpackaged/org-export-new-title-reference datum cache)) 228 ;; NOTE: This probably breaks some Org Export 229 ;; feature, but if it does what I need, fine. 230 (org-export-format-reference 231 (org-export-new-reference cache)))) 232 (reference-string new)) 233 ;; Cache contains both data already associated to 234 ;; a reference and in-use internal references, so as to make 235 ;; unique references. 236 (dolist (cell cells) (push (cons cell new) cache)) 237 ;; Retain a direct association between reference string and 238 ;; DATUM since (1) not every object or element can be given 239 ;; a search cell (2) it permits quick lookup. 240 (push (cons reference-string datum) cache) 241 (plist-put info :internal-references cache) 242 reference-string)))) 243 244 (defun unpackaged/org-export-new-title-reference (datum cache) 245 "Return new reference for DATUM that is unique in CACHE." 246 (cl-macrolet ((inc-suffixf (place) 247 `(progn 248 (string-match (rx bos 249 (minimal-match (group (1+ anything))) 250 (optional "--" (group (1+ digit))) 251 eos) 252 ,place) 253 ;; HACK: `s1' instead of a gensym. 254 (-let* (((s1 suffix) (list (match-string 1 ,place) 255 (match-string 2 ,place))) 256 (suffix (if suffix 257 (string-to-number suffix) 258 0))) 259 (setf ,place (format "%s--%s" s1 (cl-incf suffix))))))) 260 (let* ((title (org-element-property :raw-value datum)) 261 (ref (url-hexify-string (substring-no-properties title))) 262 (parent (org-element-property :parent datum))) 263 (while (--any (equal ref (car it)) 264 cache) 265 ;; Title not unique: make it so. 266 (if parent 267 ;; Append ancestor title. 268 (setf title (concat (org-element-property :raw-value parent) 269 "--" title) 270 ref (url-hexify-string (substring-no-properties title)) 271 parent (org-element-property :parent parent)) 272 ;; No more ancestors: add and increment a number. 273 (inc-suffixf ref))) 274 ref))) 275 276 (provide 'publish-common) 277 ;;; publish-common.el ends here