|
|
;;; 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 '(("&" . "&") ("<" . "<") (">" . ">")))
(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
|