Download
(and (< emacs-major-version 21)
(eval-when-compile (require 'cl)))
(require 'dired)
(require 'info+ nil t)
(require 'info)
(require 'mkhtml-htmlize)
(require 'easymenu)
(defconst mkhtml-version "1.7"
"This version of the MKHTML package (not just file `mkhtml.el'.")
(define-key menu-bar-tools-menu [mkhtml-any-buffer]
'("HTMLize Buffer" . mkhtml-any-buffer))
(when (and (boundp 'Info-mode-menu) Info-mode-menu)
(define-key Info-mode-map "c" 'mkhtml-info-buffer)
(define-key Info-mode-map "w" 'mkhtml-file)
(cond ((lookup-key Info-mode-menu [Edit\ Node])
(easy-menu-do-add-item Info-mode-menu
["HTMLize Buffer" mkhtml-info-buffer t]
"Edit Node")
(easy-menu-do-add-item Info-mode-menu
["HTMLize Whole Info File" mkhtml-file t]
"Edit Node"))
(t
(easy-menu-do-add-item Info-mode-menu
["HTMLize Buffer" mkhtml-info-buffer t]
"Exit")
(easy-menu-do-add-item Info-mode-menu
["HTMLize Whole Info File" mkhtml-file t]
"Exit"))))
(when (and (boundp 'Info-merged-menu) Info-merged-menu)
(define-key Info-merged-map "c" 'mkhtml-buffer)
(easy-menu-do-add-item Info-merged-menu
["HTMLize Buffer" mkhtml-merged-info-buffer t]
"Quit"))
(defvar mkhtml-file-node-sep "-"
"*String to separate Info file and node names in HTML file names.")
(defvar mkhtml-dir-sep-replacement "--"
"*String to replace `directory-sep-char' in Info node filenames.")
(defvar mkhtml-link-color "#02F"
"*Color to use for unvisited hypertext links.")
(defvar mkhtml-visited-link-color "#808"
"*Color to use for visited hypertext links.")
(defvar mkhtml-hover-link-fg-color "purple"
"*Color to use for foreground when mouse is over hypertext links.")
(defvar mkhtml-hover-link-bg-color "#AFB"
"*Color to use for background when mouse is over hypertext links.")
(defsubst mkhtml-file-menu-item ()
"The file menu item surrounding point, or nil if none.
A file menu item is one that ends in `::', instead of just `:'."
(Info-get-token (point) "\\* " "\\* \\([^:]*\\)::"))
(defsubst mkhtml-non-file-menu-item ()
"The non-file menu item surrounding point, or nil if none.
A non-file menu item is one that ends in `:', instead of `::'."
(Info-get-token (point) "\\* " "\\* [^:]*:[ \t]+\\([^\t,.\n]+\\)[\t,.\n]"))
(defun mkhtml-make-HTML-file-name (file dir)
"Make absolute HTML file name+path.
FILE names the file without suffix \"\.html\". DIR is the directory."
(expand-file-name (concat (file-name-nondirectory file) ".html")
(or dir (file-name-directory file))))
(defun mkhtml-convert-std-filename (filename)
"Convert FILENAME to an innocuous file name.
This uses `convert-standard-filename', after replacing occurrences of
both `directory-sep-char' and (on Windows only) \"\\\" with
`mkhtml-dir-sep-replacement'.
Note: We need to replace \"\\\" here explicitly because even on
Windows `directory-sep-char' is \"/\", not \"\\\"."
(convert-standard-filename
(dired-replace-in-string
(concat "[" (char-to-string directory-sep-char)
(and (eq system-type 'windows-nt) "\\")
"]")
mkhtml-dir-sep-replacement
filename)))
(defun mkhtml-dired-files (arg html-dir)
"HTMLize marked files in a Dired buffer. Mouse-face => HTML links.
Create an HTML file corresponding to each of the marked files.
If (prefix) ARG is an integer, use next ARG files, starting at cursor.
If ARG is otherwise non-nil, use current file (at cursor).
HTML-DIR is the directory where the HTML files are created."
(interactive
(list current-prefix-arg
(read-file-name "Directory for HTML file: " nil default-directory)))
(mkhtml-files (dired-get-marked-files nil arg) html-dir))
(defun mkhtml-files (files html-dir)
"HTMLize files specified by FILES list. Mouse-face => HTML links.
Create an HTML file corresponding to each of the files in list FILES.
This calls `mkhtml-file' on each of the FILES.
HTML-DIR is the directory where resulting HTML files are created.
Normally, each HTML file is saved to the directory of its source file."
(interactive
(list
(let (file file-list)
(while (not (eq (setq file (read-file-name "HTML-ize file (RET to finish): "
(and file-list (file-name-directory
(car file-list)))
'ommadawn t))
'ommadawn))
(push file file-list))
file-list)
(read-file-name "Directory for HTML file: " nil default-directory)))
(dolist (file files) (mkhtml-file file html-dir)))
(defun mkhtml-file (file html-dir)
"Convert FILE to an HTML file in directory HTML-DIR.
\(Source FILE is not altered.)
If FILE is an Info file, then create HTML file for each node in it.
When called interactively, the current buffer is used for FILE."
(interactive
(list nil
(read-file-name "Directory for HTML file(s): " nil default-directory)))
(let ((mode-line-id mode-line-buffer-identification)
info-file)
(when file (set-buffer (find-file-noselect file)))
(setq info-file (save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(and (re-search-forward
"\n\^_\nFile: \\([^,: \t]+\\),?[ \t]+" nil t)
(setq file
(buffer-substring-no-properties
(match-beginning 1) (match-end 1)))))))
(cond (info-file
(let ((curr-node Info-current-node))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward "\n\^_\nFile: \\([^,: \t]+\\),?[ \t]+" nil t)
(Info-select-node)
(mkhtml-any-buffer nil html-dir)
(widen))))
(when curr-node (setq Info-current-node curr-node)))
(setq mode-line-buffer-identification mode-line-id))
(t
(unless file
(setq file
(file-name-nondirectory (or (buffer-file-name) (buffer-name))))
(find-file-noselect file))
(mkhtml-any-buffer (current-buffer) html-dir)))))
(defun mkhtml-insert-header (buffer)
"Insert HTML file header.
BUFFER is the buffer whose name is used in the HTML <title> tag.
It can be a buffer or a string."
(insert (htmlize-method doctype) ?\n
(format "<!-- Created by mkhtml-%s, using htmlize-%s in %s mode. -->\n"
mkhtml-version htmlize-version htmlize-output-type))
(insert "<html>\n <head>\n <title>"
(htmlize-protect-string
(if (stringp buffer) buffer (buffer-name buffer)))
"</title>\n" htmlize-head-tags)
(htmlize-method insert-head)
(insert " </head>")
(insert "\n " (or (htmlize-method body-tag) "<body>") "\n <pre>\n"))
(defun mkhtml-any-buffer (&optional buffer html-dir)
"HTMLize BUFFER (default: current). Mouse-face => HTML links.
Save buffer as a new HTML file in directory HTML-DIR.
Certain buffer types are treated specially, in that text with
`mouse-face' property is converted to appropriate HTML links.
This is true of Dired, normal Info, and merged Info buffers.
Dired buffers are treated as by `mkhtml-dired'.
Info buffers are treated as by `mkhtml-info-buffer'.
Merged Info buffers are treated as by `mkhtml-merged-info-buffer'.
A merged Info buffer is one created by `Info-merge-subnodes' (defined
in file `info+.el'), which is a merge of an Info node with all of
its subnodes.
Other buffers are treated as by `mkhtml-plain-buffer': Note that HTML
links resulting from mouse-face'd text there are likely to point
nowhere.
\(Note: Buffers with no mouse-face'd text are treated as by
`htmlize-buffer'.)"
(interactive
(list (buffer-name)
(read-file-name "Directory for HTML file: " nil default-directory)))
(or buffer (setq buffer (current-buffer)))
(save-excursion
(set-buffer buffer)
(run-hooks 'htmlize-before-hook)
(htmlize-make-face-hash (cons 'default (htmlize-faces-in-buffer))))
(save-window-excursion
(let* ((html-buf (get-buffer-create "*html*"))
next-face-change last-face-change next-mouse-change last-mouse-change
face mouse-face face-object no-node-p link link-start link-end this-File)
(set-buffer html-buf)
(erase-buffer)
(buffer-disable-undo)
(mkhtml-insert-header buffer)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(if (setq no-node-p
(not (looking-at "File:[ \t]+\\([^:,\t\n]+\\),?[ \t]*\
Node:[ \t]+[^:,\t\n]+,?")))
(setq this-File (file-name-nondirectory (or (buffer-file-name)
(buffer-name))))
(setq this-File (buffer-substring-no-properties
(match-beginning 1) (match-end 1))))
(setq next-face-change (point))
(setq next-mouse-change (point))
(while (not (eobp))
(setq face (get-text-property (point) 'face))
(setq mouse-face (get-text-property (point) 'mouse-face))
(setq last-face-change next-face-change)
(setq last-mouse-change next-mouse-change)
(setq next-face-change (next-single-property-change
(point) 'face nil (point-max)))
(setq next-mouse-change (next-single-property-change
(point) 'mouse-face nil (point-max)))
(setq link-start (point))
(setq link-end next-mouse-change)
(when (consp face) (setq face (car face)))
(when (eq face 'default) (setq face nil))
(unless (htmlize-symbol-face-p face) (setq face nil))
(when (or mouse-face
(and face (boundp info-file-face) (eq face info-file-face)))
(cond
((not mouse-face)
(let ((menu-item (or (mkhtml-non-file-menu-item)
(mkhtml-file-menu-item))))
(when menu-item
(princ (concat "<A name=\"" menu-item "\">") html-buf))))
((and no-node-p (>= (point) last-mouse-change))
(if (memq major-mode '(dired-mode vc-dired-mode))
(princ (concat "<A H" "REF=\"" (dired-get-filename t) "\">")
html-buf)
(princ (concat "<A H" "REF=\"#"
(or (mkhtml-non-file-menu-item)
(buffer-substring-no-properties
link-start link-end))
"\">")
html-buf)))
((>= (point) last-mouse-change)
(let ((non-file-menu-item (mkhtml-non-file-menu-item))
node-name)
(cond (non-file-menu-item
(if (string-match "^dir" this-File)
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat
(substring
non-file-menu-item
1 (1- (length non-file-menu-item)))
"-Top"))
html-dir)
"\">")
html-buf)
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat this-File mkhtml-file-node-sep
non-file-menu-item))
html-dir)
"\">")
html-buf)))
((string-match "^(dir)"
(setq node-name (buffer-substring-no-properties
link-start link-end)))
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(convert-standard-filename "dir-Top")
html-dir)
"\">")
html-buf))
(t
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat this-File mkhtml-file-node-sep
node-name))
html-dir)
"\">")
html-buf)))))
(t)))
(when (and face (>= (point) last-face-change))
(setq face-object (gethash face htmlize-face-hash))
(princ (htmlize-method face-prejunk face-object) html-buf))
(princ (htmlize-protect-string
(buffer-substring-no-properties
(point) (min next-face-change next-mouse-change)))
html-buf)
(when (and face (<= next-face-change next-mouse-change))
(princ (htmlize-method face-postjunk face-object) html-buf))
(when (and mouse-face (<= next-mouse-change next-face-change))
(princ "</A>" html-buf))
(goto-char (min next-face-change next-mouse-change)))))
(insert "</pre>\n </body>\n</html>\n")
(goto-char (point-min))
(run-hooks 'htmlize-after-hook)
(buffer-enable-undo)
(mkhtml-save-buffer this-File html-dir)
(clrhash htmlize-face-hash))))
(defun mkhtml-save-buffer (filename html-dir)
"Save HTML buffer into file FILENAME in directory HTML-DIR."
(sgml-mode)
(let (start end)
(cond (
(and (re-search-forward "[Nn]ode:\\s-*" nil 'move)
(looking-at "<\\([^/ \n\t>]+\\)"))
(while (looking-at "<\\([^/ \n\t>]+\\)") (forward-list 1))
(setq start (point))
(re-search-forward "<" nil 'move)
(backward-char 1)
(setq end (point))
(write-region
(point-min) (point-max)
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat filename mkhtml-file-node-sep
(buffer-substring-no-properties start end)))
html-dir)))
(t
(write-region
(point-min) (point-max)
(mkhtml-make-HTML-file-name (mkhtml-convert-std-filename filename)
html-dir))))))
(defun mkhtml-dired (&optional buffer html-dir)
"Save Dired BUFFER as a new HTML file in directory HTML-DIR.
HTML links are provided to each of the directory's files.
HTML-DIR is the directory where resulting HTML file is created.
Defaults: BUFFER is current buffer. HTML-DIR is `default-directory'.
Hint: You can use such an HTML file to allow navigation to only
certain files in a directory."
(interactive
(list (buffer-name)
(read-file-name "Directory for HTML file: " nil default-directory)))
(or buffer (setq buffer (current-buffer)))
(mkhtml-particular-buffer buffer (file-name-nondirectory (buffer-name)) html-dir
'mkhtml-dired-link-fn))
(defun mkhtml-dired-link-fn (mouse-face last-mouse-change html-buf
ignored-1 ignored-2 ignored-3
ignored-4 ignored-5)
"Helper function used by `mkhtml-dired' to create HTML links.
MOUSE-FACE is the current value of the `mouse-face' text-property.
LAST-MOUSE-CHANGE is the position of the last `mouse-face' change.
HTML-BUF is the HTML buffer.
IGNORED-1, IGNORED-2, IGNORED-3, IGNORED-4, and IGNORED-5 are ignored."
(when (and mouse-face (>= (point) last-mouse-change))
(princ (concat "<A H" "REF=\"" (dired-get-filename t) "\">") html-buf)))
(defun mkhtml-info-buffer (&optional buffer html-dir)
"HTMLize Info BUFFER (default: current). Mouse-face => HTML links.
Save Info BUFFER as a new HTML file in directory HTML-DIR.
Text with `mouse-face' property is converted to HTML links.
The HTML file is named after the buffer's Info node. Whenever a node
name contains illegal filename characters the name is altered:
1) `directory-sep-char' is replaced by `mkhtml-dir-sep-replacement'.
2) `mkhtml-convert-std-filename' is used to replace other chars."
(interactive
(list (buffer-name)
(read-file-name "Directory for HTML file: " nil default-directory)))
(or buffer (setq buffer (current-buffer)))
(let (html-file-sans)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(if (looking-at "File:[ \t]+\\([^:,\t\n]+\\),?[ \t]*\
Node:[ \t]+[^:,\t\n]+,?")
(setq html-file-sans
(buffer-substring-no-properties (match-beginning 1) (match-end 1)))
(error "Not an Info buffer"))))
(mkhtml-particular-buffer buffer html-file-sans html-dir 'mkhtml-info-link-fn)))
(defun mkhtml-info-link-fn (mouse-face last-mouse-change html-buf
link-start link-end
html-file-sans html-dir ignored)
"Helper function used by `mkhtml-info-buffer' to create HTML links.
MOUSE-FACE is the current value of the `mouse-face' text-property.
LAST-MOUSE-CHANGE is the position of the last `mouse-face' change.
HTML-BUF is the HTML buffer.
LINK-START is the likely link start.
LINK-END is the likely link end.
HTML-FILE-SANS names the resulting HTML file, without suffix \".html\".
HTML-DIR is the directory for the output HTML file.
IGNORED is ignored."
(let ((html-buf (get-buffer-create "*html*")))
(when (and mouse-face (>= (point) last-mouse-change))
(let ((non-file-menu-item (mkhtml-non-file-menu-item))
node-name)
(cond (non-file-menu-item
(if (string-match "^dir" html-file-sans)
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat (substring
non-file-menu-item
1 (1- (length non-file-menu-item)))
"-Top"))
html-dir)
"\">")
html-buf)
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat html-file-sans mkhtml-file-node-sep
non-file-menu-item))
html-dir)
"\">")
html-buf)))
((string-match "^(dir)"
(setq node-name (buffer-substring-no-properties
link-start link-end)))
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(convert-standard-filename "dir-Top")
html-dir)
"\">")
html-buf))
(t
(princ (concat "<A H" "REF=\""
(mkhtml-make-HTML-file-name
(mkhtml-convert-std-filename
(concat html-file-sans mkhtml-file-node-sep
node-name))
html-dir)
"\">")
html-buf)))))))
(defun mkhtml-merged-info-buffer (&optional buffer html-dir)
"HTMLize merged Info BUFFER (default: current). Mouse-face => links.
Save merged Info BUFFER as a new HTML file in directory HTML-DIR.
A merged Info buffer is one created via `Info-merge-subnodes',
which is defined in file `info+.el'.
Text with `mouse-face' property is converted to HTML links.
The HTML file is named after the buffer.
The HTML file is named after the buffer's top node. Whenever it
contains illegal filename characters it is altered:
1) `directory-sep-char' is replaced by `mkhtml-dir-sep-replacement'.
2) `mkhtml-convert-std-filename' is used to replace other chars.
Note: For a merged Info buffer, there is no way of knowing if a link
is to somewhere in the same buffer or not. Most such links are
menu items, so they will point to places in the same buffer.
But cross refs (`Note:') may point beyond the buffer. We don't
treat cross refs differently here - instead, all links are made
to point to hashes (#) in the same HTML file derived from the
same buffer."
(interactive
(list (buffer-name)
(read-file-name "Directory for HTML file: " nil default-directory)))
(or buffer (setq buffer (current-buffer)))
(let (html-file-sans)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(setq html-file-sans (file-name-nondirectory
(or (buffer-file-name) (buffer-name))))))
(mkhtml-particular-buffer buffer html-file-sans html-dir
'mkhtml-merged-info-link-fn)))
(defun mkhtml-merged-info-link-fn (mouse-face last-mouse-change html-buf
link-start link-end
ignored-1 ignored-2 face)
"Helper function used by `mkhtml-merged-info-buffer' to create HTML links.
MOUSE-FACE is the current value of the `mouse-face' text-property.
LAST-MOUSE-CHANGE is the position of the last `mouse-face' change.
HTML-BUF is the HTML buffer.
LINK-START is the likely link start.
LINK-END is the likely link end.
IGNORED-1 and IGNORED-2 are ignored.
FACE = `info-file-face' and MOUSE-FACE nil means create an anchor."
(if mouse-face
(when (>= (point) last-mouse-change)
(princ (concat "<A H" "REF=\"#"
(or (mkhtml-non-file-menu-item)
(buffer-substring-no-properties link-start link-end))
"\">")
(get-buffer-create "*html*")))
(when (and face (boundp info-file-face) (eq face info-file-face))
(let ((menu-item (or (mkhtml-non-file-menu-item) (mkhtml-file-menu-item))))
(when menu-item
(princ (concat "<A name=\"" menu-item "\">") html-buf))))))
(defun mkhtml-plain-buffer (&optional buffer html-dir)
"Convert a BUFFER to HTML, changing its mouse-face text to links.
Save BUFFER as a new HTML file in directory HTML-DIR.
A link resulting from mouse-face'd text points to an HTML named after
that text. Note that in general this is likely to point nowhere, so
use this only where appropriate.
Buffers with no mouse-face'd text are treated as by `htmlize-buffer'."
(interactive
(list (buffer-name)
(read-file-name "Directory for HTML file: " nil default-directory)))
(or buffer (setq buffer (current-buffer)))
(let (html-file-sans)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(setq html-file-sans (file-name-nondirectory
(or (buffer-file-name) (buffer-name))))))
(mkhtml-particular-buffer buffer html-file-sans html-dir 'mkhtml-plain-link-fn)))
(defun mkhtml-plain-link-fn (mouse-face last-mouse-change html-buf
link-start link-end
ignored-1 ignored-2 ignored-3)
"Helper function used by `mkhtml-plain-buffer' to create HTML links.
MOUSE-FACE is the current value of the `mouse-face' text-property.
LAST-MOUSE-CHANGE is the position of the last `mouse-face' change.
HTML-BUF is the HTML buffer.
LINK-START is the likely link start.
LINK-END is the likely link end.
IGNORED-1, IGNORED-2, and IGNORED-3 are ignored."
(when (and mouse-face (>= (point) last-mouse-change))
(princ (concat "<A H" "REF=\"#"
(buffer-substring-no-properties link-start link-end)
"\">")
(get-buffer-create "*html*"))))
(defun mkhtml-particular-buffer (&optional buffer html-file-sans html-dir link-fn)
"Save BUFFER as a new HTML file in directory HTML-DIR.
This is a general function that can be parameterized by a LINK-FN
function to perform HTML link-generation for a specific kind of file.
For example uses, see `mkhtml-dired', `mkhtml-info-buffer',
`mkhtml-merged-info-buffer', and `mkhtml-plain-buffer'.
HTML-FILE-SANS is the name of the resulting HTML file, without the
\".html\" suffix.
This function skips through BUFFER, stopping at each text-property
change, where it calls LINK-FN which creates an HTML link if
appropriate.
LINK-FN is passed the current value of the mouse-face
text-property, the buffer positions of the last change in that
property, the likely link start and end, HTML-FILE-SANS, the HTML
buffer, HTML-DIR, and the current face.
Note that LINK-FN can decide to create a link even when there is no
mouse-face - see `mkhtml-merged-info-buffer' for an example."
(interactive
(list (buffer-name)
(read-file-name "HTML file: " nil (file-name-nondirectory
(or (buffer-file-name) (buffer-name))))
(read-file-name "Directory for HTML file: " nil default-directory)))
(or buffer (setq buffer (current-buffer)))
(save-excursion
(set-buffer buffer)
(run-hooks 'htmlize-before-hook)
(htmlize-make-face-hash (cons 'default (htmlize-faces-in-buffer))))
(save-window-excursion
(let* ((html-buf (get-buffer-create "*html*"))
next-face-change last-face-change next-mouse-change last-mouse-change
face mouse-face face-object no-node-p link link-start link-end)
(set-buffer html-buf)
(erase-buffer)
(buffer-disable-undo)
(mkhtml-insert-header buffer)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(setq next-face-change (point))
(setq next-mouse-change (point))
(while (not (eobp))
(setq face (get-text-property (point) 'face))
(setq mouse-face (get-text-property (point) 'mouse-face))
(setq last-face-change next-face-change)
(setq last-mouse-change next-mouse-change)
(setq next-face-change (next-single-property-change
(point) 'face nil (point-max)))
(setq next-mouse-change (next-single-property-change
(point) 'mouse-face nil (point-max)))
(setq link-start (point))
(setq link-end next-mouse-change)
(when (consp face) (setq face (car face)))
(when (eq face 'default) (setq face nil))
(unless (htmlize-symbol-face-p face) (setq face nil))
(funcall link-fn
mouse-face last-mouse-change html-buf link-start link-end
html-file-sans html-dir face)
(when (and face (>= (point) last-face-change))
(setq face-object (gethash face htmlize-face-hash))
(princ (htmlize-method face-prejunk face-object) html-buf))
(princ (htmlize-protect-string
(buffer-substring-no-properties
(point) (min next-face-change next-mouse-change)))
html-buf)
(when (and face (<= next-face-change next-mouse-change))
(princ (htmlize-method face-postjunk face-object) html-buf))
(when (and mouse-face (<= next-mouse-change next-face-change))
(princ "</A>" html-buf))
(goto-char (min next-face-change next-mouse-change)))))
(insert "</pre>\n </body>\n</html>\n")
(goto-char (point-min))
(run-hooks 'htmlize-after-hook)
(buffer-enable-undo)
(mkhtml-save-buffer html-file-sans html-dir)
(clrhash htmlize-face-hash))))
(defvar mkhtml-preserve-fonts t
"*Non-nil <=> an attempt is made to use similar fonts in HTML file(s)
to those in the Emacs buffer.")
(defvar mkhtml-font-size nil
"*Size of text in output HTML file(s).
If nil, an attempt is made to approximate the text size of the Emacs
buffer's frame. If non-nil, it should be an integer that will be used
as the BASEFONT size value (if `htmlize-output-type' = 'font) or the
font-size value (if `htmlize-output-type' = 'css).")
(defsubst mkhtml-get-css-font-size ()
"Get approximate HTML font size from current frame's font size."
(let* ((font (cdr-safe (assq 'font (frame-parameters)))))
(if (and font (string-match "[0-9]+" font))
(- (string-to-number (substring font (match-beginning 0) (match-end 0))) 3)
10)))
(defsubst mkhtml-get-basefont-size ()
"Get approximate HTML font size from current frame's font size."
(/ (- (mkhtml-get-css-font-size) 2) 3))
(defsubst mkhtml-get-font-family ()
"Return family of current frame's font."
(let ((name (x-resolve-font-name nil)))
(if (or (string-match ".+-fontset-\\([^-*]+\\)" name)
(string-match "^-[*]-\\([^-*]+\\)" name))
(match-string 1 name)
"Courrier")))
(defun htmlize-font-body-tag ()
"See `htmlize.el'.
This version adds (approximate) BASEFONT size and face,
when `mkhtml-preserve-fonts'."
(let ((face-object (gethash 'default htmlize-face-hash)))
(concat (format "<BODY text=\"%s\" bgcolor=\"%s\">"
(htmlize-face-rgb-foreground face-object)
(htmlize-face-rgb-background face-object))
(and mkhtml-preserve-fonts
(format "<BASEFONT size=\"%d\" face=\"%s\">"
(or mkhtml-font-size (mkhtml-get-basefont-size))
(mkhtml-get-font-family))))))
(defun htmlize-css-specs (face-object &optional default-face-object)
"See `htmlize.el'.
This version adds font-size and font-family,
when `mkhtml-preserve-fonts'."
(let (result)
(when mkhtml-preserve-fonts
(let ((font-size (or mkhtml-font-size (mkhtml-get-css-font-size)))
(font-family (mkhtml-get-font-family)))
(push (format "font-size: %dpt;" font-size) result)
(push (format "font-family: %s;" font-family) result)))
(when (or (not default-face-object)
(not (equal (htmlize-face-rgb-foreground face-object)
(htmlize-face-rgb-foreground default-face-object))))
(push (format "color: %s;" (htmlize-face-rgb-foreground face-object))
result))
(when (or (not default-face-object)
(not (equal (htmlize-face-rgb-background face-object)
(htmlize-face-rgb-background default-face-object))))
(push (format "background-color: %s;"
(htmlize-face-rgb-background face-object)) result))
(when (and (htmlize-face-boldp face-object)
(or (not default-face-object)
(not (htmlize-face-boldp default-face-object))))
(push "font-weight: bold;" result))
(when (and (htmlize-face-italicp face-object)
(or (not default-face-object)
(not (htmlize-face-italicp default-face-object))))
(push "font-style: italic;" result))
(when (and (htmlize-face-underlinep face-object)
(or (not default-face-object)
(not (htmlize-face-underlinep default-face-object))))
(push "text-decoration: underline;" result))
(when (and (htmlize-face-strikep face-object)
(or (not default-face-object)
(not (htmlize-face-strikep default-face-object))))
(push "text-decoration: line-through;" result))
(nreverse result)))
(defun htmlize-css-insert-head ()
"See `htmlize.el'. This version adds link colors."
(insert " <style type=\"text/css\">\n <!--\n")
(let ((default-face-object (gethash 'default htmlize-face-hash)))
(insert " BODY {\n "
(mapconcat #'identity (htmlize-css-specs default-face-object)
"\n ")
"\n } /* default */\n")
(maphash
(lambda (face face-object)
(let ((cleaned-up-face-name (symbol-name face)))
(while (string-match "--" cleaned-up-face-name)
(setq cleaned-up-face-name (replace-match "-" t t
cleaned-up-face-name)))
(while (string-match "\\*/" cleaned-up-face-name)
(setq cleaned-up-face-name (replace-match "XX" t t
cleaned-up-face-name)))
(unless (eq face 'default)
(let ((specs (htmlize-css-specs face-object default-face-object)))
(insert " span." (htmlize-face-css-name face-object))
(if (null specs)
(insert " {")
(insert " {\n "
(mapconcat #'identity specs "\n ")))
(insert "\n } /* " cleaned-up-face-name " */\n")))))
htmlize-face-hash))
(insert (concat " A:link { color: " mkhtml-link-color " }\n"))
(insert (concat " A:visited { color: " mkhtml-visited-link-color " }\n"))
(insert (concat " A:hover { color: " mkhtml-hover-link-fg-color "; background: "
mkhtml-hover-link-bg-color " }\n"))
(insert " -->\n </style>\n"))
(provide 'mkhtml)