initial commit
This commit is contained in:
928
exepub.el
Normal file
928
exepub.el
Normal file
@ -0,0 +1,928 @@
|
||||
;;; exepub.el --- Org‑Mode asset workflow management -*- lexical-binding: t -*-
|
||||
|
||||
;; Author: Emmanuele Somma <emmanuele@exedre.org>
|
||||
;; Maintainer: Emmanuele Somma <emmanuele@exedre.org>
|
||||
;; Version: 0.1
|
||||
;; Package‑Requires: ((emacs "25.1") (org "9.0"))
|
||||
;; Keywords: org, publishing, workflow, assets
|
||||
;; URL: https://git.xed.it/exedre/exepub.el
|
||||
;; License: GNU GPL 3.0
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements a complete workflow for creating, drafting,
|
||||
;; publishing, archiving, and disseminating Org‑Mode assets.
|
||||
;;
|
||||
;; Commands provided include:
|
||||
;; • exepub/article-create — create a new draft asset with metadata;
|
||||
;; • exepub/regenerate-slug — recompute #+SLUG from TITLE and KEYWORDS;
|
||||
;; • exepub/disseminate — atomically move a draft into archive,
|
||||
;; update STATUS and PUBLISHED headers;
|
||||
;; • exepub/open-drafts
|
||||
;; • exepub/open-archive
|
||||
;; • exepub/open-year
|
||||
;; • exepub/open-attic — quickly jump to respective directories;
|
||||
;; • exepub/export-to — generate a format‑specific manifestation
|
||||
;; for a given correspondent.
|
||||
;;
|
||||
;; All operations preserve atomicity (with rollback on failure), enforce
|
||||
;; a clear directory structure under `exepub/home-directory`, and maintain
|
||||
;; consistent metadata in Org headers.
|
||||
|
||||
;;; Code:
|
||||
(require 'ox-org)
|
||||
(require 'uuidgen)
|
||||
|
||||
(defgroup exepub nil
|
||||
"Configuration for the exepub workflow: asset production and dissemination."
|
||||
:group 'applications)
|
||||
|
||||
(defcustom exepub/home-directory
|
||||
"~/Dropbox/LIFE/10-projects/10.70 exepub/container/"
|
||||
"Base directory for exepub.
|
||||
Contains the subdirectories: attic, draft, archive, template."
|
||||
:type 'directory
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/log-publishing-project
|
||||
"net.exedre"
|
||||
"Base project for publishing log."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defun exepub--ensure-dirs ()
|
||||
"Ensure the existence of the required subdirectories under `exepub/home-directory`."
|
||||
(dolist (sub '("attic" "draft" "archive" "template"))
|
||||
(let ((dir (expand-file-name sub exepub/home-directory)))
|
||||
(unless (file-directory-p dir)
|
||||
(make-directory dir t)))))
|
||||
|
||||
(defun exepub/article-create (slug keywords)
|
||||
"Create a new asset under the `draft/` directory.
|
||||
|
||||
SLUG is a string where spaces (including multiple) are replaced by hyphens.
|
||||
KEYWORDS is a comma-separated list; commas become underscores, spaces become hyphens."
|
||||
(interactive
|
||||
(list (read-string "Create new article draft with slug: ") ;
|
||||
(read-string "Keywords (comma-separated): ")))
|
||||
(exepub--ensure-dirs)
|
||||
(let* ((timestamp (format-time-string "%Y%m%dT%H%M%S"))
|
||||
(clean-slug
|
||||
(downcase
|
||||
(replace-regexp-in-string
|
||||
"[[:space:]]+" "-"
|
||||
(string-trim slug))))
|
||||
(kw-list (split-string keywords "," t "[ \t\n]*"))
|
||||
(clean-kws
|
||||
(mapconcat
|
||||
(lambda (kw)
|
||||
(downcase
|
||||
(replace-regexp-in-string "[[:space:]]+" "-"
|
||||
(string-trim kw))))
|
||||
kw-list "_"))
|
||||
(dirname (format "%s--%s__%s" timestamp clean-slug clean-kws))
|
||||
(draft-root (expand-file-name "draft" exepub/home-directory))
|
||||
(template-dir (expand-file-name "template" exepub/home-directory))
|
||||
(asset-dir (expand-file-name dirname draft-root))
|
||||
(org-file (expand-file-name "draft.org" asset-dir)))
|
||||
(make-directory asset-dir t)
|
||||
(with-temp-buffer
|
||||
;; Import shared #+OPTIONS from template/options.org if available
|
||||
(let ((options-file (expand-file-name "options.org" template-dir)))
|
||||
(when (file-readable-p options-file)
|
||||
(insert-file-contents options-file)
|
||||
(unless (bolp) (insert "\n"))))
|
||||
;; Insert basic headers
|
||||
(insert (format "#+TITLE: %s\n"
|
||||
(replace-regexp-in-string "-" " " clean-slug)))
|
||||
(insert (format "#+CREATED: %s\n"
|
||||
(format-time-string "%Y-%m-%d")))
|
||||
(insert "#+STATUS: draft\n")
|
||||
(insert (format "#+SLUG: %s\n" clean-slug))
|
||||
(insert (format "#+KEYWORDS: %s\n\n" keywords))
|
||||
(write-file org-file))
|
||||
(find-file org-file)
|
||||
(message "New asset created in %s" asset-dir)))
|
||||
|
||||
(defun exepub/regenerate-slug ()
|
||||
"Regenerate the #+SLUG: value from #+TITLE: and #+KEYWORDS: in the current buffer."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (title keywords slug-base kw-list kw-part final-slug)
|
||||
(unless (re-search-forward "^#\\+TITLE:[ \t]*\\(.+\\)$" nil t)
|
||||
(user-error "No #+TITLE: found"))
|
||||
(setq title (match-string 1))
|
||||
(when (re-search-forward "^#\\+KEYWORDS:[ \t]*\\(.*\\)$" nil t)
|
||||
(setq keywords (match-string 1)))
|
||||
;; Build slug from TITLE
|
||||
(setq slug-base
|
||||
(downcase
|
||||
(replace-regexp-in-string
|
||||
"[:'[:space:]]+" "-"
|
||||
(string-trim title))))
|
||||
;; Append keyword part if present
|
||||
(when keywords
|
||||
(setq kw-list (split-string keywords "," t "[ \t\n]*")
|
||||
kw-part
|
||||
(mapconcat
|
||||
(lambda (kw)
|
||||
(downcase
|
||||
(replace-regexp-in-string "[[:space:]]+" "-"
|
||||
(string-trim kw))))
|
||||
kw-list "_")))
|
||||
(setq final-slug
|
||||
(if kw-part
|
||||
(concat slug-base "__" kw-part)
|
||||
slug-base))
|
||||
;; Replace or insert the #+SLUG: header
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^#\\+SLUG:[ \t]*\\(.*\\)$" nil t)
|
||||
(replace-match (concat "#+SLUG: " final-slug) t t)
|
||||
(when (re-search-forward "^#\\+STATUS:" nil t)
|
||||
(beginning-of-line)
|
||||
(insert (format "#+SLUG: %s\n" final-slug))))
|
||||
(message "Slug updated to: %s" final-slug))))
|
||||
|
||||
(defcustom exepub/default-created
|
||||
(format-time-string "%Y-%m-%d")
|
||||
"Default value for #+CREATED: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-status
|
||||
"draft"
|
||||
"Default value for #+STATUS: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-published
|
||||
""
|
||||
"Default value for #+PUBLISHED: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-embargo-start
|
||||
""
|
||||
"Default value for #+EMBARGO_START: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-embargo-end
|
||||
""
|
||||
"Default value for #+EMBARGO_END: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-keywords
|
||||
""
|
||||
"Default value for #+KEYWORDS: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-secs
|
||||
""
|
||||
"Default value for #+SECS: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-dissemination
|
||||
""
|
||||
"Default value for #+DISSEMINATION: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-type
|
||||
"article"
|
||||
"Default value for #+TYPE: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-bibliography
|
||||
"../../bibliografia.bib"
|
||||
"Default value for #+BIBLIOGRAPHY: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-slug
|
||||
""
|
||||
"Default value for #+SLUG: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-license
|
||||
"CC BY-NC-ND"
|
||||
"Default value for :LICENSE: property."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defcustom exepub/default-channels
|
||||
""
|
||||
"Default value for #+CHANNELS: header."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defun exepub/org-export-insert-default-template (orig-fn &rest args)
|
||||
"Extend `C-c C-e #` export template with all EXEPUB headers."
|
||||
(let ((org-export-options-alist
|
||||
(append org-export-options-alist
|
||||
`((:created "CREATED" nil ,exepub/default-created nil)
|
||||
(:status "STATUS" nil ,exepub/default-status nil)
|
||||
(:published "PUBLISHED" nil ,exepub/default-published nil)
|
||||
(:embargo_start "EMBARGO_START" nil ,exepub/default-embargo-start nil)
|
||||
(:embargo_end "EMBARGO_END" nil ,exepub/default-embargo-end nil)
|
||||
(:keywords "KEYWORDS" nil ,exepub/default-keywords nil)
|
||||
(:secs "SECS" nil ,exepub/default-secs nil)
|
||||
(:dissemination "DISSEMINATION" nil ,exepub/default-dissemination nil)
|
||||
(:type "TYPE" nil ,exepub/default-type nil)
|
||||
(:bibliography "BIBLIOGRAPHY" nil ,exepub/default-bibliography nil)
|
||||
(:slug "SLUG" nil ,exepub/default-slug nil)
|
||||
(:channels "CHANNELS" nil ,exepub/default-channels nil)))))
|
||||
(apply orig-fn args)))
|
||||
(advice-add 'org-export-insert-default-template :around
|
||||
#'exepub/org-export-insert-default-template)
|
||||
|
||||
(defun exepub/update-header (key value)
|
||||
"Set or update the Org header #+KEY: VALUE in the current buffer.
|
||||
If VALUE is a function, call it with the previous header value (or nil)
|
||||
and use its return as the new value. Otherwise VALUE must be a string."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let* ((key-up (upcase key))
|
||||
(regexp (format "^#\\+%s:[ \t]*\\(.*\\)$" key-up))
|
||||
prev new-val)
|
||||
(if (re-search-forward regexp nil t)
|
||||
(progn
|
||||
(setq prev (match-string 1))
|
||||
(setq new-val (if (functionp value)
|
||||
(funcall value prev)
|
||||
value))
|
||||
(replace-match (format "#+%s: %s" key-up new-val) t t))
|
||||
;; Insert new header at top if none found
|
||||
(setq prev nil)
|
||||
(setq new-val (if (functionp value)
|
||||
(funcall value prev)
|
||||
value))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^#\\+\\w+:" nil t)
|
||||
(progn
|
||||
(beginning-of-line)
|
||||
(insert (format "#+%s: %s\n" key-up new-val)))
|
||||
(insert (format "#+%s: %s\n" key-up new-val)))))))
|
||||
|
||||
(defun exepub/disseminate ()
|
||||
"Atomically move the current asset from draft to archive and update metadata.
|
||||
If any step fails, rollback to the original draft state, and set STATUS to 'dissemination'."
|
||||
(interactive)
|
||||
(let* ((orig-file (buffer-file-name))
|
||||
(draft-root (expand-file-name "draft/" exepub/home-directory)))
|
||||
(unless (and orig-file
|
||||
(string-prefix-p draft-root
|
||||
(file-name-directory orig-file)))
|
||||
(user-error "This must be called on an asset under %sdraft/"
|
||||
exepub/home-directory))
|
||||
;; Save buffer if modified
|
||||
(when (buffer-modified-p)
|
||||
(save-buffer))
|
||||
;; Regenerate slug from title and keywords
|
||||
(exepub/regenerate-slug)
|
||||
;; Gather paths and names
|
||||
(let* ((new-slug (save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward
|
||||
"^#\\+SLUG:[ \t]*\\(.+\\)$" nil t)
|
||||
(match-string 1)
|
||||
(user-error "No #+SLUG: header"))))
|
||||
(orig-dir (directory-file-name
|
||||
(file-name-directory orig-file)))
|
||||
(created-name (file-name-nondirectory orig-dir))
|
||||
(creation-ts (car (split-string created-name "--")))
|
||||
(new-dir-name (concat creation-ts "--" new-slug))
|
||||
(timestamp (format-time-string "%Y%m%dT%H%M%S"))
|
||||
(pub-date (format-time-string "%Y-%m-%d"))
|
||||
(year (format-time-string "%Y"))
|
||||
(archive-root (expand-file-name "archive/" exepub/home-directory))
|
||||
(year-dir (expand-file-name year archive-root))
|
||||
(new-filename (concat timestamp "--" new-slug ".org"))
|
||||
(draft-new-dir (expand-file-name new-dir-name draft-root))
|
||||
(archive-new-dir (expand-file-name new-dir-name year-dir))
|
||||
(temp-file (expand-file-name new-filename orig-dir))
|
||||
(final-file (expand-file-name new-filename archive-new-dir))
|
||||
;; stack of rollback actions
|
||||
(rollback-actions '())
|
||||
(success nil))
|
||||
(kill-buffer)
|
||||
(condition-case err
|
||||
(progn
|
||||
;; 1) rename draft.org → temp-file
|
||||
(rename-file orig-file temp-file)
|
||||
(push (lambda () (ignore-errors
|
||||
(rename-file temp-file orig-file)))
|
||||
rollback-actions)
|
||||
;; 2) rename orig-dir → draft-new-dir
|
||||
(unless (string= orig-dir draft-new-dir)
|
||||
(rename-file orig-dir draft-new-dir)
|
||||
(push (lambda () (ignore-errors
|
||||
(rename-file draft-new-dir orig-dir)))
|
||||
rollback-actions))
|
||||
;; 3) ensure year-dir exists
|
||||
(unless (file-directory-p year-dir)
|
||||
(make-directory year-dir t)
|
||||
(push (lambda () (ignore-errors
|
||||
(delete-directory year-dir)))
|
||||
rollback-actions))
|
||||
;; 4) move draft-new-dir → archive-new-dir
|
||||
(rename-file draft-new-dir archive-new-dir)
|
||||
(push (lambda () (ignore-errors
|
||||
(rename-file archive-new-dir draft-new-dir)))
|
||||
rollback-actions)
|
||||
;; 5) open final file, update headers, save
|
||||
(find-file final-file)
|
||||
(exepub/update-header "PUBLISHED" pub-date)
|
||||
(exepub/update-header "STATUS" "dissemination")
|
||||
(save-buffer)
|
||||
(setq success t)
|
||||
(message "Asset disseminated to %s" archive-new-dir))
|
||||
(error
|
||||
;; rollback on error
|
||||
(unless success
|
||||
(dolist (act rollback-actions)
|
||||
(funcall act)))
|
||||
(error "Dissemination failed: %s" (error-message-string err)))))))
|
||||
|
||||
(defun exepub/open-drafts ()
|
||||
"Open dired in the `draft` directory of `exepub/home-directory`."
|
||||
(interactive)
|
||||
(exepub--ensure-dirs)
|
||||
(dired (expand-file-name "draft" exepub/home-directory)))
|
||||
|
||||
(defun exepub/open-archive ()
|
||||
"Open dired in the `archive` directory of `exepub/home-directory`."
|
||||
(interactive)
|
||||
(exepub--ensure-dirs)
|
||||
(dired (expand-file-name "archive" exepub/home-directory)))
|
||||
|
||||
(defun exepub/open-year (year)
|
||||
"Open dired in the YEAR subdirectory under `archive`.
|
||||
Create the YEAR directory if it does not exist."
|
||||
(interactive
|
||||
(let* ((archive-root (expand-file-name "archive" exepub/home-directory))
|
||||
(years (when (file-directory-p archive-root)
|
||||
(cl-remove-if-not
|
||||
#'file-directory-p
|
||||
(directory-files archive-root t "^[0-9]\\{4\\}$"))))
|
||||
(choices (mapcar #'file-name-nondirectory years))
|
||||
(default-year (format-time-string "%Y"))
|
||||
(year (completing-read
|
||||
(format "Year (default %s): " default-year)
|
||||
choices nil nil nil nil default-year)))
|
||||
(list year)))
|
||||
(exepub--ensure-dirs)
|
||||
(let ((dir (expand-file-name year
|
||||
(expand-file-name "archive"
|
||||
exepub/home-directory))))
|
||||
(unless (file-directory-p dir)
|
||||
(make-directory dir t))
|
||||
(dired dir)))
|
||||
|
||||
(defun exepub/open-attic ()
|
||||
"Open dired in the `attic` directory of `exepub/home-directory`."
|
||||
(interactive)
|
||||
(exepub--ensure-dirs)
|
||||
(dired (expand-file-name "attic" exepub/home-directory)))
|
||||
|
||||
|
||||
|
||||
;; Keybindings for exepub under prefix C-c q
|
||||
(defvar exepub-command-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
map)
|
||||
"Keymap for exepub commands under C-c q.")
|
||||
|
||||
;; Bind the prefix
|
||||
(define-key global-map (kbd "C-c q") exepub-command-map)
|
||||
|
||||
;; Primary commands
|
||||
(define-key exepub-command-map (kbd "c") 'exepub/article-create)
|
||||
(define-key exepub-command-map (kbd "r") 'exepub/regenerate-slug)
|
||||
(define-key exepub-command-map (kbd "s") 'exepub/disseminate)
|
||||
(define-key exepub-command-map (kbd "e") 'exepub/export-to)
|
||||
|
||||
;; Directory navigation commands (two-letter suffix)
|
||||
(define-key exepub-command-map (kbd "od") 'exepub/open-drafts)
|
||||
(define-key exepub-command-map (kbd "oa") 'exepub/open-archive)
|
||||
(define-key exepub-command-map (kbd "oy") 'exepub/open-year)
|
||||
(define-key exepub-command-map (kbd "ot") 'exepub/open-attic)
|
||||
|
||||
;; If you use `which-key`, you can add descriptive labels:
|
||||
(with-eval-after-load 'which-key
|
||||
(which-key-add-key-based-replacements
|
||||
"C-c q" "exepub"
|
||||
"C-c q c" "create article"
|
||||
"C-c q r" "regenerate slug"
|
||||
"C-c q s" "disseminate asset"
|
||||
"C-c q e" "export to format"
|
||||
"C-c q od" "open drafts"
|
||||
"C-c q oa" "open archive"
|
||||
"C-c q oy" "open year"
|
||||
"C-c q ot" "open attic"))
|
||||
|
||||
|
||||
(defun exepub/update-option (option value)
|
||||
"Set or update OPTION in the #+OPTIONS line to VALUE in the current buffer.
|
||||
If VALUE is a function, it is called with the previous OPTION value (or nil)
|
||||
and its return is used as the new setting."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^#\\+OPTIONS:[ \t]*\\(.*\\)$" nil t)
|
||||
(let* ((opts (split-string (match-string 1) "[ \t]+" t))
|
||||
;; find previous value for OPTION
|
||||
(prev (catch 'found
|
||||
(dolist (opt opts)
|
||||
(when (string-prefix-p (concat option ":") opt)
|
||||
(throw 'found
|
||||
(substring opt (1+ (length option)))))
|
||||
)
|
||||
nil))
|
||||
;; compute new value
|
||||
(new-val (if (functionp value)
|
||||
(funcall value prev)
|
||||
value))
|
||||
;; remove any existing OPTION entries
|
||||
(filtered (cl-remove-if
|
||||
(lambda (opt)
|
||||
(string-prefix-p (concat option ":") opt))
|
||||
opts))
|
||||
;; append the new OPTION
|
||||
(new-opts (append filtered (list (concat option ":" new-val))))
|
||||
(joined (string-join new-opts " ")))
|
||||
;; replace the entire #+OPTIONS: line
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^#\\+OPTIONS:[ \t]*\\(.*\\)$" nil t)
|
||||
(replace-match (concat "#+OPTIONS: " joined) t t)))
|
||||
;; no OPTIONS line: insert one
|
||||
(let ((new-val (if (functionp value) (funcall value nil) value)))
|
||||
(insert (format "#+OPTIONS: %s:%s\n" option new-val))))))
|
||||
|
||||
;; export
|
||||
|
||||
(defun exepub--license-info (license)
|
||||
"Parse LICENSE and return plist (:url URL :icons ICON-LIST).
|
||||
Supports Creative Commons (CC), GNU GPL and GNU FDL.
|
||||
LICENSE may omit the version (defaults: CC→4.0, GPL→3.0, FDL→1.3)."
|
||||
(let* ((s (downcase (string-trim license)))
|
||||
(parts (split-string s "[ \t]+" t))
|
||||
(first (car parts)))
|
||||
(cond
|
||||
;; Creative Commons
|
||||
((string= first "cc")
|
||||
(let* ((rest (cdr parts))
|
||||
;; if last part is numeric, take it as version
|
||||
(lasttok (car (last rest)))
|
||||
(version (if (string-match-p "^[0-9]+\\(?:\\.[0-9]+\\)?$" lasttok)
|
||||
lasttok "4.0"))
|
||||
;; scheme tokens exclude version
|
||||
(scheme-toks (if (string= version lasttok)
|
||||
(butlast rest) rest))
|
||||
(scheme (mapconcat 'identity
|
||||
(mapcar #'downcase scheme-toks) "-"))
|
||||
(url (format "https://creativecommons.org/licenses/%s/%s/"
|
||||
scheme version))
|
||||
;; always CC icon plus each element of scheme
|
||||
(icons (cons "cc"
|
||||
(mapcar (lambda (tok) tok)
|
||||
scheme-toks))))
|
||||
(list :url url
|
||||
:icons icons)))
|
||||
;; GNU licenses
|
||||
((and (member first '("gnu"))
|
||||
(>= (length parts) 2))
|
||||
(let* ((family (nth 1 parts)) ; "gpl" or "fdl"
|
||||
(rest (nthcdr 2 parts))
|
||||
(lasttok (car (last rest)))
|
||||
(defaults '(("gpl" . "3.0") ("fdl" . "1.3")))
|
||||
(default (or (cdr (assoc family defaults)) ""))
|
||||
(version (if (and lasttok
|
||||
(string-match-p "^[0-9]+\\(?:\\.[0-9]+\\)?$"
|
||||
lasttok))
|
||||
lasttok default))
|
||||
(url-base (pcase family
|
||||
("gpl" "https://www.gnu.org/licenses/gpl-%s.html")
|
||||
("fdl" "https://www.gnu.org/licenses/fdl-%s.html")
|
||||
(_ "")))
|
||||
(url (if (and url-base (not (string-empty-p version)))
|
||||
(format url-base version)
|
||||
"")))
|
||||
(list :url url
|
||||
:icons nil)))
|
||||
((string= s "©")
|
||||
;; Copyright symbol → All Rights Reserved
|
||||
(list :url "" :icons nil :label "All Rights Reserved"))
|
||||
;; fallback: no specific license info
|
||||
(t
|
||||
(list :url ""
|
||||
:icons nil)))))
|
||||
|
||||
(defun exepub--format-org-ts (time)
|
||||
"Return org active timestamp for TIME with Italian weekday."
|
||||
(let* ((dow-num (string-to-number (format-time-string "%w" time)))
|
||||
(dows ["dom" "lun" "mar" "mer" "gio" "ven" "sab"])
|
||||
(dow (aref dows dow-num)))
|
||||
(format "<%s %s>"
|
||||
(format-time-string "%Y-%m-%d" time)
|
||||
dow)))
|
||||
|
||||
(defun exepub--ensure-manifestations-section ()
|
||||
"Ensure a top-level * Manifestations :noexport: exists."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(unless (re-search-forward "^\\*+ Manifestations" nil t)
|
||||
(goto-char (point-max))
|
||||
(insert "\n* Manifestations :noexport:\n"))))
|
||||
|
||||
(defun exepub--find-end-of-subtree ()
|
||||
"Move to end of current Org subtree and return point."
|
||||
(save-excursion
|
||||
(org-end-of-subtree t t)
|
||||
(point)))
|
||||
|
||||
(defun exepub--ensure-format-subsection (fmt corr)
|
||||
"Under * Manifestations, ensure a ** FMT:CORR heading exists."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "^\\*+ Manifestations" nil t)
|
||||
(let* ((limit (exepub--find-end-of-subtree))
|
||||
(heading (format "** %s:%s" fmt corr)))
|
||||
(unless (save-excursion
|
||||
(re-search-forward (concat "^" (regexp-quote heading) "$")
|
||||
limit t))
|
||||
(goto-char limit)
|
||||
(insert (concat "\n" heading "\n\n"))))))
|
||||
|
||||
(defun exepub--goto-format-subtree (fmt corr)
|
||||
"Position point at beginning of ** FMT:CORR subtree."
|
||||
(goto-char (point-min))
|
||||
(re-search-forward (format "^\\*+ Manifestations" ) nil t)
|
||||
(let ((limit (exepub--find-end-of-subtree))
|
||||
(re (format "^** %s:%s" fmt corr)))
|
||||
(unless (re-search-forward re limit t)
|
||||
(error "Subsection %s:%s not found" fmt corr))
|
||||
|
||||
(point)))
|
||||
|
||||
|
||||
|
||||
(defun exepub--update-property (prop value)
|
||||
"In the PROPERTIES drawer at point, set PROP to VALUE.
|
||||
If PROP exists, replace its entire line; otherwise insert it before :END:."
|
||||
(save-excursion
|
||||
(let ((drawer-beg (re-search-forward "^:PROPERTIES:" nil t))
|
||||
drawer-end)
|
||||
(unless drawer-beg
|
||||
;; create drawer if missing
|
||||
(goto-char (point-max))
|
||||
(insert "\n:PROPERTIES:\n:END:\n")
|
||||
(setq drawer-beg (save-excursion
|
||||
(re-search-backward "^:PROPERTIES:" nil t))))
|
||||
(setq drawer-end (save-excursion
|
||||
(goto-char drawer-beg)
|
||||
(re-search-forward "^:END:" nil t)))
|
||||
(goto-char drawer-beg)
|
||||
(if (re-search-forward (format "^:%s:.*$" prop) drawer-end t)
|
||||
;; replace existing line
|
||||
(let ((beg (line-beginning-position))
|
||||
(end (line-end-position)))
|
||||
(delete-region beg (1+ end))
|
||||
(goto-char beg)
|
||||
(insert (format ":%s: %s\n" prop value)))
|
||||
;; insert new line before :END:
|
||||
(goto-char drawer-end)
|
||||
(beginning-of-line)
|
||||
(insert (format ":%s: %s\n" prop value))))))
|
||||
|
||||
|
||||
|
||||
(defun exepub/org-timestamp-to-pretty (ts)
|
||||
"Restituisce TS (stringa Org like <YYYY-MM-DD dow>) formattata più leggibile."
|
||||
(let* ((plain (replace-regexp-in-string "<[<>]" "" ts)) ; togli ‹‹››
|
||||
(time-list (org-parse-time-string plain))
|
||||
;; sec min hour day month year dow ... zone
|
||||
(time (apply #'encode-time time-list)))
|
||||
(format-time-string "%A, %e %B %Y" time)))
|
||||
|
||||
(defun exepub--insert-license-footer (uuid slug author title year license licensed-to embargoed-to)
|
||||
"Append an Org-formatted license footer given SLUG, TITLE, YEAR, LICENSE."
|
||||
(let* ((info (exepub--license-info license))
|
||||
(url (plist-get info :url))
|
||||
(icons (plist-get info :icons)))
|
||||
;; link to object and author/license text
|
||||
(insert "#+ATTR_HTML: :class license-footer\n")
|
||||
(insert (format "[[https://exedre.net/objects/%s][%s]] © %s di \
|
||||
[[https://exedre.org/about][%s]] " uuid title year author))
|
||||
(if (string= license "©")
|
||||
(insert (format "Tutti i diritti riservati %s" (if (null licensed-to) "" (format ", questo contenuto è concesso a %s e non può essere destinato ad altri." licensed-to))))
|
||||
(insert (format "è concesso%s sotto licenza [[%s][%s]] "
|
||||
(if (null licensed-to) "" (format " a %s" licensed-to))
|
||||
url license)))
|
||||
;; icons as inline Org links
|
||||
(when icons
|
||||
(dolist (ic icons)
|
||||
(insert (format "[[https://mirrors.creativecommons.org/presskit/icons/%s.svg]] "
|
||||
ic))))
|
||||
(unless (null embargoed-to)
|
||||
(insert "\n#+ATTR_HTML: :class embargo-footer\n")
|
||||
(insert (format "Quest'articolo è coperto da embargo \
|
||||
fino a %s. Per favore non divulgarlo pubblicamente \
|
||||
online o in stampa fino a quella data. Dopo quella data potrai trovare
|
||||
la versione definitiva da distribuire al link https://exedre.net/objects/%s" (exepub/org-timestamp-to-pretty embargoed-to) uuid)))))
|
||||
|
||||
|
||||
(defun exepub--property-exists-p (prop)
|
||||
"Return non-nil if PROP exists in the current PROPERTIES drawer."
|
||||
(not (null (exepub--get-property prop))))
|
||||
|
||||
(defun exepub--get-bool-property (prop)
|
||||
"Return the value of PROP in the current PROPERTIES drawer, or nil."
|
||||
(let ((prop-v (exepub--get-property prop)))
|
||||
(when prop-v
|
||||
(string= prop-v "t"))))
|
||||
|
||||
(defun exepub--get-property (prop)
|
||||
"Return the value of PROP in the current PROPERTIES drawer, or nil.
|
||||
Uses `org-entry-get` instead of manual regexp parsing."
|
||||
(let ((val (org-entry-get (point) prop)))
|
||||
(and val (not (string= val "")) val)))
|
||||
|
||||
(defun exepub--collect-properties ()
|
||||
"Restituisce un’alist di tutte le proprietà PROPERTIES nel buffer corrente."
|
||||
(save-excursion
|
||||
(when (re-search-forward "^:PROPERTIES:" nil t)
|
||||
(let ((end (re-search-forward "^:END:" nil t))
|
||||
props)
|
||||
(goto-char (match-beginning 0))
|
||||
(while (re-search-forward "^:\\([^:]+\\):[ \t]*\\(.*\\)$" end t)
|
||||
(push (cons (match-string 1) (match-string 2)) props))
|
||||
props))))
|
||||
|
||||
(defun exepub/export-to (format correspondent)
|
||||
"Create a manifestation of the current asset in FORMAT for CORRESPONDENT, using LICENSE.
|
||||
|
||||
Also update the source Org with a * Manifestations section, update its
|
||||
** FORMAT:CORRESPONDENT properties and then generate the manifest Org,
|
||||
disable its title export, set STATUS to \"manifestation\" and append
|
||||
a dynamic license footer."
|
||||
(interactive
|
||||
(list (read-string "Format (e.g. html, latex, md, org): " "html")
|
||||
(read-string "Correspondent (e.g. agenda-digitale): " "personal")))
|
||||
(let ((orig-file (buffer-file-name)))
|
||||
(let ((status
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^#\\+STATUS:[ \t]*\\(.*\\)$" nil t)
|
||||
(string-trim (match-string 1))))))
|
||||
(unless (string= status "dissemination")
|
||||
(user-error "export-to only runs when STATUS is dissemination (current: %s)"
|
||||
status)))
|
||||
;; 1) ensure we are in archive/
|
||||
(unless (and orig-file
|
||||
(string-prefix-p
|
||||
(expand-file-name "archive/" exepub/home-directory)
|
||||
(file-name-directory orig-file)))
|
||||
(user-error "This must be called on a file in archive/"))
|
||||
(save-buffer)
|
||||
;; 2) update source Org's *Manifestations* subtree
|
||||
(let (license-val licensed-to embargoed-to uuid
|
||||
(prop-hash (make-hash-table :test 'equal)))
|
||||
(with-current-buffer (find-file-noselect orig-file)
|
||||
(exepub--ensure-manifestations-section)
|
||||
(let* ((fmt-down (downcase format))
|
||||
(corr-root (car (split-string correspondent "--")))
|
||||
(corr-clean (replace-regexp-in-string
|
||||
"[^[:alnum:]-]" "" corr-root))
|
||||
(corr-safe (downcase
|
||||
(replace-regexp-in-string
|
||||
"[[:space:]]+" "-" corr-clean)))
|
||||
(manifest-id (format "%s-%s" fmt-down corr-safe)))
|
||||
(exepub--ensure-format-subsection fmt-down corr-safe)
|
||||
(exepub--goto-format-subtree fmt-down corr-safe)
|
||||
(let ((lock (exepub--get-property "LOCK")))
|
||||
(when (string= lock "t")
|
||||
(user-error "Manifestation %s is locked, aborting export" manifest-id)))
|
||||
(setq licensed-to
|
||||
(exepub--get-property "LICENSED-TO"))
|
||||
(setq license-val
|
||||
(or (exepub--get-property "LICENSE")
|
||||
exepub/default-license))
|
||||
(unless (exepub--property-exists-p "LICENSE")
|
||||
(exepub--update-property "LICENSE" license-val))
|
||||
(unless (exepub--property-exists-p "UUID")
|
||||
(exepub--update-property "UUID" (uuidgen-1)))
|
||||
(exepub--update-property "DELIVERED"
|
||||
(exepub--format-org-ts (current-time)))
|
||||
(exepub--update-property "EMBARGO"
|
||||
(exepub--format-org-ts
|
||||
(time-add (current-time)
|
||||
(days-to-time 22))))
|
||||
(setq embargoed-to
|
||||
(when (exepub--get-bool-property "SHOW-EMBARGO")
|
||||
(exepub--get-property "EMBARGO")))
|
||||
(setq uuid (exepub--get-property "UUID"))
|
||||
(exepub--goto-format-subtree fmt-down corr-safe)
|
||||
(dolist (kv (org-entry-properties))
|
||||
(unless (member (car kv)
|
||||
'("CATEGORY" "BLOCKED" "ALLTAGS"
|
||||
"FILE" "PRIORITY" "ITEM"))
|
||||
(puthash (car kv) (cdr kv) prop-hash)))
|
||||
(save-buffer)
|
||||
;; 3) build paths for the manifest
|
||||
(let* ((asset-dir (file-name-directory orig-file))
|
||||
(man-root (expand-file-name "manifestation" asset-dir))
|
||||
(man-dir (expand-file-name manifest-id man-root))
|
||||
(slug-full (save-excursion
|
||||
(find-file-noselect orig-file)
|
||||
(goto-char (point-min))
|
||||
(and (re-search-forward
|
||||
"^#\\+SLUG:[[:space:]]*\\(.+\\)$"
|
||||
nil t)
|
||||
(match-string 1))))
|
||||
(slug-root (car (split-string slug-full "__")))
|
||||
(org-copy (expand-file-name (concat slug-root ".org") man-dir))
|
||||
(title (save-excursion
|
||||
(find-file-noselect orig-file)
|
||||
(goto-char (point-min))
|
||||
(and (re-search-forward
|
||||
"^#\\+TITLE:[[:space:]]*\\(.+\\)$"
|
||||
nil t)
|
||||
(match-string 1))))
|
||||
(author (save-excursion
|
||||
(find-file-noselect orig-file)
|
||||
(goto-char (point-min))
|
||||
(and (re-search-forward
|
||||
"^#\\+AUTHOR:[[:space:]]*\\(.+\\)$"
|
||||
nil t)
|
||||
(match-string 1))))
|
||||
(year (format-time-string "%Y")))
|
||||
;; 4) prepare and perform Org→Org export
|
||||
(make-directory man-dir t)
|
||||
(condition-case _
|
||||
(org-export-to-file 'org org-copy nil nil nil nil
|
||||
'(:exclude-tags ("noexport")))
|
||||
(error (copy-file orig-file org-copy t)))
|
||||
;; 5) adjust the manifest Org
|
||||
(with-current-buffer (find-file-noselect org-copy)
|
||||
(maphash (lambda (k v)
|
||||
(exepub/update-header k v))
|
||||
prop-hash)
|
||||
(exepub/update-option "title" "nil")
|
||||
(exepub/update-header "STATUS" "manifestation")
|
||||
(goto-char (point-max))
|
||||
(exepub--insert-license-footer uuid slug-root author title year license-val licensed-to embargoed-to)
|
||||
(save-buffer))
|
||||
;; 6) final export or placeholder
|
||||
(let ((buf (find-file-noselect org-copy)))
|
||||
(unwind-protect
|
||||
(with-current-buffer buf
|
||||
(pcase fmt-down
|
||||
("html" (let ((out (org-html-export-to-html nil nil nil nil nil)))
|
||||
(browse-url-of-file (expand-file-name out man-dir))))
|
||||
("md" (org-md-export-to-markdown nil nil nil nil nil))
|
||||
("latex" (org-latex-export-to-pdf nil nil nil nil nil))
|
||||
("org" (message "Org manifest dissemination: %s" org-copy))
|
||||
(_ (with-temp-file
|
||||
(expand-file-name
|
||||
(format "need-to-be-exported-to-%s" fmt-down)
|
||||
man-dir)))))
|
||||
(kill-buffer buf)))
|
||||
(message "Manifestation %s created in %s" manifest-id man-dir)))))))
|
||||
|
||||
;;; exepub-save-hook.el --- Regenerate slug and rename directory on save
|
||||
|
||||
|
||||
(defun exepub--maybe-regenerate-slug-and-rename-on-save ()
|
||||
"On save under `exepub/home-directory`, adjust slug and rename.
|
||||
If STATUS is \"manifestation\", rename only the Org file to <slug>.org.
|
||||
If STATUS is \"dissemination\", rename both containing directory to <creation>--<slug>
|
||||
and the Org file to <slug>.org.
|
||||
Otherwise, rename only the containing directory."
|
||||
(when (and buffer-file-name
|
||||
(derived-mode-p 'org-mode)
|
||||
(string-prefix-p
|
||||
(file-name-as-directory (expand-file-name exepub/home-directory))
|
||||
(file-name-as-directory (file-name-directory buffer-file-name))))
|
||||
;; Regenerate slug
|
||||
(exepub/regenerate-slug)
|
||||
;; Read STATUS
|
||||
(let* ((status (save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"^#\\+STATUS:[ \t]*\\(.*\\)$" nil t)
|
||||
(string-trim (match-string 1)))))
|
||||
(file buffer-file-name)
|
||||
(dir (file-name-directory file))
|
||||
(parent (directory-file-name dir))
|
||||
;; extract creation timestamp from dirname "TS--slug"
|
||||
(base (file-name-nondirectory parent))
|
||||
(parts (split-string base "--"))
|
||||
(creation (car parts))
|
||||
;; get full slug and root (before __)
|
||||
(full-slug (save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward
|
||||
"^#\\+SLUG:[ \t]*\\(.+\\)$" nil t)
|
||||
(match-string 1))))
|
||||
(slug-root (car (split-string full-slug "__")))
|
||||
;; new names
|
||||
(new-dir-name (concat creation "--" full-slug))
|
||||
(new-parent (expand-file-name new-dir-name
|
||||
(file-name-directory parent)))
|
||||
(new-file-name (concat slug-root ".org"))
|
||||
(new-file-path (expand-file-name new-file-name
|
||||
(if (member status '("dissemination" "default"))
|
||||
new-parent
|
||||
parent))))
|
||||
(pcase status
|
||||
("manifestation"
|
||||
;; only rename file
|
||||
(unless (string= (file-name-nondirectory file) new-file-name)
|
||||
(rename-file file new-file-path t)
|
||||
(set-visited-file-name new-file-path t t)))
|
||||
("dissemination"
|
||||
;; rename directory, then rename file inside it
|
||||
(unless (string= parent new-parent)
|
||||
(rename-file parent new-parent))
|
||||
(unless (string= (file-name-nondirectory file) new-file-name)
|
||||
(rename-file
|
||||
(expand-file-name (file-name-nondirectory file) new-parent)
|
||||
new-file-path t)
|
||||
(set-visited-file-name new-file-path t t)))
|
||||
(_
|
||||
;; other: rename directory only
|
||||
(unless (string= parent new-parent)
|
||||
(rename-file parent new-parent)
|
||||
(let ((file-in-new (expand-file-name
|
||||
(file-name-nondirectory file)
|
||||
new-parent)))
|
||||
(set-visited-file-name file-in-new t t))))))))
|
||||
|
||||
(add-hook 'before-save-hook
|
||||
#'exepub--maybe-regenerate-slug-and-rename-on-save)
|
||||
|
||||
|
||||
(defcustom exepub/git-base-url
|
||||
"https://git.xed.it/org.exedre/exepub-repo/src/branch/main"
|
||||
"Base URL for links to the Git repository."
|
||||
:type 'string
|
||||
:group 'exepub)
|
||||
|
||||
(defun exepub/log-publish-manifestation ()
|
||||
"Create a log entry org-file for the current manifestation.
|
||||
The entry is saved under the base directory of `exepub/log-publishing-project'.
|
||||
Filename is TIMESTAMP–UUID.org. Fields TITLE, AUTHOR, DATE, LICENSE,
|
||||
and a Git link are recorded."
|
||||
(interactive)
|
||||
(let* ((orig (buffer-file-name))
|
||||
(proj exepub/log-publishing-project)
|
||||
;; retrieve project plist
|
||||
(plist (cdr (assoc proj org-publish-project-alist)))
|
||||
(base (plist-get plist :base-directory)))
|
||||
(unless (and orig base (file-directory-p base))
|
||||
(user-error "Cannot find publishing project %s or its base-dir" proj))
|
||||
;; gather metadata from buffer
|
||||
(let* ((uuid (or (org-entry-get nil "ID")
|
||||
(org-entry-get nil "UUID")
|
||||
(user-error "No ID/UUID in buffer")))
|
||||
(ts (format-time-string "%Y%m%dT%H%M%S"))
|
||||
(fn (format "%s-%s.org" ts uuid))
|
||||
(dest (expand-file-name fn base))
|
||||
(title (or (org-entry-get nil "TITLE")
|
||||
(user-error "No #+TITLE: found")))
|
||||
(author (or (org-entry-get nil "AUTHOR")
|
||||
user-full-name))
|
||||
(license (or (org-entry-get nil "LICENSE")
|
||||
exepub/default-license))
|
||||
(reldir (file-relative-name orig exepub/home-directory))
|
||||
(giturl (concat (file-name-as-directory exepub/git-base-url)
|
||||
reldir)))
|
||||
;; write the log file
|
||||
(with-temp-file dest
|
||||
;; header options
|
||||
(insert "#+OPTIONS: toc:nil num:nil html-style:nil\n")
|
||||
(insert "#+HTML_HEAD: <link rel=\"stylesheet\" href=\"../css/tufte.css\" />\n")
|
||||
(insert "#+HTML_HEAD_EXTRA: <meta charset=\"utf-8\" />\n\n")
|
||||
;; metadata
|
||||
(insert (format "#+TITLE: %s\n" title))
|
||||
(insert (format "#+AUTHOR: %s\n" author))
|
||||
(insert (format "#+DATE: %s\n" ts))
|
||||
(insert (format "#+LICENSE: %s\n\n" license))
|
||||
;; git link
|
||||
(insert (format "[[%s][View source in Git]]\n" giturl)))
|
||||
;; optionally open the new log file
|
||||
(find-file dest)
|
||||
(message "Published log entry %s" fn))))
|
||||
|
||||
|
||||
;;; exepub-save-hook.el ends here
|
||||
|
||||
(provide 'exepub)
|
||||
|
||||
;; End Code
|
||||
Reference in New Issue
Block a user