;; htmlize-e.el - functions to htmlize e-scripts containing glpyhs and
;; elisp hyperlinks.
;; Written by Edrx - GPL - Version: 2004dec31

;; WARNING! WARNING! This file is not exactly part of eev.el - it was
;; put up in a hurry to generate the html files in the eev package -
;; it is not intended for public consumption (yet!) and it may depend
;; on functions that you don't have because they are only in my
;; .emacs.

;; http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el
(require 'htmlize)

;;;;;
;;
;; Some basic tools
;;
;;;;;

(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))))


;;;;;
;;
;; Dealing with glyphs - for example, converting ^Os to (real) red stars
;;
;;;;;

(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*!«»")) ; nil means use the default list
  (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)))))



;;;;;
;;
;; htmlizing elisp hyperlinks
;;
;;;;;

;; variables used by the functions that htmlize elisp hyperlinks.
;; We use dynamic scoping here: sometimes we make them local with
;; `let' and then some subfunction will set them.

(defvar eeh-text   "(text bar)")        ; overridden by `let's
(defvar eeh-sexp   '(sexp bar))         ; overridden by `let's
(defvar eeh-target "http://url/bar")    ; overridden by `let's
(defvar eeh-html   "<it>(foo bar not converted)</it>") ; same


;; modified hyperlink functions - these return either nil (meaning "do
;; not htmlize in any special way"), or a target for a html hyperlink;
;; for the really special cases - like inlined images - these
;; functions change the variable `eeh-html' and put the resulting html
;; there; when `eeh-html' is non-nil this overrides the target and all
;; the rest.

;; Hyperlinks to plain files and to files with anchors
;; (find-elnode "File Name Expansion" "Function: file-relative-name")

(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)))

;; Hyperlinks to images
;; (find-eevfile "README.html")

(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)             ; nil:   no inline image, just the link
        ((stringp perc)                 ; "nn%": inline a miniature,
         (setq eeh-html                 ;        link to full image
               (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)))))

;; Hyperlinks to info nodes

(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)))

;; Take a hyperlink sexp or its textual representation and call the
;; modified hyperlink functions to obtain its htmlization

(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)))

;; Htmlize all the elisp hyperlinks at once, and some debugging functions.
;; We do this in two separate steps to overcome limitations of htmlize.el.
;; (find-elnode "Regexp Backslash" "shy group")

(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))))))



;;;;;
;;
;; htmlize full buffers
;;
;;;;;

(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"))
  ;;
  ;; Now we're in a temporary buffer called "bufname (htmlized)";
  ;; mode is fundamental-mode
  ;;
  (goto-char (point-min))
  (my-replace-glyphs)                   ; transform glyphs into normal chars
  (eeh-encode-sexps)                    ; hack for htmlizing elisp hyperlinks
  (switch-to-buffer (htmlize-buffer))   ; ask htmlize.el to do its magic
  ;;
  ;; Now we're in a temporary buffer called "bufname.html"
  ;;
  (goto-char (point-min))
  (some-extra-replacements)             ; make some anchors
  (eeh-unencode-sexps)                  ; hack for elisp hyperlinks, part 2
  )

(defun my-htmlize-this-file ()
  (interactive)
  (let ((bufname (file-name-nondirectory (buffer-file-name))))
    ;; ^ because we don't want names like README<2>
    (my-fontify-whole-buffer)
    (my-htmlize-buffer bufname)
    (write-file (concat bufname ".html"))))

;; (find-sh0 "cp -v ~/eev-current/README /tmp/")
;; "^\\(;;\\|#\\| \\) +\\((find-[^\n]+\\)"

;; (find-efaces)
;; (find-ecolors)
;; (find-node "(elisp)Face Attributes")

(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)))

;; (htmlize-eev-files)

' (let ((eeh-regexp "^\\(.*\\)[ \t]\\((find-[^\n]+)\\)$"))
    (find-eev "NEWS")            (my-htmlize-this-file))




;; Local Variables:
;; coding:            raw-text-unix
;; ee-anchor-format:  "«%s»"
;; End: