add scripts

4 files changed, 413 insertions, 0 deletions

diff --git a/bin/export.el b/bin/export.el
new file mode 100644
index 0000000..92e4fc3
--- /dev/null
+++ b/bin/export.el
@@ -0,0 +1,379 @@
+(require 'ox-publish)
+(add-to-list 'load-path "/home/cmmm/.config/emacs/elpaca/builds/ox-rss")
+(add-to-list 'load-path "/home/cmmm/.config/emacs/elpaca/builds/htmlize")
+(add-to-list 'load-path "/home/cmmm/.config/emacs/elpaca/builds/f")
+(add-to-list 'load-path "/home/cmmm/.config/emacs/elpaca/builds/s")
+(add-to-list 'load-path "/home/cmmm/.config/emacs/elpaca/builds/dash")
+(require 'ox-rss)
+(require 'htmlize)
+(require 'project)
+(require 'f)
+
+(setq org-html-htmlize-output-type 'css
+      org-html-validation-link nil
+      org-html-head "<link rel=\"stylesheet\" href=\"/custom.css\"/>"
+      org-html-head-extra nil
+      org-html-head-include-default-style nil
+      org-html-head-include-scripts nil
+      org-html-preamble nil
+      org-html-postamble nil
+      org-html-use-infojs nil
+      org-html-self-link-headlines t
+      org-html-allow-name-attribute-in-anchors t
+
+      org-confirm-babel-evaluate nil
+      org-babel-default-header-args '((:session . "none")
+                                      (:results . "replace")
+                                      (:exports . "code")
+                                      (:cache . "no")
+                                      (:noweb . "no")
+                                      (:hlines . "no")
+                                      (:tangle . "no")
+                                      (:mkdirp . "yes"))
+
+      org-export-with-author nil
+      org-export-with-email nil
+      org-export-with-creator t
+      org-export-with-toc nil
+      org-export-with-section-numbers nil
+      org-export-with-time-stamp-file t
+      org-export-with-todo-keywords t
+      org-export-with-statistics-cookies t
+      org-export-with-broken-link t
+      org-export-with-sub-superscripts '{}
+
+      org-publish-sitemap-sort-files 'anti-chronologically
+
+      org-rss-extension "xml")
+
+
+(defun cmmm/org-list-flatten (list)
+  `(unordered (,(caadr list)
+               ,(cons 'unordered (mapcar (lambda (e) (cadadr e)) (cddr list))))))
+
+(defun cmmm/org-publish-org-sitemap (title list)
+  "Sitemap generation function."
+  (concat "#+title: " title "\n\n"
+          (org-list-to-org (cmmm/org-list-flatten list))))
+
+(defun cmmm/org-publish-org-sitemap-format-with-date (entry style project)
+  "Custom sitemap entry formatting: add date"
+  (cond ((not (directory-name-p entry))
+         (format "[[file:%s][(%s) %s]]" entry
+                 (format-time-string
+                  "%Y-%m-%d" (org-publish-find-date entry project))
+                 (org-publish-find-title entry project)))
+        ((eq style 'tree)
+         ;; Return only last subdir.
+         (file-name-nondirectory (directory-file-name entry)))
+        (t entry)))
+
+(defun cmmm/org-get-first-paragraph (file)
+  "Get string content of first paragraph of file."
+  (with-temp-buffer
+    (insert-file-contents file)
+    (goto-char (point-min))
+    (show-all)
+    (let ((first-begin (progn
+                         (org-forward-heading-same-level 1)
+                         (point)))
+          (first-end (progn
+                       (org-next-visible-heading 1)
+                       (point))))
+      (buffer-substring first-begin first-end))))
+
+;; (defun cmmm/org-rss-publish-to-rss (plist filename pub-dir)
+;;   "Prepare rss.org file before exporting."
+;;   (let* ((postsdir "posts"))
+;;     (with-current-buffer (find-file filename)
+;;       (erase-buffer)
+;;       (insert "#+TITLE: Web Log RSS\n")
+;;       ;; (insert "#+SETUPFILE: setup.org\n")
+;;       ;; (insert "#+INCLUDE: source-blocks.org\n")
+;;       ;; (insert "#+OPTIONS: toc:nil\n")
+;;       (let* ((files-all
+;;               (reverse (directory-files postsdir nil
+;;                                         "[0-9-]+.*\\.org$")))
+;;              (files (cl-subseq files-all 0 (min (length files-all) 30))))
+;;         (dolist (post files)
+;;           (let* ((post-file (concat (file-name-as-directory postsdir) post))
+;;                  (post-title (org-publish-find-title post-file plist))
+;;                  (preview-str (cmmm/org-get-first-paragraph post-file))
+;;                  (date (replace-regexp-in-string
+;;                         "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)-.*"
+;;                         "\\1" post)))
+;;             (insert (concat "* [[file:posts/" post "][" post-title "]]\n\n"))
+;;             (org-set-property "ID" post)
+;;             ;; ox-rss prepends html-link-home to permalink
+;;             (org-set-property "RSS_PERMALINK"
+;;                               (concat "../posts/"
+;;                                       (file-name-sans-extension post)
+;;                                       ".html"))
+;;             (org-set-property
+;;              "PUBDATE"
+;;              (format-time-string
+;;               "<%Y-%m-%d %a %H:%M>"
+;;               (org-time-string-to-time
+;;                (replace-regexp-in-string
+;;                 "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)-.*"
+;;                 "\\1" post))))
+;;             (insert "*")
+;;             (insert preview-str)
+;;             (newline 1)
+;;             (insert (concat "[[file:./web-log/" post "][(Read more)]]\n\n"))))
+;;         (save-buffer))))
+;;   (let ((user-mail-address "t")
+;;         (org-export-with-broken-links t)
+;;         (org-rss-use-entry-url-as-guid nil))
+;;     (org-rss-publish-to-rss plist filename pub-dir)))
+
+;; (setcdr
+;;  (assq 'path org-html-mathjax-options)
+;;  '("https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS_HTML"))
+
+(defvar cmmm/org-tangle-list-cache nil)
+(defun cmmm/org-export-collect-tangle (backend)
+  ;; Remove hook to ensure it does not get called recursively
+  (remove-hook 'org-export-before-processing-hook
+               'cmmm/org-export-collect-tangle)
+  (when (equal backend 'cmmm/html)
+    (setq cmmm/org-tangle-list-cache nil)
+    (save-excursion
+      (save-restriction
+        (widen)
+        (show-all)
+        (let ((src-blocks (org-babel-tangle-collect-blocks)))
+          (dolist (src-lang src-blocks)
+            (dolist (src-block (cdr src-lang))
+              (let ((src-block-name (nth 4 src-block))
+                    (src-block-tangle (cdr (assoc :tangle (nth 5 src-block)))))
+                (add-to-list 'cmmm/org-tangle-list-cache
+                             `(,src-block-name . ,src-block-tangle))))))))))
+
+(defun cmmm/html-src-block (src-block contents info)
+  "Transcode a SRC-BLOCK element from Org to HTML.
+CONTENTS is nil.  INFO is a plist used as a communication
+  channel.  Add name of tangle file to source block (this
+  requires a preprocessing hook to be added with
+  `cmmm/org-export-collect-tangle')."
+  (let* ((src-block-name (org-element-property :name src-block))
+         (src-block-language (org-element-property :language src-block))
+         (src-block-tangle
+          (when cmmm/org-tangle-list-cache
+            (cdr (assoc src-block-name cmmm/org-tangle-list-cache))))
+         (export-out (org-export-with-backend
+                      'html src-block contents info)))
+    (when (and src-block-tangle (> (length src-block-tangle) 0)
+               (not (string= src-block-tangle "no")))
+      (let ((src-start-pat "\\(<pre class=\"src src-[^>]+>\\)"))
+        (setq export-out
+              (replace-regexp-in-string
+               src-start-pat
+               (concat "<div class=\"src-label\">"
+                       "<span>" src-block-language "</span>"
+                       "<span>[<a href=./"
+                       src-block-tangle ">" src-block-tangle "</a>]"
+                       "</span></div>\n"
+                       "\\1\n")
+               export-out))))
+    export-out))
+
+(org-export-define-derived-backend 'cmmm/html 'html
+  :translate-alist '((src-block . cmmm/html-src-block)))
+
+(defun cmmm/org-html-head-extra (filename)
+  "Construct org-html-preamble with site navigation."
+  (let* ((src (f-join (f-full (project-root (project-current))) "src/"))
+         (relative (file-name-as-directory
+                    (string-remove-prefix src (f-dirname filename))))
+         (forward (substring relative (string-search "/" relative)))
+         (backward (mapconcat (lambda (e) "../") (f-split relative)))
+         (networks '(("https://www.michalec.dev/" . www)
+                     ("http://ygg.michalec.dev/"  . ygg)
+                     ("http://michalec.i2p/"      . i2p)))
+         (languages '(en ru sk es))
+         ;; (language-paths (mapcar (lambda (language)
+         ;;                           (cons language
+         ;;                                 (if (eq language 'en)
+         ;;                                     "/" (format "/%s/" language))))
+         ;;                         languages))
+         (up '((en . "up")
+               (ru . "вверх")
+               (sk . "hore")
+               (es . "subir")))
+         (home '((en . "home")
+                 (ru . "домой")
+                 (sk . "domov")
+                 (es . "inicio")))
+         (language (intern (car (f-split relative)))))
+    (string-join
+     (append
+      `("<nav>"
+        "<ul>"
+        "<li><span>navigation:</span>"
+        "<ul>"
+        ,(format "<li>[<a accesskey=\"h\" href=\"/%s/\">%s</a>]</li>"
+                 language (alist-get language home (alist-get 'en home)))
+        ,(format "<li>[<a accesskey=\"u\" href=\"%s\">%s</a>]</li>"
+                 (if (string-equal relative (format "%s/" language)) "." "../")
+                 (alist-get language up (alist-get 'en up)))
+        "</ul>"
+        "</li>"
+        "<li><span>networks:</span>"
+        "<ul>")
+      (mapcar (lambda (network)
+                (format "<li>[<a href=\"%s\">%s</a>]</li>"
+                        (concat (car network) relative)
+                        (cdr network)))
+              networks)
+      '("</ul>" "</li>")
+      (append
+       '("<li><span>languages:</span>" "<ul>")
+       (mapcar (lambda (language)
+                 (format "<li>[<a href=\"%s%s%s\">%s</a>]</li>"
+                         backward language forward language))
+               languages)
+       '("</ul>"
+         "</li>"
+         "</ul>"
+         "</nav>")))
+     "\n")))
+
+(defun cmmm/org-html-publish-to-html (plist filename pub-dir)
+  "Publish an org file to HTML.
+
+FILENAME is the filename of the Org file to be published.  PLIST
+is the property list for the given project.  PUB-DIR is the
+publishing directory.
+
+Return output file name."
+  (add-hook 'org-export-before-processing-hook
+            'cmmm/org-export-collect-tangle)
+  (let ((res (org-publish-org-to
+              'cmmm/html filename (concat "."
+                                          (or (plist-get plist :html-extension)
+                                              org-html-extension
+                                              "html"))
+              (append plist
+                      `(:html-head-extra ,(cmmm/org-html-head-extra filename)))
+              pub-dir)))
+    (remove-hook 'org-export-before-processing-hook
+                 'cmmm/org-export-collect-tangle)
+    res))
+
+(defun cmmm/org-babel-tangle-publish (_ filename pub-dir)
+  "Tangle FILENAME and place the results in PUB-DIR."
+  (let ((org-dir (file-name-as-directory (f-dirname filename))))
+    (mapc (lambda (tangled-file)
+            (let* ((tangled-file-relative (string-remove-prefix org-dir tangled-file))
+                   (tangled-file-pub (f-join pub-dir tangled-file-relative))
+                   (tangled-file-pub-dir (f-dirname tangled-file-pub)))
+              (unless (file-exists-p tangled-file-pub-dir)
+                (make-directory tangled-file-pub-dir t))
+              (rename-file tangled-file tangled-file-pub t)))
+          (org-babel-tangle-file filename))))
+
+(setq org-publish-project-alist
+      (append
+       (mapcar
+        (lambda (language)
+          (let ((sitemap '((en . "Sitemap")
+                           (ru . "Карта сайта")
+                           (sk . "Mapa Stránky")
+                           (es . "Mapa del Sitio"))))
+            `(,(format "%s-site" language)
+              :language ,(symbol-name language)
+              :base-directory ,(format "./src/%s/" language)
+              :recursive t
+              :base-extension "org"
+              :exclude "setup\\.org"
+              :with-toc t
+              :auto-sitemap t
+              :sitemap-title ,(alist-get language sitemap (alist-get 'en sitemap))
+              ;; :sitemap-function cmmm/org-publish-org-sitemap
+              :publishing-directory ,(format "./pub/%s/" language)
+              :publishing-function (cmmm/org-html-publish-to-html
+                                    org-org-publish-to-org))))
+        '(en ru sk es))
+
+       (mapcar
+        (lambda (language)
+          (let ((sitemap '((en . "Sitemap")
+                           (ru . "Карта сайта")
+                           (sk . "Mapa Stránky")
+                           (es . "Mapa del Sitio"))))
+            `(,(format "%s-site-articles" language)
+              :language ,(symbol-name language)
+              :base-directory ,(format "./src/%s/articles/" language)
+              :recursive t
+              :base-extension "org"
+              :exclude "setup\\.org\\|rss\\.org"
+              :with-toc t
+              :section-numbers t
+              :auto-sitemap t
+              :sitemap-title ,(alist-get language sitemap (alist-get 'en sitemap))
+              :sitemap-function cmmm/org-publish-org-sitemap
+              :publishing-directory ,(format "./pub/%s/articles/" language)
+              :publishing-function (cmmm/org-html-publish-to-html
+                                    org-org-publish-to-org
+                                    cmmm/org-babel-tangle-publish))))
+        '(en ru sk es))
+
+       (mapcar
+        (lambda (language)
+          (let ((sitemap '((en . "Sitemap")
+                           (ru . "Карта сайта")
+                           (sk . "Mapa Stránky")
+                           (es . "Mapa del Sitio"))))
+            `(,(format "%s-site-web-log" language)
+              :language ,(symbol-name language)
+              :base-directory ,(format "./src/%s/web-log/" language)
+              :recursive t
+              :base-extension "org"
+              :exclude "setup\\.org\\|rss\\.org"
+              :with-toc t
+              :auto-sitemap t
+              :sitemap-title ,(alist-get language sitemap (alist-get 'en sitemap))
+              :sitemap-function cmmm/org-publish-org-sitemap
+              :publishing-directory ,(format "./pub/%s/web-log/" language)
+              :publishing-function (cmmm/org-html-publish-to-html
+                                    org-org-publish-to-org
+                                    cmmm/org-babel-tangle-publish))))
+        '(en ru sk es))
+
+         ;; ("site-web-log-rss"
+         ;;  :base-directory "./src/web-log"
+         ;;  :base-extension "org"
+         ;;  :include ("rss.org")
+         ;;  :exclude ".*"
+         ;;  :with-todo-keywords nil
+         ;;  :with-statistics-cookies nil
+         ;;  :with-broken-link t
+         ;;  :with-email nil
+         ;;  :html-link-use-abs-url t
+         ;;  :html-link-home "/web-log/index.html"
+         ;;  :publishing-directory "./pub/web-log/"
+         ;;  :publishing-function cmmm/org-rss-publish-to-rss)
+
+       '(("site-attachments"
+          :base-directory "./src/"
+          :recursive t
+          :base-extension "css\\|woff2\\|png\\|jpg\\|gif\\|pdf\\|mp3"
+          :publishing-directory "./pub/"
+          :publishing-function org-publish-attachment)
+
+         ("site-aux"
+          :base-directory "./src/aux"
+          :recursive t
+          :base-extension any
+          :publishing-directory "./pub/aux/"
+          :publishing-function org-publish-attachment)
+
+         ("site-private"
+          :base-directory "./src/private"
+          :recursive t
+          :base-extension any
+          :publishing-directory "./pub/private/"
+          :publishing-function org-publish-attachment))))
+
+(org-publish-all t)
diff --git a/bin/filter.sh b/bin/filter.sh
new file mode 100755
index 0000000..5c7668b
--- /dev/null
+++ b/bin/filter.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+sed '/^\(#+html: *<hr\/>\)$/d' src/en/index.org > src/en/index-filtered.org
diff --git a/bin/modus2css.el b/bin/modus2css.el
new file mode 100644
index 0000000..d6a57c8
--- /dev/null
+++ b/bin/modus2css.el
@@ -0,0 +1,24 @@
+(defun mapping2css (mapping)
+  (let* ((key (symbol-name (car mapping)))
+         (value (cadr mapping))
+         (color (pcase value
+                  ((pred stringp) value)
+                  ('unspecified "none")
+                  ((pred symbolp) (concat "var(--" (symbol-name value) ")")))))
+    (concat "--" key ": " color ";")))
+
+(with-current-buffer (get-buffer-create "*modus2css*")
+  (insert
+   (string-join
+    `(":root {"
+      ,@(mapcar (lambda (line) (concat "    " line))
+                (mapcar 'mapping2css (modus-themes-get-theme-palette 'modus-operandi t t)))
+      "}"
+      ""
+      "@media (prefers-color-scheme: dark) {"
+      "    :root {"
+      ,@(mapcar (lambda (line) (concat "        " line))
+                (mapcar 'mapping2css (modus-themes-get-theme-palette 'modus-vivendi t t)))
+      "    }"
+      "}")
+    "\n")))
diff --git a/bin/org2html.el b/bin/org2html.el
new file mode 100644
index 0000000..7d5b80b
--- /dev/null
+++ b/bin/org2html.el
@@ -0,0 +1,7 @@
+(require 'org)
+(require 'ox-html)
+
+(with-temp-buffer
+  (condition-case nil (while t (insert (read-from-minibuffer "") "\n"))
+    (error))
+  (princ (org-export-as 'html nil nil nil)))