org and htmlfontify

org and htmlfontify

[David O'Toole]

Hello orgmoders. I thought I would share my custom publishing function
for using htmlfontify together with org-publish to automatically convert
Lisp source code files into HTML with my own custom-inserted anchors.

The lisp snippet is below. This was used to make the HTML links in my
developer documentation properly jump to particular headings in the
HTMLfontified output (try the page and see what I mean:
http://dto.github.com/notebook/developers-guide.html 

I am also working something else org-related:
http://dto.github.com/notebook/folio.html

(defun spaces-to-underscores (string)
  (save-match-data
    (with-temp-buffer
      (insert string)
      (goto-char (point-min))
      (while (re-search-forward " \\|-" nil t) ;; and dashes!
	(replace-match "_"))
      (buffer-substring-no-properties (point-min) (point-max)))))

(defun publish-lisp-to-html (plist filename pub-dir)
  (interactive)
    (let* ((dir (file-name-directory filename))
	   (base (file-name-sans-extension (file-name-nondirectory filename)))
	   (target (expand-file-name (concat base ".html") pub-dir))
	   (html nil)
	   (hfy-src-doc-link-style "color: #a020f0; font-weight: bold;")
	   (hfy-sec-doc-link-unstyle " color: #4d4d4d;"))
      (with-current-buffer (find-file-noselect filename)
	(hfy-force-fontification)
	(setf html (hfy-fontify-buffer dir filename)))
      (with-current-buffer html
	;; add anchors for all three-semicolon headings
	(goto-char (point-min))
	(while (re-search-forward ";;;[^@]*@@ \\([^<>]*\\)" nil t)
	  (message "matched %s" (match-string-no-properties 1))
	  (replace-match (format ";;; <a name=\"%s\">@@ %s</a>"
				 (spaces-to-underscores (match-string-no-properties 1))
				 (match-string-no-properties 1))))
	(write-file target nil))
      (kill-buffer html)))