]> git.eshelyaron.com Git - esy-publish.git/commitdiff
Fontify examples in Texinfo manuals exported to HTML
authorEshel Yaron <me@eshelyaron.com>
Mon, 28 Aug 2023 08:13:57 +0000 (10:13 +0200)
committerEshel Yaron <me@eshelyaron.com>
Mon, 28 Aug 2023 10:23:52 +0000 (12:23 +0200)
.gitignore
drafts/.keep [new file with mode: 0644]
esy-publish.el

index 5f8512042482169b9bb97be8c80ebf9ed1caae1c..dcc81365d91af1230cf4c7519e75db508389193d 100644 (file)
@@ -21,3 +21,4 @@
 /esy-publish-autoloads.el
 /esy-publish-pkg.el
 /esy-publish.elc
+/drafts/*.org
diff --git a/drafts/.keep b/drafts/.keep
new file mode 100644 (file)
index 0000000..e69de29
index c9f635bfc7c953c4b8dbe1499e4e244eded3c669..473bc0b7991b108cc8025ccde06bdd1175837e7a 100644 (file)
          (file-name-directory path)
        path))))
 
+;;;###autoload
+(defun esy-publish-setup ()
+  (unless esy-publish-did-setup-p
+    (dolist (cell '(("posts"         . esy-publish-insert-posts-dblock)
+                    ("notes"         . esy-publish-insert-notes-dblock)
+                    ("links-to-note" . esy-publish-insert-links-to-note-dblock)))
+      (org-dynamic-block-define (car cell) (cdr cell)))
+    (org-link-set-parameters "note"
+                             :follow             #'esy-publish-follow-note-link
+                             :export             #'esy-publish-export-note-link
+                             :store              #'esy-publish-store-note-link
+                             :complete           #'esy-publish-complete-note-link
+                             :insert-description #'esy-publish-describe-note-link
+                             :face                'esy-publish-note-link)
+    (function-put 'esy/init-step 'doc-string-elt 2)
+    (setq esy-publish-did-setup-p t)))
+
 ;;;###autoload
 (defun esy-publish-create-post (title subtitle description keywords)
   (interactive (list (read-string "Post title: ")
   '((t :underline (:style wave) :slant italic))
   "Face applied to \"note:\" links.")
 
-;;;###autoload
-(defun esy-publish-setup ()
-  (unless esy-publish-did-setup-p
-    (dolist (cell '(("posts"         . esy-publish-insert-posts-dblock)
-                    ("notes"         . esy-publish-insert-notes-dblock)
-                    ("links-to-note" . esy-publish-insert-links-to-note-dblock)))
-      (org-dynamic-block-define (car cell) (cdr cell)))
-    (org-link-set-parameters "note"
-                             :follow             #'esy-publish-follow-note-link
-                             :export             #'esy-publish-export-note-link
-                             :store              #'esy-publish-store-note-link
-                             :complete           #'esy-publish-complete-note-link
-                             :insert-description #'esy-publish-describe-note-link
-                             :face                'esy-publish-note-link)
-    (function-put 'esy/init-step 'doc-string-elt 2)
-    (setq esy-publish-did-setup-p t)))
-
 (defun esy-publish--post-to-feed-item (file)
   (with-current-buffer (find-file-noselect
                         (expand-file-name
     (org-transclusion-add-all)
     (push (current-buffer) esy-publish--buffers)))
 
+(defvar esy-publish-example-modes '(("lisp"   . emacs-lisp-mode)
+                                    ("prolog" . prolog-mode)))
+
+(defun esy-publish-fontify-examples (file)
+  (interactive "fFile: ")
+  (let ((tmp (concat file ".tmp.html"))
+        (src (find-file-noselect file)))
+    (with-current-buffer src
+      (let ((dom (without-restriction
+                   (xml-remove-comments (point-min) (point-max))
+                   (set-buffer-modified-p nil)
+                   (libxml-parse-html-region (point-min) (point-max)))))
+        (dolist-with-progress-reporter (example (dom-by-class dom "example[ ]"))
+            (concat "Processing example in " file)
+          (let ((example-class (dom-attr example 'class)))
+            (when (string-match (rx "example " (group-n 1 (+ (or alnum (any "-"))))) example-class)
+              (let ((go t)
+                    (ms (match-string 1 example-class)))
+                (dolist (r-mm esy-publish-example-modes)
+                  (if (and go (string-match (car r-mm) ms nil t))
+                      (dolist (pre (dom-by-tag example 'pre))
+                        (setcdr
+                         (cdr pre)
+                         (let ((prog-mode-hook '(rainbow-delimiters-mode))
+                               (htmlize-css-name-prefix org-html-htmlize-font-prefix)
+                               (buf (generate-new-buffer "*Example*")))
+                           (with-current-buffer buf
+                             (insert (dom-text pre))
+                             (funcall (cdr r-mm))
+                             (buffer-disable-undo (current-buffer))
+                             (buffer-enable-undo)
+                             (let* ((hb (htmlize-buffer buf))
+                                    (new (dom-children
+                                          (with-current-buffer hb
+                                            (car (dom-by-tag
+                                                  (libxml-parse-html-region
+                                                   (point-min)
+                                                   (point-max))
+                                                  'pre))))))
+                               (kill-buffer buf)
+                               (kill-buffer hb)
+                               new)))))))))))
+        (dom-add-child-before (car (dom-by-tag dom 'head))
+                              `(link ((rel . "canonical")
+                                      (href . ,(esy-publish--file-url file)))))
+        (with-temp-buffer
+          (let ((gc-cons-threshold most-positive-fixnum))
+            (with-delayed-message (1 (concat "Printing new DOM for "
+                                             file "..."))
+              (dom-print dom)))
+          (write-file tmp))))
+    (kill-buffer src)
+    (rename-file tmp file t)))
+
 (defun esy-publish--sweep-texinfo (plist)
   (with-current-buffer
       (find-file-noselect
     (org-texinfo-export-to-texinfo)
     (push (current-buffer) esy-publish--buffers))
   (make-directory esy-publish-local-man-directory t)
-  (call-process "texi2any"
-                nil nil nil
-                "--html"
-                "--css-ref" "../../style.css"
-                "-c" "TREE_TRANSFORMATIONS=regenerate_master_menu"
-                "-c" (concat "AFTER_BODY_OPEN="
-                             (esy-publish--dom-to-string
-                              '(div ((id . "preamble")
-                                     (class . "status"))
-                                    (nav ((id . "icon-links")
-                                          (class . "icon-links"))
-                                         (div ((class . "home-link"))
-                                              (a ((href . "/"))
-                                                 (img ((src . "/home.svg")
-                                                       (height . "35")
-                                                       (width . "35")
-                                                       (alt . "Home")))))
-                                         (div ((class . "other-links"))
-                                              (a ((href . "mailto:me@eshelyaron.com"))
-                                                 (img ((src . "/mail.svg")
-                                                       (height . "30")
-                                                       (width . "30")
-                                                       (alt . "Mail"))))
-                                              " "
-                                              (a ((href . "https://emacs.ch/@eshel")
-                                                  (rel . "me"))
-                                                 (img ((src . "/mastodon.svg")
-                                                       (height . "28")
-                                                       (width . "28")
-                                                       (alt . "Mastodon"))))
-                                              " "
-                                              (a ((href . "/rss.xml"))
-                                                 (img ((src . "/rss.svg")
-                                                       (height . "30")
-                                                       (width . "30")
-                                                       (alt . "RSS Feed")))))))
-                              '(hr nil)))
-                "-c" (concat "PRE_BODY_CLOSE="
-                             (esy-publish--dom-to-string
-                              '(div ((id . "postamble")
-                                     (class . "status"))
-                                    (footer ((id . "footer")
-                                             (class . "footer"))
-                                            (hr nil)
-                                            "© "
-                                            (time ((class . "copyright-year")) "2023")
-                                            " Eshel Yaron"))))
-                ;; TODO - also add @contents
-                "--output" (expand-file-name "sweep" esy-publish-local-man-directory)
-                (expand-file-name "sweep/sweep.texi" esy-publish-root-directory)))
+  (let ((out (expand-file-name "sweep" esy-publish-local-man-directory)))
+    (call-process "texi2any"
+                  nil nil nil
+                  "--html"
+                  "--css-ref" "../../style.css"
+                  "-c" "TREE_TRANSFORMATIONS=regenerate_master_menu"
+                  "-c" (concat "AFTER_BODY_OPEN="
+                               (esy-publish--dom-to-string
+                                '(div ((id . "preamble")
+                                       (class . "status"))
+                                      (nav ((id . "icon-links")
+                                            (class . "icon-links"))
+                                           (div ((class . "home-link"))
+                                                (a ((href . "/"))
+                                                   (img ((src . "/home.svg")
+                                                         (height . "35")
+                                                         (width . "35")
+                                                         (alt . "Home")))))
+                                           (div ((class . "other-links"))
+                                                (a ((href . "mailto:me@eshelyaron.com"))
+                                                   (img ((src . "/mail.svg")
+                                                         (height . "30")
+                                                         (width . "30")
+                                                         (alt . "Mail"))))
+                                                " "
+                                                (a ((href . "https://emacs.ch/@eshel")
+                                                    (rel . "me"))
+                                                   (img ((src . "/mastodon.svg")
+                                                         (height . "28")
+                                                         (width . "28")
+                                                         (alt . "Mastodon"))))
+                                                " "
+                                                (a ((href . "/rss.xml"))
+                                                   (img ((src . "/rss.svg")
+                                                         (height . "30")
+                                                         (width . "30")
+                                                         (alt . "RSS Feed")))))))
+                                '(hr nil)))
+                  "-c" (concat "PRE_BODY_CLOSE="
+                               (esy-publish--dom-to-string
+                                '(div ((id . "postamble")
+                                       (class . "status"))
+                                      (footer ((id . "footer")
+                                               (class . "footer"))
+                                              (hr nil)
+                                              "© "
+                                              (time ((class . "copyright-year")) "2023")
+                                              " Eshel Yaron"))))
+                  ;; TODO - also add @contents
+                  "--output" out
+                  (expand-file-name "sweep/sweep.texi" esy-publish-root-directory))
+    (dolist (file (directory-files out t (rx ".html" eos)))
+      (esy-publish-fontify-examples file))))
 
 (defun esy-publish--prepare-indices (&rest _)
   (dolist (dir (list esy-publish-notes-source-directory
       (push (current-buffer) esy-publish--buffers))))
 
 (defun esy-publish--finalize (plist)
-  (esy-publish--add-canonical-tags plist)
-  (esy-publish--finalize-feed plist)
   (esy-publish--sweep-texinfo plist)
+  (esy-publish--finalize-feed plist)
+  (esy-publish--add-canonical-tags plist)
   (esy-publish--finalize-sitemap plist))
 
 ;;;###autoload