693 lines
31 KiB
EmacsLisp
693 lines
31 KiB
EmacsLisp
;;; arcology.el --- Another org-mode static site generator
|
|
|
|
;; Copyright (C) 2016 Ryan Rix
|
|
;; Author: Ryan Rix <ryan@whatthefuck.computer>
|
|
;; Version: 0.1
|
|
;; Package-Requires: ((json "0.1") (org "8.0"))
|
|
;; Keywords: web
|
|
;; URL: http://notes.whatthefuck.computer/
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package generates a small blog from org-mode files, leveraging Microformats to provide
|
|
;; semantic information about the posts; you can use this information to automate sharing,
|
|
;; linkbacks, embedding images in 3rd party silso, and more; see http://indiewebcamp.com and
|
|
;; http://microformats.org for more information.
|
|
|
|
;; This package can be used by configuring the various variables and then calling [`arcology']
|
|
;; which will publish the blog index, an RSS feed and URLs for each entry. You can then have Brid.gy
|
|
;; automatically syndicate the content to silos by calling [`arcology-syndicate-entry-at-point'].
|
|
|
|
;; From Wikipedia:
|
|
|
|
;; Arcology, a portmanteau of "architecture" and "ecology", is a vision of architectural design
|
|
;; principles for very densely populated habitats. The concept has been primarily popularized, and
|
|
;; the term itself coined, by architect Paolo Soleri. It also appears in science fiction. These
|
|
;; structures have been largely hypothetical insofar as no 'arcology' envisioned by Soleri himself
|
|
;; has yet been completed, but he posited that a completed arcology would provide space for a
|
|
;; variety of residential, commercial, and agricultural facilities while minimizing individual human
|
|
;; environmental impact. Arcologies are often portrayed in sci-fi as self-contained or economically
|
|
;; self-sufficient.
|
|
|
|
;; Arcology aims to be a self-sufficient blogging platform, where you can leverage the work that
|
|
;; IndieWeb actors have done to build a self-sufficient site with the full support of "social media"
|
|
;; type offerings like comments, reposts, checkins, all running under your own domain and backed by
|
|
;; plain text that you can control yourself or generate using simple scripts or Memacs
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl)
|
|
(require 'org-attach)
|
|
(require 'ox-html)
|
|
(require 'htmlize)
|
|
(require 'url-http)
|
|
(require 'url)
|
|
(require 'json)
|
|
|
|
(require 'arcology-util)
|
|
|
|
;;;###autoload
|
|
(defgroup arcology nil
|
|
"Static org-mode site generator")
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-site-root "~/tmp/arcology"
|
|
"The base directory to generate the site in to."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-site-tag "BLORG-NOEXPORT+EXPORT"
|
|
"Org tag that Arcology will look for."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-publish-config
|
|
'(:rss-image-url "http://whatthefuck.computer/~rrix/25ZLKRlf.jpg"
|
|
:html-link-home "https://notes.whatthefuck.computer"
|
|
:html-link-use-abs-url t
|
|
:rss-extension "xml"
|
|
:select-tags ("EXPORT")
|
|
:exclude-tags ("NOEXPORT")
|
|
:publishing-directory "/ssh:fontkeming.fail:/var/www/sites/notes.whatthefuck.computer/_site/"
|
|
:table-of-contents nil
|
|
:section-numbers nil
|
|
:recursive t)
|
|
"An `org-publish-project-alist' format plist containing shared state between all of the temporary publish projects."
|
|
:group 'arcology)
|
|
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-default-template-file (expand-file-name "~/Code/notes/templates/default.html")
|
|
"Template file to use for fallback"
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-note-template-file (expand-file-name "~/Code/notes/templates/note.html")
|
|
"Template file to use for notes"
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-read-template-file (expand-file-name "~/Code/notes/templates/default.html")
|
|
"Template file to use for read-items"
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-article-template-file (expand-file-name "~/Code/notes/templates/default.html")
|
|
"Template file to use for full-length articles."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-photo-template-file (expand-file-name "~/Code/notes/templates/default.html")
|
|
"Template file to use for notes."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-jam-template-file (expand-file-name "~/Code/notes/templates/default.html")
|
|
"Template file to use for jam posts."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-reply-template-file (expand-file-name "~/Code/notes/templates/reply.html")
|
|
"Template file to use for replies."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-index-template-file (expand-file-name "~/Code/notes/templates/index.html")
|
|
"Template file to use for the site index."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-review-template-file (expand-file-name "~/Code/notes/templates/review.html")
|
|
"Template file to use for reviews."
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-index-title "Computer :("
|
|
"The title of your site"
|
|
:group 'arcology)
|
|
|
|
;;;###autoload
|
|
(defcustom arcology-webmention.io-api-key nil
|
|
"API Key for webmention.io, used to pull all mentions."
|
|
:group 'arcology)
|
|
|
|
(defvar arcology-entry-cache nil)
|
|
(defvar arcology-full-postlist nil)
|
|
|
|
;;;###autoload
|
|
(defun arcology (use-cache &optional preview)
|
|
"Generate the Arcology site.
|
|
|
|
If USE-CACHE is non-nil, use the cache instead of refreshing the
|
|
cache. If PREVIEW is non-nil, skip publishing."
|
|
(interactive "P")
|
|
(let ((config (arcology-make-config)))
|
|
(when (not use-cache)
|
|
(setq arcology-entry-cache nil)
|
|
(setq arcology-full-postlist nil)
|
|
(arcology-index-entries config))
|
|
(unless (file-exists-p arcology-site-root)
|
|
(mkdir arcology-site-root t))
|
|
(arcology-generate-modified-entries config)
|
|
(arcology-generate-indices config))
|
|
(copy-file "~/Code/notes/webmention.js" (concat arcology-site-root "/webmention.js") t)
|
|
(copy-file "~/Code/notes/go.png" (concat arcology-site-root "/go.png") t)
|
|
(copy-file "~/Code/notes/favicon.gif" (concat arcology-site-root "/favicon.gif") t)
|
|
(copy-file "~/Code/notes/rix_green.png" (concat arcology-site-root "/rix_green.png") t)
|
|
(copy-directory "~/Code/notes/css" (concat arcology-site-root "/css") t t t)
|
|
(copy-directory "~/Code/notes/font" (concat arcology-site-root "/font") t t t)
|
|
(unless preview
|
|
(arcology-publish)))
|
|
|
|
(defun arcology-publish ()
|
|
"Publish an already-rendered Arcology site"
|
|
(interactive)
|
|
(let* ((config (arcology-make-config))
|
|
(org-publish-project-alist
|
|
(list (append '("notes_other")
|
|
(arcology-plist-merge '(:base-extension "JPG\\|js\\|html\\|jpg\\|gif\\|png\\|css\\|woff\\|eot\\|ttf\\|svg\\|woff2" :publishing-function (org-publish-attachment))
|
|
arcology-publish-config
|
|
config)))))
|
|
(org-publish "notes_other")))
|
|
|
|
(defun arcology-generate-indices (config)
|
|
(arcology-generate-index config :index (lambda (metadata) nil))
|
|
(mapc (lambda (post-type)
|
|
(arcology-generate-index config post-type
|
|
(lambda (metadata)
|
|
(not (eq (elt metadata 0) post-type)))))
|
|
(arcology-post-types-from-list arcology-full-postlist)))
|
|
|
|
(defun arcology-post-types-from-list (postlist)
|
|
(reduce (lambda (last current)
|
|
(if (member (elt current 0) last)
|
|
last
|
|
(append last (list (elt current 0)))))
|
|
postlist
|
|
:initial-value '()))
|
|
|
|
(defun arcology-make-config (&optional base)
|
|
(let (plist (list))
|
|
(append (list :base-directory arcology-site-root)
|
|
(list :site-tag arcology-site-tag)
|
|
(when base
|
|
base))))
|
|
|
|
(defun arcology-index-entries (config)
|
|
"Generate an index of entries that Arcology should build in to its site."
|
|
(org-map-entries 'arcology-index-entry
|
|
(plist-get config :site-tag)
|
|
'agenda))
|
|
|
|
(defun arcology-generate-modified-entries (config)
|
|
;; XXX: Have this just iterate over the entry-cache using the logic in at-point....
|
|
;; Right now this O(x^N) where x is posts, and N is post types. UGH.
|
|
(arcology-plist-mapc #'arcology-generate-modified-entries-for-type
|
|
arcology-entry-cache))
|
|
|
|
(defun arcology-filter (condp lst)
|
|
(delq nil
|
|
(mapcar (lambda (x) (and (funcall condp x) x)) lst)))
|
|
|
|
(defun arcology-format-time (time &optional iso)
|
|
"Convert a time as float or int since epoch to presentable."
|
|
(let ((format (if iso
|
|
"%FT%T%z"
|
|
"%H:%MZ on %e %B %Y")))
|
|
(format-time-string format (seconds-to-time time) t)))
|
|
|
|
(defun arcology-generate-index (config type filterfun)
|
|
(arcology-write-template
|
|
(format "%s/%s.html" arcology-site-root
|
|
(replace-regexp-in-string ":" "" (prin1-to-string type)))
|
|
arcology-index-template-file
|
|
:content (mapconcat (lambda (metadata)
|
|
(let* ((entry-type (elt metadata 0))
|
|
(key (elt metadata 1))
|
|
(entry-list (plist-get arcology-entry-cache
|
|
entry-type))
|
|
(entry (lax-plist-get entry-list
|
|
key)))
|
|
(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>"
|
|
(replace-regexp-in-string ":" "" (prin1-to-string entry-type))
|
|
(plist-get entry :title-html)
|
|
(elt metadata 3)
|
|
(arcology-format-time (elt metadata 4) t)
|
|
(arcology-format-time (elt metadata 4))
|
|
(plist-get entry :index-html))))
|
|
(cl-remove-if filterfun (reverse arcology-full-postlist)) "\n")
|
|
:title arcology-index-title
|
|
:title-html arcology-index-title
|
|
:url (plist-get config :base-directory)))
|
|
|
|
(defun arcology-plist-mapc (fun plist)
|
|
(cl-loop for (k v) on plist by 'cddr
|
|
collect
|
|
(funcall fun k v)))
|
|
|
|
(defun arcology-generate-modified-entries-for-type (cache-type entries)
|
|
(case cache-type
|
|
((:note) (arcology-plist-mapc #'arcology-make-note-entry entries))
|
|
((:read) (arcology-plist-mapc #'arcology-make-read-entry entries))
|
|
((:like) (arcology-plist-mapc #'arcology-make-like-entry entries))
|
|
((:step) (arcology-plist-mapc #'arcology-make-step-entry entries))
|
|
((:photo) (arcology-plist-mapc #'arcology-make-photo-entry entries))
|
|
((:video) (arcology-plist-mapc #'arcology-make-video-entry entries))
|
|
((:jam) (arcology-plist-mapc #'arcology-make-jam-entry entries))
|
|
((:review) (arcology-plist-mapc #'arcology-make-review-entry entries))
|
|
((:reply) (arcology-plist-mapc #'arcology-make-reply-entry entries))
|
|
((:rsvp) (arcology-plist-mapc #'arcology-make-rsvp-entry entries))
|
|
((:checkin) (progn
|
|
(require 'arcology-checkin)
|
|
(arcology-plist-mapc #'arcology-make-checkin-entry entries)))
|
|
((:article) (arcology-plist-mapc #'arcology-make-article-entry entries))))
|
|
|
|
(defmacro def-arcology-entry-generator (type content-generator &optional extra-body extra-lets)
|
|
(let ((fname (intern (format "arcology-make-%s-entry" type)))
|
|
(type-as-symbol (intern (format ":%s" type)))
|
|
(template-file-var (intern (format "arcology-%s-template-file" type))))
|
|
`(defun ,fname (key entry)
|
|
(save-window-excursion
|
|
(with-current-buffer (plist-get entry :buffer)
|
|
(goto-char (plist-get entry :point))
|
|
(unless (file-exists-p arcology-site-root)
|
|
(make-directory arcology-site-root))
|
|
(let* ((pubdate (plist-get entry :created-at))
|
|
(pubdate (org-time-string-to-seconds pubdate))
|
|
(filename (format "%s-note.html" pubdate))
|
|
(fullpath (format "%s/%s" arcology-site-root filename))
|
|
(title (plist-get entry :title))
|
|
(title-html (plist-get entry :title-html))
|
|
(content (funcall ,content-generator entry))
|
|
(base-url (plist-get arcology-publish-config :html-link-home))
|
|
(full-url (concat base-url "/" filename))
|
|
(syn-twitter-url (arcology-alist-get "SYN-TWITTER" (plist-get entry :properties)))
|
|
(syn-facebook-url (arcology-alist-get "SYN-FACEBOOK" (plist-get entry :properties)))
|
|
(syn-twitter-href (if (> (length syn-twitter-url) 0)
|
|
(format "<a rel=\"syndication\" href=\"%s\">On Twitter</a>" syn-twitter-url)
|
|
""))
|
|
(syn-facebook-href (if (> (length syn-facebook-url) 0)
|
|
(format "<a rel=\"syndication\" href=\"%s\">On Facebook</a>" syn-facebook-url)
|
|
""))
|
|
,@(when extra-lets
|
|
extra-lets))
|
|
(org-entry-put (point) "RSS_PERMALINK" filename)
|
|
,@(when extra-body
|
|
extra-body)
|
|
(arcology-write-template fullpath ,(if (boundp template-file-var)
|
|
template-file-var
|
|
arcology-default-template-file)
|
|
:content content
|
|
:title title
|
|
:title-html title-html
|
|
:url full-url
|
|
:dt-published (format "<time class=\"dt-published\" datetime=\"%s\">%s</time>"
|
|
(arcology-format-time (truncate pubdate) t)
|
|
(arcology-format-time (truncate pubdate)))
|
|
:twitter syn-twitter-href
|
|
:facebook syn-facebook-href)
|
|
(let ((cache-entry (list ,type-as-symbol key fullpath full-url (truncate pubdate))))
|
|
(unless (member cache-entry arcology-full-postlist)
|
|
(add-to-ordered-list 'arcology-full-postlist
|
|
cache-entry
|
|
pubdate)))))))))
|
|
|
|
(defun arcology-write-template (fullpath template-file &rest template-args)
|
|
(with-current-buffer (find-file-noselect fullpath)
|
|
(erase-buffer)
|
|
(if (file-exists-p template-file)
|
|
(insert-file template-file)
|
|
(insert-file arcology-default-template-file))
|
|
(goto-char (point-min))
|
|
(replace-regexp "{{content}}" (or (plist-get template-args :content)
|
|
""))
|
|
(goto-char (point-min))
|
|
(replace-regexp "{{title}}" (or (plist-get template-args :title)
|
|
""))
|
|
(goto-char (point-min))
|
|
(replace-regexp "{{title-html}}" (or (plist-get template-args :title-html)
|
|
""))
|
|
(goto-char (point-min))
|
|
(replace-regexp "{{url}}" (or (plist-get template-args :url)
|
|
""))
|
|
(goto-char (point-min))
|
|
(replace-regexp "{{dt-published}}" (or (plist-get template-args :dt-published)
|
|
""))
|
|
(goto-char (point-min))
|
|
(replace-regexp "<a class=\"u-syndication\" href=\"{{twitter}}\">On Twitter</a>" (or (plist-get template-args :twitter)
|
|
""))
|
|
(goto-char (point-min))
|
|
(replace-regexp "<a class=\"u-syndication\" href=\"{{facebook}}\">On Facebook</a>" (or (plist-get template-args :facebook)
|
|
""))
|
|
(write-file fullpath)
|
|
(kill-buffer (current-buffer))))
|
|
|
|
(defun arcology-index-entry (&optional not-scanning)
|
|
"Index the entry at point.
|
|
|
|
This function basically just routes to other functions based on
|
|
inferring the post type of a given entry."
|
|
(interactive)
|
|
(let* ((org-trust-scanner-tags nil)
|
|
(proptable (org-entry-properties))
|
|
(ctime (arcology-get-ctime proptable))
|
|
(key (or (org-id-get)
|
|
ctime)))
|
|
(let* ((title (elt (org-heading-components) 4))
|
|
(buffer (current-buffer))
|
|
(point (point))
|
|
(tags (org-get-tags-at))
|
|
(entry-text (arcology-clean-entry-text (org-get-entry)))
|
|
(sub-cache-type (arcology-entry-type-at-point))
|
|
(sub-cache (or (plist-get arcology-entry-cache sub-cache-type)
|
|
(list)))
|
|
(index-html (arcology-index-snippet-for-entry-at-point)))
|
|
(if (not (member "NOEXPORT" tags))
|
|
(let ((res (list :title (replace-regexp-in-string "<.*> " "" title)
|
|
:title-html (replace-regexp-in-string "<.*>" "" (arcology-heading-to-html))
|
|
:length (length entry-text)
|
|
:buffer buffer
|
|
:point point
|
|
:properties proptable
|
|
:index-html index-html
|
|
:created-at ctime)))
|
|
(setq arcology-entry-cache
|
|
(plist-put arcology-entry-cache sub-cache-type
|
|
(plist-put sub-cache key
|
|
res)))
|
|
(list sub-cache-type res))))))
|
|
|
|
(defun arcology-entry-type-at-point ()
|
|
(cond ((member "READ" tags) :read)
|
|
((member "CHECKIN" tags) :checkin)
|
|
((arcology-alist-get "P-RSVP" proptable) :rsvp)
|
|
((arcology-alist-get "YOUTUBE-URL" proptable) :video)
|
|
((member "REPLY" tags) :reply)
|
|
((member "LIKE" tags) :like)
|
|
((member "STEPS" tags) :step)
|
|
;; ((member "EVENT" tags) :event)
|
|
;; ((member "BOOKMARK" tags) :bookmark)
|
|
;; ((member "REPOST" tags) :repost)
|
|
((member "JAM" tags) :jam)
|
|
((member "REVIEW" tags) :review)
|
|
;; ((member "RSVP" tags) :rsvp)
|
|
((and (member "ATTACH" tags)
|
|
(string-match-p "\\.[\(jpg\)\|\(png\)\|\(gif\)]+$"
|
|
(arcology-alist-get "ATTACHMENTS" proptable)))
|
|
:photo)
|
|
((and (member "ATTACH" tags)
|
|
(string-match-p "\\.[\(ogv\)\|\(mp4\)\|\(mkv\)]+$"
|
|
(arcology-alist-get "ATTACHMENTS" proptable)))
|
|
:video)
|
|
((not (> (length entry-text) 0)) :note)
|
|
(t :article)))
|
|
|
|
(defun arcology-index-snippet-for-entry-at-point ()
|
|
(cond ((> (length (if (org-attach-dir) (org-attach-file-list (org-attach-dir)) '())) 0)
|
|
(arcology-add-image-content-at-point 10))
|
|
(t "")))
|
|
|
|
(defun arcology-publish-entry-at-point (point &optional suppress-publish)
|
|
(interactive "d")
|
|
(goto-char point)
|
|
;; index the entry
|
|
(let* ((entry (arcology-index-entry t))
|
|
(proptable (org-entry-properties))
|
|
(ctime (arcology-get-ctime proptable))
|
|
(key (or (org-id-get)
|
|
ctime)))
|
|
(case (car entry)
|
|
;; render it
|
|
((:note) (arcology-make-note-entry key (cadr entry)))
|
|
((:read) (arcology-make-read-entry key (cadr entry)))
|
|
((:like) (arcology-make-like-entry key (cadr entry)))
|
|
((:step) (arcology-make-step-entry key (cadr entry)))
|
|
((:photo) (arcology-make-photo-entry key (cadr entry)))
|
|
((:video) (arcology-make-video-entry key (cadr entry)))
|
|
((:jam) (arcology-make-jam-entry key (cadr entry)))
|
|
((:review) (arcology-make-review-entry key (cadr entry)))
|
|
((:reply) (arcology-make-reply-entry key (cadr entry)))
|
|
((:checkin) (progn
|
|
(require 'arcology-checkin)
|
|
(arcology-make-checkin-entry key (cadr entry))))
|
|
((:article) (arcology-make-article-entry key (cadr entry))))
|
|
;; render indices
|
|
(arcology-generate-indices (arcology-make-config))
|
|
;; publish
|
|
(unless suppress-publish
|
|
(arcology-publish))))
|
|
|
|
(defun arcology-clean-entry-text (entry)
|
|
(replace-regexp-in-string
|
|
"[[0-9]+-.*]\n?" ""
|
|
(replace-regexp-in-string
|
|
"CLOSED:.*\n?" ""
|
|
(replace-regexp-in-string
|
|
"^\s*:[A-Za-z0-9-_]+:.*\n?" ""
|
|
(org-get-entry)))))
|
|
|
|
(defun arcology-alist-get (key obj)
|
|
"Easy JSON accessor, get KEY's value from OBJ."
|
|
(cdr (assoc key obj)))
|
|
|
|
(defun arcology-heading-to-html ()
|
|
"HTMLize the heading at point, cleaning up crap and generating in-reply-to URLs."
|
|
(let ((heading (org-get-heading)))
|
|
(with-current-buffer (get-buffer-create "*arcology-tmp*")
|
|
(org-mode)
|
|
(insert heading)
|
|
(goto-char (point-min))
|
|
(replace-regexp ":[:a-zA-Z0-9-_]+:$" "")
|
|
(let* ((str (htmlize-region-for-paste (point-min) (point-max))))
|
|
(kill-buffer)
|
|
(with-temp-buffer
|
|
(insert str)
|
|
(goto-char (point-min))
|
|
(replace-regexp "<pre>" "")
|
|
(goto-char (point-min))
|
|
(replace-regexp "</pre>" "")
|
|
(goto-char (point-min))
|
|
(replace-regexp "<a href=\"https://twitter" "<a class=\"u-in-reply-to\" href=\"https://twitter")
|
|
(buffer-string))))))
|
|
|
|
(defun arcology-get-default-content (entry)
|
|
(with-current-buffer (plist-get entry :buffer)
|
|
(goto-char (plist-get entry :point))
|
|
(with-current-buffer (org-html-export-as-html nil t nil t)
|
|
(buffer-string))))
|
|
|
|
(defun arcology-add-image-content-at-point (&optional width)
|
|
(let* ((id (org-id-get-create))
|
|
(attach-dir (org-attach-dir))
|
|
(file-list (if attach-dir
|
|
(org-attach-file-list attach-dir)
|
|
'()))
|
|
(real-width (cond (width width)
|
|
((= (length file-list) 1)
|
|
100)
|
|
((= (length file-list) 2)
|
|
49)
|
|
(t 32))))
|
|
(concat
|
|
"<br/>"
|
|
(mapconcat (lambda (file)
|
|
(let ((file- (concat attach-dir "/" file))
|
|
(newfile (concat arcology-site-root "/" id "-" file)))
|
|
(message "%s" id)
|
|
(unless (file-exists-p newfile)
|
|
(copy-file file- newfile)
|
|
(set-file-modes newfile 420))
|
|
(format "%s%s%s"
|
|
(concat "<a style=\"width: "
|
|
(number-to-string real-width) "%\" href=\"" id "-" file "\">")
|
|
(concat "<img src=\"" id "-" file "\" class=\"u-photo\"/>")
|
|
"</a>")))
|
|
file-list
|
|
"\n"))))
|
|
|
|
(defun arcology-add-image-content (entry &optional width)
|
|
(with-current-buffer (plist-get entry :buffer)
|
|
(goto-char (plist-get entry :point))
|
|
(arcology-add-image-content-at-point width)))
|
|
|
|
(defun arcology-plist-merge (&rest plists)
|
|
"Merge a bunch of PLISTS together."
|
|
(if plists
|
|
(let ((result (copy-sequence (car plists))))
|
|
(while (setq plists (cdr plists))
|
|
(let ((plist (car plists)))
|
|
(while plist
|
|
(setq result (plist-put result (car plist) (car (cdr plist)))
|
|
plist (cdr (cdr plist))))))
|
|
result)
|
|
nil))
|
|
|
|
(defun arcology-get-ctime (proptable)
|
|
"Infer a created time from PROPTABLE"
|
|
(or (arcology-alist-get "CLOSED" proptable)
|
|
(arcology-alist-get "TIMESTAMP_IA" proptable)
|
|
(arcology-alist-get "TIMESTAMP" proptable)))
|
|
|
|
(defun arcology-entry-to-html (entry)
|
|
(with-current-buffer (plist-get entry :buffer)
|
|
(goto-char (plist-get entry :point))
|
|
(with-current-buffer (org-html-export-as-html nil t nil t)
|
|
(buffer-string))))
|
|
|
|
(defun arcology-syndicate-entry-at-point (&optional no-twitter no-facebook)
|
|
"Syndicate the org-mode entry at point, by calling out to Bridgy and storing the result."
|
|
(interactive)
|
|
(let* ((date (arcology-get-ctime (org-entry-properties)))
|
|
(date (org-time-string-to-seconds date))
|
|
(base-url (plist-get arcology-publish-config :html-link-home))
|
|
(url (format "%s/%s-note.html" base-url date))
|
|
(syn-twitter (org-entry-get (point) "SYN-TWITTER"))
|
|
(syn-facebook (org-entry-get (point) "SYN-FACEBOOK"))
|
|
(syn-reply (org-entry-get (point) "SYN-IN-REPLY-TO"))
|
|
(syn-like (org-entry-get (point) "SYN-LIKE-OF"))
|
|
(realpoint (point)))
|
|
(unless (and (not no-twitter) (> (length syn-twitter) 0))
|
|
(let* ((url-request-data (format "source=%s&target=http://brid.gy/publish/twitter" url))
|
|
(url-request-method "POST")
|
|
(buf (url-retrieve-synchronously "https://brid.gy/publish/webmention")))
|
|
(org-entry-put realpoint "SYN-TWITTER"
|
|
(with-current-buffer buf
|
|
(goto-char url-http-end-of-headers)
|
|
(let* ((body (json-read))
|
|
(url (assoc 'url body)))
|
|
(when url
|
|
(cdr url)))))))
|
|
(unless (and (not no-facebook) (> (length syn-facebook) 0))
|
|
(let* ((url-request-data (format "source=%s&target=http://brid.gy/publish/facebook" url))
|
|
(url-request-method "POST")
|
|
(buf (url-retrieve-synchronously "https://brid.gy/publish/webmention")))
|
|
(org-entry-put realpoint "SYN-FACEBOOK"
|
|
(with-current-buffer buf
|
|
(goto-char url-http-end-of-headers)
|
|
(let* ((body (json-read))
|
|
(url (assoc 'url body)))
|
|
(when url
|
|
(cdr url)))))))))
|
|
|
|
(def-arcology-entry-generator note (lambda (entry) ""))
|
|
(def-arcology-entry-generator read
|
|
#'arcology-get-default-content)
|
|
(def-arcology-entry-generator article
|
|
#'arcology-get-default-content)
|
|
(def-arcology-entry-generator photo
|
|
(lambda (entry)
|
|
(concat
|
|
(arcology-add-image-content entry)
|
|
(arcology-entry-to-html entry))))
|
|
(def-arcology-entry-generator jam
|
|
(lambda (entry)
|
|
(let ((query (replace-regexp-in-string "<.*> " "" (plist-get entry :title)))
|
|
(str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
|
|
(arcology-entry-to-html entry)
|
|
"")))
|
|
(format "<a href=\"https://youtube.com/results?search_query=%s\">%s</a> on YouTube <p>%s</p>" query query str))))
|
|
(def-arcology-entry-generator
|
|
like (lambda (entry) "")
|
|
nil ((title-html (replace-regexp-in-string))))
|
|
(def-arcology-entry-generator reply
|
|
(lambda (entry)
|
|
(let ((properties (plist-get entry :properties))
|
|
(str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
|
|
(arcology-entry-to-html entry)
|
|
"")))
|
|
(format "<a class=\"u-in-reply-to\" href=\"%s\">In reply to %s</a>... <p>%s</p>"
|
|
(arcology-alist-get "U-IN-REPLY-TO" properties)
|
|
(arcology-alist-get "U-IN-REPLY-TO" properties)
|
|
str))))
|
|
(def-arcology-entry-generator like
|
|
(lambda (entry)
|
|
(let ((properties (plist-get entry :properties))
|
|
(str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
|
|
(arcology-entry-to-html entry)
|
|
"")))
|
|
(format "<a class=\"u-like-of\" href=\"%s\">Ryan likes %s</a>... <p>%s</p>"
|
|
(arcology-alist-get "U-LIKE-OF" properties)
|
|
(arcology-alist-get "U-LIKE-OF" properties)
|
|
str))))
|
|
(def-arcology-entry-generator rsvp
|
|
(lambda (entry)
|
|
(let* ((properties (plist-get entry :properties))
|
|
(rsvp (arcology-alist-get "P-RSVP" properties))
|
|
(str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
|
|
(arcology-entry-to-html entry)
|
|
"")))
|
|
(format "<a class=\"u-in-reply-to\" href=\"%s\"><data class=\"p-rsvp\" value=\"%s\">Ryan %s %s</data></a>... <p>%s</p>"
|
|
(arcology-alist-get "U-IN-REPLY-TO" properties)
|
|
rsvp
|
|
(cond ((equal rsvp "yes")
|
|
"is going to")
|
|
((equal rsvp "interested")
|
|
"is interested in")
|
|
((equal rsvp "no")
|
|
"is not going to")
|
|
((equal rsvp "maybe")
|
|
"might go to"))
|
|
(arcology-alist-get "U-IN-REPLY-TO" properties)
|
|
str))))
|
|
(def-arcology-entry-generator step
|
|
(lambda (entry)
|
|
(let* ((properties (plist-get entry :properties))
|
|
(str (if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
|
|
(arcology-entry-to-html entry)
|
|
"")))
|
|
(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>"
|
|
(arcology-alist-get "CALORIES" properties)
|
|
(arcology-alist-get "CALORIES" properties)
|
|
(arcology-alist-get "DISTANCE" properties)
|
|
(arcology-alist-get "DISTANCE" properties)
|
|
(arcology-alist-get "STEPS" properties)
|
|
(arcology-alist-get "STEPS" properties)
|
|
str))))
|
|
|
|
(def-arcology-entry-generator video
|
|
(lambda (entry)
|
|
(let* ((properties (plist-get entry :properties))
|
|
(id (org-id-get-create))
|
|
(attach-dir (org-attach-dir))
|
|
(file-list (if attach-dir
|
|
(org-attach-file-list attach-dir)
|
|
'())))
|
|
(format "%s%s%s"
|
|
(if (arcology-alist-get "YOUTUBE-URL" properties)
|
|
(format "<iframe %s %s src=\"http://www.youtube.com/embed/%s\"></iframe>"
|
|
"type=\"text/html\" frameborder=\"0\""
|
|
"width=\"750px\" height=\"562px\""
|
|
(car (last (split-string (arcology-alist-get "YOUTUBE-URL" properties)
|
|
"="))))
|
|
"")
|
|
(mapconcat (lambda (file)
|
|
(let ((file- (concat attach-dir "/" file))
|
|
(newfile (concat arcology-site-root "/" id "-" file)))
|
|
(unless (file-exists-p newfile)
|
|
(copy-file file- newfile)
|
|
(set-file-modes newfile 420))
|
|
(concat "<video controls style=\"width: 100%\" src=\"" id "-" file "\" class=\"u-video\"/><br/>")))
|
|
file-list "\n")
|
|
(if (> (length (arcology-clean-entry-text (org-get-entry))) 0)
|
|
(arcology-entry-to-html entry)
|
|
"")))))
|
|
|
|
(def-arcology-entry-generator review
|
|
(lambda (entry)
|
|
(let* ((properties (plist-get entry :properties))
|
|
(rating (arcology-alist-get "P-RATING" properties))
|
|
(item (arcology-alist-get "P-ITEM" properties))
|
|
(id (org-id-get-create))
|
|
(attach-dir (org-attach-dir))
|
|
(file-list (if attach-dir
|
|
(org-attach-file-list attach-dir)
|
|
'())))
|
|
(format "%s%s%s%s"
|
|
item
|
|
(arcology-add-image-content entry)
|
|
(arcology-entry-to-html entry)
|
|
(format "I give this item a <data class=\"p-rating\" value=\"%s\">%s star</data> review out of 5 stars." rating rating)))))
|
|
|
|
(provide 'arcology)
|
|
;;; arcology.el ends here
|