mfblog.el 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264
  1. ;;; mfblog.el --- Microformats2 compatible notes site generator
  2. ;; Copyright (C) 2016 Free Software Foundation, Inc.
  3. ;; Author: Ryan Rix <ryan@whatthefuck.computer>
  4. ;; Version: 0.1
  5. ;; Package-Requires: ((json "0.1") (org "8.0"))
  6. ;; Keywords: web
  7. ;; URL: http://notes.whatthefuck.computer/
  8. ;;; Commentary:
  9. ;; This package generates a small blog from a single org-mode file, leveraging Microformats to
  10. ;; provide semantic information about the posts; you can use this information to automate sharing,
  11. ;; linkbacks, embedding images in 3rd party silso, and more; see http://indiewebcamp.com and
  12. ;; http://microformats.org for more information.
  13. ;; This package can be used by configuring the various variables and then calling [`mfblog:gen']
  14. ;; which will publish the blog index, an RSS feed and URLs for each entry. You can then have Brid.gy
  15. ;; automatically syndicate the content to silos by calling [`mfblog:syndicate-entry-at-point'].
  16. ;;; Code:
  17. (require 'org-attach)
  18. (require 'ox-html)
  19. (require 'htmlize)
  20. (require 'url-http)
  21. (require 'url)
  22. (require 'json)
  23. (defgroup mfblog nil
  24. "Microformats/IndieWeb blog.")
  25. (defcustom mfblog:template-file "/home/rrix/Projects/notes/template.html"
  26. "Template file for mfblog to use.
  27. You should provide your own, but feel free to base it on the one in the package."
  28. :group 'mfblog)
  29. (defvar mfblog:postlist '())
  30. (defcustom mfblog:preamble
  31. "<p> This page is short notes, things I've read, and not full
  32. length posts; long-form is posted on <a
  33. href=\"http://whatthefuck.computer/\">my main site</a> and linked
  34. to from here, as sort of a self-hosted broadcast-only
  35. Twitter. This site uses semantic markup to automatically
  36. syndicate to social networks (<a
  37. href=\"http://indiewebcamp.com/POSSE\">POSSE</a>-style). Comments
  38. and feedback are handled via <a
  39. href=\"http://indiewebcamp.com/webmention\">webmention</a>.
  40. Subscribe via <a
  41. href=\"http://notes.whatthefuck.computer/index.xml\">RSS</a>.</p>"
  42. "A preamble to post at the end of each page."
  43. :group 'mfblog)
  44. (defcustom mfblog:publish-config '(
  45. :rss-image-url "http://notes.whatthefuck.computer/~rrix/25ZLKRlf.jpg"
  46. :html-link-home "http://notes.whatthefuck.computer"
  47. :html-link-use-abs-url t
  48. :rss-extension "xml"
  49. :select-tags ("EXPORT")
  50. :publishing-directory "/ssh:li01.rix.si:/home/rrix/public_html/notes/"
  51. :table-of-contents nil
  52. :section-numbers nil)
  53. "An `org-publish-project-alist' format plist containing shared state between all of the temporary publish projects."
  54. :group 'mfblog)
  55. (defun mfblog:gen ()
  56. "Generate the mfblog and publish it."
  57. (interactive)
  58. (setq mfblog:postlist nil)
  59. (message "Generating notes files")
  60. (with-current-buffer (find-file-noselect "~/Projects/notes/index.org")
  61. (goto-char (point-min))
  62. (org-sort-entries nil ?T)
  63. ;; (org-map-entries 'mfblog:index-posts "EXPORT" 'file)
  64. (org-map-entries 'mfblog:entry-to-page "EXPORT" 'file))
  65. (let ((org-publish-project-alist
  66. (list (append '("notes_rss")
  67. (mfblog:plist-merge '(:base-directory "~/Projects/notes" :base-extension "org" :publishing-function (org-rss-publish-to-rss) :exclude ".*" :include ("index.org"))
  68. mfblog:publish-config))
  69. (append '("notes_other")
  70. (mfblog:plist-merge '(:base-directory "/var/tmp/mfblog" :base-extension "JPG\\|js\\|html\\|jpg\\|gif\\|png" :publishing-function (org-publish-attachment))
  71. mfblog:publish-config)))))
  72. (copy-file "~/Projects/notes/webmention.js" "/var/tmp/mfblog/webmention.js" t)
  73. (copy-file "~/Projects/notes/go.png" "/var/tmp/mfblog/go.png" t)
  74. (copy-file "~/Projects/notes/favicon.gif" "/var/tmp/mfblog/favicon.gif" t)
  75. (org-publish "notes_rss")
  76. (mfblog:make-index)
  77. (org-publish "notes_other")))
  78. (defun mfblog:syndicate-entry-at-point ()
  79. "Syndicate the org-mode entry at point, by calling out to Bridgy and storing the result."
  80. (interactive)
  81. (let* ((date (org-entry-get (point) "CLOSED"))
  82. (date (org-time-string-to-seconds date))
  83. (base-url (plist-get mfblog:publish-config :html-link-home))
  84. (url (format "%s/%s-note.html" base-url date))
  85. (syn-twitter (org-entry-get (point) "SYN-TWITTER"))
  86. (syn-facebook (org-entry-get (point) "SYN-FACEBOOK"))
  87. (realpoint (point)))
  88. (unless syn-twitter
  89. (let* ((url-request-data (format "source=%s&target=http://brid.gy/publish/twitter" url))
  90. (url-request-method "POST")
  91. (buf (url-retrieve-synchronously "https://brid.gy/publish/webmention")))
  92. (org-entry-put realpoint "SYN-TWITTER"
  93. (with-current-buffer buf
  94. (goto-char url-http-end-of-headers)
  95. (let* ((body (json-read))
  96. (url (assoc 'url body)))
  97. (when url
  98. (cdr url)))))))
  99. (unless syn-facebook
  100. (let* ((url-request-data (format "source=%s&target=http://brid.gy/publish/facebook" url))
  101. (url-request-method "POST")
  102. (buf (url-retrieve-synchronously "https://brid.gy/publish/webmention")))
  103. (org-entry-put realpoint "SYN-FACEBOOK"
  104. (with-current-buffer buf
  105. (goto-char url-http-end-of-headers)
  106. (let* ((body (json-read))
  107. (url (assoc 'url body)))
  108. (when url
  109. (cdr url)))))))))
  110. (defun mfblog:heading-to-html (heading)
  111. "HTMLize the given HEADING, cleaning up crap and generating in-reply-to URLs."
  112. (with-temp-buffer
  113. (insert heading)
  114. (let* ((str (htmlize-region-for-paste (point-min) (point-max))))
  115. (with-temp-buffer
  116. (insert str)
  117. (goto-char (point-min))
  118. (replace-regexp "<pre>" "")
  119. (goto-char (point-min))
  120. (replace-regexp "</pre>" "")
  121. (goto-char (point-min))
  122. (replace-regexp "<a href=\"https://twitter" "<a class=\"u-in-reply-to\" href=\"https://twitter")
  123. (buffer-string)))))
  124. (defun mfblog:to-html ()
  125. "Convert the heading at point to HTML, sprinkling in ID where necessary."
  126. (let* ((id (org-id-get-create))
  127. (location (first (org-property-values "LOCATION")))
  128. (attach-dir (org-attach-dir))
  129. (file-list (if attach-dir
  130. (org-attach-file-list attach-dir)
  131. '())))
  132. (with-current-buffer (org-html-export-as-html nil t nil t)
  133. (dolist (file file-list)
  134. (let ((file- (concat attach-dir "/" file))
  135. (newfile (concat "/var/tmp/mfblog/" id "-" file))
  136. )
  137. (unless (file-exists-p newfile)
  138. (copy-file file- newfile)
  139. (set-file-modes newfile 420))
  140. (insert "<img style=\"width: 100%\" src=\"" id "-" file "\" class=\"u-photo\"/><br/>")))
  141. (when location
  142. (insert "<span class=\"p-location\">" location "</span>"))
  143. (buffer-string))))
  144. (defun mfblog:entry-to-page ()
  145. "Convert the heading at POINT to an HTML page"
  146. (save-window-excursion
  147. (unless (file-exists-p "/var/tmp/mfblog")
  148. (make-directory "/var/tmp/mfblog"))
  149. (let* ((pubdate (org-entry-get (point) "CLOSED"))
  150. (pubdate (org-time-string-to-seconds pubdate))
  151. (id (org-id-get-create))
  152. (filename (format "%s-note.html" pubdate))
  153. (fullpath (format "/var/tmp/mfblog/%s" filename))
  154. (title (mfblog:heading-to-html (org-get-heading)))
  155. (content (mfblog:to-html))
  156. (base-url (plist-get mfblog:publish-config :html-link-home))
  157. (full-url (concat base-url "/" filename))
  158. (syn-twitter-url (or (org-entry-get (point) "SYN-TWITTER") ""))
  159. (syn-facebook-url (or (org-entry-get (point) "SYN-FACEBOOK") ""))
  160. (syn-twitter-href (if (> (length syn-twitter-url) 0)
  161. (format "<a rel=\"syndication\" href=\"%s\">On Twitter</a>" syn-twitter-url)
  162. ""))
  163. (syn-facebook-href (if (> (length syn-facebook-url) 0)
  164. (format "<a rel=\"syndication\" href=\"%s\">On Facebook</a>" syn-facebook-url)
  165. "")))
  166. (org-entry-put (point) "RSS_PERMALINK" filename)
  167. (with-current-buffer (find-file-noselect fullpath)
  168. (erase-buffer)
  169. (insert-file mfblog:template-file)
  170. (goto-char (point-min))
  171. (replace-regexp "{{content}}" content)
  172. (goto-char (point-min))
  173. (replace-regexp "{{title}}" title)
  174. (goto-char (point-min))
  175. (replace-regexp "{{url}}" full-url)
  176. (goto-char (point-min))
  177. (replace-regexp "<a href=\"{{twitter}}\">On Twitter</a>" syn-twitter-href)
  178. (goto-char (point-min))
  179. (replace-regexp "<a href=\"{{facebook}}\">On Facebook</a>" syn-facebook-href)
  180. (write-file fullpath)
  181. (kill-buffer (current-buffer))
  182. (add-to-ordered-list 'mfblog:postlist
  183. (list pubdate fullpath title content filename)
  184. pubdate)))))
  185. (defun mfblog:index-posts ()
  186. "Create an index of all the posts to speed up generation of index.html"
  187. (save-window-excursion
  188. (let* ((pubdate (org-entry-get (point) "CLOSED"))
  189. (pubdate (org-time-string-to-seconds pubdate))
  190. (id (org-id-get-create))
  191. (filename (format "%s-note.html" pubdate))
  192. (fullpath (format "/var/tmp/mfblog/%s" filename)))
  193. (unless (alist-get pubdate 'mfblog:postlist)
  194. (let* ((title-html (mfblog:heading-to-html (org-get-heading)))
  195. (title-txt (mfblog:heading-to-txt (org-get-heading)))
  196. (base-url (plist-get mfblog:publish-config :html-link-home))
  197. (full-url (concat base-url "/" filename)))
  198. (add-to-ordered-list 'mfblog:postlist
  199. (list fullpath title-html title-text filename full-url)
  200. pubdate))))))
  201. (defun mfblog:plist-merge (&rest plists)
  202. "Merge a bunch of PLISTS together."
  203. (if plists
  204. (let ((result (copy-sequence (car plists))))
  205. (while (setq plists (cdr plists))
  206. (let ((plist (car plists)))
  207. (while plist
  208. (setq result (plist-put result (car plist) (car (cdr plist)))
  209. plist (cdr (cdr plist))))))
  210. result)
  211. nil))
  212. (defun mfblog:make-index ()
  213. "Generate the mfblog index page."
  214. (let* ((index-path "/var/tmp/mfblog/index.html")
  215. (all-content
  216. (mapconcat
  217. (lambda (post)
  218. (let ((pubdate (pop post))
  219. (fullpath (pop post))
  220. (title (pop post))
  221. (content (pop post))
  222. (filename (pop post)))
  223. (format "<li style=\"text-size: 0.8em;\">%s (<a href=\"/%s\">Permalink</a>)</li>" title filename)))
  224. (reverse mfblog:postlist) "\n"))
  225. (all-content (format "%s<ul>%s</ul>" mfblog:preamble all-content)))
  226. (with-current-buffer (find-file-noselect "/var/tmp/mfblog/index.html")
  227. (erase-buffer)
  228. (insert-file mfblog:template-file)
  229. (goto-char (point-min))
  230. (replace-regexp "{{content}}" all-content)
  231. (goto-char (point-min))
  232. (replace-regexp "{{url}}" (concat (plist-get mfblog:publish-config :html-link-home) "/"))
  233. (goto-char (point-min))
  234. (replace-regexp "{{twitter}}" "https://twitter.com/rrrrrrrix")
  235. (goto-char (point-min))
  236. (replace-regexp "{{facebook}}" "https://facebook.com/rjrix")
  237. (goto-char (point-min))
  238. (replace-regexp "{{title}}" "Ryan's Shortnotes")
  239. (write-file "/var/tmp/mfblog/index.html"))))
  240. (provide 'mfblog)
  241. ;;; mfblog.el ends here