;;; 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 |