;; htmlize.el -- HTML-ize font-lock buffers
-;; Copyright (C) 1997,1998
Free Software Foundation
+;; Copyright (C) 1997,1998
;; Author: Hrvoje Niksic <firstname.lastname@example.org>
;; Keywords: hypermedia, extensions
-;; This file is not yet part of any Emacs, but it may be distributed
-;; under the XEmacs distribution terms:
-;; XEmacs is free software; you can redistribute it and/or modify
+;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
XEmacs is distributed in the hope that it will be useful,
+;; is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with
XEmacs; see the file COPYING. If not, write to the
+;; along with ; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Synched up with: not in FSF
-;; This package will allow you to HTML-ize your font-lock buffers,
-;; analyzing the text properties and transforming them to HTML. Mail
-;; to <email@example.com> to discuss features and additions. All
+;; This package analyses the text properties of the buffer and
+;; converts them, along with the text, to HTML. Mail to
+;; <firstname.lastname@example.org> to discuss features and additions. All
;; suggestions are more than welcome.
;; To use, just switch to a buffer you want HTML-ized, and type `M-x
;; htmlize-buffer'. After that, you should find yourself in an HTML
-;; buffer, which you can save.
+;; buffer, which you can save. Alternatively, `M-x htmlize-file' will
+;; find a file, font-lockify the buffer, and save the HTML version,
+;; all before you blink. Even more alternatively, `M-x
+;; htmlize-many-files' will prompt you for a slew of files to undergo
+;; the same treatment. `M-x htmlize-many-files-dired' will do the
+;; same for the files marked by dired.
;; The code attempts to generate compliant HTML, but I can't make any
;; guarantees; I haven't yet bothered to run the generated markup
;; through a validator. I tried to make the package elisp-compatible
;; with multiple Emacsen, specifically aiming for XEmacs 19.14+ and
-;; GNU Emacs 19.34+. Please let me know if it doesn't, and I'll try
-;; to fix it. I relied heavily on the presence of CL extensions,
-;; especially for compatibility; please don't try to remove that
+;; GNU Emacs 19.34+. Please let me know if it doesn't work on any of
+;; those, and I'll try to fix it. I relied heavily on the presence of
+;; CL extensions, especially for compatibility; please don't try to
+;; remove that dependency.
-;; When compiling under GNU Emacs, you'
ll likely to get oodles of
+;; When compiling under GNU Emacs, you' likely to get oodles of
;; warnings; ignore them all. For any of this to work, you need to
;; run Emacs under a window-system -- anything else will almost
-;; Thanks go to: Ron Gut <email@example.com> for useful additions that I
-;; incorporated; to Bob Weiner <firstname.lastname@example.org> for neat ideas
-;; (use of rgb.txt and caching face colors); to Toni Drabik
-;; <email@example.com> for a crash course to CSS1.
+;; The latest version should be available at:
+;; * Ron Gut <firstname.lastname@example.org>, for useful additions (hooks and
+;; * Bob Weiner <email@example.com>, for neat ideas (use of
+;; rgb.txt and caching color strings);
+;; * Toni Drabik <firstname.lastname@example.org>, for a crash course to
+;; * Peter Breton <email@example.com>, for useful suggestions
+;; (multiple file stuff) and dired code.
+;; * Thomas Vogels <firstname.lastname@example.org> and Juanma Barranquero
+;; <email@example.com> for contributing fixes.
+;; * A bunch of other people for sending reports.
;; TODO: Should attempt to merge faces (utilize CSS for this?).
;; Should recognize all extents under XEmacs, not just text
(if (string-match "XEmacs" emacs-version)
- (warnings (- unresolved)))))
+ (warnings (- unresolved))))
+ (defvar font-lock-auto-fontify)
+ (defvar global-font-lock-mode))
-(defconst htmlize-version "0.
+(defconst htmlize-version "0.")
-;; BLOB to make custom stuff work even without customize
+;; Incantations to make custom stuff work without customize, e.g. on
+;; XEmacs 19.14 or GNU Emacs 19.34.
(defmacro defgroup (&rest args)
(defmacro defcustom (var value doc &rest args)
- (` (defvar (, var) (, value) (, doc))))))
+ (` (defvar (, var) (, value) (, doc))))
+ (defmacro defface (face value doc &rest stuff)
"HTMLize font-locked buffers."
"*Output type of generated HTML. Legal values are `css' and `font'.
When set to `css' (the default), htmlize will generate a style sheet
with description of faces, and use it in the HTML document, specifying
-the faces in the actual text with <span>.
+the faces in the actual text with <span>.
When set to `font', the properties will be set using layout tags
<font>, <b>, <i>, <u>, and <strike>."
Unlike `htmlize-before-hook', these functions are run in the HTML
buffer. You may use them to modify the outlook of the final HTML
+(defvar htmlize-file-hook nil
+ "Hook run after htmlizing a file, and before writing it out to disk.
+This is run by the `htmlize-file'.")
;; I try to conditionalize on features rather than Emacs version, but
;; in some cases checking against the version *is* necessary.
(if (not (string-match "[&<>\"]" string))
(mapconcat (lambda (char)
+ ;; This will signal an error if CHAR is something
+ ;; outside the 0-255 range. Maybe that is just as
+ ;; well, as I've no idea how to convert a Mule
(aref htmlize-character-table char))
(when (file-exists-p (expand-file-name file dir))
(return (expand-file-name file dir))))))
-(unless (fboundp 'with-current-buffer)
- (defmacro with-current-buffer (buffer &rest forms)
- `(save-excursion (set-buffer ,buffer) ,@forms)))
-(unless (fboundp 'with-temp-buffer)
- (defmacro with-temp-buffer (&rest forms)
- (let ((temp-buffer (make-symbol "temp-buffer")))
- (get-buffer-create (generate-new-buffer-name " *temp*"))))
+(if (fboundp 'file-name-extension)
+ (defalias 'htmlize-file-name-extension 'file-name-extension)
+ (defun htmlize-file-name-extension (filename &optional period)
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
+ (and (string-match "\\.[^.]*\\'" file)
+ (substring file (+ (match-beginning 0) (if period 0 1)))))))
+ ;; I hate having replacement macros which are not colorized or
+ ;; indented properly, so I'll just define save-current-buffer and
+ ;; with-current-buffer if I can't find them. htmlize is hardly a
+ ;; package that you use all the time, so that should be fine.
+ (unless (fboundp 'save-current-buffer)
+ (defmacro save-current-buffer (&rest forms)
+ `(let ((__scb_current (current-buffer)))
- (with-current-buffer ,temp-buffer
- (and (buffer-name ,temp-buffer)
- (kill-buffer ,temp-buffer)))))))
+ (set-buffer __scb_current)))))
+ (unless (fboundp 'with-current-buffer)
+ (defmacro with-current-buffer (buffer &rest forms)
+ `(save-current-buffer (set-buffer ,buffer) ,@forms)))
+ (unless (fboundp 'with-temp-buffer)
+ (defmacro with-temp-buffer (&rest forms)
+ (let ((temp-buffer (gensym "tb-")))
+ (get-buffer-create (generate-new-buffer-name " *temp*"))))
+ (with-current-buffer ,temp-buffer
+ (and (buffer-live-p ,temp-buffer)
+ (kill-buffer ,temp-buffer))))))))
(defun htmlize-face-foreground (face)
(or (face-foreground face)
- ;; Totally bogus, but in my FSFmacs, (face-foreground
- ;; 'default) simply returns nil. Is it a bug? Is there
+ (frame-parameter (selected-frame) 'foreground-color)
(defun htmlize-face-background (face)
(or (face-background face)
+ (frame-parameter (selected-frame) 'background-color)
strikep ; whether face is strikethrough
css-name ; CSS name of face
-(defvar htmlize-face-hash (make-hash-table :t
+(defvar htmlize-face-hash (make-hash-table :t 'eq))
(defun htmlize-make-face-hash (faces)
;; OK, you may open them again.
(setf (htmlize-face-strikep object) (face-strikethru-p face)))
- (htmlize-face-boldp object) (face-bold-p face)
- ;; Italic-ness, GNU Emacs
- (htmlize-face-italicp object) (face-italic-p face)
- ;; Strikethrough is not supported by GNU Emacs.
- (htmlize-face-strikep object) nil))
+ (when (fboundp 'face-bold-p)
+ ;; Boldness, GNU Emacs 20
+ (setf (htmlize-face-boldp object) (face-bold-p face)))
+ (when (fboundp 'face-italic-p)
+ ;; Italic-ness, GNU Emacs
+ (setf (htmlize-face-italicp object) (face-italic-p face)))
+ ;; Strikethrough is not supported by GNU Emacs.
+ (setf (htmlize-face-strikep object) nil))
;; css-name. Emacs is lenient about face names -- virtually
;; any string may name a face, even those consisting of
(while (string-match "--" cleaned-up-face-name)
(setq cleaned-up-face-name (replace-match "-" t t
- (while (string-match "*/" cleaned-up-face-name)
+ (while (string-match "*/" cleaned-up-face-name)
(setq cleaned-up-face-name (replace-match "XX" t t
(unless (eq face 'default)
(funcall ,func ,@args)))))
-;; The one and only entry level function.
(defun htmlize-buffer (&optional buffer)
;; to free up the used conses.
+(defun htmlize-make-file-name (file dir)
+ (let* ((nondir (file-name-nondirectory file))
+ (extension (htmlize-file-name-extension file))
+ (sans-extension (file-name-sans-extension nondir)))
+ (expand-file-name (if (or (equal extension "html")
+ (equal extension "htm")
+ (equal sans-extension ""))
+ (concat nondir ".html")
+ (concat sans-extension ".html"))
+ (or dir (file-name-directory file)))))
+(defun htmlize-file (file &optional target-directory)
+ "HTML-ize FILE, and save the result.
+If TARGET-DIRECTORY is non-nil, the resulting HTML file will be saved
+to that directory, instead of to the FILE's directory."
+ (interactive "fHTML-ize file: ")
+ (let* ((was-visited (get-file-buffer file))
+ ;; Set these to nil to prevent double fontification; we'll
+ ;; fontify manually below.
+ (font-lock-auto-fontify nil)
+ (global-font-lock-mode nil)
+ (origbuf (set-buffer (find-file-noselect file t))))
+ (run-hooks 'htmlize-file-hook)
+ (write-region (point-min) (point-max)
+ (htmlize-make-file-name file target-directory))
+ (kill-buffer (current-buffer))
+ (kill-buffer origbuf))))
+(defun htmlize-many-files (files &optional target-directory)
+ "HTML-ize files specified by FILES, and save them to `.html' files.
+If TARGET-DIRECTORY is specified, the HTML files will be saved to that
+directory. Normally, each HTML file is saved to the directory of the
+corresponding source file."
+ ;; Check for `ommadawn', because checking against nil doesn't do
+ (while (not (eq (setq file (read-file-name "HTML-ize file (RET to finish): "
+ (and list (file-name-directory
+ (htmlize-file file target-directory)))
+(defun htmlize-many-files-dired (arg &optional target-directory)
+ "HTMLize dired-marked files."
+ (htmlize-many-files (dired-get-marked-files nil arg) target-directory))