diff --git a/exepub.el b/exepub.el index 38c07a5..551bb83 100644 --- a/exepub.el +++ b/exepub.el @@ -32,120 +32,31 @@ ;;; Code: (require 'ox-org) (require 'uuidgen) +(require 'subr-x) +(require 'org-element) +(require 'ox) +(require 'seq) (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. +(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) -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") + (format-time-string "<%Y-%m-%d>") "Default value for #+CREATED: header." :type 'string :group 'exepub) @@ -222,27 +133,345 @@ KEYWORDS is a comma-separated list; commas become underscores, spaces become hyp :type 'string :group 'exepub) +(defcustom exepub/default-personal-site + "https://exedre.org/about" + "Default value for #+PERSONAL-SITE: header." + :type 'string + :group 'exepub) + +(defcustom exepub/export-default-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)) + "Alist of extra export keywords that exepub injects into Org exports. +Each element is of the form (SYMBOL KEYWORD OPTION-NAME DEFAULT BEHAVIOR) +and will be appended to `org-export-options-alist'." + :type '(alist :key-type symbol + :value-type (list :tag "Option spec" + (symbol :tag "Internal name") + (string :tag "Keyword") + (choice (const :tag "no option" nil) + (string :tag "Option letter")) + sexp + (choice (const :tag "nil" nil) + (const :tag "replace" t) + (const :tag "split" split) + (const :tag "newline" newline)))) + :group 'exepub) + +;; directories management + +(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) + + +(defvar exepub--dirs + '((:base . nil) + (:archive . nil) + (:drafts . nil) + (:logs . nil) + (:attic . nil) + (:template . nil) + (:trash . nil)) + "Alist of project directories for exepub.") + +(defun exepub--dirs-setup (base-dir) + "Initialize `exepub--dirs` under BASE-DIR. +:base → BASE-DIR/ +:archive → BASE-DIR/archive/ +:drafts → BASE-DIR/drafts/ +:logs → BASE-DIR/logs/ +:attic → BASE-DIR/attic/ +:template → BASE-DIR/template/ +:trash → BASE-DIR/trash/" + (let ((bd (file-name-as-directory (expand-file-name base-dir)))) + (dolist (entry exepub--dirs) + (let* ((key (car entry)) + (sub (substring (symbol-name key) 1)) ; drop leading “:” + (path (if (eq key :base) + bd + (expand-file-name (concat sub "/") bd)))) + (setf (alist-get key exepub--dirs) path)))) + exepub--dirs) + +(defun exepub--dir (key) + "Return the exepub directory associated with KEY (a keyword symbol). +If `exepub--dirs' is not yet initialized, set it up using +`exepub/home-directory`." + (unless (alist-get :base exepub--dirs nil nil #'eq) + (exepub--dirs-setup exepub/home-directory)) + (let ((dir (alist-get key exepub--dirs nil nil #'eq))) + (if (and dir (file-directory-p dir)) + dir + (user-error "Unknown or missing exepub directory for key: %s" key)))) + +(defun exepub--dirs-ensure () + "Ensure existence of all exepub directories defined in `exepub--dirs`." + ;; Initialize exepub--dirs if needed + (unless (alist-get :base exepub--dirs nil nil #'eq) + (exepub--dirs-setup exepub/home-directory)) + ;; Create each directory if missing + (dolist (pair exepub--dirs) + (let ((dir (cdr pair))) + (unless (file-directory-p dir) + (make-directory dir t))))) + +;; Article creation + +(defun exepub--template-insert (fname) + (let ((options-file (expand-file-name fname (exepub--dir :template)))) + (when (file-readable-p options-file) + (insert-file-contents options-file) + (unless (bolp) (insert "\n"))))) + + +(defun exepub--article-setup (org-file title slug kws) + (with-temp-buffer + (org-mode) + (org-export-insert-default-template 'default) + ;; Import shared #+OPTIONS from template/options.org if available + (exepub--template-insert "draft-head.org") + ;; Insert basic headers + (exepub--update-keyword "TITLE" title) + (exepub--update-keyword "CREATED" (format-time-string "%Y-%m-%d")) + (exepub--update-keyword "STATUS" "draft") + (exepub--update-keyword "SLUG" slug) + (exepub--update-keyword "KEYWORDS" kws) + (org-forward-paragraph) + (insert "\n") + (write-file org-file))) + + +(defun exepub--slugify (title) + (downcase (replace-regexp-in-string + "[^[:alnum:]]+" "-" + (string-trim title)))) + +(defun exepub/article-create (title keywords) + "Create a new asset under the `draft/` directory. + +TITLE 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 Title: ") ; + (read-string "Keywords (comma-separated): "))) + (exepub--dirs-ensure) + (let* ((timestamp (format-time-string "%Y%m%dT%H%M%S")) + (clean-slug (exepub--slugify title)) + (clean-kws (exepub--split-and-sort-keywords keywords)) + (clean-kws-comma (string-join clean-kws ", ")) + (clean-kws-underscore (string-join clean-kws "_")) + (dirname (format "%s--%s__%s" timestamp clean-slug clean-kws-underscore)) + (draft-root (exepub--dir :drafts)) + (template-dir (exepub--dir :template)) + (asset-dir (expand-file-name dirname draft-root)) + (org-file (expand-file-name "draft.org" asset-dir))) + (make-directory asset-dir t) + (exepub--article-setup org-file title clean-slug clean-kws-comma) + (find-file org-file) + (goto-char (point-max)) + (message "New draft created in %s" asset-dir))) + +;;; Library + +(defun exepub--get-keyword (key &optional default full ast &rest err) + "Return the value of #+KEY: in the current buffer using Org parsing. +KEY is a string, e.g. \"TITLE\" or \"LICENSE\". +If the keyword is not found, return DEFAULT (which may be nil) unless +ERR is non-nil, in which case ERR is passed to `user-error`." + (let* ((ast (or ast (org-element-parse-buffer))) + (matches + (org-element-map ast 'keyword + (lambda (kw) + (when (string-equal (org-element-property :key kw) key) + (org-element-property :value kw)))))) + (if-let* ((val (if full (string-join matches " ") (car matches)))) + val + (if err + (apply #'user-error err) + default)))) + +(defun exepub--get-bool-keyword (key &optional default full ast &rest err) + "Return t[rue] the value of #+KEY: in the current buffer is 't', nil otherwise +KEY is a string, e.g. \"TITLE\" or \"LICENSE\". +If the keyword is not found, return DEFAULT (which may be nil) unless +ERR is non-nil, in which case ERR is passed to `user-error`." + (let ((v (exepub--get-keyword key default full ast err))) + (when v + (string= v "t")))) + +(defun exepub--split-and-sort-keywords (keywords) + (when-let* ((kw-list (split-string keywords "," t "[ \t\n]*")) + (clean-kws + (sort + (mapcar + (lambda (kw) + (downcase + (replace-regexp-in-string "[[:space:]]+" "-" + (string-trim kw)))) + kw-list)))) + clean-kws)) + +(defun exepub--sort-and-get-KEYWORDS-keyword () + (when-let* ((keywords (exepub--get-keyword "KEYWORDS")) + (kw-list (split-string keywords "," t "[ \t\n]*")) + (clean-kws + (sort + (mapcar + (lambda (kw) + (downcase + (replace-regexp-in-string "[[:space:]]+" "-" + (string-trim kw)))) + kw-list))) + (clean-cs-kw (string-join clean-kws ","))) + (exepub--update-keyword "KEYWORDS"clean-cs-kw) + clean-kws)) + +(defun exepub--generate-slug (title kw-list) + (when-let* ((slug-base (downcase + (replace-regexp-in-string + "[:'[:space:]]+" "-" + (string-trim title)))) + (kw-part (mapconcat + (lambda (kw) + (downcase + (replace-regexp-in-string "[[:space:]]+" "-" + (string-trim kw)))) + kw-list "_")) + (final-slug (if kw-part + (concat slug-base "__" kw-part) + slug-base))) + final-slug)) + +(defun exepub/regenerate-slug () + "Regenerate the #+SLUG: value from #+TITLE: and #+KEYWORDS: in the current buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (when-let* ((title (or (exepub--get-keyword "TITLE") + (user-error "No #+TITLE: found"))) + (kw-list (exepub--sort-and-get-KEYWORDS-keyword)) + (final-slug (exepub--generate-slug title kw-list))) + ;; Replace or insert the #+SLUG: header + (goto-char (point-min)) + (exepub--update-keyword "SLUG" final-slug) + (message "Slug updated to: %s" final-slug)))) + (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))))) + exepub/export-default-options-alist))) (apply orig-fn args))) + (advice-add 'org-export-insert-default-template :around #'exepub/org-export-insert-default-template) -(defun exepub/update-header (key value) +(defun exepub--option-key (option) + "Return the plist key symbol for Org OPTION string." + (downcase option)) + +(defun exepub--parse-options-string (str) + "Parse an Org #+OPTIONS STR into a plist of the form +(:key1 \"val1\" :key2 \"val2\" …), correctly handling values +in parentheses (e.g. d:(not \"LOGBOOK\"))." + (let ((plist nil) + (s (or str ""))) + (while (string-match + ;; match KEY:VALUE where VALUE is either (...) or non-space + "\\`[ \t]*\\([^ \t\n]+\\):\\(([^)]*)\\|[^ \t\n]+\\)" + s) + (let* ((key (match-string 1 s)) + (val (match-string 2 s)) + (sym (downcase key))) + (setq plist (plist-put plist sym val)) + ;; advance past the matched portion + (setq s (substring s (match-end 0))))) + plist)) + +(defun exepub--options-plist-to-string (plist) + "Convert an export OPTIONS PLIST back into a space-separated string. +PLIST is of the form (:key1 \"val1\" :key2 \"val2\")." + (mapconcat + (lambda (pair) + (format "%s:%s" + (car pair) + (cadr pair))) + plist + " ")) + +(defun exepub--get-options-plist () + "Return the plist of the first #+OPTIONS: line in the buffer, or nil." + (when-let* ((options (exepub--get-keyword "OPTIONS" "" t))) + (exepub--parse-options-string options))) + +(defun exepub--set-options-plist (plist &optional maxlen) + "Remove all existing #+OPTIONS: lines and insert wrapped ones from PLIST. +Each line will be at most MAXLEN characters wide (default `fill-column')." + (let* ((maxlen (or maxlen fill-column)) + (optstr (exepub--options-plist-to-string plist)) + (tokens (split-string optstr "[ \t]+" t)) + (prefix "#+OPTIONS:") + (prefix-len (length prefix))) + ;; Remove all existing OPTIONS lines + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^#\\+OPTIONS:.*$" nil t) + (delete-region (line-beginning-position) + (min (point-max) (1+ (line-end-position))))) + ;; Insert wrapped OPTIONS lines at top + (goto-char (point-min)) + (let ((current "")) + (dolist (tok tokens) + (let ((candidate + (if (string-empty-p current) + tok + (concat current " " tok)))) + (if (> (+ prefix-len 1 (length candidate)) maxlen) + (progn + ;; flush the line we have so far + (insert prefix " " current "\n") + (setq current tok)) + (setq current candidate)))) + ;; flush the remainder + (unless (string-empty-p current) + (insert prefix " " current "\n")))))) + +(defun exepub--update-option (option value) + "Set or update Org export OPTION in the #+OPTIONS line to VALUE. +If VALUE is a function, call it with the previous option value (or nil)." + (let* ((plist (or (exepub--get-options-plist) '())) + (key (exepub--option-key option)) + (old (plist-get plist key)) + (new (if (functionp value) + (funcall value old) + value)) + (new-plist '())) + ;; Ricostruisci la plist filtrando la chiave vecchia + (while plist + (let ((k (pop plist)) + (v (pop plist))) + (unless (equal k key) + (setq new-plist (append new-plist (list k v)))))) + ;; Aggiungi la nuova coppia + (setq new-plist (append new-plist (list key new))) + ;; Salva + (exepub--set-options-plist (seq-partition new-plist 2)))) + +(defun exepub--update-keyword (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." @@ -258,7 +487,7 @@ and use its return as the new value. Otherwise VALUE must be a string." (funcall value prev) value)) (replace-match (format "#+%s: %s" key-up new-val) t t)) - ;; Insert new header at top if none found + ;; Insert new header at bottom if none found (setq prev nil) (setq new-val (if (functionp value) (funcall value prev) @@ -266,33 +495,47 @@ and use its return as the new value. Otherwise VALUE must be a string." (goto-char (point-min)) (if (re-search-forward "^#\\+\\w+:" nil t) (progn + (org-forward-paragraph) (beginning-of-line) (insert (format "#+%s: %s\n" key-up new-val))) (insert (format "#+%s: %s\n" key-up new-val))))))) +;; + +(defun exepub--ensure-file-in-drafts (orig-file &rest err) + "Ensure that ORIG-FILE is located under the `:drafts` directory. +If ERR is non-nil, pass ERR as arguments to `user-error` on failure. +Otherwise, return t if inside drafts, nil if not." + (let ((draft-root (exepub--dir :drafts))) + (if (and orig-file + (string-prefix-p + (file-name-as-directory draft-root) + (file-name-as-directory + (file-name-directory orig-file)))) + t + (when err + (apply #'user-error err)) + nil))) + (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)) + (let* ((orig-file (buffer-file-name))) + (exepub--ensure-file-in-drafts + orig-file + "This command only works on files under %s" + (exepub--dir :drafts)) ;; Save buffer if modified - (when (buffer-modified-p) - (save-buffer)) + (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")))) + (let* ((new-slug + (exepub--get-keyword "SLUG" + nil nil nil "No #+SLUG: header")) (orig-dir (directory-file-name (file-name-directory orig-file))) (created-name (file-name-nondirectory orig-dir)) @@ -301,7 +544,7 @@ If any step fails, rollback to the original draft state, and set STATUS to 'diss (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)) + (archive-root (exepub--dir :archive)) (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)) @@ -316,30 +559,38 @@ If any step fails, rollback to the original draft state, and set STATUS to 'diss (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) + (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)) + (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)) + (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) + (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") + (exepub--update-keyword "PUBLISHED" pub-date) + (exepub--update-keyword "STATUS" "dissemination") (save-buffer) (setq success t) (message "Asset disseminated to %s" archive-new-dir)) @@ -350,23 +601,28 @@ If any step fails, rollback to the original draft state, and set STATUS to 'diss (funcall act))) (error "Dissemination failed: %s" (error-message-string err))))))) +(defun exepub/open (sec) + "Open dired in the `draft` directory of `exepub/home-directory`." + (interactive) + (exepub--dirs-ensure) + (dired (exepub--dir sec))) + + (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))) + (exepub/open :drafts)) (defun exepub/open-archive () - "Open dired in the `archive` directory of `exepub/home-directory`." + "Open dired in the `draft` directory of `exepub/home-directory`." (interactive) - (exepub--ensure-dirs) - (dired (expand-file-name "archive" exepub/home-directory))) + (exepub/open :archive)) (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)) + (let* ((archive-root (exepub--dic :archive)) (years (when (file-directory-p archive-root) (cl-remove-if-not #'file-directory-p @@ -377,23 +633,19 @@ Create the YEAR directory if it does not exist." (format "Year (default %s): " default-year) choices nil nil nil nil default-year))) (list year))) - (exepub--ensure-dirs) + (exepub--dirs-ensure) (let ((dir (expand-file-name year - (expand-file-name "archive" - exepub/home-directory)))) - (unless (file-directory-p dir) - (make-directory dir t)) - (dired dir))) + (exepub--dir :archive)))) + (when (file-directory-p dir) + (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))) - - + (exepub/open :attic)) ;; Keybindings for exepub under prefix C-c q + (defvar exepub-command-map (let ((map (make-sparse-keymap))) map) @@ -407,6 +659,7 @@ Create the YEAR directory if it does not exist." (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) +(define-key exepub-command-map (kbd "l") 'exepub/log-publishing-project) ;; Directory navigation commands (two-letter suffix) (define-key exepub-command-map (kbd "od") 'exepub/open-drafts) @@ -422,48 +675,13 @@ Create the YEAR directory if it does not exist." "C-c q r" "regenerate slug" "C-c q s" "disseminate asset" "C-c q e" "export to format" + "C-c q l" "log manifestations" "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) @@ -601,6 +819,21 @@ If PROP exists, replace its entire line; otherwise insert it before :END:." (insert (format ":%s: %s\n" prop value)))))) +(defun exepub/org-timestamp-to-long (ts) + "Restituisce TS (stringa Org like ) 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 "%Y%m%dT%H%M%S" time))) + +(defun exepub/org-timestamp-to-date (ts) + "Restituisce TS (stringa Org like ) 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 "%Y%m%d" time))) (defun exepub/org-timestamp-to-pretty (ts) "Restituisce TS (stringa Org like ) formattata più leggibile." @@ -610,34 +843,10 @@ If PROP exists, replace its entire line; otherwise insert it before :END:." (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)))) @@ -664,6 +873,72 @@ Uses `org-entry-get` instead of manual regexp parsing." (push (cons (match-string 1) (match-string 2)) props)) props)))) +(defun exepub--ensure-STATUS (want &rest err) + "Ensure that #+STATUS: in the buffer equals WANT. +If not, signal a user-error. +ERR may be a single string, or a list (FORMAT &rest ARGS) for `user-error`." + (let* ((st (or (exepub--get-keyword "STATUS") "")) + (match (string= (downcase st) (downcase want)))) + (unless match + (when err + (apply #'user-error err))) + match)) + +(defun exepub--ensure-property-not (name value &rest err) + (let ((lock (exepub--get-property name))) + (when (string= lock value) + (if err + (apply #'user-error err) + t)))) + +(defun exepub--ensure-file-in (file where &rest err) + "Ensure that FILE is located under the exepub directory identified by WHERE. +WHERE is a keyword like :drafts or :archive. On success return t. +If FILE is not under that directory and ERR is non-nil, call `user-error` +with ERR as arguments; if ERR is nil, return nil." + (let ((root (exepub--dir where))) + (if (and file + (string-prefix-p + (file-name-as-directory root) + (file-name-as-directory (file-name-directory file)))) + t + (when err + (apply #'user-error err)) + nil))) + +(defun exepub/lock-exported (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"))) + (exepub--ensure-STATUS "dissemination" + "export-to only runs when STATUS is dissemination (current: %s)" + (exepub--get-keyword "STATUS")) + (let ((orig-file (buffer-file-name))) + (exepub--ensure-file-in orig-file :archive "This must be called on a file in archive/") + (save-buffer) + (exepub--ensure-manifestations-section) + + ;; 2) update source Org's *Manifestations* subtree + (let* (license-val licensed-to embargoed-to uuid delivered proposal + (prop-hash (make-hash-table :test 'equal)) + (fmt-down (downcase format)) + (corr-root (car (split-string correspondent "--"))) + (corr-safe (exepub--slugify corr-root)) + (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) + (exepub--ensure-property-not "LOCK" "t" "Manifestation %s is locked, aborting export" manifest-id) + (exepub--update-property "LOCK" "t") + (save-buffer)))) + + (defun exepub/export-to (format correspondent) "Create a manifestation of the current asset in FORMAT for CORRESPONDENT, using LICENSE. @@ -674,58 +949,46 @@ a dynamic license footer." (interactive (list (read-string "Format (e.g. html, latex, md, org): " "html") (read-string "Correspondent (e.g. agenda-digitale): " "personal"))) + (exepub--ensure-STATUS "dissemination" + "export-to only runs when STATUS is dissemination (current: %s)" + (exepub--get-keyword "STATUS")) (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/")) + (exepub--ensure-file-in orig-file :archive "This must be called on a file in archive/") (save-buffer) + (exepub--ensure-manifestations-section) + ;; 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))) + (let* (license-val licensed-to embargoed-to uuid delivered proposal + (prop-hash (make-hash-table :test 'equal)) + (fmt-down (downcase format)) + (corr-root (car (split-string correspondent "--"))) + (corr-safe (exepub--slugify corr-root)) + (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)) + (exepub--ensure-property-not "LOCK" "t" "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)))) + (unless (exepub--property-exists-p "DELIVERED") + (exepub--update-property "DELIVERED" + (exepub--format-org-ts (current-time)))) + (unless (exepub--property-exists-p "EMBARGO") + (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 delivered (exepub--get-property "DELIVERED")) + (setq proposal (exepub--get-property "PROPOSAL")) (setq uuid (exepub--get-property "UUID")) (exepub--goto-format-subtree fmt-down corr-safe) (dolist (kv (org-entry-properties)) @@ -738,30 +1001,13 @@ a dynamic license footer." (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-full (exepub--get-keyword "SLUG")) (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"))) + (title (or (exepub--get-property "TITLE") + (exepub--get-keyword "TITLE"))) + (org-copy (expand-file-name (concat (exepub--slugify title) ".org") man-dir)) + (author (exepub--get-keyword "AUTHOR")) + (year (format-time-string "%Y"))) ;; 4) prepare and perform Org→Org export (make-directory man-dir t) (condition-case _ @@ -771,29 +1017,48 @@ a dynamic license footer." ;; 5) adjust the manifest Org (with-current-buffer (find-file-noselect org-copy) (maphash (lambda (k v) - (exepub/update-header k v)) + (exepub--update-keyword k v)) prop-hash) - (exepub/update-option "title" "nil") - (exepub/update-header "STATUS" "manifestation") + (exepub--update-option "title" "nil") + (exepub--update-keyword "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))) + ("html" (let ((out (org-html-export-to-html))) (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)) + ("md" (org-md-export-to-markdown)) + ("latex" (org-latex-export-to-pdf)) ("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))))))) + (message "Manifestation %s created in %s" manifest-id man-dir))))) + +(with-eval-after-load 'ox + ;; livello headings a zero → H:0 + (add-to-list 'org-export-options-alist + '(:headline-levels + nil ; no file-local #+KEYWORD + "H" ; OPTION keyword for #+OPTIONS + org-export-headline-levels)) + ;; disabilita il link di validazione HTML → validate:nil + (add-to-list 'org-export-options-alist + '(:html-validation-link + nil + "validate" + org-html-validation-link)) + ;; disabilita sommario → toc:nil + (add-to-list 'org-export-options-alist + '(:with-toc + nil + "toc" + org-export-with-toc))) ;;; exepub-save-hook.el --- Regenerate slug and rename directory on save @@ -812,11 +1077,7 @@ Otherwise, rename only the containing directory." ;; 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))))) + (let* ((status (exepub--get-keyword "STATUS")) (file buffer-file-name) (dir (file-name-directory file)) (parent (directory-file-name dir)) @@ -825,11 +1086,7 @@ Otherwise, rename only the containing directory." (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)))) + (full-slug (exepub--get-keyword "SLUG")) (slug-root (car (split-string full-slug "__"))) ;; new names (new-dir-name (concat creation "--" full-slug)) @@ -868,12 +1125,15 @@ Otherwise, rename only the containing directory." #'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--insert-vars (vars &optional section) + (let ((intro (or (when section (concat "." section)) ""))) + (dolist (kv props) + (let ((k (car kv)) + (v (cdr kv))) + (insert (format "#+%s%s = %s\n" intro k v)))))) + + (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'. @@ -888,18 +1148,25 @@ and a Git link are recorded." (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")) + (let* ((props (org-entry-properties (point) 'standard)) + (uuid (or (org-entry-get nil "ID") + (org-entry-get nil "UUID") + (user-error "No ID/UUID in buffer"))) + (delivered (org-entry-get nil "DELIVERED")) + (ts (exepub/org-timestamp-to-date delivered)) (fn (format "%s-%s.org" ts uuid)) (dest (expand-file-name fn base)) - (title (or (org-entry-get nil "TITLE") + (title (or (exepub--get-property "TITLE") + (exepub--get-keyword "TITLE") (user-error "No #+TITLE: found"))) - (author (or (org-entry-get nil "AUTHOR") + (author (or (exepub--get-property "AUTHOR") + (exepub--get-keyword "AUTHOR") user-full-name)) - (license (or (org-entry-get nil "LICENSE") + (license (or (exepub--get-property "LICENSE") + (exepub--get-keyword "LICENSE") exepub/default-license)) + (summary-params (exepub--get-entry-properties-alist)) + (summary (exepub--get-summary-section)) (reldir (file-relative-name orig exepub/home-directory)) (giturl (concat (file-name-as-directory exepub/git-base-url) reldir))) @@ -908,21 +1175,251 @@ and a Git link are recorded." ;; header options (insert "#+OPTIONS: toc:nil num:nil html-style:nil\n") (insert "#+HTML_HEAD: \n") - (insert "#+HTML_HEAD_EXTRA: \n\n") + (insert "#+HTML_HEAD_EXTRA: \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))) + (exepub--update-keyword "#+TEMPLATE: %s\n" "manifestation") + (exepub--update-keyword "#+TITLE: %s\n" title) + (exepub--update-keyword "#+AUTHOR: %s\n" author) + (exepub--update-keyword "#+DATE: %s\n" delivered) + (exepub--update-keyword "#+LICENSE: %s\n" license) + (exepub--update-keyword "#+GIT: %s\n\n" giturl) + (exepub--insert-vars vars "manifestation" ) + (exepub--insert-vars summary-props "summary" ) + (insert summary)) ;; optionally open the new log file (find-file dest) (message "Published log entry %s" fn)))) +;; Word-count + +(defun exepub/count-words-txt-in-kw () + "Count words in the current Org buffer (excluding :noexport: subtrees) +and store the result in the #+WORD-COUNT: keyword. + +Exports the buffer to plain text via `org-export-string-as', stripping +all subtrees tagged :noexport:, then counts words and updates the +keyword at the top of the file." + (interactive) + (require 'ox) ;; assicuriamoci che il meccanismo di export sia caricato + (let* ((plain-text + (org-export-string-as + (buffer-string) + 'ascii ;; export to plain text + t ;; body-only + '(:exclude-tags ("noexport")))) + (words (split-string plain-text "[[:space:]\n\r]+" t)) + (wc (length words))) + ;; aggiorna o inserisci #+WORD-COUNT: + (exepub--update-keyword "WORD-COUNT" (number-to-string wc)) + (message "Word count (excl. noexport): %d" wc))) + +;;; sintesi via LLM + +(defun exepub/chatgpt-summarize (&optional force model) + "Summarize the current Org file via chatgpt-shell. +Exports the buffer (excluding :noexport: subtrees) to plain text, +prepends the prompt, sends it to ChatGPT and inserts the result +in a new\n* Sintesi IA :noexport: subtree. + +If a Sintesi IA subtree already exists, aborts with an error unless +called with a prefix argument (FORCE). With prefix, prompts for MODEL." + (interactive "P\nP") + ;; 1) abort if subtree exists and not forced + (save-excursion + (goto-char (point-min)) + (when (and (not force) + (re-search-forward "^\\*+ Sintesi IA" nil t)) + (user-error "Sintesi IA già presente; passare \\[universal-argument] per rigenerare"))) + ;; 2) choose model + (let* ((chosen-model (if force + (read-string + (format "Model (default %s): " chatgpt-shell-model) + nil nil chatgpt-shell-model) + chatgpt-shell-model)) + ;; 3) export Org→ASCII excluding :noexport: + (org-export-exclude-tags '("noexport")) + (plain + (org-export-as 'ascii nil nil t nil)) + (prompt + (concat "Sintetizza questo testo in una frase di almeno 200 caratteri:\n\n" + plain))) + ;; 4) send to ChatGPT and capture response + (let ((chatgpt-shell-model chosen-model) + response) + ;; assuming chatgpt-shell-request returns the string synchronously + (setq response + (chatgpt-shell-request + prompt + :mode 'completions + :system-prompt nil)) + ;; 5) insert subtree + (save-excursion + (goto-char (point-max)) + (insert "\n* Sintesi IA :noexport:\n\n") + (insert response "\n"))))) + +(defun exepub--get-entry-properties-alist () + "Return an alist of all local PROPERTIES for the current Org entry." + (org-entry-properties (point) 'standard)) + +(defun exepub--get-summary-section () + "Return the contents of the first “Sintesi” heading tagged :noexport:, +excluding any PROPERTIES drawer, using Org API only." + (let (result) + (org-element-map + (org-element-parse-buffer) 'headline + (lambda (hl) + (when (and (string= (org-element-property :raw-value hl) "Sintesi") + (member "noexport" (org-element-property :tags hl)) + (not result)) + ;; collect only text nodes under this subtree, skipping drawers + (let ((contents (org-element-contents hl))) + (setq result + (string-trim + (mapconcat + (lambda (el) + (when (memq (org-element-type el) + '(paragraph plain-list verse-block example-block + fixed-width-block)) + (org-element-interpret-data el))) + contents + "\n\n")))))) + nil t) + result)) + ;;; exepub-save-hook.el ends here +(defun exepub--plist-keys (plist) + "Return a list of all keys (symbols) in PLIST. +PLIST is a property list of the form (:key1 val1 :key2 val2 …)." + (cl-loop for (k v) on plist by 'cddr + collect k)) + +(defun exepub--html-preamble (info) + (let* ((title (org-no-properties (string-join (plist-get info :title) " "))) + (subtitle (org-no-properties (string-join (plist-get info :subtitle) " "))) + (author (org-no-properties (string-join (plist-get info :author)) " ")) + (description (plist-get info :description)) + (ast (plist-get info :parse-tree)) + (personal (exepub--get-keyword "PERSONAL-SITE" nil t ast)) + (personal (if (and personal (= (length personal) 0)) + exepub/default-personal-site)) + (proposal (exepub--get-bool-keyword "PROPOSAL" nil t ast)) + (licensed-to (exepub--get-keyword "LICENSED-TO" nil t ast)) + (keys (exepub--plist-keys info)) + (out (concat + (if proposal + (let ((licensed (or licensed-to + (user-error "Se l'articolo è una proposta bisogna indicare :LICENSED-TO:")))) + (format "

Quest'articolo è una proposta per %s

\n" + licensed)) + "") + (format "

%s

\n" title) + (format "

%s

\n" subtitle) + (format "

%s

\n" personal author) + (if (and description (not (string-empty-p description))) + (format "

%s

" description) "")))) + out)) + + +(setq org-html-preamble #'exepub--html-preamble) + +(defun exepub--html-postamble (info) + (let* ((title (org-no-properties (string-join (plist-get info :title) " "))) + (author (org-no-properties (string-join (plist-get info :author)) " ")) + (description (plist-get info :description)) + (ast (plist-get info :parse-tree)) + (delivered (exepub--get-keyword "DELIVERED" nil t ast)) + (date (exepub/org-timestamp-to-date delivered)) + (year (substring date 0 4)) + (personal (exepub--get-keyword "PERSONAL-SITE" nil t ast)) + (personal (if (and personal (= (length personal) 0)) + exepub/default-personal-site)) + (uuid (exepub--get-keyword "UUID" nil t ast)) + (license-val (exepub--get-keyword "LICENSE" nil t ast)) + (slug (exepub--slugify title)) + (proposal (exepub--get-bool-keyword "PROPOSAL" nil t ast)) + (licensed-to (exepub--get-keyword "LICENSED-TO" nil t ast)) + (embargoed-to (exepub--get-keyword "EMBARGO-TO" nil t ast)) + (out (exepub--insert-license-footer delivered uuid + slug personal author title year license-val + proposal licensed-to embargoed-to))) + out)) + +(setq org-html-postamble #'exepub--html-postamble) + + +(defun exepub--insert-license-footer (delivered uuid slug personal author title year license proposal 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 + (out (concat (format + "

\n + %s © %s di %s\n" + (exepub/org-timestamp-to-date delivered) uuid title year + personal author) + (if (string= license "©") + (concat "Tutti i diritti riservati" + (if (null licensed-to) + "" + (format ", questo contenuto è concesso a %s%s e non può essere destinato ad altri." + licensed-to + (if proposal " per la valutazione della proposta" "")))) + (format ", concesso%s sotto licenza %s" + (if (null licensed-to) "" (format " a %s" licensed-to)) + url license)) + ;; icons as inline Org links + (when icons + (dolist (ic icons) + (insert (format "" + ic)))) + "

" + (unless (or (null embargoed-to) (= (length embargoed-to) 0)) + (format "

\n +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/%s-%s.html

" + (exepub/org-timestamp-to-pretty embargoed-to) + (exepub/org-timestamp-to-date delivered) + uuid))))) + out)) + +;; Assicurati di avere transient installato e caricato +(require 'transient) + +(transient-define-prefix exepub/transient () + "Transient menu for exepub commands." + ;; Header + ["Exepub: quick access to project commands" + ;; Sezione di creazione / emissione + ("c" "Create article" exepub/article-create) + ("d" "Disseminate asset" exepub/disseminate) + ("e" "Export manifestation" exepub/export-to) + ;; Sezione di navigazione + ("o" "Open drafts" exepub/open-drafts) + ("a" "Open archive" exepub/open-archive) + ("y" "Open year dir" exepub/open-year) + ("t" "Open attic" exepub/open-attic) + ;; Strumenti di analisi + ("s" "Summarize (ChatGPT)" exepub/chatgpt-summarize) + ("w" "Count words" exepub/count-words-txt-in-kw)] + ;; Sezione di utilità + ["Utilities" + ("r" "Setup directories" (lambda () (interactive) + (exepub--dirs-setup exepub/home-directory))) + ("q" "Quit" transient-quit-one)]) + +;; Assegna un binding globale sotto C-c p +(global-set-key (kbd "C-c q q") 'exepub/transient) + (provide 'exepub) ;; End Code + +(setq org-html-preamble-format + '(("it" "

%t

%s

%a

"))) +