changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / emacs/lib/publish.el

changeset 606: 6fc04c4d465c
parent: 3734c596d103
child: 57813b8ee029
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 18 Aug 2024 20:34:26 -0400
permissions: -rw-r--r--
description: emacs and rocksdb upgrades

- more org workflow updates
- added scrum.el
- renamed batch.lisp > writebatch.lisp
- callback tests		 
     1 ;;; publish.el --- the.compiler.company publishing script  -*- lexical-binding:t -*-
     2 
     3 ;; emacsclient -e '(load-file "publish.el")' '(publish)'
     4 
     5 ;;; Code:
     6 (require 'ox-publish)
     7 (require 'org-id)
     8 (require 'dash)
     9 ;; vendored
    10 (require 'htmlize)
    11 (defvar project-dir "~/comp/org")
    12 (defvar publish-dir "/tmp/www")
    13 (defvar html-theme nil)
    14 (defvar url "https://compiler.company")
    15 (defvar vc-url "https://vc.compiler.company")
    16 (defvar packy-url "https://packy.compiler.company")
    17 (defvar html-nav (format "<div class=\"nav\" id=\"nav\"><h2 id=\"index\">*</h2><div id=\"text-index\"> (<a href = \"%s\">~</a><br> (<a href = \"%s/blog\">blog</a> <a href = \"%s/docs\">docs</a> <a href = \"%s/plan\">plan</a> <a href = \"%s/notes\">notes</a>)<br> (<a href = \"%s\">vc</a> <a href = \"%s\">packy</a>))</div></div>"
    18                        url url url url url vc-url packy-url))
    19 
    20 (defvar html-foot "<footer><p>updated %C</p></footer>")
    21 
    22 ;; (setq org-protocol-project-alist
    23 ;;       '(("comp"
    24 ;;          :base-url url
    25 ;;          :working-directory project-dir
    26 ;;          :online-suffix ".html"
    27 ;;          :working-suffix ".org")))
    28 
    29 (setq org-html-style-default ""
    30       org-html-scripts ""
    31       org-html-htmlize-output-type 'css
    32       org-export-htmlize-output-type 'css
    33       org-export-allow-bind-keywords t
    34       org-html-doctype "html5"
    35       org-html-html5-fancy t
    36       org-html-validation-link nil
    37       org-src-fontify-natively t
    38       make-backup-files nil
    39       debug-on-error t
    40       org-id-link-to-org-use-id t)
    41 
    42 (setq org-publish-project-alist
    43       `(("compiler.company" :components ("index" "meta" "blog" "docs" "notes" "plan"))
    44         ("index"
    45          :base-directory ,project-dir
    46          :base-extension "org"
    47          :recursive nil
    48          :htmlized-source t
    49          :footnote-section-p t
    50          :html-doctype "<!doctype html>"
    51 	 ;; :html-preamble ,html-nav
    52 	 :html-postamble ,html-foot
    53          :publishing-directory ,publish-dir
    54          :publishing-function org-html-publish-to-html)
    55         ("meta"
    56          :base-directory ,(expand-file-name "meta" project-dir)
    57          :base-extension "org"
    58          :recursive t
    59          :footnote-section-p t
    60          :html-doctype "<!doctype html>"
    61          :publishing-directory ,(expand-file-name "meta" publish-dir)
    62          :publishing-function org-html-publish-to-html
    63          :htmlized-source t
    64          :html-preamble ,html-nav
    65          :html-postamble ,html-foot)
    66         ("blog"
    67          :base-directory ,(expand-file-name "blog" project-dir)
    68          :recursive t
    69          :base-extension "org"
    70          :footnote-section-p t
    71          :html-doctype "<!doctype html>"
    72 	 :publishing-directory ,(expand-file-name "blog" publish-dir)
    73 	 :publishing-function org-html-publish-to-html
    74 	 :htmlized-source t
    75 	 :html-preamble ,html-nav
    76 	 :html-postamble ,html-foot)
    77         ("plan"
    78          :base-directory ,(expand-file-name "plan" project-dir)
    79          :recursive t
    80          :base-extension "org"
    81          :footnote-section-p t
    82          :html-doctype "<!doctype html>"
    83          :publishing-directory ,(expand-file-name "plan" publish-dir)
    84          :publishing-function org-html-publish-to-html
    85          :htmlized-source t
    86          :html-preamble ,html-nav
    87          :html-postamble ,html-foot)
    88         ("notes"
    89          :base-directory ,(expand-file-name "notes" project-dir)
    90          :recursive t
    91          :base-extension "org"
    92          :footnote-section-p t
    93          :html-doctype "<!doctype html>"
    94          :publishing-directory ,(expand-file-name "notes" publish-dir)
    95          :publishing-function org-html-publish-to-html
    96          :htmlized-source t
    97          :html-preamble ,html-nav
    98          :html-postamble ,html-foot)
    99         ("docs"
   100          :base-directory ,(expand-file-name "docs" project-dir)
   101          :base-extension "org"
   102          :recursive t
   103          :footnote-section-p t
   104          :html-doctype "<!doctype html>"
   105          :publishing-directory ,(expand-file-name "docs" publish-dir)
   106          :publishing-function org-html-publish-to-html
   107          :htmlized-source t
   108          :html-preamble ,html-nav
   109          :html-postamble ,html-foot)))
   110 
   111   (defun org-export-get-reference-title (datum info)
   112     "Like `org-export-get-reference', except uses heading titles instead of random numbers."
   113     (let ((cache (plist-get info :internal-references)))
   114       (or (car (rassq datum cache))
   115           (let* ((crossrefs (plist-get info :crossrefs))
   116                  (cells (org-export-search-cells datum))
   117                  ;; Preserve any pre-existing association between
   118                  ;; a search cell and a reference, i.e., when some
   119                  ;; previously published document referenced a location
   120                  ;; within current file (see
   121                  ;; `org-publish-resolve-external-link').
   122                  ;;
   123                  ;; However, there is no guarantee that search cells are
   124                  ;; unique, e.g., there might be duplicate custom ID or
   125                  ;; two headings with the same title in the file.
   126                  ;;
   127                  ;; As a consequence, before re-using any reference to
   128                  ;; an element or object, we check that it doesn't refer
   129                  ;; to a previous element or object.
   130                  (new (or (cl-some
   131                            (lambda (cell)
   132                              (let ((stored (cdr (assoc cell crossrefs))))
   133                                (when stored
   134                                  (let ((old (org-export-format-reference stored)))
   135                                    (and (not (assoc old cache)) stored)))))
   136                            cells)
   137                           (when (org-element-property :raw-value datum)
   138                             ;; Heading with a title
   139                             (org-export-new-title-reference datum cache))
   140                           ;; NOTE: This probably breaks some Org Export
   141                           ;; feature, but if it does what I need, fine.
   142                           (org-export-format-reference
   143                            (org-export-new-reference cache))))
   144                  (reference-string new))
   145             ;; Cache contains both data already associated to
   146             ;; a reference and in-use internal references, so as to make
   147             ;; unique references.
   148             (dolist (cell cells) (push (cons cell new) cache))
   149             ;; Retain a direct association between reference string and
   150             ;; DATUM since (1) not every object or element can be given
   151             ;; a search cell (2) it permits quick lookup.
   152             (push (cons reference-string datum) cache)
   153             (plist-put info :internal-references cache)
   154             reference-string))))
   155 
   156   (defun org-export-new-title-reference (datum cache)
   157     "Return new reference for DATUM that is unique in CACHE."
   158     (cl-macrolet ((inc-suffixf (place)
   159                                `(progn
   160                                   (string-match (rx bos
   161                                                     (minimal-match (group (1+ anything)))
   162                                                     (optional "--" (group (1+ digit)))
   163                                                     eos)
   164                                                 ,place)
   165                                   ;; HACK: `s1' instead of a gensym.
   166                                   (-let* (((s1 suffix) (list (match-string 1 ,place)
   167                                                              (match-string 2 ,place)))
   168                                           (suffix (if suffix
   169                                                       (string-to-number suffix)
   170                                                     0)))
   171                                     (setf ,place (format "%s--%s" s1 (cl-incf suffix)))))))
   172       (let* ((title (org-element-property :raw-value datum))
   173              (ref (url-hexify-string (substring-no-properties title)))
   174              (parent (org-element-property :parent datum)))
   175         (while (--any (equal ref (car it))
   176                       cache)
   177           ;; Title not unique: make it so.
   178           (if parent
   179               ;; Append ancestor title.
   180               (setf title (concat (org-element-property :raw-value parent)
   181                                   "--" title)
   182                     ref (url-hexify-string (substring-no-properties title))
   183                     parent (org-element-property :parent parent))
   184             ;; No more ancestors: add and increment a number.
   185             (inc-suffixf ref)))
   186         ref)))
   187 
   188 (advice-add #'org-export-get-reference :override #'org-export-get-reference-title)
   189 
   190 ;;;###autoload
   191 (defun publish (&optional sitemap static force async)
   192   "publish `rwest-io' content.
   193 If STATIC is t, also publish media and static files.
   194 If FORCE is t, skip checking file mod date and just publish all files.
   195 If ASYNC is t, call `org-publish' asynchronously.
   196 If given a prefix (C-u), set all args to t"
   197   (interactive)
   198   (if current-prefix-arg
   199       (setq static t
   200 	    force t
   201             async t))
   202   (let ((default-directory project-dir))
   203     (message (format "publishing from %s" default-directory))    
   204     (org-publish "compiler.company" force async)))
   205 (provide 'publish)
   206 ;;; publish.el ends here