(require 'htmlize)
(defun ee-kill-buffer (buffer-or-name &rest rest)
"For each BUFFER-OR-NAME in the list of arguments kills it if it exists"
(if (get-buffer buffer-or-name) (kill-buffer buffer-or-name))
(if rest (apply 'ee-kill-buffer rest)))
(defun my-replace-regexps-with-inheritance (regexp to &rest rest)
(save-excursion
(while (re-search-forward regexp nil 'no-error)
(replace-match to 'fixedcase nil)))
(if rest (apply 'my-replace-regexps-with-inheritance rest)))
(defun my-replace-strings-with-inheritance (from to &rest rest)
(save-excursion
(while (search-forward from nil 'no-error)
(delete-region (match-beginning 0) (match-end 0))
(insert-and-inherit to))))
(defun my-replace-strings (from to &rest rest)
(save-excursion
(while (search-forward from nil 'no-error)
(delete-region (match-beginning 0) (match-end 0))
(insert to))))
(defun glyphs-faceglyph-to-facechar (code)
"Convert a character associated to a glyph to a propertized string.
CODE is an integer - the code of the character (e.g. 15 for ^O)."
(let* ((n (aref (aref standard-display-table code) 0))
(faceid (ash n -19))
(face (ee-faceid-to-face faceid (face-list)))
(char (logand n 524287))
(charstr (format "%c" char)))
(add-text-properties 0 1 (list 'face face) charstr)
charstr))
(defun my-replace-glyphs (&optional glyphsstr)
(or glyphsstr (setq glyphsstr " LM*!«»")) (if (> (length glyphsstr) 0)
(let* ((code (aref glyphsstr 0))
(firstchar (substring glyphsstr 0 1))
(rest (substring glyphsstr 1 nil))
(unglyphstr (glyphs-faceglyph-to-facechar code)))
(my-replace-strings firstchar unglyphstr)
(my-replace-glyphs (substring glyphsstr 1 nil)))))
(defvar eeh-text "(text bar)") (defvar eeh-sexp '(sexp bar)) (defvar eeh-target "http://url/bar") (defvar eeh-html "<it>(foo bar not converted)</it>")
(defun eeh-find-anchor (fname &optional anchor &rest rest)
(concat (file-relative-name fname)
".html"
(if anchor (format "#%s" anchor) "")))
(defun eeh-find-eev (fname &optional anchor &rest rest)
(eeh-find-anchor (ee-eevfile fname) anchor))
(defun eeh-find-angg (fname &optional anchor &rest rest)
(eeh-find-anchor (ee-anggfile fname) anchor))
(defun eeh-find-eevfile (fname &rest rest)
(file-relative-name (ee-eevfile fname)))
(defun eeh-find-anggfile (fname &rest rest)
(file-relative-name (ee-anggfile fname)))
(defun eeh-find-eimage0 (fname &optional nlines nchars perc &rest ignore)
"Htmlize hyperlinks to images. Supports inlining and scaling.
NLINES and NCHARS are ignored, PERC controls whether to inline or scale.
Examples (try with \\[eeh-1flash]):\n
(find-eimage0 \"f3.png\")
-> just a link to the image\n
(find-eimage0 \"f3.png\" nil nil 'anything-not-nil-or-string)
-> \"<img src=\"doc/f3.png\" border=0>\"\n
(find-eimage0 \"f3.png\" nil nil \"40%\")
-> <a href=\"f3.png\">
<img src=\"f3.png\" width=\"40%\" height=\"40%\" border=0>
</a>"
(cond ((null perc) fname) ((stringp perc) (setq eeh-html (format (concat
"<a href=\"%s\">"
"<img src=\"%s\" width=\"%s\" height=\"%s\" border=0>"
"</a>")
fname fname perc perc)))
(t (setq eeh-html (format "<img src=\"%s\" border=0>" fname)))))
(defun eeh-info-dash (url node)
(concat url (replace-regexp-in-string "[ &<>]" "-" node) ".html"))
(defun eeh-info (manual-and-node)
"Htmlize some hyperlinks to info nodes.
Examples: (eeh-info \"(emacs)Lisp Eval\")
(eeh-info \"(elisp)Scope\")
(eeh-info \"(eintr)Buffer Names\")"
(if (string-match "^(\\([^()]+\\))\\(.*\\)" manual-and-node)
(let ((manual (match-string 1 manual-and-node))
(node (match-string 2 manual-and-node)))
(cond
((equal manual "emacs")
(eeh-info-dash "http://www.gnu.org/software/emacs/manual/html_node/" node))
((equal manual "elisp")
"http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_toc.html")
((member manual '("eintr" "elintro"))
(eeh-info-dash "http://www.gnu.org/software/emacs/emacs-lisp-intro/html_node/" node))))))
(defun eeh-find-node (node &rest rest)
(eeh-info node))
(defun eeh-find-enode (node &rest rest)
(eeh-info (format "(emacs)%s" node)))
(defun eeh-find-elnode (node &rest rest)
(eeh-info (format "(elisp)%s" node)))
(defun eeh-find-elinode (node &rest rest)
(eeh-info (format "(eintr)%s" node)))
(defvar eeh-functions nil)
(setq eeh-functions
'((find-eimage0 . eeh-find-eimage0)
(find-eev . eeh-find-eev)
(find-eevfile . eeh-find-eevfile)
(find-angg . eeh-find-angg)
(find-anggfile . eeh-find-anggfile)
(info . eeh-info)
(find-node . eeh-find-node)
(find-enode . eeh-find-enode)
(find-elnode . eeh-find-elnode)
))
(defun eeh-sexp-to-html (sexp)
"Take a hyperlink sexp and htmlize it."
(let* ((eeh-target nil)
(eeh-html nil)
(f (car sexp))
(eeh-f (cdr (assoc f eeh-functions))))
(if eeh-f (setq eeh-target (apply eeh-f (cdr sexp))))
(or eeh-html
(if eeh-target
(format "<a href=\"%s\">%s</a>" eeh-target eeh-text)
eeh-text))))
(defun eeh-text-to-html (text)
"Take the textual representation of a hyperlink sexp and htmlize it.
This function invokes `eeh-sexp-to-html', which in its turn uses
the table `eeh-functions' to pass the control to the modified
hyperlink functions (find-node -> eeh-find-node, etc); we use
variables with dynamic scoping to make the definitions of the
modified hyperlink functions shorter."
(let ((eeh-text text)
(eeh-sexp (read text)))
(eeh-sexp-to-html eeh-sexp)))
(defvar eeh-regexp-no-space "^\\(;;\\|#\\) +\\((find-[^\n]+\\)")
(defvar eeh-regexp-space "^\\(;;\\|#\\| \\) +\\((find-[^\n]+\\)")
(defvar eeh-regexp eeh-regexp-space)
(defvar eeh-regexp-sexp-n 2)
(defvar eeh-pairs nil)
(defvar eeh-n 0)
(defun eeh-flash ()
"Show which hyperlink sexps after point will be processed"
(interactive)
(save-excursion
(while (re-search-forward eeh-regexp nil t)
(let* ((b (match-beginning eeh-regexp-sexp-n))
(e (match-end eeh-regexp-sexp-n)))
(eeflash b e)))))
(defun eeh-1flash ()
"Show the next hyperlink sexp after point and how will be htmlized"
(interactive)
(if (re-search-forward eeh-regexp nil t)
(let* ((b (match-beginning eeh-regexp-sexp-n))
(e (match-end eeh-regexp-sexp-n))
(str (buffer-substring-no-properties b e)))
(eeflash b e)
(message "%s" (eeh-text-to-html str)))))
(defun eeh-encode-sexps ()
"Transform all the htmlizable hyperlink sexps after point into \"@nn@\"s"
(interactive)
(setq eeh-pairs nil)
(setq eeh-n 0)
(while (re-search-forward eeh-regexp nil t)
(let* ((b (match-beginning eeh-regexp-sexp-n))
(e (match-end eeh-regexp-sexp-n))
(str (buffer-substring-no-properties b e))
(html (eeh-text-to-html str)))
(when (not (equal str html))
(setq eeh-n (1+ eeh-n))
(let ((newstr (format "@%d@" eeh-n)))
(delete-region b e)
(insert-and-inherit newstr)
(setq eeh-pairs `((,newstr . ,html) . ,eeh-pairs)))))))
(defun eeh-unencode-sexps ()
"Transform all the \"@nn@\"s after point into the corresponding htmlized sexps"
(interactive)
(let ((pairs-left (reverse eeh-pairs)))
(while pairs-left
(let* ((encstr (caar pairs-left))
(html (cdar pairs-left)))
(search-forward encstr)
(delete-region (match-beginning 0) (match-end 0))
(insert-and-inherit html)
(setq pairs-left (cdr pairs-left))))))
(defun my-fontify-whole-buffer ()
"Fontify the whole buffer. BTW, it took me *ages* to discover how to do this."
(interactive)
(font-lock-mode 1)
(jit-lock-fontify-now))
(defun some-extra-replacements ()
(interactive)
(my-replace-regexps-with-inheritance
(concat "\\(<span class=\"\\(function\\|variable\\)-name\">\\)"
"\\([-_A-Za-z0-9]+\\)"
"\\(</span>\\)")
"<a name=\"\\3\">\\1\\3\\4</a>"))
(defun my-htmlize-buffer (&optional bufname)
(interactive)
(or bufname (setq bufname (buffer-name)))
(let ((ee-buffer-name (concat bufname " (htmlized)")))
(find-estring (buffer-substring (point-min) (point-max))))
(ee-kill-buffer (concat bufname ".html"))
(goto-char (point-min))
(my-replace-glyphs) (eeh-encode-sexps) (switch-to-buffer (htmlize-buffer)) (goto-char (point-min))
(some-extra-replacements) (eeh-unencode-sexps) )
(defun my-htmlize-this-file ()
(interactive)
(let ((bufname (file-name-nondirectory (buffer-file-name))))
(my-fontify-whole-buffer)
(my-htmlize-buffer bufname)
(write-file (concat bufname ".html"))))
(defun htmlize-eev-files ()
(interactive)
(require 'outline)
(set-face-foreground 'outline-1 "OrangeRed")
(set-face-foreground 'outline-2 "Goldenrod2")
(set-face-foreground 'outline-3 "LimeGreen")
(set-face-foreground 'outline-4 "Dodger Blue")
(let ((eeh-regexp "^\\(.*\\)[ \t]\\((find-[^\n]+)\\)$"))
(find-eev "EMACS") (my-htmlize-this-file)
(find-eev "INSTALL") (my-htmlize-this-file)
(find-eev "INTERFACE") (my-htmlize-this-file)
(find-eev "NEWS") (my-htmlize-this-file)
(find-eev "README") (my-htmlize-this-file))
(let ((eeh-regexp "^\\(.*;.*\\)[ \t]\\((find-[^\n]+)\\)$"))
(find-eev "eev-dev.el") (my-htmlize-this-file)
(find-eev "eev-insert.el") (my-htmlize-this-file)
(find-eev "eev-langs.el") (my-htmlize-this-file)
(find-eev "compose.el") (my-htmlize-this-file)
(find-eev "glyphs.el") (my-htmlize-this-file)
(find-eev "htmlize-eev.el") (my-htmlize-this-file))
(let ((eeh-regexp "^\\(.*#.*\\)[ \t]\\((find-[^\n]+)\\)$"))
(find-eev "eeg4") (my-htmlize-this-file)
(find-eev "eegchannel") (my-htmlize-this-file)))
' (let ((eeh-regexp "^\\(.*\\)[ \t]\\((find-[^\n]+)\\)$"))
(find-eev "NEWS") (my-htmlize-this-file))
«»