;;; html-encode.el --- Exporting files with Emacs font into html format.

;; Author: Wei Cai <caiwei@mit.edu> Dongyi Liao <liaody@mit.edu>
;; Maintainer: Wei Cai <caiwei@mit.edu>
;; Created: 21 Sep 1997
;; Version: 1.1
;; Keywords: HTML face text-properties

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License.

;;; Commentary:

;; Installation:
;;   Add this line in your .emacs:
;;     (autoload 'html-encode-buffer "html-encode" "HTML Encode Buffer" t)
;;     (autoload 'html-encode-region "html-encode" "HTML Encode Region" t)
;;

;; Description:
;;   html-encode exports files in emacs buffer into html format
;; when viewed from netscape, the font and color is the same
;; as viewed by emacs in font-lock-mode.


;;; Code:

(defun html-encode-buffer (fname)
  "export current buffer in html format"
  (interactive "BFile name(*.html)? \n")
  (html-encode-region fname (point-min) (point-max)))
(defun html-encode-region (fname from to) 
  "export region in html format"
  (interactive "BFile name(*.html)? \nr")
  (let ((oldbuf (current-buffer))
        (oldname (buffer-name))
        (writable t)
        (q nil)
        (title "#emacs2html#"))         ;temporary buffer storing the contents to be encoded
    (save-excursion
      (prog1
          (if (eq (buffer-name) fname)
              (progn (message "Export filename = current filename, invalid!")
                     (setq writable nil))
            (progn
              (set-buffer (get-buffer-create title))
              (if (file-exists-p fname)
                  (progn (message "File:%s exists, overwrite(y/n)?" fname)
                         (setq q (read-char))
                         (if (= q 121) (prog1 (message "Delete file %s" fname)
                                         (delete-region (point-min) (point-max)))
                           (prog1 (setq writable nil)
                             (message "Cancelled"))))
                nil )
              (if writable              ; if the filename specified is confirmed, do the encoding
                  (progn 
                    (insert-buffer-substring oldbuf from to)
                    (message "File copied to (tmp)%s. Converting to html...." title)
                    (save-restriction
                      (delete-to-left-margin)
                      (unjustify-region)
                      (goto-char (point-min))
                      (format-replace-strings '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
                      (format-insert-annotations 
                       (format-annotate-region (point-min) (point-max) html-translations
                                               (lambda (name positive)
                                                 (concat "<" (if positive "" "/") name ">"))
                                               html-ignore))
                      (goto-char (point-min))
                      (insert (concat "<HTML> <HEAD> <TITLE>"
                                      oldname
                                      "</TITLE> </HEAD> <BODY> <PRE> \n")))      
                    (goto-char (point-max))
                    (insert "</PRE> </BODY> </HTML>")
                    (bracket-delete "</FONT" ">") ; delete extra strings in tag </font>
                    (write-region (point-min) (point-max) fname) ; save buffer into specified file
                    (kill-buffer (current-buffer)) ; kill the working buffer
                    ))))))))
(defconst html-ignore
  '(front-sticky rear-nonsticky hard lazy-lock mouse-face invisible)
  "Properties that are OK to ignore when using html-encoding
Any property that is neither on this list nor dealt with by
`html-translations' will generate a warning.")

(defconst html-translations
  '((face          (bold-italic "B" "I")
		   (bold        "B")
		   (italic      "I")
		   (underline   "U")
		   (fixed       "TT")
		   (excerpt     "I")
		   (default     )
		   (nil         html-encode-other-face))
    (left-margin   (4           "indent"))
    (right-margin  (4           "indentright"))
    (justification (none        "nofill")
		   (right       "flushright")
		   (left        "flushleft")
		   (full        "flushboth")
		   (center      "center"))
    )
  "List of definitions of text/html annotations.
See `format-annotate-region' and `format-deannotate-region' for the definition
of this structure.")

(defun html-encode-other-face (old new)
  "Generate annotations for random face change.
One annotation each for foreground color, background color, italic, etc."
  (cons (and old
             (let* ((fg (face-foreground old))
                    (bg (face-background old))
                    (props (face-font old t))
                    (ans (cdr (format-annotate-single-property-change
                               'face nil props html-translations))))
               (if (or fg bg) (setq ans (cons (concat "FONT "
                                                      (if fg (concat "COLOR=" fg) "")
                                                      (if bg (concat "BGCOLOR=" bg) "")) ans)))
               ans))
        (and new
             (let* ((fg (face-foreground new))
                    (bg (face-background new))
                    (props (face-font new t))
                    (ans (cdr (format-annotate-single-property-change
                               'face nil props html-translations))))
               (if (or fg bg) (setq ans (cons (concat "FONT "
                                                      (if fg (concat "COLOR=" fg) "")
                                                      (if bg (concat "BGCOLOR=" bg) "")) ans)))
               ans))))

(defun bracket-delete (start end &optional complete)
  "Delete area bracketed by strings START and END.
If COMPLETE is ture, the strings START and END is also deleted."
  (goto-char (point-min))
  (let (from to)
    (while (search-forward start nil t)
      (setq from (match-beginning 0))
      (if (search-forward end nil t)
          (setq to (match-beginning 0)))
      (if complete
          (progn (delete-region from (+ to (length end)))
                 (goto-char from))
        (progn (delete-region (+ from (length start)) to)
               (goto-char (+ from (length start) (length end))))
        ))))
            
(provide 'html-encode)
;;; html-encode.el ends here