mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2025-04-29 03:44:49 +02:00
2033 lines
154 KiB
HTML
2033 lines
154 KiB
HTML
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
|
|
<!-- Created by htmlize-1.45 in css mode. -->
|
|
<html>
|
|
<head>
|
|
<title>htmlize.el</title>
|
|
<style type="text/css">
|
|
<!--
|
|
body {
|
|
color: #839496;
|
|
background-color: #002b36;
|
|
}
|
|
.builtin {
|
|
/* font-lock-builtin-face */
|
|
color: #859900;
|
|
}
|
|
.comment {
|
|
/* font-lock-comment-face */
|
|
color: #586e75;
|
|
font-style: italic;
|
|
}
|
|
.comment-delimiter {
|
|
/* font-lock-comment-delimiter-face */
|
|
color: #586e75;
|
|
font-style: italic;
|
|
}
|
|
.constant {
|
|
/* font-lock-constant-face */
|
|
color: #2aa198;
|
|
}
|
|
.doc {
|
|
/* font-lock-doc-face */
|
|
color: #586e75;
|
|
font-style: italic;
|
|
}
|
|
.function-name {
|
|
/* font-lock-function-name-face */
|
|
color: #268bd2;
|
|
}
|
|
.keyword {
|
|
/* font-lock-keyword-face */
|
|
color: #859900;
|
|
}
|
|
.negation-char {
|
|
/* font-lock-negation-char-face */
|
|
color: #dc322f;
|
|
}
|
|
.regexp-grouping-backslash {
|
|
/* font-lock-regexp-grouping-backslash */
|
|
color: #b58900;
|
|
}
|
|
.regexp-grouping-construct {
|
|
/* font-lock-regexp-grouping-construct */
|
|
color: #cb4b16;
|
|
}
|
|
.string {
|
|
/* font-lock-string-face */
|
|
color: #2aa198;
|
|
}
|
|
.type {
|
|
/* font-lock-type-face */
|
|
color: #b58900;
|
|
}
|
|
.variable-name {
|
|
/* font-lock-variable-name-face */
|
|
color: #268bd2;
|
|
}
|
|
.warning {
|
|
/* font-lock-warning-face */
|
|
color: #dc322f;
|
|
font-weight: bold;
|
|
}
|
|
|
|
a {
|
|
color: inherit;
|
|
background-color: inherit;
|
|
font: inherit;
|
|
text-decoration: inherit;
|
|
}
|
|
a:hover {
|
|
text-decoration: underline;
|
|
}
|
|
-->
|
|
</style>
|
|
</head>
|
|
<body>
|
|
<pre>
|
|
<span class="comment-delimiter">;;; </span><span class="comment">htmlize.el --- Convert buffer text and decorations to HTML.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Copyright (C) 1997-2003,2005,2006,2009,2011,2012 Hrvoje Niksic
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Author: Hrvoje Niksic <a href="mailto:hniksic%40xemacs.org"><hniksic@xemacs.org></a>
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Keywords: hypermedia, extensions
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Version: 1.45
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">This program is free software; you can redistribute it and/or modify
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">it under the terms of the GNU General Public License as published by
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">the Free Software Foundation; either version 2, or (at your option)
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">any later version.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">This program is distributed in the hope that it will be useful,
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">GNU General Public License for more details.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">You should have received a copy of the GNU General Public License
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">along with this program; see the file COPYING. If not, write to the
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Boston, MA 02111-1307, USA.
|
|
</span>
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Commentary:
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">This package converts the buffer text and the associated
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">decorations to HTML. Mail to <a href="mailto:hniksic%40xemacs.org"><hniksic@xemacs.org></a> to discuss
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">features and additions. All suggestions are more than welcome.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">To use it, just switch to the buffer you want HTML-ized and type
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">`M-x htmlize-buffer'. You will be switched to a new buffer that
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">contains the resulting HTML code. You can edit and inspect this
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">buffer, or you can just save it with C-x C-w. `M-x htmlize-file'
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">will find a file, fontify it, and save the HTML version in
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">FILE.html, without any additional intervention. `M-x
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">htmlize-many-files' allows you to htmlize any number of files in
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">the same manner. `M-x htmlize-many-files-dired' does the same for
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">files marked in a dired buffer.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">htmlize supports three types of HTML output, selected by setting
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">htmlize-output-type</span></span><span class="comment">': `</span><span class="comment"><span class="constant">css</span></span><span class="comment">', `</span><span class="comment"><span class="constant">inline-css</span></span><span class="comment">', and `</span><span class="comment"><span class="constant">font</span></span><span class="comment">'. In `</span><span class="comment"><span class="constant">css</span></span><span class="comment">'
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">mode, htmlize uses cascading style sheets to specify colors; it
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">generates classes that correspond to Emacs faces and uses <span
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">class=FACE>...</span> to color parts of text. In this mode, the
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">produced HTML is valid under the 4.01 strict DTD, as confirmed by
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">the W3C validator. `</span><span class="comment"><span class="constant">inline-css</span></span><span class="comment">' is like `</span><span class="comment"><span class="constant">css</span></span><span class="comment">', except the CSS is
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">put directly in the STYLE attribute of the SPAN element, making it
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">possible to paste the generated HTML into existing HTML documents.
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">In `</span><span class="comment"><span class="constant">font</span></span><span class="comment">' mode, htmlize uses <font color="...">...</font> to
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">colorize HTML, which is not standard-compliant, but works better in
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">older browsers. `</span><span class="comment"><span class="constant">css</span></span><span class="comment">' mode is the default.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">You can also use htmlize from your Emacs Lisp code. When called
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">non-interactively, `</span><span class="comment"><span class="constant">htmlize-buffer</span></span><span class="comment">' and `</span><span class="comment"><span class="constant">htmlize-region</span></span><span class="comment">' will
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">return the resulting HTML buffer, but will not change current
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">buffer or move the point. htmlize will do its best to work on
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">non-windowing Emacs sessions but the result will be limited to
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">colors supported by the terminal.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">htmlize aims for compatibility with Emacsen version 21 and later.
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Please let me know if it doesn't work on the version of XEmacs or
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">GNU Emacs that you are using. The package relies on the presence
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">of CL extensions, especially for cross-emacs compatibility; please
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">don't try to remove that dependency. I see no practical problems
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">with using the full power of the CL extensions, except that one
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">might learn to like them too much.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">The latest version is available as a git repository at:
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="http://fly.srk.fer.hr/~hniksic/emacs/htmlize.git"><http://fly.srk.fer.hr/~hniksic/emacs/htmlize.git></a>
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">The snapshot of the latest release can be obtained at:
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.cgi"><http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.cgi></a>
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">You can find a sample of htmlize's output (possibly generated with
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">an older version) at:
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html"><http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html></a>
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Thanks go to the many people who have sent reports and contributed
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">comments, suggestions, and fixes. They include Ron Gut, Bob
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Weiner, Toni Drabik, Peter Breton, Ville Skytta, Thomas Vogels,
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Juri Linkov, Maciek Pasternacki, and many others.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">User quotes: "You sir, are a sick, sick, _sick_ person. :)"
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">-- Bill Perry, author of Emacs/W3
|
|
|
|
<hr /></span>
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Code:
|
|
</span>
|
|
(<span class="keyword">require</span> '<span class="constant">cl</span>)
|
|
(<span class="keyword">eval-when-compile</span>
|
|
(<span class="keyword">defvar</span> <span class="variable-name">unresolved</span>)
|
|
(<span class="keyword">if</span> (string-match <span class="string">"XEmacs"</span> emacs-version)
|
|
(byte-compiler-options
|
|
(warnings (- unresolved))))
|
|
(<span class="keyword">defvar</span> <span class="variable-name">font-lock-auto-fontify</span>)
|
|
(<span class="keyword">defvar</span> <span class="variable-name">font-lock-support-mode</span>)
|
|
(<span class="keyword">defvar</span> <span class="variable-name">global-font-lock-mode</span>))
|
|
|
|
(<span class="keyword">defconst</span> <span class="variable-name">htmlize-version</span> <span class="string">"1.45"</span>)
|
|
|
|
(<span class="keyword">defgroup</span> <span class="type">htmlize</span> nil
|
|
<span class="doc">"Convert buffer text and faces to HTML."</span>
|
|
<span class="builtin">:group</span> 'hypermedia)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-head-tags</span> <span class="string">""</span>
|
|
<span class="doc">"Additional tags to insert within HEAD of the generated document."</span>
|
|
<span class="builtin">:type</span> 'string
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-output-type</span> 'css
|
|
<span class="doc">"Output type of generated HTML, one of `</span><span class="doc"><span class="constant">css</span></span><span class="doc">', `</span><span class="doc"><span class="constant">inline-css</span></span><span class="doc">', or `</span><span class="doc"><span class="constant">font</span></span><span class="doc">'.
|
|
When set to `</span><span class="doc"><span class="constant">css</span></span><span class="doc">' (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 class=\"FACE\">.
|
|
|
|
When set to `</span><span class="doc"><span class="constant">inline-css</span></span><span class="doc">', the style will be generated as above, but
|
|
placed directly in the STYLE attribute of the span ELEMENT: <span
|
|
style=\"STYLE\">. This makes it easier to paste the resulting HTML to
|
|
other documents.
|
|
|
|
When set to `</span><span class="doc"><span class="constant">font</span></span><span class="doc">', the properties will be set using layout tags
|
|
<font>, <b>, <i>, <u>, and <strike>.
|
|
|
|
`</span><span class="doc"><span class="constant">css</span></span><span class="doc">' output is normally preferred, but `</span><span class="doc"><span class="constant">font</span></span><span class="doc">' is still useful for
|
|
supporting old, pre-CSS browsers, and both `</span><span class="doc"><span class="constant">inline-css</span></span><span class="doc">' and `</span><span class="doc"><span class="constant">font</span></span><span class="doc">' for
|
|
easier embedding of colorized text in foreign HTML documents (no style
|
|
sheet to carry around)."</span>
|
|
<span class="builtin">:type</span> '(choice (const css) (const inline-css) (const font))
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-use-images</span> t
|
|
<span class="doc">"Whether htmlize generates `</span><span class="doc"><span class="constant">img</span></span><span class="doc">' for images attached to buffer contents."</span>
|
|
<span class="builtin">:type</span> 'boolean
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-force-inline-images</span> nil
|
|
<span class="doc">"Non-nil means generate all images inline using data URLs.
|
|
Normally htmlize converts image descriptors with :file properties to
|
|
relative URIs, and those with :data properties to data URIs. With this
|
|
flag set, the images specified as a file name are loaded into memory and
|
|
embedded in the HTML as data URIs."</span>
|
|
<span class="builtin">:type</span> 'boolean
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-max-alt-text</span> 100
|
|
<span class="doc">"Maximum size of text to use as ALT text in images.
|
|
|
|
Normally when htmlize encounters text covered by the `</span><span class="doc"><span class="constant">display</span></span><span class="doc">' property
|
|
that specifies an image, it generates an `</span><span class="doc"><span class="constant">alt</span></span><span class="doc">' attribute containing the
|
|
original text. If the text is larger than `</span><span class="doc"><span class="constant">htmlize-max-alt-text</span></span><span class="doc">' characters,
|
|
this will not be done."</span>)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-transform-image</span> 'htmlize-default-transform-image
|
|
<span class="doc">"Function called to modify the image descriptor.
|
|
|
|
The function is called with the image descriptor found in the buffer and
|
|
the text the image is supposed to replace. It should return a (possibly
|
|
different) image descriptor property list or a replacement string to use
|
|
instead of of the original buffer text.
|
|
|
|
Returning nil is the same as returning the original text."</span>
|
|
<span class="builtin">:type</span> 'boolean
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-generate-hyperlinks</span> t
|
|
<span class="doc">"Non-nil means auto-generate the links from URLs and mail addresses in buffer.
|
|
|
|
This is on by default; set it to nil if you don't want htmlize to
|
|
autogenerate such links. Note that this option only turns off automatic
|
|
search for contents that looks like URLs and converting them to links.
|
|
It has no effect on whether htmlize respects the `</span><span class="doc"><span class="constant">htmlize-link</span></span><span class="doc">' property."</span>
|
|
<span class="builtin">:type</span> 'boolean
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-hyperlink-style</span> <span class="string">"
|
|
a {
|
|
color: inherit;
|
|
background-color: inherit;
|
|
font: inherit;
|
|
text-decoration: inherit;
|
|
}
|
|
a:hover {
|
|
text-decoration: underline;
|
|
}
|
|
"</span>
|
|
<span class="doc">"The CSS style used for hyperlinks when in CSS mode."</span>
|
|
<span class="builtin">:type</span> 'string
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-replace-form-feeds</span> t
|
|
<span class="doc">"Non-nil means replace form feeds in source code with HTML separators.
|
|
Form feeds are the ^L characters at line beginnings that are sometimes
|
|
used to separate sections of source code. If this variable is set to
|
|
`t', form feed characters are replaced with the <hr> separator. If this
|
|
is a string, it specifies the replacement to use. Note that <pre> is
|
|
temporarily closed before the separator is inserted, so the default
|
|
replacement is effectively \"</pre><hr /><pre>\". If you specify
|
|
another replacement, don't forget to close and reopen the <pre> if you
|
|
want the output to remain valid HTML.
|
|
|
|
If you need more elaborate processing, set this to nil and use
|
|
htmlize-after-hook."</span>
|
|
<span class="builtin">:type</span> 'boolean
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-html-charset</span> nil
|
|
<span class="doc">"The charset declared by the resulting HTML documents.
|
|
When non-nil, causes htmlize to insert the following in the HEAD section
|
|
of the generated HTML:
|
|
|
|
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=CHARSET\">
|
|
|
|
where CHARSET is the value you've set for htmlize-html-charset. Valid
|
|
charsets are defined by MIME and include strings like \"iso-8859-1\",
|
|
\"iso-8859-15\", \"utf-8\", etc.
|
|
|
|
If you are using non-Latin-1 charsets, you might need to set this for
|
|
your documents to render correctly. Also, the W3C validator requires
|
|
submitted HTML documents to declare a charset. So if you care about
|
|
validation, you can use this to prevent the validator from bitching.
|
|
|
|
Needless to say, if you set this, you should actually make sure that
|
|
the buffer is in the encoding you're claiming it is in. (This is
|
|
normally achieved by using the correct file coding system for the
|
|
buffer.) If you don't understand what that means, you should probably
|
|
leave this option in its default setting."</span>
|
|
<span class="builtin">:type</span> '(choice (const <span class="builtin">:tag</span> <span class="string">"Unset"</span> nil)
|
|
string)
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-convert-nonascii-to-entities</span> t
|
|
<span class="doc">"Whether non-ASCII characters should be converted to HTML entities.
|
|
|
|
When this is non-nil, characters with codes in the 128-255 range will be
|
|
considered Latin 1 and rewritten as \"&#CODE;\". Characters with codes
|
|
above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode
|
|
code point of the character. If the code point cannot be determined,
|
|
the character will be copied unchanged, as would be the case if the
|
|
option were nil.
|
|
|
|
When the option is nil, the non-ASCII characters are copied to HTML
|
|
without modification. In that case, the web server and/or the browser
|
|
must be set to understand the encoding that was used when saving the
|
|
buffer. (You might also want to specify it by setting
|
|
`</span><span class="doc"><span class="constant">htmlize-html-charset</span></span><span class="doc">'.)
|
|
|
|
Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point,
|
|
which has nothing to do with the charset the page is in. For example,
|
|
\"&#169;\" *always* refers to the copyright symbol, regardless of charset
|
|
specified by the META tag or the charset sent by the HTTP server. In
|
|
other words, \"&#169;\" is exactly equivalent to \"&copy;\".
|
|
|
|
For most people htmlize will work fine with this option left at the
|
|
default setting; don't change it unless you know what you're doing."</span>
|
|
<span class="builtin">:type</span> 'sexp
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-ignore-face-size</span> 'absolute
|
|
<span class="doc">"Whether face size should be ignored when generating HTML.
|
|
If this is nil, face sizes are used. If set to t, sizes are ignored
|
|
If set to `</span><span class="doc"><span class="constant">absolute</span></span><span class="doc">', only absolute size specifications are ignored.
|
|
Please note that font sizes only work with CSS-based output types."</span>
|
|
<span class="builtin">:type</span> '(choice (const <span class="builtin">:tag</span> <span class="string">"Don't ignore"</span> nil)
|
|
(const <span class="builtin">:tag</span> <span class="string">"Ignore all"</span> t)
|
|
(const <span class="builtin">:tag</span> <span class="string">"Ignore absolute"</span> absolute))
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-css-name-prefix</span> <span class="string">""</span>
|
|
<span class="doc">"The prefix used for CSS names.
|
|
The CSS names that htmlize generates from face names are often too
|
|
generic for CSS files; for example, `</span><span class="doc"><span class="constant">font-lock-type-face</span></span><span class="doc">' is transformed
|
|
to `</span><span class="doc"><span class="constant">type</span></span><span class="doc">'. Use this variable to add a prefix to the generated names.
|
|
The string \"htmlize-\" is an example of a reasonable prefix."</span>
|
|
<span class="builtin">:type</span> 'string
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-use-rgb-txt</span> t
|
|
<span class="doc">"Whether `</span><span class="doc"><span class="constant">rgb.txt</span></span><span class="doc">' should be used to convert color names to RGB.
|
|
|
|
This conversion means determining, for instance, that the color
|
|
\"IndianRed\" corresponds to the (205, 92, 92) RGB triple. `</span><span class="doc"><span class="constant">rgb.txt</span></span><span class="doc">'
|
|
is the X color database that maps hundreds of color names to such RGB
|
|
triples. When this variable is non-nil, `</span><span class="doc"><span class="constant">htmlize</span></span><span class="doc">' uses `</span><span class="doc"><span class="constant">rgb.txt</span></span><span class="doc">' to
|
|
look up color names.
|
|
|
|
If this variable is nil, htmlize queries Emacs for RGB components of
|
|
colors using `</span><span class="doc"><span class="constant">color-instance-rgb-components</span></span><span class="doc">' and `</span><span class="doc"><span class="constant">color-values</span></span><span class="doc">'.
|
|
This can yield incorrect results on non-true-color displays.
|
|
|
|
If the `</span><span class="doc"><span class="constant">rgb.txt</span></span><span class="doc">' file is not found (which will be the case if you're
|
|
running Emacs on non-X11 systems), this option is ignored."</span>
|
|
<span class="builtin">:type</span> 'boolean
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defcustom</span> <span class="variable-name">htmlize-html-major-mode</span> nil
|
|
<span class="doc">"The mode the newly created HTML buffer will be put in.
|
|
Set this to nil if you prefer the default (fundamental) mode."</span>
|
|
<span class="builtin">:type</span> '(radio (const <span class="builtin">:tag</span> <span class="string">"No mode (fundamental)"</span> nil)
|
|
(function-item html-mode)
|
|
(function <span class="builtin">:tag</span> <span class="string">"User-defined major mode"</span>))
|
|
<span class="builtin">:group</span> 'htmlize)
|
|
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-before-hook</span> nil
|
|
<span class="doc">"Hook run before htmlizing a buffer.
|
|
The hook functions are run in the source buffer (not the resulting HTML
|
|
buffer)."</span>)
|
|
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-after-hook</span> nil
|
|
<span class="doc">"Hook run after htmlizing a buffer.
|
|
Unlike `</span><span class="doc"><span class="constant">htmlize-before-hook</span></span><span class="doc">', these functions are run in the generated
|
|
HTML buffer. You may use them to modify the outlook of the final HTML
|
|
output."</span>)
|
|
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-file-hook</span> nil
|
|
<span class="doc">"Hook run by `</span><span class="doc"><span class="constant">htmlize-file</span></span><span class="doc">' after htmlizing a file, but before saving it."</span>)
|
|
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-buffer-places</span>)
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Some cross-Emacs compatibility.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">I try to conditionalize on features rather than Emacs version, but
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">in some cases checking against the version *is* necessary.
|
|
</span>(<span class="keyword">defconst</span> <span class="variable-name">htmlize-running-xemacs</span> (string-match <span class="string">"XEmacs"</span> emacs-version))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">We need a function that efficiently finds the next change of a
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">property regardless of whether the change occurred because of a
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">text property or an extent/overlay.
|
|
</span>(<span class="keyword">cond</span>
|
|
(htmlize-running-xemacs
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-next-change</span> (pos prop <span class="type">&optional</span> limit)
|
|
(<span class="keyword">if</span> prop
|
|
(next-single-char-property-change pos prop nil (or limit (point-max)))
|
|
(next-property-change pos nil (or limit (point-max)))))
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-next-face-change</span> (pos <span class="type">&optional</span> limit)
|
|
(htmlize-next-change pos 'face limit)))
|
|
((fboundp 'next-single-char-property-change)
|
|
<span class="comment-delimiter">;; </span><span class="comment">GNU Emacs 21+
|
|
</span> (<span class="keyword">defun</span> <span class="function-name">htmlize-next-change</span> (pos prop <span class="type">&optional</span> limit)
|
|
(<span class="keyword">if</span> prop
|
|
(next-single-char-property-change pos prop nil limit)
|
|
(next-char-property-change pos limit)))
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-overlay-faces-at</span> (pos)
|
|
(delq nil (mapcar (<span class="keyword">lambda</span> (o) (overlay-get o 'face)) (overlays-at pos))))
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-next-face-change</span> (pos <span class="type">&optional</span> limit)
|
|
<span class="comment-delimiter">;; </span><span class="comment">(htmlize-next-change pos 'face limit) would skip over entire
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">overlays that specify the `</span><span class="comment"><span class="constant">face</span></span><span class="comment">' property, even when they
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">contain smaller text properties that also specify `</span><span class="comment"><span class="constant">face</span></span><span class="comment">'.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">Emacs display engine merges those faces, and so must we.
|
|
</span> (or limit
|
|
(setq limit (point-max)))
|
|
(<span class="keyword">let</span> ((next-prop (next-single-property-change pos 'face nil limit))
|
|
(overlay-faces (htmlize-overlay-faces-at pos)))
|
|
(<span class="keyword">while</span> (<span class="keyword">progn</span>
|
|
(setq pos (next-overlay-change pos))
|
|
(and (< pos next-prop)
|
|
(equal overlay-faces (htmlize-overlay-faces-at pos)))))
|
|
(setq pos (min pos next-prop))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Additionally, we include the entire region that specifies the
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">display</span></span><span class="comment">' property.
|
|
</span> (<span class="keyword">when</span> (get-char-property pos 'display)
|
|
(setq pos (next-single-char-property-change pos 'display nil limit)))
|
|
pos)))
|
|
(t
|
|
(<span class="warning">error</span> <span class="string">"htmlize requires next-single-property-change or \
|
|
next-single-char-property-change"</span>)))
|
|
|
|
(<span class="keyword">defmacro</span> <span class="function-name">htmlize-lexlet</span> (<span class="type">&rest</span> letforms)
|
|
(<span class="keyword">declare</span> (indent 1) (debug let))
|
|
(<span class="keyword">if</span> (and (boundp 'lexical-binding)
|
|
lexical-binding)
|
|
`(<span class="keyword">let</span> ,@letforms)
|
|
<span class="comment-delimiter">;; </span><span class="comment">cl extensions have a macro implementing lexical let
|
|
</span> `(<span class="keyword">lexical-let</span> ,@letforms)))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Simple overlay emulation for XEmacs
|
|
</span>
|
|
(<span class="keyword">cond</span>
|
|
(htmlize-running-xemacs
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-make-overlay</span> 'make-extent)
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-overlay-put</span> 'set-extent-property)
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-overlay-get</span> 'extent-property)
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-overlays-in</span> (beg end) (extent-list nil beg end))
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-delete-overlay</span> 'detach-extent))
|
|
(t
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-make-overlay</span> 'make-overlay)
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-overlay-put</span> 'overlay-put)
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-overlay-get</span> 'overlay-get)
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-overlays-in</span> 'overlays-in)
|
|
(<span class="keyword">defalias</span> '<span class="function-name">htmlize-delete-overlay</span> 'delete-overlay)))
|
|
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Transformation of buffer text: HTML escapes, untabification, etc.
|
|
</span>
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-basic-character-table</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Map characters in the 0-127 range to either one-character strings
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">or to numeric entities.
|
|
</span> (<span class="keyword">let</span> ((table (make-vector 128 ?\0)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Map characters in the 32-126 range to themselves, others to
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">&#CODE entities;
|
|
</span> (<span class="keyword">dotimes</span> (i 128)
|
|
(setf (aref table i) (<span class="keyword">if</span> (and (>= i 32) (<= i 126))
|
|
(char-to-string i)
|
|
(format <span class="string">"&#%d;"</span> i))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Set exceptions manually.
|
|
</span> (setf
|
|
<span class="comment-delimiter">;; </span><span class="comment">Don't escape newline, carriage return, and TAB.
|
|
</span> (aref table ?\n) <span class="string">"\n"</span>
|
|
(aref table ?\r) <span class="string">"\r"</span>
|
|
(aref table ?\t) <span class="string">"\t"</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Escape &, <, and >.
|
|
</span> (aref table ?&) <span class="string">"&amp;"</span>
|
|
(aref table ?<) <span class="string">"&lt;"</span>
|
|
(aref table ?>) <span class="string">"&gt;"</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Not escaping '"' buys us a measurable speedup. It's only
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">necessary to quote it for strings used in attribute values,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">which htmlize doesn't typically do.
|
|
</span> <span class="comment-delimiter">;</span><span class="comment">(aref table ?\") "&quot;"
|
|
</span> )
|
|
table))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">A cache of HTML representation of non-ASCII characters. Depending
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">on the setting of `</span><span class="comment"><span class="constant">htmlize-convert-nonascii-to-entities</span></span><span class="comment">', this maps
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">non-ASCII characters to either "&#<code>;" or "<char>" (mapconcat's
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">mapper must always return strings). It's only filled as characters
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">are encountered, so that in a buffer with e.g. French text, it will
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">only ever contain French accented characters as keys. It's cleared
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">on each entry to htmlize-buffer-1 to allow modifications of
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">htmlize-convert-nonascii-to-entities</span></span><span class="comment">' to take effect.
|
|
</span>(<span class="keyword">defvar</span> <span class="variable-name">htmlize-extended-character-cache</span> (make-hash-table <span class="builtin">:test</span> 'eq))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-protect-string</span> (string)
|
|
<span class="doc">"HTML-protect string, escaping HTML metacharacters and I18N chars."</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Only protecting strings that actually contain unsafe or non-ASCII
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">chars removes a lot of unnecessary funcalls and consing.
|
|
</span> (<span class="keyword">if</span> (not (string-match <span class="string">"[</span><span class="string"><span class="negation-char">^</span></span><span class="string">\r\n\t -%'-;=?-~]"</span> string))
|
|
string
|
|
(mapconcat (<span class="keyword">lambda</span> (char)
|
|
(<span class="keyword">cond</span>
|
|
((< char 128)
|
|
<span class="comment-delimiter">;; </span><span class="comment">ASCII: use htmlize-basic-character-table.
|
|
</span> (aref htmlize-basic-character-table char))
|
|
((gethash char htmlize-extended-character-cache)
|
|
<span class="comment-delimiter">;; </span><span class="comment">We've already seen this char; return the cached
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">string.
|
|
</span> )
|
|
((not htmlize-convert-nonascii-to-entities)
|
|
<span class="comment-delimiter">;; </span><span class="comment">If conversion to entities is not desired, always
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">copy the char literally.
|
|
</span> (setf (gethash char htmlize-extended-character-cache)
|
|
(char-to-string char)))
|
|
((< char 256)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Latin 1: no need to call encode-char.
|
|
</span> (setf (gethash char htmlize-extended-character-cache)
|
|
(format <span class="string">"&#%d;"</span> char)))
|
|
((encode-char char 'ucs)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Must check if encode-char works for CHAR;
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">it fails for Arabic and possibly elsewhere.
|
|
</span> (setf (gethash char htmlize-extended-character-cache)
|
|
(format <span class="string">"&#%d;"</span> (encode-char char 'ucs))))
|
|
(t
|
|
<span class="comment-delimiter">;; </span><span class="comment">encode-char doesn't work for this char. Copy it
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">unchanged and hope for the best.
|
|
</span> (setf (gethash char htmlize-extended-character-cache)
|
|
(char-to-string char)))))
|
|
string <span class="string">""</span>)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-attr-escape</span> (string)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Like htmlize-protect-string, but also escapes double-quoted
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">strings to make it usable in attribute values.
|
|
</span> (setq string (htmlize-protect-string string))
|
|
(<span class="keyword">if</span> (not (string-match <span class="string">"\""</span> string))
|
|
string
|
|
(mapconcat (<span class="keyword">lambda</span> (char)
|
|
(<span class="keyword">if</span> (eql char ?\")
|
|
<span class="string">"&quot;"</span>
|
|
(char-to-string char)))
|
|
string <span class="string">""</span>)))
|
|
|
|
(<span class="keyword">defsubst</span> <span class="function-name">htmlize-concat</span> (list)
|
|
(<span class="keyword">if</span> (and (consp list) (null (cdr list)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Don't create a new string in the common case where the list only
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">consists of one element.
|
|
</span> (car list)
|
|
(apply #'concat list)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-format-link</span> (linkprops text)
|
|
(<span class="keyword">let</span> ((uri (<span class="keyword">if</span> (stringp linkprops)
|
|
linkprops
|
|
(plist-get linkprops <span class="builtin">:uri</span>)))
|
|
(escaped-text (htmlize-protect-string text)))
|
|
(<span class="keyword">if</span> uri
|
|
(format <span class="string">"<a href=\"%s\">%s</a>"</span> (htmlize-attr-escape uri) escaped-text)
|
|
escaped-text)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-escape-or-link</span> (string)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Escape STRING and/or add hyperlinks. STRING comes from a
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">display</span></span><span class="comment">' property.
|
|
</span> (<span class="keyword">let</span> ((pos 0) (end (length string)) outlist)
|
|
(<span class="keyword">while</span> (< pos end)
|
|
(<span class="keyword">let*</span> ((link (get-char-property pos 'htmlize-link string))
|
|
(next-link-change (next-single-property-change
|
|
pos 'htmlize-link string end))
|
|
(chunk (substring string pos next-link-change)))
|
|
(push
|
|
(<span class="keyword">cond</span> (link
|
|
(htmlize-format-link link chunk))
|
|
((get-char-property 0 'htmlize-literal chunk)
|
|
chunk)
|
|
(t
|
|
(htmlize-protect-string chunk)))
|
|
outlist)
|
|
(setq pos next-link-change)))
|
|
(htmlize-concat (nreverse outlist))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-display-prop-to-html</span> (display text)
|
|
(<span class="keyword">let</span> (desc)
|
|
(<span class="keyword">cond</span> ((stringp display)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Emacs ignores recursive display properties.
|
|
</span> (htmlize-escape-or-link display))
|
|
((not (eq (car-safe display) 'image))
|
|
(htmlize-protect-string text))
|
|
((null (setq desc (funcall htmlize-transform-image
|
|
(cdr display) text)))
|
|
(htmlize-escape-or-link text))
|
|
((stringp desc)
|
|
(htmlize-escape-or-link desc))
|
|
(t
|
|
(htmlize-generate-image desc text)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-string-to-html</span> (string)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Convert the string to HTML, including images attached as
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">display</span></span><span class="comment">' property and links as `</span><span class="comment"><span class="constant">htmlize-link</span></span><span class="comment">' property. In a
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">string without images or links, this is equivalent to
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">htmlize-protect-string</span></span><span class="comment">'.
|
|
</span> (<span class="keyword">let</span> ((pos 0) (end (length string)) outlist)
|
|
(<span class="keyword">while</span> (< pos end)
|
|
(<span class="keyword">let*</span> ((display (get-char-property pos 'display string))
|
|
(next-display-change (next-single-property-change
|
|
pos 'display string end))
|
|
(chunk (substring string pos next-display-change)))
|
|
(push
|
|
(<span class="keyword">if</span> display
|
|
(htmlize-display-prop-to-html display chunk)
|
|
(htmlize-escape-or-link chunk))
|
|
outlist)
|
|
(setq pos next-display-change)))
|
|
(htmlize-concat (nreverse outlist))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-default-transform-image</span> (imgprops _text)
|
|
<span class="doc">"Default transformation of image descriptor to something usable in HTML.
|
|
|
|
If `</span><span class="doc"><span class="constant">htmlize-use-images</span></span><span class="doc">' is nil, the function always returns nil, meaning
|
|
use original text. Otherwise, it tries to find the image for images that
|
|
specify a file name. If `</span><span class="doc"><span class="constant">htmlize-force-inline-images</span></span><span class="doc">' is non-nil, it also
|
|
converts the :file attribute to :data and returns the modified property
|
|
list."</span>
|
|
(<span class="keyword">when</span> htmlize-use-images
|
|
(<span class="keyword">when</span> (plist-get imgprops <span class="builtin">:file</span>)
|
|
(<span class="keyword">let</span> ((location (plist-get (cdr (find-image (list imgprops))) <span class="builtin">:file</span>)))
|
|
(<span class="keyword">when</span> location
|
|
(setq imgprops (plist-put (copy-list imgprops) <span class="builtin">:file</span> location)))))
|
|
(<span class="keyword">if</span> htmlize-force-inline-images
|
|
(<span class="keyword">let</span> ((location (plist-get imgprops <span class="builtin">:file</span>))
|
|
data)
|
|
(<span class="keyword">when</span> location
|
|
(<span class="keyword">with-temp-buffer</span>
|
|
(<span class="keyword">condition-case</span> nil
|
|
(<span class="keyword">progn</span>
|
|
(insert-file-contents-literally location)
|
|
(setq data (buffer-string)))
|
|
(<span class="warning">error</span> nil))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">if successful, return the new plist, otherwise return
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">nil, which will use the original text
|
|
</span> (and data
|
|
(plist-put (plist-put imgprops <span class="builtin">:file</span> nil)
|
|
<span class="builtin">:data</span> data)))
|
|
imgprops)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-alt-text</span> (_imgprops origtext)
|
|
(and (/= (length origtext) 0)
|
|
(<= (length origtext) htmlize-max-alt-text)
|
|
(not (string-match <span class="string">"[\0-\x1f]"</span> origtext))
|
|
origtext))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-generate-image</span> (imgprops origtext)
|
|
(<span class="keyword">let*</span> ((alt-text (htmlize-alt-text imgprops origtext))
|
|
(alt-attr (<span class="keyword">if</span> alt-text
|
|
(format <span class="string">" alt=\"%s\""</span> (htmlize-attr-escape alt-text))
|
|
<span class="string">""</span>)))
|
|
(<span class="keyword">cond</span> ((plist-get imgprops <span class="builtin">:file</span>)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Try to find the image in image-load-path
|
|
</span> (<span class="keyword">let*</span> ((found-props (cdr (find-image (list imgprops))))
|
|
(file (or (plist-get found-props <span class="builtin">:file</span>)
|
|
(plist-get imgprops <span class="builtin">:file</span>))))
|
|
(format <span class="string">"<img src=\"%s\"%s />"</span>
|
|
(htmlize-attr-escape (file-relative-name file))
|
|
alt-attr)))
|
|
((plist-get imgprops <span class="builtin">:data</span>)
|
|
(format <span class="string">"<img src=\"data:image/%s;base64,%s\"%s />"</span>
|
|
(or (plist-get imgprops <span class="builtin">:type</span>) <span class="string">""</span>)
|
|
(base64-encode-string (plist-get imgprops <span class="builtin">:data</span>))
|
|
alt-attr)))))
|
|
|
|
(<span class="keyword">defconst</span> <span class="variable-name">htmlize-ellipsis</span> <span class="string">"..."</span>)
|
|
(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-match-inv-spec</span> (inv)
|
|
(member* inv buffer-invisibility-spec
|
|
<span class="builtin">:key</span> (<span class="keyword">lambda</span> (i)
|
|
(<span class="keyword">if</span> (symbolp i) i (car i)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-decode-invisibility-spec</span> (invisible)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Return t, nil, or `</span><span class="comment"><span class="constant">ellipsis</span></span><span class="comment">', depending on how invisible text should be inserted.
|
|
</span>
|
|
(<span class="keyword">if</span> (not (listp buffer-invisibility-spec))
|
|
<span class="comment-delimiter">;; </span><span class="comment">If buffer-invisibility-spec is not a list, then all
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">characters with non-nil `</span><span class="comment"><span class="constant">invisible</span></span><span class="comment">' property are visible.
|
|
</span> (not invisible)
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Otherwise, the value of a non-nil `</span><span class="comment"><span class="constant">invisible</span></span><span class="comment">' property can be:
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">1. a symbol -- make the text invisible if it matches
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">buffer-invisibility-spec.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">2. a list of symbols -- make the text invisible if
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">any symbol in the list matches
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">buffer-invisibility-spec.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">If the match of buffer-invisibility-spec has a non-nil
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">CDR, replace the invisible text with an ellipsis.
|
|
</span> (<span class="keyword">let</span> ((match (<span class="keyword">if</span> (symbolp invisible)
|
|
(htmlize-match-inv-spec invisible)
|
|
(some #'htmlize-match-inv-spec invisible))))
|
|
(<span class="keyword">cond</span> ((null match) t)
|
|
((cdr-safe (car match)) 'ellipsis)
|
|
(t nil)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-add-before-after-strings</span> (beg end text)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Find overlays specifying before-string and after-string in [beg,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">pos). If any are found, splice them into TEXT and return the new
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">text.
|
|
</span> (<span class="keyword">let</span> (additions)
|
|
(<span class="keyword">dolist</span> (overlay (overlays-in beg end))
|
|
(<span class="keyword">let</span> ((before (overlay-get overlay 'before-string))
|
|
(after (overlay-get overlay 'after-string)))
|
|
(<span class="keyword">when</span> after
|
|
(push (cons (- (overlay-end overlay) beg)
|
|
after)
|
|
additions))
|
|
(<span class="keyword">when</span> before
|
|
(push (cons (- (overlay-start overlay) beg)
|
|
before)
|
|
additions))))
|
|
(<span class="keyword">if</span> additions
|
|
(<span class="keyword">let</span> ((textlist nil)
|
|
(strpos 0))
|
|
(<span class="keyword">dolist</span> (add (stable-sort additions #'< <span class="builtin">:key</span> #'car))
|
|
(<span class="keyword">let</span> ((addpos (car add))
|
|
(addtext (cdr add)))
|
|
(push (substring text strpos addpos) textlist)
|
|
(push addtext textlist)
|
|
(setq strpos addpos)))
|
|
(push (substring text strpos) textlist)
|
|
(apply #'concat (nreverse textlist)))
|
|
text)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-copy-prop</span> (prop beg end string)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Copy the specified property from the specified region of the
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">buffer to the target string. We cannot rely on Emacs to copy the
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">property because we want to handle properties coming from both
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">text properties and overlays.
|
|
</span> (<span class="keyword">let</span> ((pos beg))
|
|
(<span class="keyword">while</span> (< pos end)
|
|
(<span class="keyword">let</span> ((value (get-char-property pos prop))
|
|
(next-change (htmlize-next-change pos prop end)))
|
|
(<span class="keyword">when</span> value
|
|
(put-text-property (- pos beg) (- next-change beg)
|
|
prop value string))
|
|
(setq pos next-change)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-get-text-with-display</span> (beg end)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Like buffer-substring-no-properties, except it copies the
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">display</span></span><span class="comment">' property from the buffer, if found.
|
|
</span> (<span class="keyword">let</span> ((text (buffer-substring-no-properties beg end)))
|
|
(htmlize-copy-prop 'display beg end text)
|
|
(htmlize-copy-prop 'htmlize-link beg end text)
|
|
(<span class="keyword">unless</span> htmlize-running-xemacs
|
|
(setq text (htmlize-add-before-after-strings beg end text)))
|
|
text))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-buffer-substring-no-invisible</span> (beg end)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Like buffer-substring-no-properties, but don't copy invisible
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">parts of the region. Where buffer-substring-no-properties
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
|
|
</span> (<span class="keyword">let</span> ((pos beg)
|
|
visible-list invisible show last-show next-change)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Iterate over the changes in the `</span><span class="comment"><span class="constant">invisible</span></span><span class="comment">' property and filter
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">out the portions where it's non-nil, i.e. where the text is
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">invisible.
|
|
</span> (<span class="keyword">while</span> (< pos end)
|
|
(setq invisible (get-char-property pos 'invisible)
|
|
next-change (htmlize-next-change pos 'invisible end)
|
|
show (htmlize-decode-invisibility-spec invisible))
|
|
(<span class="keyword">cond</span> ((eq show t)
|
|
(push (htmlize-get-text-with-display pos next-change)
|
|
visible-list))
|
|
((and (eq show 'ellipsis)
|
|
(not (eq last-show 'ellipsis))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Conflate successive ellipses.
|
|
</span> (push htmlize-ellipsis visible-list))))
|
|
(setq pos next-change last-show show))
|
|
(htmlize-concat (nreverse visible-list))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-trim-ellipsis</span> (text)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Remove htmlize-ellipses ("...") from the beginning of TEXT if it
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">starts with it. It checks for the special property of the
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">ellipsis so it doesn't work on ordinary text that begins with
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">"...".
|
|
</span> (<span class="keyword">if</span> (get-text-property 0 'htmlize-ellipsis text)
|
|
(substring text (length htmlize-ellipsis))
|
|
text))
|
|
|
|
(<span class="keyword">defconst</span> <span class="variable-name">htmlize-tab-spaces</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">A table of strings with spaces. (aref htmlize-tab-spaces 5) is
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">like (make-string 5 ?\ ), except it doesn't cons.
|
|
</span> (<span class="keyword">let</span> ((v (make-vector 32 nil)))
|
|
(<span class="keyword">dotimes</span> (i (length v))
|
|
(setf (aref v i) (make-string i ?\ )))
|
|
v))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-untabify</span> (text start-column)
|
|
<span class="doc">"Untabify TEXT, assuming it starts at START-COLUMN."</span>
|
|
(<span class="keyword">let</span> ((column start-column)
|
|
(last-match 0)
|
|
(chunk-start 0)
|
|
chunks match-pos tab-size)
|
|
(<span class="keyword">while</span> (string-match <span class="string">"[\t\n]"</span> text last-match)
|
|
(setq match-pos (match-beginning 0))
|
|
(<span class="keyword">cond</span> ((eq (aref text match-pos) ?\t)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Encountered a tab: create a chunk of text followed by
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">the expanded tab.
|
|
</span> (push (substring text chunk-start match-pos) chunks)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Increase COLUMN by the length of the text we've
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">skipped since last tab or newline. (Encountering
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">newline resets it.)
|
|
</span> (incf column (- match-pos last-match))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Calculate tab size based on tab-width and COLUMN.
|
|
</span> (setq tab-size (- tab-width (% column tab-width)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Expand the tab, carefully recreating the `</span><span class="comment"><span class="constant">display</span></span><span class="comment">'
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">property if one was on the TAB.
|
|
</span> (<span class="keyword">let</span> ((display (get-text-property match-pos 'display text))
|
|
(expanded-tab (aref htmlize-tab-spaces tab-size)))
|
|
(<span class="keyword">when</span> display
|
|
(put-text-property 0 tab-size 'display display expanded-tab))
|
|
(push expanded-tab chunks))
|
|
(incf column tab-size)
|
|
(setq chunk-start (1+ match-pos)))
|
|
(t
|
|
<span class="comment-delimiter">;; </span><span class="comment">Reset COLUMN at beginning of line.
|
|
</span> (setq column 0)))
|
|
(setq last-match (1+ match-pos)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">If no chunks have been allocated, it means there have been no
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">tabs to expand. Return TEXT unmodified.
|
|
</span> (<span class="keyword">if</span> (null chunks)
|
|
text
|
|
(<span class="keyword">when</span> (< chunk-start (length text))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Push the remaining chunk.
|
|
</span> (push (substring text chunk-start) chunks))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Generate the output from the available chunks.
|
|
</span> (htmlize-concat (nreverse chunks)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-extract-text</span> (beg end trailing-ellipsis)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Extract buffer text, sans the invisible parts. Then
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">untabify it and escape the HTML metacharacters.
|
|
</span> (<span class="keyword">let</span> ((text (htmlize-buffer-substring-no-invisible beg end)))
|
|
(<span class="keyword">when</span> trailing-ellipsis
|
|
(setq text (htmlize-trim-ellipsis text)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">If TEXT ends up empty, don't change trailing-ellipsis.
|
|
</span> (<span class="keyword">when</span> (> (length text) 0)
|
|
(setq trailing-ellipsis
|
|
(get-text-property (1- (length text))
|
|
'htmlize-ellipsis text)))
|
|
(setq text (htmlize-untabify text (current-column)))
|
|
(setq text (htmlize-string-to-html text))
|
|
(values text trailing-ellipsis)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-despam-address</span> (string)
|
|
<span class="doc">"Replace every occurrence of '@' in STRING with %40.
|
|
This is used to protect mailto links without modifying their meaning."</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Suggested by Ville Skytta.
|
|
</span> (<span class="keyword">while</span> (string-match <span class="string">"@"</span> string)
|
|
(setq string (replace-match <span class="string">"%40"</span> nil t string)))
|
|
string)
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-make-tmp-overlay</span> (beg end props)
|
|
(<span class="keyword">let</span> ((overlay (htmlize-make-overlay beg end)))
|
|
(htmlize-overlay-put overlay 'htmlize-tmp-overlay t)
|
|
(<span class="keyword">while</span> props
|
|
(htmlize-overlay-put overlay (pop props) (pop props)))
|
|
overlay))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-delete-tmp-overlays</span> ()
|
|
(<span class="keyword">dolist</span> (overlay (htmlize-overlays-in (point-min) (point-max)))
|
|
(<span class="keyword">when</span> (htmlize-overlay-get overlay 'htmlize-tmp-overlay)
|
|
(htmlize-delete-overlay overlay))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-make-link-overlay</span> (beg end uri)
|
|
(htmlize-make-tmp-overlay beg end `(htmlize-link (<span class="builtin">:uri</span> ,uri))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-create-auto-links</span> ()
|
|
<span class="doc">"Add `</span><span class="doc"><span class="constant">htmlize-link</span></span><span class="doc">' property to all mailto links in the buffer."</span>
|
|
(<span class="keyword">save-excursion</span>
|
|
(goto-char (point-min))
|
|
(<span class="keyword">while</span> (re-search-forward
|
|
<span class="string">"<</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">mailto:</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">?</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">[-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">>"</span>
|
|
nil t)
|
|
(<span class="keyword">let*</span> ((address (match-string 3))
|
|
(beg (match-beginning 0)) (end (match-end 0))
|
|
(uri (concat <span class="string">"mailto:"</span> (htmlize-despam-address address))))
|
|
(htmlize-make-link-overlay beg end uri)))
|
|
(goto-char (point-min))
|
|
(<span class="keyword">while</span> (re-search-forward <span class="string">"<</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">URL:</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">?</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">[a-zA-Z]+://[</span><span class="string"><span class="negation-char">^</span></span><span class="string">;]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">>"</span>
|
|
nil t)
|
|
(htmlize-make-link-overlay
|
|
(match-beginning 0) (match-end 0) (match-string 3)))))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Tests for htmlize-create-auto-links:
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment"><a href="mailto:hniksic%40xemacs.org"><mailto:hniksic@xemacs.org></a>
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="http://fly.srk.fer.hr"><http://fly.srk.fer.hr></a>
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="http://www.xemacs.org"><URL:http://www.xemacs.org></a>
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="http://www.mail-archive.com/bbdb-info@xemacs.org/"><http://www.mail-archive.com/bbdb-info@xemacs.org/></a>
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="mailto:hniksic%40xemacs.org"><hniksic@xemacs.org></a>
|
|
</span><span class="comment-delimiter">;; </span><span class="comment"><a href="mailto:xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com%40xml.apache.org"><xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com@xml.apache.org></a>
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-shadow-form-feeds</span> ()
|
|
(<span class="keyword">let</span> ((s <span class="string">"\n<hr />"</span>))
|
|
(put-text-property 0 (length s) 'htmlize-literal t s)
|
|
(<span class="keyword">let</span> ((disp `(display ,s)))
|
|
(<span class="keyword">while</span> (re-search-forward <span class="string">"\n\^L"</span> nil t)
|
|
(htmlize-make-tmp-overlay (match-beginning 0) (match-end 0) disp)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-defang-local-variables</span> ()
|
|
<span class="comment-delimiter">;; </span><span class="comment">Juri Linkov reports that an HTML-ized "Local variables" can lead
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">visiting the HTML to fail with "Local variables list is not
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">properly terminated". He suggested changing the phrase to
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">syntactically equivalent HTML that Emacs doesn't recognize.
|
|
</span> (goto-char (point-min))
|
|
(<span class="keyword">while</span> (search-forward <span class="string">"Local Variables:"</span> nil t)
|
|
(replace-match <span class="string">"Local Variables&#58;"</span> nil t)))
|
|
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Color handling.
|
|
</span>
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-x-library-search-path</span>
|
|
`(,data-directory
|
|
<span class="string">"/etc/X11/rgb.txt"</span>
|
|
<span class="string">"/usr/share/X11/rgb.txt"</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">the remainder of this list really belongs in a museum
|
|
</span> <span class="string">"/usr/X11R6/lib/X11/"</span>
|
|
<span class="string">"/usr/X11R5/lib/X11/"</span>
|
|
<span class="string">"/usr/lib/X11R6/X11/"</span>
|
|
<span class="string">"/usr/lib/X11R5/X11/"</span>
|
|
<span class="string">"/usr/local/X11R6/lib/X11/"</span>
|
|
<span class="string">"/usr/local/X11R5/lib/X11/"</span>
|
|
<span class="string">"/usr/local/lib/X11R6/X11/"</span>
|
|
<span class="string">"/usr/local/lib/X11R5/X11/"</span>
|
|
<span class="string">"/usr/X11/lib/X11/"</span>
|
|
<span class="string">"/usr/lib/X11/"</span>
|
|
<span class="string">"/usr/local/lib/X11/"</span>
|
|
<span class="string">"/usr/X386/lib/X11/"</span>
|
|
<span class="string">"/usr/x386/lib/X11/"</span>
|
|
<span class="string">"/usr/XFree86/lib/X11/"</span>
|
|
<span class="string">"/usr/unsupported/lib/X11/"</span>
|
|
<span class="string">"/usr/athena/lib/X11/"</span>
|
|
<span class="string">"/usr/local/x11r5/lib/X11/"</span>
|
|
<span class="string">"/usr/lpp/Xamples/lib/X11/"</span>
|
|
<span class="string">"/usr/openwin/lib/X11/"</span>
|
|
<span class="string">"/usr/openwin/share/lib/X11/"</span>))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-get-color-rgb-hash</span> (<span class="type">&optional</span> rgb-file)
|
|
<span class="doc">"Return a hash table mapping X color names to RGB values.
|
|
The keys in the hash table are X11 color names, and the values are the
|
|
#rrggbb RGB specifications, extracted from `</span><span class="doc"><span class="constant">rgb.txt</span></span><span class="doc">'.
|
|
|
|
If RGB-FILE is nil, the function will try hard to find a suitable file
|
|
in the system directories.
|
|
|
|
If no rgb.txt file is found, return nil."</span>
|
|
(<span class="keyword">let</span> ((rgb-file (or rgb-file (locate-file
|
|
<span class="string">"rgb.txt"</span>
|
|
htmlize-x-library-search-path)))
|
|
(hash nil))
|
|
(<span class="keyword">when</span> rgb-file
|
|
(<span class="keyword">with-temp-buffer</span>
|
|
(insert-file-contents rgb-file)
|
|
(setq hash (make-hash-table <span class="builtin">:test</span> 'equal))
|
|
(<span class="keyword">while</span> (not (eobp))
|
|
(<span class="keyword">cond</span> ((looking-at <span class="string">"^\\s-*</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">[!#]</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">|</span></span><span class="string">$</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">"</span>)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Skip comments and empty lines.
|
|
</span> )
|
|
((looking-at
|
|
<span class="string">"[ \t]*</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">[0-9]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">[ \t]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">[0-9]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">[ \t]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">[0-9]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">[ \t]+</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">(</span></span><span class="string">.*</span><span class="string"><span class="regexp-grouping-backslash">\\</span></span><span class="string"><span class="regexp-grouping-construct">)</span></span><span class="string">"</span>)
|
|
(setf (gethash (downcase (match-string 4)) hash)
|
|
(format <span class="string">"#%02x%02x%02x"</span>
|
|
(string-to-number (match-string 1))
|
|
(string-to-number (match-string 2))
|
|
(string-to-number (match-string 3)))))
|
|
(t
|
|
(<span class="warning">error</span>
|
|
<span class="string">"Unrecognized line in %s: %s"</span>
|
|
rgb-file
|
|
(buffer-substring (point) (<span class="keyword">progn</span> (end-of-line) (point))))))
|
|
(forward-line 1))))
|
|
hash))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Compile the RGB map when loaded. On systems where rgb.txt is
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">missing, the value of the variable will be nil, and rgb.txt will
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">not be used.
|
|
</span>(<span class="keyword">defvar</span> <span class="variable-name">htmlize-color-rgb-hash</span> (htmlize-get-color-rgb-hash))
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Face handling.
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-specifies-property</span> (face prop)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Return t if face specifies PROP, as opposed to it being inherited
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">from the default face. The problem with e.g.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">face-foreground-instance</span></span><span class="comment">' is that it returns an instance for
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">EVERY face because every face inherits from the default face.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">However, we'd like htmlize-face-{fore,back}ground to return nil
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">when called with a face that doesn't specify its own foreground
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">or background.
|
|
</span> (or (eq face 'default)
|
|
(assq 'global (specifier-spec-list (face-property face prop)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-color-internal</span> (face fg)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Used only under GNU Emacs. Return the color of FACE, but don't
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">return "unspecified-fg" or "unspecified-bg". If the face is
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">default</span></span><span class="comment">' and the color is unspecified, look up the color in
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">frame parameters.
|
|
</span> (<span class="keyword">let*</span> ((function (<span class="keyword">if</span> fg #'face-foreground #'face-background))
|
|
color)
|
|
(<span class="keyword">if</span> (>= emacs-major-version 22)
|
|
<span class="comment-delimiter">;; </span><span class="comment">For GNU Emacs 22+ set INHERIT to get the inherited values.
|
|
</span> (setq color (funcall function face nil t))
|
|
(setq color (funcall function face))
|
|
<span class="comment-delimiter">;; </span><span class="comment">For GNU Emacs 21 (which has `</span><span class="comment"><span class="constant">face-attribute</span></span><span class="comment">'): if the color
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">is nil, recursively check for the face's parent.
|
|
</span> (<span class="keyword">when</span> (and (null color)
|
|
(fboundp 'face-attribute)
|
|
(face-attribute face <span class="builtin">:inherit</span>)
|
|
(not (eq (face-attribute face <span class="builtin">:inherit</span>) 'unspecified)))
|
|
(setq color (htmlize-face-color-internal
|
|
(face-attribute face <span class="builtin">:inherit</span>) fg))))
|
|
(<span class="keyword">when</span> (and (eq face 'default) (null color))
|
|
(setq color (cdr (assq (<span class="keyword">if</span> fg 'foreground-color 'background-color)
|
|
(frame-parameters)))))
|
|
(<span class="keyword">when</span> (or (eq color 'unspecified)
|
|
(equal color <span class="string">"unspecified-fg"</span>)
|
|
(equal color <span class="string">"unspecified-bg"</span>))
|
|
(setq color nil))
|
|
(<span class="keyword">when</span> (and (eq face 'default)
|
|
(null color))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Assuming black on white doesn't seem right, but I can't think
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">of anything better to do.
|
|
</span> (setq color (<span class="keyword">if</span> fg <span class="string">"black"</span> <span class="string">"white"</span>)))
|
|
color))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-foreground</span> (face)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Return the name of the foreground color of FACE. If FACE does
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">not specify a foreground color, return nil.
|
|
</span> (<span class="keyword">cond</span> (htmlize-running-xemacs
|
|
<span class="comment-delimiter">;; </span><span class="comment">XEmacs.
|
|
</span> (and (htmlize-face-specifies-property face 'foreground)
|
|
(color-instance-name (face-foreground-instance face))))
|
|
(t
|
|
<span class="comment-delimiter">;; </span><span class="comment">GNU Emacs.
|
|
</span> (htmlize-face-color-internal face t))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-background</span> (face)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Return the name of the background color of FACE. If FACE does
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">not specify a background color, return nil.
|
|
</span> (<span class="keyword">cond</span> (htmlize-running-xemacs
|
|
<span class="comment-delimiter">;; </span><span class="comment">XEmacs.
|
|
</span> (and (htmlize-face-specifies-property face 'background)
|
|
(color-instance-name (face-background-instance face))))
|
|
(t
|
|
<span class="comment-delimiter">;; </span><span class="comment">GNU Emacs.
|
|
</span> (htmlize-face-color-internal face nil))))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Convert COLOR to the #RRGGBB string. If COLOR is already in that
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">format, it's left unchanged.
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-color-to-rgb</span> (color)
|
|
(<span class="keyword">let</span> ((rgb-string nil))
|
|
(<span class="keyword">cond</span> ((null color)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Ignore nil COLOR because it means that the face is not
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">specifying any color. Hence (htmlize-color-to-rgb nil)
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">returns nil.
|
|
</span> )
|
|
((string-match <span class="string">"\\`#"</span> color)
|
|
<span class="comment-delimiter">;; </span><span class="comment">The color is already in #rrggbb format.
|
|
</span> (setq rgb-string color))
|
|
((and htmlize-use-rgb-txt
|
|
htmlize-color-rgb-hash)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Use of rgb.txt is requested, and it's available on the
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">system. Use it.
|
|
</span> (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
|
|
(t
|
|
<span class="comment-delimiter">;; </span><span class="comment">We're getting the RGB components from Emacs.
|
|
</span> (<span class="keyword">let</span> ((rgb
|
|
(<span class="keyword">if</span> (fboundp 'color-instance-rgb-components)
|
|
(mapcar (<span class="keyword">lambda</span> (arg)
|
|
(/ arg 256))
|
|
(color-instance-rgb-components
|
|
(make-color-instance color)))
|
|
(mapcar (<span class="keyword">lambda</span> (arg)
|
|
(/ arg 256))
|
|
(color-values color)))))
|
|
(<span class="keyword">when</span> rgb
|
|
(setq rgb-string (apply #'format <span class="string">"#%02x%02x%02x"</span> rgb))))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">If RGB-STRING is still nil, it means the color cannot be found,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">for whatever reason. In that case just punt and return COLOR.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">Most browsers support a decent set of color names anyway.
|
|
</span> (or rgb-string color)))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">We store the face properties we care about into an
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">htmlize-fstruct</span></span><span class="comment">' type. That way we only have to analyze face
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">properties, which can be time consuming, once per each face. The
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">mapping between Emacs faces and htmlize-fstructs is established by
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">htmlize-make-face-map. The name "fstruct" refers to variables of
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">type `</span><span class="comment"><span class="constant">htmlize-fstruct</span></span><span class="comment">', while the term "face" is reserved for Emacs
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">faces.
|
|
</span>
|
|
(<span class="keyword">defstruct</span> <span class="type">htmlize-fstruct</span>
|
|
foreground <span class="comment-delimiter">; </span><span class="comment">foreground color, #rrggbb
|
|
</span> background <span class="comment-delimiter">; </span><span class="comment">background color, #rrggbb
|
|
</span> size <span class="comment-delimiter">; </span><span class="comment">size
|
|
</span> boldp <span class="comment-delimiter">; </span><span class="comment">whether face is bold
|
|
</span> italicp <span class="comment-delimiter">; </span><span class="comment">whether face is italic
|
|
</span> underlinep <span class="comment-delimiter">; </span><span class="comment">whether face is underlined
|
|
</span> overlinep <span class="comment-delimiter">; </span><span class="comment">whether face is overlined
|
|
</span> strikep <span class="comment-delimiter">; </span><span class="comment">whether face is struck through
|
|
</span> css-name <span class="comment-delimiter">; </span><span class="comment">CSS name of face
|
|
</span> )
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-emacs21-attr</span> (fstruct attr value)
|
|
<span class="comment-delimiter">;; </span><span class="comment">For ATTR and VALUE, set the equivalent value in FSTRUCT.
|
|
</span> (<span class="keyword">case</span> attr
|
|
(<span class="builtin">:foreground</span>
|
|
(setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
|
|
(<span class="builtin">:background</span>
|
|
(setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
|
|
(<span class="builtin">:height</span>
|
|
(setf (htmlize-fstruct-size fstruct) value))
|
|
(<span class="builtin">:weight</span>
|
|
(<span class="keyword">when</span> (string-match (symbol-name value) <span class="string">"bold"</span>)
|
|
(setf (htmlize-fstruct-boldp fstruct) t)))
|
|
(<span class="builtin">:slant</span>
|
|
(setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
|
|
(eq value 'oblique))))
|
|
(<span class="builtin">:bold</span>
|
|
(setf (htmlize-fstruct-boldp fstruct) value))
|
|
(<span class="builtin">:italic</span>
|
|
(setf (htmlize-fstruct-italicp fstruct) value))
|
|
(<span class="builtin">:underline</span>
|
|
(setf (htmlize-fstruct-underlinep fstruct) value))
|
|
(<span class="builtin">:overline</span>
|
|
(setf (htmlize-fstruct-overlinep fstruct) value))
|
|
(<span class="builtin">:strike-through</span>
|
|
(setf (htmlize-fstruct-strikep fstruct) value))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-size</span> (face)
|
|
<span class="comment-delimiter">;; </span><span class="comment">The size (height) of FACE, taking inheritance into account.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">Only works in Emacs 21 and later.
|
|
</span> (<span class="keyword">let</span> ((size-list
|
|
(<span class="keyword">loop</span>
|
|
for f = face then (face-attribute f <span class="builtin">:inherit</span>)
|
|
until (or (not f) (eq f 'unspecified))
|
|
for h = (face-attribute f <span class="builtin">:height</span>)
|
|
collect (<span class="keyword">if</span> (eq h 'unspecified) nil h))))
|
|
(reduce 'htmlize-merge-size (cons nil size-list))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-css-name</span> (face)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Generate the css-name property for the given face. Emacs places
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">no restrictions on the names of symbols that represent faces --
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">any characters may be in the name, even control chars. We try
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">hard to beat the face name into shape, both esthetically and
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">according to CSS1 specs.
|
|
</span> (<span class="keyword">let</span> ((name (downcase (symbol-name face))))
|
|
(<span class="keyword">when</span> (string-match <span class="string">"\\`font-lock-"</span> name)
|
|
<span class="comment-delimiter">;; </span><span class="comment">font-lock-FOO-face -> FOO.
|
|
</span> (setq name (replace-match <span class="string">""</span> t t name)))
|
|
(<span class="keyword">when</span> (string-match <span class="string">"-face\\'"</span> name)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Drop the redundant "-face" suffix.
|
|
</span> (setq name (replace-match <span class="string">""</span> t t name)))
|
|
(<span class="keyword">while</span> (string-match <span class="string">"[</span><span class="string"><span class="negation-char">^</span></span><span class="string">-a-zA-Z0-9]"</span> name)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Drop the non-alphanumerics.
|
|
</span> (setq name (replace-match <span class="string">"X"</span> t t name)))
|
|
(<span class="keyword">when</span> (string-match <span class="string">"\\`[-0-9]"</span> name)
|
|
<span class="comment-delimiter">;; </span><span class="comment">CSS identifiers may not start with a digit.
|
|
</span> (setq name (concat <span class="string">"X"</span> name)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">After these transformations, the face could come out empty.
|
|
</span> (<span class="keyword">when</span> (equal name <span class="string">""</span>)
|
|
(setq name <span class="string">"face"</span>))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Apply the prefix.
|
|
</span> (concat htmlize-css-name-prefix name)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-face-to-fstruct</span> (face)
|
|
<span class="doc">"Convert Emacs face FACE to fstruct."</span>
|
|
(<span class="keyword">let</span> ((fstruct (make-htmlize-fstruct
|
|
<span class="builtin">:foreground</span> (htmlize-color-to-rgb
|
|
(htmlize-face-foreground face))
|
|
<span class="builtin">:background</span> (htmlize-color-to-rgb
|
|
(htmlize-face-background face)))))
|
|
(<span class="keyword">if</span> htmlize-running-xemacs
|
|
<span class="comment-delimiter">;; </span><span class="comment">XEmacs doesn't provide a way to detect whether a face is
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">bold or italic, so we need to examine the font instance.
|
|
</span> (<span class="keyword">let*</span> ((font-instance (face-font-instance face))
|
|
(props (font-instance-properties font-instance)))
|
|
(<span class="keyword">when</span> (equalp (cdr (assq 'WEIGHT_NAME props)) <span class="string">"bold"</span>)
|
|
(setf (htmlize-fstruct-boldp fstruct) t))
|
|
(<span class="keyword">when</span> (or (equalp (cdr (assq 'SLANT props)) <span class="string">"i"</span>)
|
|
(equalp (cdr (assq 'SLANT props)) <span class="string">"o"</span>))
|
|
(setf (htmlize-fstruct-italicp fstruct) t))
|
|
(setf (htmlize-fstruct-strikep fstruct)
|
|
(face-strikethru-p face))
|
|
(setf (htmlize-fstruct-underlinep fstruct)
|
|
(face-underline-p face)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">GNU Emacs
|
|
</span> (<span class="keyword">dolist</span> (attr '(<span class="builtin">:weight</span> <span class="builtin">:slant</span> <span class="builtin">:underline</span> <span class="builtin">:overline</span> <span class="builtin">:strike-through</span>))
|
|
(<span class="keyword">let</span> ((value (<span class="keyword">if</span> (>= emacs-major-version 22)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Use the INHERIT arg in GNU Emacs 22.
|
|
</span> (face-attribute face attr nil t)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Otherwise, fake it.
|
|
</span> (<span class="keyword">let</span> ((face face))
|
|
(<span class="keyword">while</span> (and (eq (face-attribute face attr)
|
|
'unspecified)
|
|
(not (eq (face-attribute face <span class="builtin">:inherit</span>)
|
|
'unspecified)))
|
|
(setq face (face-attribute face <span class="builtin">:inherit</span>)))
|
|
(face-attribute face attr)))))
|
|
(<span class="keyword">when</span> (and value (not (eq value 'unspecified)))
|
|
(htmlize-face-emacs21-attr fstruct attr value))))
|
|
(<span class="keyword">let</span> ((size (htmlize-face-size face)))
|
|
(<span class="keyword">unless</span> (eql size 1.0) <span class="comment-delimiter">; </span><span class="comment">ignore non-spec
|
|
</span> (setf (htmlize-fstruct-size fstruct) size))))
|
|
(setf (htmlize-fstruct-css-name fstruct) (htmlize-face-css-name face))
|
|
fstruct))
|
|
|
|
(<span class="keyword">defmacro</span> <span class="function-name">htmlize-copy-attr-if-set</span> (attr-list dest source)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Generate code with the following pattern:
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(progn
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(when (htmlize-fstruct-ATTR source)
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">...)
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">for the given list of boolean attributes.
|
|
</span> (cons 'progn
|
|
(<span class="keyword">loop</span> for attr in attr-list
|
|
for attr-sym = (intern (format <span class="string">"htmlize-fstruct-%s"</span> attr))
|
|
collect `(<span class="keyword">when</span> (,attr-sym ,source)
|
|
(setf (,attr-sym ,dest) (,attr-sym ,source))))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-merge-size</span> (merged next)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Calculate the size of the merge of MERGED and NEXT.
|
|
</span> (<span class="keyword">cond</span> ((null merged) next)
|
|
((integerp next) next)
|
|
((null next) merged)
|
|
((floatp merged) (* merged next))
|
|
((integerp merged) (round (* merged next)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-merge-two-faces</span> (merged next)
|
|
(htmlize-copy-attr-if-set
|
|
(foreground background boldp italicp underlinep overlinep strikep)
|
|
merged next)
|
|
(setf (htmlize-fstruct-size merged)
|
|
(htmlize-merge-size (htmlize-fstruct-size merged)
|
|
(htmlize-fstruct-size next)))
|
|
merged)
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-merge-faces</span> (fstruct-list)
|
|
(<span class="keyword">cond</span> ((null fstruct-list)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Nothing to do, return a dummy face.
|
|
</span> (make-htmlize-fstruct))
|
|
((null (cdr fstruct-list))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Optimize for the common case of a single face, simply
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">return it.
|
|
</span> (car fstruct-list))
|
|
(t
|
|
(reduce #'htmlize-merge-two-faces
|
|
(cons (make-htmlize-fstruct) fstruct-list)))))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">GNU Emacs 20+ supports attribute lists in `</span><span class="comment"><span class="constant">face</span></span><span class="comment">' properties. For
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">example, you can use `(:foreground "red" :weight bold)' as an
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">overlay's "face", or you can even use a list of such lists, etc.
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">We call those "attrlists".
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">htmlize supports attrlist by converting them to fstructs, the same
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">as with regular faces.
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-attrlist-to-fstruct</span> (attrlist)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
|
|
</span> (<span class="keyword">let</span> ((fstruct (make-htmlize-fstruct)))
|
|
(<span class="keyword">cond</span> ((eq (car attrlist) 'foreground-color)
|
|
<span class="comment-delimiter">;; </span><span class="comment">ATTRLIST is (foreground-color . COLOR)
|
|
</span> (setf (htmlize-fstruct-foreground fstruct)
|
|
(htmlize-color-to-rgb (cdr attrlist))))
|
|
((eq (car attrlist) 'background-color)
|
|
<span class="comment-delimiter">;; </span><span class="comment">ATTRLIST is (background-color . COLOR)
|
|
</span> (setf (htmlize-fstruct-background fstruct)
|
|
(htmlize-color-to-rgb (cdr attrlist))))
|
|
(t
|
|
<span class="comment-delimiter">;; </span><span class="comment">ATTRLIST is a plist.
|
|
</span> (<span class="keyword">while</span> attrlist
|
|
(<span class="keyword">let</span> ((attr (pop attrlist))
|
|
(value (pop attrlist)))
|
|
(<span class="keyword">when</span> (and value (not (eq value 'unspecified)))
|
|
(htmlize-face-emacs21-attr fstruct attr value))))))
|
|
(setf (htmlize-fstruct-css-name fstruct) <span class="string">"ATTRLIST"</span>)
|
|
fstruct))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-decode-face-prop</span> (prop)
|
|
<span class="doc">"Turn face property PROP into a list of face-like objects."</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">PROP can be a symbol naming a face, a string naming such a
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">symbol, a cons (foreground-color . COLOR) or (background-color
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">COLOR), a property list (:attr1 val1 :attr2 val2 ...), or a list
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">of any of those.
|
|
</span> <span class="comment-delimiter">;;</span><span class="comment">
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(htmlize-decode-face-prop 'face) -> (face)
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(htmlize-decode-face-prop '(face1 face2)) -> (face1 face2)
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(htmlize-decode-face-prop '(:attr "val")) -> ((:attr "val"))
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">(htmlize-decode-face-prop '((:attr "val") face (foreground-color "red")))
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">-> ((:attr "val") face (foreground-color "red"))
|
|
</span> <span class="comment-delimiter">;;</span><span class="comment">
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">Unrecognized atoms or non-face symbols/strings are silently
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">stripped away.
|
|
</span> (<span class="keyword">cond</span> ((null prop)
|
|
nil)
|
|
((symbolp prop)
|
|
(and (facep prop)
|
|
(list prop)))
|
|
((stringp prop)
|
|
(and (facep (intern-soft prop))
|
|
(list prop)))
|
|
((atom prop)
|
|
nil)
|
|
((and (symbolp (car prop))
|
|
(eq ?: (aref (symbol-name (car prop)) 0)))
|
|
(list prop))
|
|
((or (eq (car prop) 'foreground-color)
|
|
(eq (car prop) 'background-color))
|
|
(list prop))
|
|
(t
|
|
(apply #'nconc (mapcar #'htmlize-decode-face-prop prop)))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-make-face-map</span> (faces)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Return a hash table mapping Emacs faces to htmlize's fstructs.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">The keys are either face symbols or attrlists, so the test
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">function must be `</span><span class="comment"><span class="constant">equal</span></span><span class="comment">'.
|
|
</span> (<span class="keyword">let</span> ((face-map (make-hash-table <span class="builtin">:test</span> 'equal))
|
|
css-names)
|
|
(<span class="keyword">dolist</span> (face faces)
|
|
(<span class="keyword">unless</span> (gethash face face-map)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Haven't seen FACE yet; convert it to an fstruct and cache
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">it.
|
|
</span> (<span class="keyword">let</span> ((fstruct (<span class="keyword">if</span> (symbolp face)
|
|
(htmlize-face-to-fstruct face)
|
|
(htmlize-attrlist-to-fstruct face))))
|
|
(setf (gethash face face-map) fstruct)
|
|
(<span class="keyword">let*</span> ((css-name (htmlize-fstruct-css-name fstruct))
|
|
(new-name css-name)
|
|
(i 0))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Uniquify the face's css-name by using NAME-1, NAME-2,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">etc.
|
|
</span> (<span class="keyword">while</span> (member new-name css-names)
|
|
(setq new-name (format <span class="string">"%s-%s"</span> css-name (incf i))))
|
|
(<span class="keyword">unless</span> (equal new-name css-name)
|
|
(setf (htmlize-fstruct-css-name fstruct) new-name))
|
|
(push new-name css-names)))))
|
|
face-map))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-unstringify-face</span> (face)
|
|
<span class="doc">"If FACE is a string, return it interned, otherwise return it unchanged."</span>
|
|
(<span class="keyword">if</span> (stringp face)
|
|
(intern face)
|
|
face))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-faces-in-buffer</span> ()
|
|
<span class="doc">"Return a list of faces used in the current buffer.
|
|
Under XEmacs, this returns the set of faces specified by the extents
|
|
with the `</span><span class="doc"><span class="constant">face</span></span><span class="doc">' property. (This covers text properties as well.) Under
|
|
GNU Emacs, it returns the set of faces specified by the `</span><span class="doc"><span class="constant">face</span></span><span class="doc">' text
|
|
property and by buffer overlays that specify `</span><span class="doc"><span class="constant">face</span></span><span class="doc">'."</span>
|
|
(<span class="keyword">let</span> (faces)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Testing for (fboundp 'map-extents) doesn't work because W3
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">defines `</span><span class="comment"><span class="constant">map-extents</span></span><span class="comment">' under FSF.
|
|
</span> (<span class="keyword">if</span> htmlize-running-xemacs
|
|
(<span class="keyword">let</span> (face-prop)
|
|
(map-extents (<span class="keyword">lambda</span> (extent ignored)
|
|
(setq face-prop (extent-face extent)
|
|
<span class="comment-delimiter">;; </span><span class="comment">FACE-PROP can be a face or a list of
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">faces.
|
|
</span> faces (<span class="keyword">if</span> (listp face-prop)
|
|
(union face-prop faces)
|
|
(adjoin face-prop faces)))
|
|
nil)
|
|
nil
|
|
<span class="comment-delimiter">;; </span><span class="comment">Specify endpoints explicitly to respect
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">narrowing.
|
|
</span> (point-min) (point-max) nil nil 'face))
|
|
<span class="comment-delimiter">;; </span><span class="comment">FSF Emacs code.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">Faces used by text properties.
|
|
</span> (<span class="keyword">let</span> ((pos (point-min)) face-prop next)
|
|
(<span class="keyword">while</span> (< pos (point-max))
|
|
(setq face-prop (get-text-property pos 'face)
|
|
next (or (next-single-property-change pos 'face) (point-max)))
|
|
(setq faces (nunion (htmlize-decode-face-prop face-prop)
|
|
faces <span class="builtin">:test</span> 'equal))
|
|
(setq pos next)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Faces used by overlays.
|
|
</span> (<span class="keyword">dolist</span> (overlay (overlays-in (point-min) (point-max)))
|
|
(<span class="keyword">let</span> ((face-prop (overlay-get overlay 'face)))
|
|
(setq faces (nunion (htmlize-decode-face-prop face-prop)
|
|
faces <span class="builtin">:test</span> 'equal)))))
|
|
faces))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">htmlize-faces-at-point returns the faces in use at point. The
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">faces are sorted by increasing priority, i.e. the last face takes
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">precedence.
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Under XEmacs, this returns all the faces in all the extents at
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">point. Under GNU Emacs, this returns all the faces in the `</span><span class="comment"><span class="constant">face</span></span><span class="comment">'
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">property and all the faces in the overlays at point.
|
|
</span>
|
|
(<span class="keyword">cond</span> (htmlize-running-xemacs
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-faces-at-point</span> ()
|
|
(<span class="keyword">let</span> (extent extent-list face-list face-prop)
|
|
(<span class="keyword">while</span> (setq extent (extent-at (point) nil 'face extent))
|
|
(push extent extent-list))
|
|
<span class="comment-delimiter">;; </span><span class="comment">extent-list is in reverse display order, meaning that
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">smallest ones come last. That is the order we want,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">except it can be overridden by the `</span><span class="comment"><span class="constant">priority</span></span><span class="comment">' property.
|
|
</span> (setq extent-list (stable-sort extent-list #'<
|
|
<span class="builtin">:key</span> #'extent-priority))
|
|
(<span class="keyword">dolist</span> (extent extent-list)
|
|
(setq face-prop (extent-face extent))
|
|
<span class="comment-delimiter">;; </span><span class="comment">extent's face-list is in reverse order from what we
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">want, but the `</span><span class="comment"><span class="constant">nreverse</span></span><span class="comment">' below will take care of it.
|
|
</span> (setq face-list (<span class="keyword">if</span> (listp face-prop)
|
|
(append face-prop face-list)
|
|
(cons face-prop face-list))))
|
|
(nreverse face-list))))
|
|
(t
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-faces-at-point</span> ()
|
|
(<span class="keyword">let</span> (all-faces)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Faces from text properties.
|
|
</span> (<span class="keyword">let</span> ((face-prop (get-text-property (point) 'face)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">we need to reverse the `</span><span class="comment"><span class="constant">face</span></span><span class="comment">' prop because we want
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">more specific faces to come later
|
|
</span> (setq all-faces (nreverse (htmlize-decode-face-prop face-prop))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Faces from overlays.
|
|
</span> (<span class="keyword">let</span> ((overlays
|
|
<span class="comment-delimiter">;; </span><span class="comment">Collect overlays at point that specify `</span><span class="comment"><span class="constant">face</span></span><span class="comment">'.
|
|
</span> (delete-if-not (<span class="keyword">lambda</span> (o)
|
|
(overlay-get o 'face))
|
|
(overlays-at (point))))
|
|
list face-prop)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Sort the overlays so the smaller (more specific) ones
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">come later. The number of overlays at each one
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">position should be very small, so the sort shouldn't
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">slow things down.
|
|
</span> (setq overlays (sort* overlays
|
|
<span class="comment-delimiter">;; </span><span class="comment">Sort by ascending...
|
|
</span> #'<
|
|
<span class="comment-delimiter">;; </span><span class="comment">...overlay size.
|
|
</span> <span class="builtin">:key</span> (<span class="keyword">lambda</span> (o)
|
|
(- (overlay-end o)
|
|
(overlay-start o)))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Overlay priorities, if present, override the above
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">established order. Larger overlay priority takes
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">precedence and therefore comes later in the list.
|
|
</span> (setq overlays (stable-sort
|
|
overlays
|
|
<span class="comment-delimiter">;; </span><span class="comment">Reorder (stably) by acending...
|
|
</span> #'<
|
|
<span class="comment-delimiter">;; </span><span class="comment">...overlay priority.
|
|
</span> <span class="builtin">:key</span> (<span class="keyword">lambda</span> (o)
|
|
(or (overlay-get o 'priority) 0))))
|
|
(<span class="keyword">dolist</span> (overlay overlays)
|
|
(setq face-prop (overlay-get overlay 'face)
|
|
list (nconc (htmlize-decode-face-prop face-prop) list)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Under "Merging Faces" the manual explicitly states
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">that faces specified by overlays take precedence over
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">faces specified by text properties.
|
|
</span> (setq all-faces (nconc all-faces list)))
|
|
all-faces))))
|
|
<hr />
|
|
<span class="comment-delimiter">;; </span><span class="comment">htmlize supports generating HTML in several flavors, some of which
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">use CSS, and others the <font> element. We take an OO approach and
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">define "methods" that indirect to the functions that depend on
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">htmlize-output-type</span></span><span class="comment">'. The currently used methods are `</span><span class="comment"><span class="constant">doctype</span></span><span class="comment">',
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">insert-head</span></span><span class="comment">', `</span><span class="comment"><span class="constant">body-tag</span></span><span class="comment">', and `</span><span class="comment"><span class="constant">text-markup</span></span><span class="comment">'. Not all output types
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">define all methods.
|
|
</span><span class="comment-delimiter">;;</span><span class="comment">
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">Methods are called either with (htmlize-method METHOD ARGS...)
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">special form, or by accessing the function with
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">(htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">The latter form is useful in tight loops because `</span><span class="comment"><span class="constant">htmlize-method</span></span><span class="comment">'
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">conses.
|
|
</span>
|
|
(<span class="keyword">defmacro</span> <span class="function-name">htmlize-method</span> (method <span class="type">&rest</span> args)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Expand to (htmlize-TYPE-METHOD ...ARGS...). TYPE is the value of
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">htmlize-output-type</span></span><span class="comment">' at run time.
|
|
</span> `(funcall (htmlize-method-function ',method) ,@args))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-method-function</span> (method)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Return METHOD's function definition for the current output type.
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">The returned object can be safely funcalled.
|
|
</span> (<span class="keyword">let</span> ((sym (intern (format <span class="string">"htmlize-%s-%s"</span> htmlize-output-type method))))
|
|
(indirect-function (<span class="keyword">if</span> (fboundp sym)
|
|
sym
|
|
(<span class="keyword">let</span> ((default (intern (concat <span class="string">"htmlize-default-"</span>
|
|
(symbol-name method)))))
|
|
(<span class="keyword">if</span> (fboundp default)
|
|
default
|
|
'ignore))))))
|
|
|
|
(<span class="keyword">defvar</span> <span class="variable-name">htmlize-memoization-table</span> (make-hash-table <span class="builtin">:test</span> 'equal))
|
|
|
|
(<span class="keyword">defmacro</span> <span class="function-name">htmlize-memoize</span> (key generator)
|
|
<span class="doc">"Return the value of GENERATOR, memoized as KEY.
|
|
That means that GENERATOR will be evaluated and returned the first time
|
|
it's called with the same value of KEY. All other times, the cached
|
|
\(memoized) value will be returned."</span>
|
|
(<span class="keyword">let</span> ((value (gensym)))
|
|
`(<span class="keyword">let</span> ((,value (gethash ,key htmlize-memoization-table)))
|
|
(<span class="keyword">unless</span> ,value
|
|
(setq ,value ,generator)
|
|
(setf (gethash ,key htmlize-memoization-table) ,value))
|
|
,value)))
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">Default methods.
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-default-doctype</span> ()
|
|
nil <span class="comment-delimiter">; </span><span class="comment">no doc-string
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">Note that the `</span><span class="comment"><span class="constant">font</span></span><span class="comment">' output is technically invalid under this DTD
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">because the DTD doesn't allow embedding <font> in <pre>.
|
|
</span> <span class="string">"<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"</span>
|
|
)
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-default-body-tag</span> (face-map)
|
|
nil <span class="comment-delimiter">; </span><span class="comment">no doc-string
|
|
</span> face-map <span class="comment-delimiter">; </span><span class="comment">shut up the byte-compiler
|
|
</span> <span class="string">"<body>"</span>)
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">CSS based output support.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Internal function; not a method.
|
|
</span>(<span class="keyword">defun</span> <span class="function-name">htmlize-css-specs</span> (fstruct)
|
|
(<span class="keyword">let</span> (result)
|
|
(<span class="keyword">when</span> (htmlize-fstruct-foreground fstruct)
|
|
(push (format <span class="string">"color: %s;"</span> (htmlize-fstruct-foreground fstruct))
|
|
result))
|
|
(<span class="keyword">when</span> (htmlize-fstruct-background fstruct)
|
|
(push (format <span class="string">"background-color: %s;"</span>
|
|
(htmlize-fstruct-background fstruct))
|
|
result))
|
|
(<span class="keyword">let</span> ((size (htmlize-fstruct-size fstruct)))
|
|
(<span class="keyword">when</span> (and size (not (eq htmlize-ignore-face-size t)))
|
|
(<span class="keyword">cond</span> ((floatp size)
|
|
(push (format <span class="string">"font-size: %d%%;"</span> (* 100 size)) result))
|
|
((not (eq htmlize-ignore-face-size 'absolute))
|
|
(push (format <span class="string">"font-size: %spt;"</span> (/ size 10.0)) result)))))
|
|
(<span class="keyword">when</span> (htmlize-fstruct-boldp fstruct)
|
|
(push <span class="string">"font-weight: bold;"</span> result))
|
|
(<span class="keyword">when</span> (htmlize-fstruct-italicp fstruct)
|
|
(push <span class="string">"font-style: italic;"</span> result))
|
|
(<span class="keyword">when</span> (htmlize-fstruct-underlinep fstruct)
|
|
(push <span class="string">"text-decoration: underline;"</span> result))
|
|
(<span class="keyword">when</span> (htmlize-fstruct-overlinep fstruct)
|
|
(push <span class="string">"text-decoration: overline;"</span> result))
|
|
(<span class="keyword">when</span> (htmlize-fstruct-strikep fstruct)
|
|
(push <span class="string">"text-decoration: line-through;"</span> result))
|
|
(nreverse result)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-css-insert-head</span> (buffer-faces face-map)
|
|
(insert <span class="string">" <style type=\"text/css\">\n <!--\n"</span>)
|
|
(insert <span class="string">" body {\n "</span>
|
|
(mapconcat #'identity
|
|
(htmlize-css-specs (gethash 'default face-map))
|
|
<span class="string">"\n "</span>)
|
|
<span class="string">"\n }\n"</span>)
|
|
(<span class="keyword">dolist</span> (face (sort* (copy-list buffer-faces) #'string-lessp
|
|
<span class="builtin">:key</span> (<span class="keyword">lambda</span> (f)
|
|
(htmlize-fstruct-css-name (gethash f face-map)))))
|
|
(<span class="keyword">let*</span> ((fstruct (gethash face face-map))
|
|
(cleaned-up-face-name
|
|
(<span class="keyword">let</span> ((s
|
|
<span class="comment-delimiter">;; </span><span class="comment">Use `</span><span class="comment"><span class="constant">prin1-to-string</span></span><span class="comment">' rather than `</span><span class="comment"><span class="constant">symbol-name</span></span><span class="comment">'
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">to get the face name because the "face" can also
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">be an attrlist, which is not a symbol.
|
|
</span> (prin1-to-string face)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">If the name contains `</span><span class="comment"><span class="constant">--</span></span><span class="comment">' or `</span><span class="comment"><span class="constant">*/</span></span><span class="comment">', remove them.
|
|
</span> (<span class="keyword">while</span> (string-match <span class="string">"--"</span> s)
|
|
(setq s (replace-match <span class="string">"-"</span> t t s)))
|
|
(<span class="keyword">while</span> (string-match <span class="string">"\\*/"</span> s)
|
|
(setq s (replace-match <span class="string">"XX"</span> t t s)))
|
|
s))
|
|
(specs (htmlize-css-specs fstruct)))
|
|
(insert <span class="string">" ."</span> (htmlize-fstruct-css-name fstruct))
|
|
(<span class="keyword">if</span> (null specs)
|
|
(insert <span class="string">" {"</span>)
|
|
(insert <span class="string">" {\n /* "</span> cleaned-up-face-name <span class="string">" */\n "</span>
|
|
(mapconcat #'identity specs <span class="string">"\n "</span>)))
|
|
(insert <span class="string">"\n }\n"</span>)))
|
|
(insert htmlize-hyperlink-style
|
|
<span class="string">" -->\n </style>\n"</span>))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-css-text-markup</span> (fstruct-list buffer)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Open the markup needed to insert text colored with FACES into
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">BUFFER. Return the function that closes the markup.
|
|
</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">In CSS mode, this is easy: just nest the text in one <span
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">class=...> tag for each face in FSTRUCT-LIST.
|
|
</span> (<span class="keyword">dolist</span> (fstruct fstruct-list)
|
|
(princ <span class="string">"<span class=\""</span> buffer)
|
|
(princ (htmlize-fstruct-css-name fstruct) buffer)
|
|
(princ <span class="string">"\">"</span> buffer))
|
|
(htmlize-lexlet ((fstruct-list fstruct-list) (buffer buffer))
|
|
(<span class="keyword">lambda</span> ()
|
|
(<span class="keyword">dolist</span> (fstruct fstruct-list)
|
|
(ignore fstruct) <span class="comment-delimiter">; </span><span class="comment">shut up the byte-compiler
|
|
</span> (princ <span class="string">"</span>"</span> buffer)))))
|
|
<hr />
|
|
<span class="comment-delimiter">;; </span><span class="comment">`</span><span class="comment"><span class="constant">inline-css</span></span><span class="comment">' output support.
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-inline-css-body-tag</span> (face-map)
|
|
(format <span class="string">"<body style=\"%s\">"</span>
|
|
(mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
|
|
<span class="string">" "</span>)))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-inline-css-text-markup</span> (fstruct-list buffer)
|
|
(<span class="keyword">let*</span> ((merged (htmlize-merge-faces fstruct-list))
|
|
(style (htmlize-memoize
|
|
merged
|
|
(<span class="keyword">let</span> ((specs (htmlize-css-specs merged)))
|
|
(and specs
|
|
(mapconcat #'identity (htmlize-css-specs merged) <span class="string">" "</span>))))))
|
|
(<span class="keyword">when</span> style
|
|
(princ <span class="string">"<span style=\""</span> buffer)
|
|
(princ style buffer)
|
|
(princ <span class="string">"\">"</span> buffer))
|
|
(htmlize-lexlet ((style style) (buffer buffer))
|
|
(<span class="keyword">lambda</span> ()
|
|
(<span class="keyword">when</span> style
|
|
(princ <span class="string">"</span>"</span> buffer))))))
|
|
<hr />
|
|
<span class="comment-delimiter">;;; </span><span class="comment">`</span><span class="comment"><span class="constant">font</span></span><span class="comment">' tag based output support.
|
|
</span>
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-font-body-tag</span> (face-map)
|
|
(<span class="keyword">let</span> ((fstruct (gethash 'default face-map)))
|
|
(format <span class="string">"<body text=\"%s\" bgcolor=\"%s\">"</span>
|
|
(htmlize-fstruct-foreground fstruct)
|
|
(htmlize-fstruct-background fstruct))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-font-text-markup</span> (fstruct-list buffer)
|
|
<span class="comment-delimiter">;; </span><span class="comment">In `</span><span class="comment"><span class="constant">font</span></span><span class="comment">' mode, we use the traditional HTML means of altering
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">presentation: <font> tag for colors, <b> for bold, <u> for
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">underline, and <strike> for strike-through.
|
|
</span> (<span class="keyword">let*</span> ((merged (htmlize-merge-faces fstruct-list))
|
|
(markup (htmlize-memoize
|
|
merged
|
|
(cons (concat
|
|
(and (htmlize-fstruct-foreground merged)
|
|
(format <span class="string">"<font color=\"%s\">"</span> (htmlize-fstruct-foreground merged)))
|
|
(and (htmlize-fstruct-boldp merged) <span class="string">"<b>"</span>)
|
|
(and (htmlize-fstruct-italicp merged) <span class="string">"<i>"</span>)
|
|
(and (htmlize-fstruct-underlinep merged) <span class="string">"<u>"</span>)
|
|
(and (htmlize-fstruct-strikep merged) <span class="string">"<strike>"</span>))
|
|
(concat
|
|
(and (htmlize-fstruct-strikep merged) <span class="string">"</strike>"</span>)
|
|
(and (htmlize-fstruct-underlinep merged) <span class="string">"</u>"</span>)
|
|
(and (htmlize-fstruct-italicp merged) <span class="string">"</i>"</span>)
|
|
(and (htmlize-fstruct-boldp merged) <span class="string">"</b>"</span>)
|
|
(and (htmlize-fstruct-foreground merged) <span class="string">"</font>"</span>))))))
|
|
(princ (car markup) buffer)
|
|
(htmlize-lexlet ((markup markup) (buffer buffer))
|
|
(<span class="keyword">lambda</span> ()
|
|
(princ (cdr markup) buffer)))))
|
|
<hr />
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-buffer-1</span> ()
|
|
<span class="comment-delimiter">;; </span><span class="comment">Internal function; don't call it from outside this file. Htmlize
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">current buffer, writing the resulting HTML to a new buffer, and
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">return it. Unlike htmlize-buffer, this doesn't change current
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">buffer or use switch-to-buffer.
|
|
</span> (<span class="keyword">save-excursion</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Protect against the hook changing the current buffer.
|
|
</span> (<span class="keyword">save-excursion</span>
|
|
(run-hooks 'htmlize-before-hook))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Convince font-lock support modes to fontify the entire buffer
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">in advance.
|
|
</span> (htmlize-ensure-fontified)
|
|
(clrhash htmlize-extended-character-cache)
|
|
(clrhash htmlize-memoization-table)
|
|
<span class="comment-delimiter">;; </span><span class="comment">It's important that the new buffer inherits default-directory
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">from the current buffer.
|
|
</span> (<span class="keyword">let</span> ((htmlbuf (generate-new-buffer (<span class="keyword">if</span> (buffer-file-name)
|
|
(htmlize-make-file-name
|
|
(file-name-nondirectory
|
|
(buffer-file-name)))
|
|
<span class="string">"*html*"</span>)))
|
|
(completed nil))
|
|
(<span class="keyword">unwind-protect</span>
|
|
(<span class="keyword">let*</span> ((buffer-faces (htmlize-faces-in-buffer))
|
|
(face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
|
|
(places (gensym))
|
|
(title (<span class="keyword">if</span> (buffer-file-name)
|
|
(file-name-nondirectory (buffer-file-name))
|
|
(buffer-name))))
|
|
(<span class="keyword">when</span> htmlize-generate-hyperlinks
|
|
(htmlize-create-auto-links))
|
|
(<span class="keyword">when</span> htmlize-replace-form-feeds
|
|
(htmlize-shadow-form-feeds))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Initialize HTMLBUF and insert the HTML prolog.
|
|
</span> (<span class="keyword">with-current-buffer</span> htmlbuf
|
|
(buffer-disable-undo)
|
|
(insert (htmlize-method doctype) ?\n
|
|
(format <span class="string">"<!-- Created by htmlize-%s in %s mode. -->\n"</span>
|
|
htmlize-version htmlize-output-type)
|
|
<span class="string">"<html>\n "</span>)
|
|
(put places 'head-start (point-marker))
|
|
(insert <span class="string">"<head>\n"</span>
|
|
<span class="string">" <title>"</span> (htmlize-protect-string title) <span class="string">"</title>\n"</span>
|
|
(<span class="keyword">if</span> htmlize-html-charset
|
|
(format (concat <span class="string">" <meta http-equiv=\"Content-Type\" "</span>
|
|
<span class="string">"content=\"text/html; charset=%s\">\n"</span>)
|
|
htmlize-html-charset)
|
|
<span class="string">""</span>)
|
|
htmlize-head-tags)
|
|
(htmlize-method insert-head buffer-faces face-map)
|
|
(insert <span class="string">" </head>"</span>)
|
|
(put places 'head-end (point-marker))
|
|
(insert <span class="string">"\n "</span>)
|
|
(put places 'body-start (point-marker))
|
|
(insert (htmlize-method body-tag face-map)
|
|
<span class="string">"\n "</span>)
|
|
(put places 'content-start (point-marker))
|
|
(insert <span class="string">"<pre>\n"</span>))
|
|
(<span class="keyword">let</span> ((text-markup
|
|
<span class="comment-delimiter">;; </span><span class="comment">Get the inserter method, so we can funcall it inside
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">the loop. Not calling `</span><span class="comment"><span class="constant">htmlize-method</span></span><span class="comment">' in the loop
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">body yields a measurable speed increase.
|
|
</span> (htmlize-method-function 'text-markup))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Declare variables used in loop body outside the loop
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">because it's faster to establish `</span><span class="comment"><span class="constant">let</span></span><span class="comment">' bindings only
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">once.
|
|
</span> next-change text face-list trailing-ellipsis
|
|
fstruct-list last-fstruct-list
|
|
(close-markup (<span class="keyword">lambda</span> ())))
|
|
<span class="comment-delimiter">;; </span><span class="comment">This loop traverses and reads the source buffer, appending
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">the resulting HTML to HTMLBUF. This method is fast
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">because: 1) it doesn't require examining the text
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">properties char by char (htmlize-next-face-change is used
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">to move between runs with the same face), and 2) it doesn't
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">require frequent buffer switches, which are slow because
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">they rebind all buffer-local vars.
|
|
</span> (goto-char (point-min))
|
|
(<span class="keyword">while</span> (not (eobp))
|
|
(setq next-change (htmlize-next-face-change (point)))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Get faces in use between (point) and NEXT-CHANGE, and
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">convert them to fstructs.
|
|
</span> (setq face-list (htmlize-faces-at-point)
|
|
fstruct-list (delq nil (mapcar (<span class="keyword">lambda</span> (f)
|
|
(gethash f face-map))
|
|
face-list)))
|
|
(multiple-value-setq (text trailing-ellipsis)
|
|
(htmlize-extract-text (point) next-change trailing-ellipsis))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Don't bother writing anything if there's no text (this
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">happens in invisible regions).
|
|
</span> (<span class="keyword">when</span> (> (length text) 0)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Open the new markup if necessary and insert the text.
|
|
</span> (<span class="keyword">when</span> (not (equalp fstruct-list last-fstruct-list))
|
|
(funcall close-markup)
|
|
(setq last-fstruct-list fstruct-list
|
|
close-markup (funcall text-markup fstruct-list htmlbuf)))
|
|
(princ text htmlbuf))
|
|
(goto-char next-change))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">We've gone through the buffer; close the markup from
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">the last run, if any.
|
|
</span> (funcall close-markup))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Insert the epilog and post-process the buffer.
|
|
</span> (<span class="keyword">with-current-buffer</span> htmlbuf
|
|
(insert <span class="string">"</pre>"</span>)
|
|
(put places 'content-end (point-marker))
|
|
(insert <span class="string">"\n </body>"</span>)
|
|
(put places 'body-end (point-marker))
|
|
(insert <span class="string">"\n</html>\n"</span>)
|
|
(htmlize-defang-local-variables)
|
|
(goto-char (point-min))
|
|
(<span class="keyword">when</span> htmlize-html-major-mode
|
|
<span class="comment-delimiter">;; </span><span class="comment">What sucks about this is that the minor modes, most notably
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">font-lock-mode, won't be initialized. Oh well.
|
|
</span> (funcall htmlize-html-major-mode))
|
|
(set (make-local-variable 'htmlize-buffer-places)
|
|
(symbol-plist places))
|
|
(run-hooks 'htmlize-after-hook)
|
|
(buffer-enable-undo))
|
|
(setq completed t)
|
|
htmlbuf)
|
|
|
|
(<span class="keyword">when</span> (not completed)
|
|
(kill-buffer htmlbuf))
|
|
(htmlize-delete-tmp-overlays)))))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Utility functions.
|
|
</span>
|
|
(<span class="keyword">defmacro</span> <span class="function-name">htmlize-with-fontify-message</span> (<span class="type">&rest</span> body)
|
|
<span class="comment-delimiter">;; </span><span class="comment">When forcing fontification of large buffers in
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">htmlize-ensure-fontified, inform the user that he is waiting for
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">font-lock, not for htmlize to finish.
|
|
</span> `(<span class="keyword">progn</span>
|
|
(<span class="keyword">if</span> (> (buffer-size) 65536)
|
|
(message <span class="string">"Forcing fontification of %s..."</span>
|
|
(buffer-name (current-buffer))))
|
|
,@body
|
|
(<span class="keyword">if</span> (> (buffer-size) 65536)
|
|
(message <span class="string">"Forcing fontification of %s...done"</span>
|
|
(buffer-name (current-buffer))))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-ensure-fontified</span> ()
|
|
<span class="comment-delimiter">;; </span><span class="comment">If font-lock is being used, ensure that the "support" modes
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">actually fontify the buffer. If font-lock is not in use, we
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">don't care because, except in htmlize-file, we don't force
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">font-lock on the user.
|
|
</span> (<span class="keyword">when</span> (and (boundp 'font-lock-mode)
|
|
font-lock-mode)
|
|
<span class="comment-delimiter">;; </span><span class="comment">In part taken from ps-print-ensure-fontified in GNU Emacs 21.
|
|
</span> (<span class="keyword">cond</span>
|
|
((and (boundp 'jit-lock-mode)
|
|
(symbol-value 'jit-lock-mode))
|
|
(htmlize-with-fontify-message
|
|
(jit-lock-fontify-now (point-min) (point-max))))
|
|
((and (boundp 'lazy-lock-mode)
|
|
(symbol-value 'lazy-lock-mode))
|
|
(htmlize-with-fontify-message
|
|
(lazy-lock-fontify-region (point-min) (point-max))))
|
|
((and (boundp 'lazy-shot-mode)
|
|
(symbol-value 'lazy-shot-mode))
|
|
(htmlize-with-fontify-message
|
|
<span class="comment-delimiter">;; </span><span class="comment">lazy-shot is amazing in that it must *refontify* the region,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">even if the whole buffer has already been fontified. <sigh>
|
|
</span> (lazy-shot-fontify-region (point-min) (point-max))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">There's also fast-lock, but we don't need to handle specially,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">I think. fast-lock doesn't really defer fontification, it
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">just saves it to an external cache so it's not done twice.
|
|
</span> )))
|
|
|
|
<hr />
|
|
<span class="comment-delimiter">;;;</span><span class="comment">###</span><span class="comment"><span class="warning">autoload</span></span><span class="comment">
|
|
</span>(<span class="keyword">defun</span> <span class="function-name">htmlize-buffer</span> (<span class="type">&optional</span> buffer)
|
|
<span class="doc">"Convert BUFFER to HTML, preserving colors and decorations.
|
|
|
|
The generated HTML is available in a new buffer, which is returned.
|
|
When invoked interactively, the new buffer is selected in the current
|
|
window. The title of the generated document will be set to the buffer's
|
|
file name or, if that's not available, to the buffer's name.
|
|
|
|
Note that htmlize doesn't fontify your buffers, it only uses the
|
|
decorations that are already present. If you don't set up font-lock or
|
|
something else to fontify your buffers, the resulting HTML will be
|
|
plain. Likewise, if you don't like the choice of colors, fix the mode
|
|
that created them, or simply alter the faces it uses."</span>
|
|
(interactive)
|
|
(<span class="keyword">let</span> ((htmlbuf (<span class="keyword">with-current-buffer</span> (or buffer (current-buffer))
|
|
(htmlize-buffer-1))))
|
|
(<span class="keyword">when</span> (interactive-p)
|
|
(switch-to-buffer htmlbuf))
|
|
htmlbuf))
|
|
|
|
<span class="comment-delimiter">;;;</span><span class="comment">###</span><span class="comment"><span class="warning">autoload</span></span><span class="comment">
|
|
</span>(<span class="keyword">defun</span> <span class="function-name">htmlize-region</span> (beg end)
|
|
<span class="doc">"Convert the region to HTML, preserving colors and decorations.
|
|
See `</span><span class="doc"><span class="constant">htmlize-buffer</span></span><span class="doc">' for details."</span>
|
|
(interactive <span class="string">"r"</span>)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Don't let zmacs region highlighting end up in HTML.
|
|
</span> (<span class="keyword">when</span> (fboundp 'zmacs-deactivate-region)
|
|
(zmacs-deactivate-region))
|
|
(<span class="keyword">let</span> ((htmlbuf (<span class="keyword">save-restriction</span>
|
|
(narrow-to-region beg end)
|
|
(htmlize-buffer-1))))
|
|
(<span class="keyword">when</span> (interactive-p)
|
|
(switch-to-buffer htmlbuf))
|
|
htmlbuf))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-region-for-paste</span> (beg end)
|
|
<span class="doc">"Htmlize the region and return just the HTML as a string.
|
|
This forces the `</span><span class="doc"><span class="constant">inline-css</span></span><span class="doc">' style and only returns the HTML body,
|
|
but without the BODY tag. This should make it useful for inserting
|
|
the text to another HTML buffer."</span>
|
|
(<span class="keyword">let*</span> ((htmlize-output-type 'inline-css)
|
|
(htmlbuf (htmlize-region beg end)))
|
|
(<span class="keyword">unwind-protect</span>
|
|
(<span class="keyword">with-current-buffer</span> htmlbuf
|
|
(buffer-substring (plist-get htmlize-buffer-places 'content-start)
|
|
(plist-get htmlize-buffer-places 'content-end)))
|
|
(kill-buffer htmlbuf))))
|
|
|
|
(<span class="keyword">defun</span> <span class="function-name">htmlize-make-file-name</span> (file)
|
|
<span class="doc">"Make an HTML file name from FILE.
|
|
|
|
In its default implementation, this simply appends `</span><span class="doc"><span class="constant">.html</span></span><span class="doc">' to FILE.
|
|
This function is called by htmlize to create the buffer file name, and
|
|
by `</span><span class="doc"><span class="constant">htmlize-file</span></span><span class="doc">' to create the target file name.
|
|
|
|
More elaborate transformations are conceivable, such as changing FILE's
|
|
extension to `</span><span class="doc"><span class="constant">.html</span></span><span class="doc">' (\"file.c\" -> \"file.html\"). If you want them,
|
|
overload this function to do it and htmlize will comply."</span>
|
|
(concat file <span class="string">".html"</span>))
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Older implementation of htmlize-make-file-name that changes FILE's
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">extension to ".html".
|
|
</span><span class="comment-delimiter">;</span><span class="comment">(defun htmlize-make-file-name (file)
|
|
</span><span class="comment-delimiter">; </span><span class="comment">(let ((extension (file-name-extension file))
|
|
</span><span class="comment-delimiter">;</span><span class="comment"> (sans-extension (file-name-sans-extension file)))
|
|
</span><span class="comment-delimiter">; </span><span class="comment">(if (or (equal extension "html")
|
|
</span><span class="comment-delimiter">;</span><span class="comment"> (equal extension "htm")
|
|
</span><span class="comment-delimiter">;</span><span class="comment"> (equal sans-extension ""))
|
|
</span><span class="comment-delimiter">;</span><span class="comment"> (concat file ".html")
|
|
</span><span class="comment-delimiter">; </span><span class="comment">(concat sans-extension ".html"))))
|
|
</span>
|
|
<span class="comment-delimiter">;;;</span><span class="comment">###</span><span class="comment"><span class="warning">autoload</span></span><span class="comment">
|
|
</span>(<span class="keyword">defun</span> <span class="function-name">htmlize-file</span> (file <span class="type">&optional</span> target)
|
|
<span class="doc">"Load FILE, fontify it, convert it to HTML, and save the result.
|
|
|
|
Contents of FILE are inserted into a temporary buffer, whose major mode
|
|
is set with `</span><span class="doc"><span class="constant">normal-mode</span></span><span class="doc">' as appropriate for the file type. The buffer
|
|
is subsequently fontified with `</span><span class="doc"><span class="constant">font-lock</span></span><span class="doc">' and converted to HTML. Note
|
|
that, unlike `</span><span class="doc"><span class="constant">htmlize-buffer</span></span><span class="doc">', this function explicitly turns on
|
|
font-lock. If a form of highlighting other than font-lock is desired,
|
|
please use `</span><span class="doc"><span class="constant">htmlize-buffer</span></span><span class="doc">' directly on buffers so highlighted.
|
|
|
|
Buffers currently visiting FILE are unaffected by this function. The
|
|
function does not change current buffer or move the point.
|
|
|
|
If TARGET is specified and names a directory, the resulting file will be
|
|
saved there instead of to FILE's directory. If TARGET is specified and
|
|
does not name a directory, it will be used as output file name."</span>
|
|
(interactive (list (read-file-name
|
|
<span class="string">"HTML-ize file: "</span>
|
|
nil nil nil (and (buffer-file-name)
|
|
(file-name-nondirectory
|
|
(buffer-file-name))))))
|
|
(<span class="keyword">let</span> ((output-file (<span class="keyword">if</span> (and target (not (file-directory-p target)))
|
|
target
|
|
(expand-file-name
|
|
(htmlize-make-file-name (file-name-nondirectory file))
|
|
(or target (file-name-directory file)))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Try to prevent `</span><span class="comment"><span class="constant">find-file-noselect</span></span><span class="comment">' from triggering
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">font-lock because we'll fontify explicitly below.
|
|
</span> (font-lock-mode nil)
|
|
(font-lock-auto-fontify nil)
|
|
(global-font-lock-mode nil)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Ignore the size limit for the purposes of htmlization.
|
|
</span> (font-lock-maximum-size nil)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Disable font-lock support modes. This will only work in
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">more recent Emacs versions, so htmlize-buffer-1 still needs
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">to call htmlize-ensure-fontified.
|
|
</span> (font-lock-support-mode nil))
|
|
(<span class="keyword">with-temp-buffer</span>
|
|
<span class="comment-delimiter">;; </span><span class="comment">Insert FILE into the temporary buffer.
|
|
</span> (insert-file-contents file)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Set the file name so normal-mode and htmlize-buffer-1 pick it
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">up. Restore it afterwards so with-temp-buffer's kill-buffer
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">doesn't complain about killing a modified buffer.
|
|
</span> (<span class="keyword">let</span> ((buffer-file-name file))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Set the major mode for the sake of font-lock.
|
|
</span> (normal-mode)
|
|
(font-lock-mode 1)
|
|
(<span class="keyword">unless</span> font-lock-mode
|
|
<span class="comment-delimiter">;; </span><span class="comment">In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">contrary to the documentation. This seems to work.
|
|
</span> (font-lock-fontify-buffer))
|
|
<span class="comment-delimiter">;; </span><span class="comment">htmlize the buffer and save the HTML.
|
|
</span> (<span class="keyword">with-current-buffer</span> (htmlize-buffer-1)
|
|
(<span class="keyword">unwind-protect</span>
|
|
(<span class="keyword">progn</span>
|
|
(run-hooks 'htmlize-file-hook)
|
|
(write-region (point-min) (point-max) output-file))
|
|
(kill-buffer (current-buffer)))))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">I haven't decided on a useful return value yet, so just return
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">nil.
|
|
</span> nil)
|
|
|
|
<span class="comment-delimiter">;;;</span><span class="comment">###</span><span class="comment"><span class="warning">autoload</span></span><span class="comment">
|
|
</span>(<span class="keyword">defun</span> <span class="function-name">htmlize-many-files</span> (files <span class="type">&optional</span> target-directory)
|
|
<span class="doc">"Convert FILES to HTML and save the corresponding HTML versions.
|
|
|
|
FILES should be a list of file names to convert. This function calls
|
|
`</span><span class="doc"><span class="constant">htmlize-file</span></span><span class="doc">' on each file; see that function for details. When
|
|
invoked interactively, you are prompted for a list of files to convert,
|
|
terminated with RET.
|
|
|
|
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."</span>
|
|
(interactive
|
|
(list
|
|
(<span class="keyword">let</span> (list file)
|
|
<span class="comment-delimiter">;; </span><span class="comment">Use empty string as DEFAULT because setting DEFAULT to nil
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">defaults to the directory name, which is not what we want.
|
|
</span> (<span class="keyword">while</span> (not (equal (setq file (read-file-name
|
|
<span class="string">"HTML-ize file (RET to finish): "</span>
|
|
(and list (file-name-directory
|
|
(car list)))
|
|
<span class="string">""</span> t))
|
|
<span class="string">""</span>))
|
|
(push file list))
|
|
(nreverse list))))
|
|
<span class="comment-delimiter">;; </span><span class="comment">Verify that TARGET-DIRECTORY is indeed a directory. If it's a
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">file, htmlize-file will use it as target, and that doesn't make
|
|
</span> <span class="comment-delimiter">;; </span><span class="comment">sense.
|
|
</span> (and target-directory
|
|
(not (file-directory-p target-directory))
|
|
(<span class="warning">error</span> <span class="string">"target-directory must name a directory: %s"</span> target-directory))
|
|
(<span class="keyword">dolist</span> (file files)
|
|
(htmlize-file file target-directory)))
|
|
|
|
<span class="comment-delimiter">;;;</span><span class="comment">###</span><span class="comment"><span class="warning">autoload</span></span><span class="comment">
|
|
</span>(<span class="keyword">defun</span> <span class="function-name">htmlize-many-files-dired</span> (arg <span class="type">&optional</span> target-directory)
|
|
<span class="doc">"HTMLize dired-marked files."</span>
|
|
(interactive <span class="string">"P"</span>)
|
|
(htmlize-many-files (dired-get-marked-files nil arg) target-directory))
|
|
|
|
(<span class="keyword">provide</span> '<span class="constant">htmlize</span>)
|
|
|
|
<span class="comment-delimiter">;; </span><span class="comment">Local Variables:
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">byte-compile-warnings: (not cl-functions lexical unresolved obsolete)
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">lexical-binding: t
|
|
</span><span class="comment-delimiter">;; </span><span class="comment">End:
|
|
</span>
|
|
<span class="comment-delimiter">;;; </span><span class="comment">htmlize.el ends here
|
|
</span></pre>
|
|
</body>
|
|
</html>
|