arcology.el 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692
  1. ;;; arcology.el --- Another org-mode static site generator
  2. ;; Copyright (C) 2016 Ryan Rix
  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 org-mode files, leveraging Microformats to provide
  10. ;; 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 [`arcology']
  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 [`arcology-syndicate-entry-at-point'].
  16. ;; From Wikipedia:
  17. ;; Arcology, a portmanteau of "architecture" and "ecology", is a vision of architectural design
  18. ;; principles for very densely populated habitats. The concept has been primarily popularized, and
  19. ;; the term itself coined, by architect Paolo Soleri. It also appears in science fiction. These
  20. ;; structures have been largely hypothetical insofar as no 'arcology' envisioned by Soleri himself
  21. ;; has yet been completed, but he posited that a completed arcology would provide space for a
  22. ;; variety of residential, commercial, and agricultural facilities while minimizing individual human
  23. ;; environmental impact. Arcologies are often portrayed in sci-fi as self-contained or economically
  24. ;; self-sufficient.
  25. ;; Arcology aims to be a self-sufficient blogging platform, where you can leverage the work that
  26. ;; IndieWeb actors have done to build a self-sufficient site with the full support of "social media"
  27. ;; type offerings like comments, reposts, checkins, all running under your own domain and backed by
  28. ;; plain text that you can control yourself or generate using simple scripts or Memacs
  29. ;;; Code:
  30. (require 'cl)
  31. (require 'org-attach)
  32. (require 'ox-html)
  33. (require 'htmlize)
  34. (require 'url-http)
  35. (require 'url)
  36. (require 'json)
  37. (require 'arcology-util)
  38. ;;;###autoload
  39. (defgroup arcology nil
  40. "Static org-mode site generator")
  41. ;;;###autoload
  42. (defcustom arcology-site-root "~/tmp/arcology"
  43. "The base directory to generate the site in to."
  44. :group 'arcology)
  45. ;;;###autoload
  46. (defcustom arcology-site-tag "BLORG-NOEXPORT+EXPORT"
  47. "Org tag that Arcology will look for."
  48. :group 'arcology)
  49. ;;;###autoload
  50. (defcustom arcology-publish-config
  51. '(:rss-image-url "http://notes.whatthefuck.computer/~rrix/25ZLKRlf.jpg"
  52. :html-link-home "http://notes.whatthefuck.computer"
  53. :html-link-use-abs-url t
  54. :rss-extension "xml"
  55. :select-tags ("EXPORT")
  56. :exclude-tags ("NOEXPORT")
  57. :publishing-directory "/ssh:fontkeming.fail:/home/rrix/public_html/notes/"
  58. :table-of-contents nil
  59. :section-numbers nil
  60. :recursive t)
  61. "An `org-publish-project-alist' format plist containing shared state between all of the temporary publish projects."
  62. :group 'arcology)
  63. ;;;###autoload
  64. (defcustom arcology-default-template-file (expand-file-name "~/Code/notes/templates/default.html")
  65. "Template file to use for fallback"
  66. :group 'arcology)
  67. ;;;###autoload
  68. (defcustom arcology-note-template-file (expand-file-name "~/Code/notes/templates/note.html")
  69. "Template file to use for notes"
  70. :group 'arcology)
  71. ;;;###autoload
  72. (defcustom arcology-read-template-file (expand-file-name "~/Code/notes/templates/default.html")
  73. "Template file to use for read-items"
  74. :group 'arcology)
  75. ;;;###autoload
  76. (defcustom arcology-article-template-file (expand-file-name "~/Code/notes/templates/default.html")
  77. "Template file to use for full-length articles."
  78. :group 'arcology)
  79. ;;;###autoload
  80. (defcustom arcology-photo-template-file (expand-file-name "~/Code/notes/templates/default.html")
  81. "Template file to use for notes."
  82. :group 'arcology)
  83. ;;;###autoload
  84. (defcustom arcology-jam-template-file (expand-file-name "~/Code/notes/templates/default.html")
  85. "Template file to use for jam posts."
  86. :group 'arcology)
  87. ;;;###autoload
  88. (defcustom arcology-reply-template-file (expand-file-name "~/Code/notes/templates/reply.html")
  89. "Template file to use for replies."
  90. :group 'arcology)
  91. ;;;###autoload
  92. (defcustom arcology-index-template-file (expand-file-name "~/Code/notes/templates/index.html")
  93. "Template file to use for the site index."
  94. :group 'arcology)
  95. ;;;###autoload
  96. (defcustom arcology-review-template-file (expand-file-name "~/Code/notes/templates/review.html")
  97. "Template file to use for reviews."
  98. :group 'arcology)
  99. ;;;###autoload
  100. (defcustom arcology-index-title "Computer :("
  101. "The title of your site"
  102. :group 'arcology)
  103. ;;;###autoload
  104. (defcustom arcology-webmention.io-api-key nil
  105. "API Key for webmention.io, used to pull all mentions."
  106. :group 'arcology)
  107. (defvar arcology-entry-cache nil)
  108. (defvar arcology-full-postlist nil)
  109. ;;;###autoload
  110. (defun arcology (use-cache &optional preview)
  111. "Generate the Arcology site.
  112. If USE-CACHE is non-nil, use the cache instead of refreshing the
  113. cache. If PREVIEW is non-nil, skip publishing."
  114. (interactive "P")
  115. (let ((config (arcology-make-config)))
  116. (when (not use-cache)
  117. (setq arcology-entry-cache nil)
  118. (setq arcology-full-postlist nil)
  119. (arcology-index-entries config))
  120. (unless (file-exists-p arcology-site-root)
  121. (mkdir arcology-site-root t))
  122. (arcology-generate-modified-entries config)
  123. (arcology-generate-indices config))
  124. (copy-file "~/Code/notes/webmention.js" (concat arcology-site-root "/webmention.js") t)
  125. (copy-file "~/Code/notes/go.png" (concat arcology-site-root "/go.png") t)
  126. (copy-file "~/Code/notes/favicon.gif" (concat arcology-site-root "/favicon.gif") t)
  127. (copy-file "~/Code/notes/rix_green.png" (concat arcology-site-root "/rix_green.png") t)
  128. (copy-directory "~/Code/notes/css" (concat arcology-site-root "/") t t t)
  129. (copy-directory "~/Code/notes/font" (concat arcology-site-root "/") t t t)
  130. (unless preview
  131. (arcology-publish)))
  132. (defun arcology-publish ()
  133. "Publish an already-rendered Arcology site"
  134. (interactive)
  135. (let* ((config (arcology-make-config))
  136. (org-publish-project-alist
  137. (list (append '("notes_other")
  138. (arcology-plist-merge '(:base-extension "JPG\\|js\\|html\\|jpg\\|gif\\|png\\|css\\|woff\\|eot\\|ttf\\|svg\\|woff2" :publishing-function (org-publish-attachment))
  139. arcology-publish-config
  140. config)))))
  141. (org-publish "notes_other")))
  142. (defun arcology-generate-indices (config)
  143. (arcology-generate-index config :index (lambda (metadata) nil))
  144. (mapc (lambda (post-type)
  145. (arcology-generate-index config post-type
  146. (lambda (metadata)
  147. (not (eq (elt metadata 0) post-type)))))
  148. (arcology-post-types-from-list arcology-full-postlist)))
  149. (defun arcology-post-types-from-list (postlist)
  150. (reduce (lambda (last current)
  151. (if (member (elt current 0) last)
  152. last
  153. (append last (list (elt current 0)))))
  154. postlist
  155. :initial-value '()))
  156. (defun arcology-make-config (&optional base)
  157. (let (plist (list))
  158. (append (list :base-directory arcology-site-root)
  159. (list :site-tag arcology-site-tag)
  160. (when base
  161. base))))
  162. (defun arcology-index-entries (config)
  163. "Generate an index of entries that Arcology should build in to its site."
  164. (org-map-entries 'arcology-index-entry
  165. (plist-get config :site-tag)
  166. 'agenda))
  167. (defun arcology-generate-modified-entries (config)
  168. ;; XXX: Have this just iterate over the entry-cache using the logic in at-point....
  169. ;; Right now this O(x^N) where x is posts, and N is post types. UGH.
  170. (arcology-plist-mapc #'arcology-generate-modified-entries-for-type
  171. arcology-entry-cache))
  172. (defun arcology-filter (condp lst)
  173. (delq nil
  174. (mapcar (lambda (x) (and (funcall condp x) x)) lst)))
  175. (defun arcology-format-time (time &optional iso)
  176. "Convert a time as float or int since epoch to presentable."
  177. (let ((format (if iso
  178. "%FT%T%z"
  179. "%H:%MZ on %e %B %Y")))
  180. (format-time-string format (seconds-to-time time) t)))
  181. (defun arcology-generate-index (config type filterfun)
  182. (arcology-write-template
  183. (format "%s/%s.html" arcology-site-root
  184. (replace-regexp-in-string ":" "" (prin1-to-string type)))
  185. arcology-index-template-file
  186. :content (mapconcat (lambda (metadata)
  187. (let* ((entry-type (elt metadata 0))
  188. (key (elt metadata 1))
  189. (entry-list (plist-get arcology-entry-cache
  190. entry-type))
  191. (entry (lax-plist-get entry-list
  192. key)))
  193. (format "<div class=\"h-entry\"><div class=\"row\"><i class=\"icon-%s\" aria-hidden=true></i><h2 class=\"p-name\">%s</h2> <a class=\"u-url\" href=\"%s\"><time class=\"dt-published\" datetime=\"%s\">%s</time></a></div><div class=\"row\">%s</div></div>"
  194. (replace-regexp-in-string ":" "" (prin1-to-string entry-type))
  195. (plist-get entry :title-html)
  196. (elt metadata 3)
  197. (arcology-format-time (elt metadata 4) t)
  198. (arcology-format-time (elt metadata 4))
  199. (plist-get entry :index-html))))
  200. (cl-remove-if filterfun (reverse arcology-full-postlist)) "\n")
  201. :title arcology-index-title
  202. :title-html arcology-index-title
  203. :url (plist-get config :base-directory)))
  204. (defun arcology-plist-mapc (fun plist)
  205. (cl-loop for (k v) on plist by 'cddr
  206. collect
  207. (funcall fun k v)))
  208. (defun arcology-generate-modified-entries-for-type (cache-type entries)
  209. (case cache-type
  210. ((:note) (arcology-plist-mapc #'arcology-make-note-entry entries))
  211. ((:read) (arcology-plist-mapc #'arcology-make-read-entry entries))
  212. ((:like) (arcology-plist-mapc #'arcology-make-like-entry entries))
  213. ((:step) (arcology-plist-mapc #'arcology-make-step-entry entries))
  214. ((:photo) (arcology-plist-mapc #'arcology-make-photo-entry entries))
  215. ((:video) (arcology-plist-mapc #'arcology-make-video-entry entries))
  216. ((:jam) (arcology-plist-mapc #'arcology-make-jam-entry entries))
  217. ((:review) (arcology-plist-mapc #'arcology-make-review-entry entries))
  218. ((:reply) (arcology-plist-mapc #'arcology-make-reply-entry entries))
  219. ((:rsvp) (arcology-plist-mapc #'arcology-make-rsvp-entry entries))
  220. ((:checkin) (progn
  221. (require 'arcology-checkin)
  222. (arcology-plist-mapc #'arcology-make-checkin-entry entries)))
  223. ((:article) (arcology-plist-mapc #'arcology-make-article-entry entries))))
  224. (defmacro def-arcology-entry-generator (type content-generator &optional extra-body extra-lets)
  225. (let ((fname (intern (format "arcology-make-%s-entry" type)))
  226. (type-as-symbol (intern (format ":%s" type)))
  227. (template-file-var (intern (format "arcology-%s-template-file" type))))
  228. `(defun ,fname (key entry)
  229. (save-window-excursion
  230. (with-current-buffer (plist-get entry :buffer)
  231. (goto-char (plist-get entry :point))
  232. (unless (file-exists-p arcology-site-root)
  233. (make-directory arcology-site-root))
  234. (let* ((pubdate (plist-get entry :created-at))
  235. (pubdate (org-time-string-to-seconds pubdate))
  236. (filename (format "%s-note.html" pubdate))
  237. (fullpath (format "%s/%s" arcology-site-root filename))
  238. (title (plist-get entry :title))
  239. (title-html (plist-get entry :title-html))
  240. (content (funcall ,content-generator entry))
  241. (base-url (plist-get arcology-publish-config :html-link-home))
  242. (full-url (concat base-url "/" filename))
  243. (syn-twitter-url (arcology-alist-get "SYN-TWITTER" (plist-get entry :properties)))
  244. (syn-facebook-url (arcology-alist-get "SYN-FACEBOOK" (plist-get entry :properties)))
  245. (syn-twitter-href (if (> (length syn-twitter-url) 0)
  246. (format "<a rel=\"syndication\" href=\"%s\">On Twitter</a>" syn-twitter-url)
  247. ""))
  248. (syn-facebook-href (if (> (length syn-facebook-url) 0)
  249. (format "<a rel=\"syndication\" href=\"%s\">On Facebook</a>" syn-facebook-url)
  250. ""))
  251. ,@(when extra-lets
  252. extra-lets))
  253. (org-entry-put (point) "RSS_PERMALINK" filename)
  254. ,@(when extra-body
  255. extra-body)
  256. (arcology-write-template fullpath ,(if (boundp template-file-var)
  257. template-file-var
  258. arcology-default-template-file)
  259. :content content
  260. :title title
  261. :title-html title-html
  262. :url full-url
  263. :dt-published (format "<time class=\"dt-published\" datetime=\"%s\">%s</time>"
  264. (arcology-format-time (truncate pubdate) t)
  265. (arcology-format-time (truncate pubdate)))
  266. :twitter syn-twitter-href
  267. :facebook syn-facebook-href)
  268. (let ((cache-entry (list ,type-as-symbol key fullpath full-url (truncate pubdate))))
  269. (unless (member cache-entry arcology-full-postlist)
  270. (add-to-ordered-list 'arcology-full-postlist
  271. cache-entry
  272. pubdate)))))))))
  273. (defun arcology-write-template (fullpath template-file &rest template-args)
  274. (with-current-buffer (find-file-noselect fullpath)
  275. (erase-buffer)
  276. (if (file-exists-p template-file)
  277. (insert-file template-file)
  278. (insert-file arcology-default-template-file))
  279. (goto-char (point-min))
  280. (replace-regexp "{{content}}" (or (plist-get template-args :content)
  281. ""))
  282. (goto-char (point-min))
  283. (replace-regexp "{{title}}" (or (plist-get template-args :title)
  284. ""))
  285. (goto-char (point-min))
  286. (replace-regexp "{{title-html}}" (or (plist-get template-args :title-html)
  287. ""))
  288. (goto-char (point-min))
  289. (replace-regexp "{{url}}" (or (plist-get template-args :url)
  290. ""))
  291. (goto-char (point-min))
  292. (replace-regexp "{{dt-published}}" (or (plist-get template-args :dt-published)
  293. ""))
  294. (goto-char (point-min))
  295. (replace-regexp "<a class=\"u-syndication\" href=\"{{twitter}}\">On Twitter</a>" (or (plist-get template-args :twitter)
  296. ""))
  297. (goto-char (point-min))
  298. (replace-regexp "<a class=\"u-syndication\" href=\"{{facebook}}\">On Facebook</a>" (or (plist-get template-args :facebook)
  299. ""))
  300. (write-file fullpath)
  301. (kill-buffer (current-buffer))))
  302. (defun arcology-index-entry (&optional not-scanning)
  303. "Index the entry at point.
  304. This function basically just routes to other functions based on
  305. inferring the post type of a given entry."
  306. (interactive)
  307. (let* ((org-trust-scanner-tags (not not-scanning))
  308. (proptable (org-entry-properties))
  309. (ctime (arcology-get-ctime proptable))
  310. (key (or (org-id-get)
  311. ctime)))
  312. (let* ((title (elt (org-heading-components) 4))
  313. (buffer (current-buffer))
  314. (point (point))
  315. (tags (org-get-tags-at))
  316. (entry-text (arcology-clean-entry-text (org-get-entry)))
  317. (sub-cache-type (arcology-entry-type-at-point))
  318. (sub-cache (or (plist-get arcology-entry-cache sub-cache-type)
  319. (list)))
  320. (index-html (arcology-index-snippet-for-entry-at-point)))
  321. (if (not (member "NOEXPORT" tags))
  322. (let ((res (list :title (replace-regexp-in-string "<.*> " "" title)
  323. :title-html (replace-regexp-in-string "&lt;.*&gt;" "" (arcology-heading-to-html))
  324. :length (length entry-text)
  325. :buffer buffer
  326. :point point
  327. :properties proptable
  328. :index-html index-html
  329. :created-at ctime)))
  330. (setq arcology-entry-cache
  331. (plist-put arcology-entry-cache sub-cache-type
  332. (plist-put sub-cache key
  333. res)))
  334. (list sub-cache-type res))))))
  335. (defun arcology-entry-type-at-point ()
  336. (cond ((member "READ" tags) :read)
  337. ((member "CHECKIN" tags) :checkin)
  338. ((arcology-alist-get "P-RSVP" proptable) :rsvp)
  339. ((arcology-alist-get "YOUTUBE-URL" proptable) :video)
  340. ((member "REPLY" tags) :reply)
  341. ((member "LIKE" tags) :like)
  342. ((member "STEPS" tags) :step)
  343. ;; ((member "EVENT" tags) :event)
  344. ;; ((member "BOOKMARK" tags) :bookmark)
  345. ;; ((member "REPOST" tags) :repost)
  346. ((member "JAM" tags) :jam)
  347. ((member "REVIEW" tags) :review)
  348. ;; ((member "RSVP" tags) :rsvp)
  349. ((and (member "ATTACH" tags)
  350. (string-match-p "\\.[\(jpg\)\|\(png\)\|\(gif\)]+$"
  351. (arcology-alist-get "ATTACHMENTS" proptable)))
  352. :photo)
  353. ((and (member "ATTACH" tags)
  354. (string-match-p "\\.[\(ogv\)\|\(mp4\)\|\(mkv\)]+$"
  355. (arcology-alist-get "ATTACHMENTS" proptable)))
  356. :video)
  357. ((not (> (length entry-text) 0)) :note)
  358. (t :article)))
  359. (defun arcology-index-snippet-for-entry-at-point ()
  360. (cond ((> (length (if (org-attach-dir) (org-attach-file-list (org-attach-dir)) '())) 0)
  361. (arcology-add-image-content-at-point 10))
  362. (t "")))
  363. (defun arcology-publish-entry-at-point (point &optional suppress-publish)
  364. (interactive "d")
  365. (goto-char point)
  366. ;; index the entry
  367. (let* ((entry (arcology-index-entry t))
  368. (proptable (org-entry-properties))
  369. (ctime (arcology-get-ctime proptable))
  370. (key (or (org-id-get)
  371. ctime)))
  372. (case (car entry)
  373. ;; render it
  374. ((:note) (arcology-make-note-entry key (cadr entry)))
  375. ((:read) (arcology-make-read-entry key (cadr entry)))
  376. ((:like) (arcology-make-like-entry key (cadr entry)))
  377. ((:step) (arcology-make-step-entry key (cadr entry)))
  378. ((:photo) (arcology-make-photo-entry key (cadr entry)))
  379. ((:video) (arcology-make-video-entry key (cadr entry)))
  380. ((:jam) (arcology-make-jam-entry key (cadr entry)))
  381. ((:review) (arcology-make-review-entry key (cadr entry)))
  382. ((:reply) (arcology-make-reply-entry key (cadr entry)))
  383. ((:checkin) (progn
  384. (require 'arcology-checkin)
  385. (arcology-make-checkin-entry key (cadr entry))))
  386. ((:article) (arcology-make-article-entry key (cadr entry))))
  387. ;; render indices
  388. (arcology-generate-indices (arcology-make-config))
  389. ;; publish
  390. (unless suppress-publish
  391. (arcology-publish))))
  392. (defun arcology-clean-entry-text (entry)
  393. (replace-regexp-in-string
  394. "[[0-9]+-.*]\n?" ""
  395. (replace-regexp-in-string
  396. "CLOSED:.*\n?" ""
  397. (replace-regexp-in-string
  398. "^\s*:[A-Za-z0-9-_]+:.*\n?" ""
  399. (org-get-entry)))))
  400. (defun arcology-alist-get (key obj)
  401. "Easy JSON accessor, get KEY's value from OBJ."
  402. (cdr (assoc key obj)))
  403. (defun arcology-heading-to-html ()
  404. "HTMLize the heading at point, cleaning up crap and generating in-reply-to URLs."
  405. (let ((heading (org-get-heading)))
  406. (with-current-buffer (get-buffer-create "*arcology-tmp*")
  407. (org-mode)
  408. (insert heading)
  409. (goto-char (point-min))
  410. (replace-regexp ":[:a-zA-Z0-9-_]+:$" "")
  411. (let* ((str (htmlize-region-for-paste (point-min) (point-max))))
  412. (kill-buffer)
  413. (with-temp-buffer
  414. (insert str)
  415. (goto-char (point-min))
  416. (replace-regexp "<pre>" "")
  417. (goto-char (point-min))
  418. (replace-regexp "</pre>" "")
  419. (goto-char (point-min))
  420. (replace-regexp "<a href=\"https://twitter" "<a class=\"u-in-reply-to\" href=\"https://twitter")
  421. (buffer-string))))))
  422. (defun arcology-get-default-content (entry)
  423. (with-current-buffer (plist-get entry :buffer)
  424. (goto-char (plist-get entry :point))
  425. (with-current-buffer (org-html-export-as-html nil t nil t)
  426. (buffer-string))))
  427. (defun arcology-add-image-content-at-point (&optional width)
  428. (let* ((id (org-id-get-create))
  429. (attach-dir (org-attach-dir))
  430. (file-list (if attach-dir
  431. (org-attach-file-list attach-dir)
  432. '()))
  433. (real-width (cond (width width)
  434. ((= (length file-list) 1)
  435. 100)
  436. ((= (length file-list) 2)
  437. 49)
  438. (t 32))))
  439. (concat
  440. "<br/>"
  441. (mapconcat (lambda (file)
  442. (let ((file- (concat attach-dir "/" file))
  443. (newfile (concat arcology-site-root "/" id "-" file)))
  444. (message "%s" id)
  445. (unless (file-exists-p newfile)
  446. (copy-file file- newfile)
  447. (set-file-modes newfile 420))
  448. (format "%s%s%s"
  449. (concat "<a style=\"width: "
  450. (number-to-string real-width) "%\" href=\"" id "-" file "\">")
  451. (concat "<img src=\"" id "-" file "\" class=\"u-photo\"/>")
  452. "</a>")))
  453. file-list
  454. "\n"))))
  455. (defun arcology-add-image-content (entry &optional width)
  456. (with-current-buffer (plist-get entry :buffer)
  457. (goto-char (plist-get entry :point))
  458. (arcology-add-image-content-at-point width)))
  459. (defun arcology-plist-merge (&rest plists)
  460. "Merge a bunch of PLISTS together."
  461. (if plists
  462. (let ((result (copy-sequence (car plists))))
  463. (while (setq plists (cdr plists))
  464. (let ((plist (car plists)))
  465. (while plist
  466. (setq result (plist-put result (car plist) (car (cdr plist)))
  467. plist (cdr (cdr plist))))))
  468. result)
  469. nil))
  470. (defun arcology-get-ctime (proptable)
  471. "Infer a created time from PROPTABLE"
  472. (or (arcology-alist-get "CLOSED" proptable)
  473. (arcology-alist-get "TIMESTAMP_IA" proptable)
  474. (arcology-alist-get "TIMESTAMP" proptable)))
  475. (defun arcology-entry-to-html (entry)
  476. (with-current-buffer (plist-get entry :buffer)
  477. (goto-char (plist-get entry :point))
  478. (with-current-buffer (org-html-export-as-html nil t nil t)
  479. (buffer-string))))
  480. (defun arcology-syndicate-entry-at-point (&optional no-twitter no-facebook)
  481. "Syndicate the org-mode entry at point, by calling out to Bridgy and storing the result."
  482. (interactive)
  483. (let* ((date (arcology-get-ctime (org-entry-properties)))
  484. (date (org-time-string-to-seconds date))
  485. (base-url (plist-get arcology-publish-config :html-link-home))
  486. (url (format "%s/%s-note.html" base-url date))
  487. (syn-twitter (org-entry-get (point) "SYN-TWITTER"))
  488. (syn-facebook (org-entry-get (point) "SYN-FACEBOOK"))
  489. (syn-reply (org-entry-get (point) "SYN-IN-REPLY-TO"))
  490. (syn-like (org-entry-get (point) "SYN-LIKE-OF"))
  491. (realpoint (point)))
  492. (unless (and (not no-twitter) (> (length syn-twitter) 0))
  493. (let* ((url-request-data (format "source=%s&target=http://brid.gy/publish/twitter" url))
  494. (url-request-method "POST")
  495. (buf (url-retrieve-synchronously "https://brid.gy/publish/webmention")))
  496. (org-entry-put realpoint "SYN-TWITTER"
  497. (with-current-buffer buf
  498. (goto-char url-http-end-of-headers)
  499. (let* ((body (json-read))
  500. (url (assoc 'url body)))
  501. (when url
  502. (cdr url)))))))
  503. (unless (and (not no-facebook) (> (length syn-facebook) 0))
  504. (let* ((url-request-data (format "source=%s&target=http://brid.gy/publish/facebook" url))
  505. (url-request-method "POST")
  506. (buf (url-retrieve-synchronously "https://brid.gy/publish/webmention")))
  507. (org-entry-put realpoint "SYN-FACEBOOK"
  508. (with-current-buffer buf
  509. (goto-char url-http-end-of-headers)
  510. (let* ((body (json-read))
  511. (url (assoc 'url body)))
  512. (when url
  513. (cdr url)))))))))
  514. (def-arcology-entry-generator note (lambda (entry) ""))
  515. (def-arcology-entry-generator read
  516. #'arcology-get-default-content)
  517. (def-arcology-entry-generator article
  518. #'arcology-get-default-content)
  519. (def-arcology-entry-generator photo
  520. (lambda (entry)
  521. (concat
  522. (arcology-add-image-content entry)
  523. (arcology-entry-to-html entry))))
  524. (def-arcology-entry-generator jam
  525. (lambda (entry)
  526. (let ((query (replace-regexp-in-string "<.*> " "" (plist-get entry :title)))
  527. (str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
  528. (arcology-entry-to-html entry)
  529. "")))
  530. (format "<a href=\"https://youtube.com/results?search_query=%s\">%s</a> on YouTube <p>%s</p>" query query str))))
  531. (def-arcology-entry-generator
  532. like (lambda (entry) "")
  533. nil ((title-html (replace-regexp-in-string))))
  534. (def-arcology-entry-generator reply
  535. (lambda (entry)
  536. (let ((properties (plist-get entry :properties))
  537. (str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
  538. (arcology-entry-to-html entry)
  539. "")))
  540. (format "<a class=\"u-in-reply-to\" href=\"%s\">In reply to %s</a>... <p>%s</p>"
  541. (arcology-alist-get "U-IN-REPLY-TO" properties)
  542. (arcology-alist-get "U-IN-REPLY-TO" properties)
  543. str))))
  544. (def-arcology-entry-generator like
  545. (lambda (entry)
  546. (let ((properties (plist-get entry :properties))
  547. (str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
  548. (arcology-entry-to-html entry)
  549. "")))
  550. (format "<a class=\"u-like-of\" href=\"%s\">Ryan likes %s</a>... <p>%s</p>"
  551. (arcology-alist-get "U-LIKE-OF" properties)
  552. (arcology-alist-get "U-LIKE-OF" properties)
  553. str))))
  554. (def-arcology-entry-generator rsvp
  555. (lambda (entry)
  556. (let* ((properties (plist-get entry :properties))
  557. (rsvp (arcology-alist-get "P-RSVP" properties))
  558. (str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
  559. (arcology-entry-to-html entry)
  560. "")))
  561. (format "<a class=\"u-in-reply-to\" href=\"%s\"><data class=\"p-rsvp\" value=\"%s\">Ryan %s %s</data></a>... <p>%s</p>"
  562. (arcology-alist-get "U-IN-REPLY-TO" properties)
  563. rsvp
  564. (cond ((equal rsvp "yes")
  565. "is going to")
  566. ((equal rsvp "interested")
  567. "is interested in")
  568. ((equal rsvp "no")
  569. "is not going to")
  570. ((equal rsvp "maybe")
  571. "might go to"))
  572. (arcology-alist-get "U-IN-REPLY-TO" properties)
  573. str))))
  574. (def-arcology-entry-generator step
  575. (lambda (entry)
  576. (let* ((properties (plist-get entry :properties))
  577. (str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
  578. (arcology-entry-to-html entry)
  579. "")))
  580. (format "Ryan burnt <data class=\"p-calories\" value=\"%s\">%s calories</data> and walked <data class=\"p-distance\" value=\"%s\">%s</data> miles in <data class=\"p-steps\" value=\"%s\">%s steps</data> <p>%s</p>"
  581. (arcology-alist-get "CALORIES" properties)
  582. (arcology-alist-get "CALORIES" properties)
  583. (arcology-alist-get "DISTANCE" properties)
  584. (arcology-alist-get "DISTANCE" properties)
  585. (arcology-alist-get "STEPS" properties)
  586. (arcology-alist-get "STEPS" properties)
  587. str))))
  588. (def-arcology-entry-generator video
  589. (lambda (entry)
  590. (let* ((properties (plist-get entry :properties))
  591. (id (org-id-get-create))
  592. (attach-dir (org-attach-dir))
  593. (file-list (if attach-dir
  594. (org-attach-file-list attach-dir)
  595. '())))
  596. (format "%s%s%s"
  597. (if (arcology-alist-get "YOUTUBE-URL" properties)
  598. (format "<iframe %s %s src=\"http://www.youtube.com/embed/%s\"></iframe>"
  599. "type=\"text/html\" frameborder=\"0\""
  600. "width=\"750px\" height=\"562px\""
  601. (car (last (split-string (arcology-alist-get "YOUTUBE-URL" properties)
  602. "="))))
  603. "")
  604. (mapconcat (lambda (file)
  605. (let ((file- (concat attach-dir "/" file))
  606. (newfile (concat arcology-site-root "/" id "-" file)))
  607. (unless (file-exists-p newfile)
  608. (copy-file file- newfile)
  609. (set-file-modes newfile 420))
  610. (concat "<video controls style=\"width: 100%\" src=\"" id "-" file "\" class=\"u-video\"/><br/>")))
  611. file-list "\n")
  612. (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
  613. (arcology-entry-to-html entry)
  614. "")))))
  615. (def-arcology-entry-generator review
  616. (lambda (entry)
  617. (let* ((properties (plist-get entry :properties))
  618. (rating (arcology-alist-get "P-RATING" properties))
  619. (item (arcology-alist-get "P-ITEM" properties))
  620. (id (org-id-get-create))
  621. (attach-dir (org-attach-dir))
  622. (file-list (if attach-dir
  623. (org-attach-file-list attach-dir)
  624. '())))
  625. (format "%s%s%s%s"
  626. item
  627. (arcology-add-image-content entry)
  628. (arcology-entry-to-html entry)
  629. (format "I give this item a <data class=\"p-rating\" value=\"%s\">%s star</data> review out of 5 stars." rating rating)))))
  630. (provide 'arcology)
  631. ;;; arcology.el ends here