Browse files

random stuff

  • Loading branch information...
1 parent d06f5a8 commit cdb5ead4f542f354f3b4506eb364a7bc51651d32 @jrockway committed Dec 17, 2008
Showing with 3,107 additions and 0 deletions.
  1. +1,769 −0 htmlize.el
  2. +1,338 −0 lua-mode.el
View
1,769 htmlize.el
@@ -0,0 +1,1769 @@
+;; htmlize.el -- Convert buffer text and decorations to HTML.
+
+;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005,2006 Hrvoje Niksic
+
+;; Author: Hrvoje Niksic <hniksic@xemacs.org>
+;; Keywords: hypermedia, extensions
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package converts the buffer text and the associated
+;; decorations to HTML. Mail to <hniksic@xemacs.org> to discuss
+;; features and additions. All suggestions are more than welcome.
+
+;; To use this, just switch to the buffer you want HTML-ized and type
+;; `M-x htmlize-buffer'. You will be switched to a new buffer that
+;; contains the resulting HTML code. You can edit and inspect this
+;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file'
+;; will find a file, fontify it, and save the HTML version in
+;; FILE.html, without any additional intervention. `M-x
+;; htmlize-many-files' allows you to htmlize any number of files in
+;; the same manner. `M-x htmlize-many-files-dired' does the same for
+;; files marked in a dired buffer.
+
+;; htmlize supports three types of HTML output, selected by setting
+;; `htmlize-output-type': `css', `inline-css', and `font'. In `css'
+;; mode, htmlize uses cascading style sheets to specify colors; it
+;; generates classes that correspond to Emacs faces and uses <span
+;; class=FACE>...</span> to color parts of text. In this mode, the
+;; produced HTML is valid under the 4.01 strict DTD, as confirmed by
+;; the W3C validator. `inline-css' is like `css', except the CSS is
+;; put directly in the STYLE attribute of the SPAN element, making it
+;; possible to paste the generated HTML to other documents. In `font'
+;; mode, htmlize uses <font color="...">...</font> to colorize HTML,
+;; which is not standard-compliant, but works better in older
+;; browsers. `css' mode is the default.
+
+;; You can also use htmlize from your Emacs Lisp code. When called
+;; non-interactively, `htmlize-buffer' and `htmlize-region' will
+;; return the resulting HTML buffer, but will not change current
+;; buffer or move the point.
+
+;; I tried to make the package elisp-compatible with multiple Emacsen,
+;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please
+;; let me know if it doesn't work on some of those, and I'll try to
+;; fix it. I relied heavily on the presence of CL extensions,
+;; especially for cross-emacs compatibility; please don't try to
+;; remove that particular dependency. When byte-compiling under GNU
+;; Emacs, you're likely to get some warnings; just ignore them.
+
+;; The latest version should be available at:
+;;
+;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el>
+;;
+;; You can find a sample of htmlize's output (possibly generated with
+;; an older version) at:
+;;
+;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html>
+
+;; Thanks go to the multitudes of people who have sent reports and
+;; contributed comments, suggestions, and fixes. They include Ron
+;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri
+;; Linkov, Maciek Pasternacki, and many others.
+
+;; User quotes: "You sir, are a sick, sick, _sick_ person. :)"
+;; -- Bill Perry, author of Emacs/W3
+
+
+;;; Code:
+
+(require 'cl)
+(eval-when-compile
+ (if (string-match "XEmacs" emacs-version)
+ (byte-compiler-options
+ (warnings (- unresolved))))
+ (defvar font-lock-auto-fontify)
+ (defvar font-lock-support-mode)
+ (defvar global-font-lock-mode)
+ (when (and (eq emacs-major-version 19)
+ (not (string-match "XEmacs" emacs-version)))
+ ;; Older versions of GNU Emacs fail to autoload cl-extra even when
+ ;; `cl' is loaded.
+ (load "cl-extra")))
+
+(defconst htmlize-version "1.34")
+
+;; Incantations to make custom stuff work without customize, e.g. on
+;; XEmacs 19.14 or GNU Emacs 19.34.
+(eval-and-compile
+ (condition-case ()
+ (require 'custom)
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ; we've got what we needed
+ ;; No custom or obsolete custom, define surrogates. Define all
+ ;; three macros, so we don't hose another library that expects
+ ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds.
+ (defmacro defgroup (&rest ignored) nil)
+ (defmacro defcustom (var value doc &rest ignored)
+ `(defvar ,var ,value ,doc))
+ (defmacro defface (face value doc &rest stuff)
+ `(make-face ,face))))
+
+(defgroup htmlize nil
+ "Convert buffer text and faces to HTML."
+ :group 'hypermedia)
+
+(defcustom htmlize-head-tags ""
+ "*Additional tags to insert within HEAD of the generated document."
+ :type 'string
+ :group 'htmlize)
+
+(defcustom htmlize-output-type 'css
+ "*Output type of generated HTML, one of `css', `inline-css', or `font'.
+When set to `css' (the default), htmlize will generate a style sheet
+with description of faces, and use it in the HTML document, specifying
+the faces in the actual text with <span class=\"FACE\">.
+
+When set to `inline-css', 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 `font', the properties will be set using layout tags
+<font>, <b>, <i>, <u>, and <strike>.
+
+`css' output is normally preferred, but `font' is still useful for
+supporting old, pre-CSS browsers, and both `inline-css' and `font' for
+easier embedding of colorized text in foreign HTML documents (no style
+sheet to carry around)."
+ :type '(choice (const css) (const inline-css) (const font))
+ :group 'htmlize)
+
+(defcustom htmlize-generate-hyperlinks t
+ "*Non-nil means generate the hyperlinks for URLs and mail addresses.
+This is on by default; set it to nil if you don't want htmlize to
+insert hyperlinks in the resulting HTML. (In which case you can still
+do your own hyperlinkification from htmlize-after-hook.)"
+ :type 'boolean
+ :group 'htmlize)
+
+(defcustom htmlize-hyperlink-style "
+ a {
+ color: inherit;
+ background-color: inherit;
+ font: inherit;
+ text-decoration: inherit;
+ }
+ a:hover {
+ text-decoration: underline;
+ }
+"
+ "*The CSS style used for hyperlinks when in CSS mode."
+ :type 'string
+ :group 'htmlize)
+
+(defcustom htmlize-replace-form-feeds t
+ "*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."
+ :type 'boolean
+ :group 'htmlize)
+
+(defcustom htmlize-html-charset nil
+ "*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. (Under Mule
+that is done by ensuring the correct \"file coding system\" for the
+buffer.) If you don't understand what that means, this option is
+probably not for you."
+ :type '(choice (const :tag "Unset" nil)
+ string)
+ :group 'htmlize)
+
+(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule)
+ "*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
+`htmlize-html-charset'.)
+
+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;\".
+
+By default, entity conversion is turned on for Mule-enabled Emacsen and
+turned off otherwise. This is because Mule knows the charset of
+non-ASCII characters in the buffer. A non-Mule Emacs cannot tell
+whether a character with code 0xA9 represents Latin 1 copyright symbol,
+Latin 2 \"S with caron\", or something else altogether. Setting this to
+t without Mule means asserting that 128-255 characters always mean Latin
+1.
+
+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."
+ :type 'sexp
+ :group 'htmlize)
+
+(defcustom htmlize-ignore-face-size 'absolute
+ "*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 `absolute', only absolute size specifications are ignored.
+Please note that font sizes only work with CSS-based output types."
+ :type '(choice (const :tag "Don't ignore" nil)
+ (const :tag "Ignore all" t)
+ (const :tag "Ignore absolute" absolute))
+ :group 'htmlize)
+
+(defcustom htmlize-css-name-prefix ""
+ "*The prefix used for CSS names.
+The CSS names that htmlize generates from face names are often too
+generic for CSS files; for example, `font-lock-type-face' is transformed
+to `type'. Use this variable to add a prefix to the generated names.
+The string \"htmlize-\" is an example of a reasonable prefix."
+ :type 'string
+ :group 'htmlize)
+
+(defcustom htmlize-use-rgb-txt t
+ "*Whether `rgb.txt' 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. `rgb.txt'
+is the X color database that maps hundreds of color names to such RGB
+triples. When this variable is non-nil, `htmlize' uses `rgb.txt' to
+look up color names.
+
+If this variable is nil, htmlize queries Emacs for RGB components of
+colors using `color-instance-rgb-components' and `x-color-values'.
+This can yield incorrect results on non-true-color displays.
+
+If the `rgb.txt' file is not found (which will be the case if you're
+running Emacs on non-X11 systems), this option is ignored."
+ :type 'boolean
+ :group 'htmlize)
+
+(defcustom htmlize-html-major-mode nil
+ "The mode the newly created HTML buffer will be put in.
+Set this to nil if you prefer the default (fundamental) mode."
+ :type '(radio (const :tag "No mode (fundamental)" nil)
+ (function-item html-mode)
+ (function :tag "User-defined major mode"))
+ :group 'htmlize)
+
+(defvar htmlize-before-hook nil
+ "Hook run before htmlizing a buffer.
+The hook functions are run in the source buffer (not the resulting HTML
+buffer).")
+
+(defvar htmlize-after-hook nil
+ "Hook run after htmlizing a buffer.
+Unlike `htmlize-before-hook', these functions are run in the generated
+HTML buffer. You may use them to modify the outlook of the final HTML
+output.")
+
+(defvar htmlize-file-hook nil
+ "Hook run by `htmlize-file' after htmlizing a file, but before saving it.")
+
+(defvar htmlize-buffer-places)
+
+;;; Some cross-Emacs compatibility.
+
+;; I try to conditionalize on features rather than Emacs version, but
+;; in some cases checking against the version *is* necessary.
+(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version))
+
+(eval-and-compile
+ ;; save-current-buffer, with-current-buffer, and with-temp-buffer
+ ;; are not available in 19.34 and in older XEmacsen. Strictly
+ ;; speaking, we should stick to our own namespace and define and use
+ ;; htmlize-save-current-buffer, etc. But non-standard special forms
+ ;; are a pain because they're not properly fontified or indented and
+ ;; because they look weird and ugly. So I'll just go ahead and
+ ;; define the real ones if they're not available. If someone
+ ;; convinces me that this breaks something, I'll switch to the
+ ;; "htmlize-" namespace.
+ (unless (fboundp 'save-current-buffer)
+ (defmacro save-current-buffer (&rest forms)
+ `(let ((__scb_current (current-buffer)))
+ (unwind-protect
+ (progn ,@forms)
+ (set-buffer __scb_current)))))
+ (unless (fboundp 'with-current-buffer)
+ (defmacro with-current-buffer (buffer &rest forms)
+ `(save-current-buffer (set-buffer ,buffer) ,@forms)))
+ (unless (fboundp 'with-temp-buffer)
+ (defmacro with-temp-buffer (&rest forms)
+ (let ((temp-buffer (gensym "tb-")))
+ `(let ((,temp-buffer
+ (get-buffer-create (generate-new-buffer-name " *temp*"))))
+ (unwind-protect
+ (with-current-buffer ,temp-buffer
+ ,@forms)
+ (and (buffer-live-p ,temp-buffer)
+ (kill-buffer ,temp-buffer))))))))
+
+;; We need a function that efficiently finds the next change of a
+;; property (usually `face'), preferably regardless of whether the
+;; change occurred because of a text property or an extent/overlay.
+;; As it turns out, it is not easy to do that compatibly.
+;;
+;; Under XEmacs, `next-single-property-change' does that. Under GNU
+;; Emacs beginning with version 21, `next-single-char-property-change'
+;; is available and does the same. GNU Emacs 20 had
+;; `next-char-property-change', which we can use. GNU Emacs 19 didn't
+;; provide any means for simultaneously examining overlays and text
+;; properties, so when using Emacs 19.34, we punt and fall back to
+;; `next-single-property-change', thus ignoring overlays altogether.
+
+(cond
+ (htmlize-running-xemacs
+ ;; XEmacs: good.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (next-single-property-change pos prop nil (or limit (point-max)))))
+ ((fboundp 'next-single-char-property-change)
+ ;; GNU Emacs 21: good.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (next-single-char-property-change pos prop nil limit)))
+ ((fboundp 'next-char-property-change)
+ ;; GNU Emacs 20: bad, but fixable.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (let ((done nil)
+ (current-value (get-char-property pos prop))
+ newpos next-value)
+ ;; Loop over positions returned by next-char-property-change
+ ;; until the value of PROP changes or we've hit EOB.
+ (while (not done)
+ (setq newpos (next-char-property-change pos limit)
+ next-value (get-char-property newpos prop))
+ (cond ((eq newpos pos)
+ ;; Possibly at EOB? Whatever, just don't infloop.
+ (setq done t))
+ ((eq next-value current-value)
+ ;; PROP hasn't changed -- keep looping.
+ )
+ (t
+ (setq done t)))
+ (setq pos newpos))
+ pos)))
+ (t
+ ;; GNU Emacs 19.34: hopeless, cannot properly support overlays.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (unless limit
+ (setq limit (point-max)))
+ (let ((res (next-single-property-change pos prop)))
+ (if (or (null res)
+ (> res limit))
+ limit
+ res)))))
+
+;;; Transformation of buffer text: HTML escapes, untabification, etc.
+
+(defvar htmlize-basic-character-table
+ ;; Map characters in the 0-127 range to either one-character strings
+ ;; or to numeric entities.
+ (let ((table (make-vector 128 ?\0)))
+ ;; Map characters in the 32-126 range to themselves, others to
+ ;; &#CODE entities;
+ (dotimes (i 128)
+ (setf (aref table i) (if (and (>= i 32) (<= i 126))
+ (char-to-string i)
+ (format "&#%d;" i))))
+ ;; Set exceptions manually.
+ (setf
+ ;; Don't escape newline, carriage return, and TAB.
+ (aref table ?\n) "\n"
+ (aref table ?\r) "\r"
+ (aref table ?\t) "\t"
+ ;; Escape &, <, and >.
+ (aref table ?&) "&amp;"
+ (aref table ?<) "&lt;"
+ (aref table ?>) "&gt;"
+ ;; Not escaping '"' buys us a measurable speedup. It's only
+ ;; necessary to quote it for strings used in attribute values,
+ ;; which htmlize doesn't do.
+ ;(aref table ?\") "&quot;"
+ )
+ table))
+
+;; A cache of HTML representation of non-ASCII characters. Depending
+;; on availability of `encode-char' and the setting of
+;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII
+;; characters to either "&#<code>;" or "<char>" (mapconcat's mapper
+;; must always return strings). It's only filled as characters are
+;; encountered, so that in a buffer with e.g. French text, it will
+;; only ever contain French accented characters as keys. It's cleared
+;; on each entry to htmlize-buffer-1 to allow modifications of
+;; `htmlize-convert-nonascii-to-entities' to take effect.
+(defvar htmlize-extended-character-cache (make-hash-table :test 'eq))
+
+(defun htmlize-protect-string (string)
+ "HTML-protect string, escaping HTML metacharacters and I18N chars."
+ ;; Only protecting strings that actually contain unsafe or non-ASCII
+ ;; chars removes a lot of unnecessary funcalls and consing.
+ (if (not (string-match "[^\r\n\t -%'-;=?-~]" string))
+ string
+ (mapconcat (lambda (char)
+ (cond
+ ((< char 128)
+ ;; ASCII: use htmlize-basic-character-table.
+ (aref htmlize-basic-character-table char))
+ ((gethash char htmlize-extended-character-cache)
+ ;; We've already seen this char; return the cached
+ ;; string.
+ )
+ ((not htmlize-convert-nonascii-to-entities)
+ ;; If conversion to entities is not desired, always
+ ;; copy the char literally.
+ (setf (gethash char htmlize-extended-character-cache)
+ (char-to-string char)))
+ ((< char 256)
+ ;; Latin 1: no need to call encode-char.
+ (setf (gethash char htmlize-extended-character-cache)
+ (format "&#%d;" char)))
+ ((and (fboundp 'encode-char)
+ ;; Must check if encode-char works for CHAR;
+ ;; it fails for Arabic and possibly elsewhere.
+ (encode-char char 'ucs))
+ (setf (gethash char htmlize-extended-character-cache)
+ (format "&#%d;" (encode-char char 'ucs))))
+ (t
+ ;; encode-char doesn't work for this char. Copy it
+ ;; unchanged and hope for the best.
+ (setf (gethash char htmlize-extended-character-cache)
+ (char-to-string char)))))
+ string "")))
+
+(defconst htmlize-ellipsis "...")
+(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
+
+(defun htmlize-buffer-substring-no-invisible (beg end)
+ ;; Like buffer-substring-no-properties, but don't copy invisible
+ ;; parts of the region. Where buffer-substring-no-properties
+ ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
+ (let ((pos beg)
+ visible-list invisible show next-change)
+ ;; Iterate over the changes in the `invisible' property and filter
+ ;; out the portions where it's non-nil, i.e. where the text is
+ ;; invisible.
+ (while (< pos end)
+ (setq invisible (get-char-property pos 'invisible)
+ next-change (htmlize-next-change pos 'invisible end))
+ (if (not (listp buffer-invisibility-spec))
+ ;; If buffer-invisibility-spec is not a list, then all
+ ;; characters with non-nil `invisible' property are visible.
+ (setq show (not invisible))
+ ;; Otherwise, the value of a non-nil `invisible' property can be:
+ ;; 1. a symbol -- make the text invisible if it matches
+ ;; buffer-invisibility-spec.
+ ;; 2. a list of symbols -- make the text invisible if
+ ;; any symbol in the list matches
+ ;; buffer-invisibility-spec.
+ ;; If the match of buffer-invisibility-spec has a non-nil
+ ;; CDR, replace the invisible text with an ellipsis.
+ (let (match)
+ (if (symbolp invisible)
+ (setq match (member* invisible buffer-invisibility-spec
+ :key (lambda (i)
+ (if (symbolp i) i (car i)))))
+ (setq match (block nil
+ (dolist (elem invisible)
+ (let ((m (member*
+ elem buffer-invisibility-spec
+ :key (lambda (i)
+ (if (symbolp i) i (car i))))))
+ (when m (return m))))
+ nil)))
+ (setq show (cond ((null match) t)
+ ((and (cdr-safe (car match))
+ ;; Conflate successive ellipses.
+ (not (eq show htmlize-ellipsis)))
+ htmlize-ellipsis)
+ (t nil)))))
+ (cond ((eq show t)
+ (push (buffer-substring-no-properties pos next-change) visible-list))
+ ((stringp show)
+ (push show visible-list)))
+ (setq pos next-change))
+ (if (= (length visible-list) 1)
+ ;; If VISIBLE-LIST consists of only one element, return it
+ ;; without concatenation. This avoids additional consing in
+ ;; regions without any invisible text.
+ (car visible-list)
+ (apply #'concat (nreverse visible-list)))))
+
+(defun htmlize-trim-ellipsis (text)
+ ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it
+ ;; starts with it. It checks for the special property of the
+ ;; ellipsis so it doesn't work on ordinary text that begins with
+ ;; "...".
+ (if (get-text-property 0 'htmlize-ellipsis text)
+ (substring text (length htmlize-ellipsis))
+ text))
+
+(defconst htmlize-tab-spaces
+ ;; A table of strings with spaces. (aref htmlize-tab-spaces 5) is
+ ;; like (make-string 5 ?\ ), except it doesn't cons.
+ (let ((v (make-vector 32 nil)))
+ (dotimes (i (length v))
+ (setf (aref v i) (make-string i ?\ )))
+ v))
+
+(defun htmlize-untabify (text start-column)
+ "Untabify TEXT, assuming it starts at START-COLUMN."
+ (let ((column start-column)
+ (last-match 0)
+ (chunk-start 0)
+ chunks match-pos tab-size)
+ (while (string-match "[\t\n]" text last-match)
+ (setq match-pos (match-beginning 0))
+ (cond ((eq (aref text match-pos) ?\t)
+ ;; Encountered a tab: create a chunk of text followed by
+ ;; the expanded tab.
+ (push (substring text chunk-start match-pos) chunks)
+ ;; Increase COLUMN by the length of the text we've
+ ;; skipped since last tab or newline. (Encountering
+ ;; newline resets it.)
+ (incf column (- match-pos last-match))
+ ;; Calculate tab size based on tab-width and COLUMN.
+ (setq tab-size (- tab-width (% column tab-width)))
+ ;; Expand the tab.
+ (push (aref htmlize-tab-spaces tab-size) chunks)
+ (incf column tab-size)
+ (setq chunk-start (1+ match-pos)))
+ (t
+ ;; Reset COLUMN at beginning of line.
+ (setq column 0)))
+ (setq last-match (1+ match-pos)))
+ ;; If no chunks have been allocated, it means there have been no
+ ;; tabs to expand. Return TEXT unmodified.
+ (if (null chunks)
+ text
+ (when (< chunk-start (length text))
+ ;; Push the remaining chunk.
+ (push (substring text chunk-start) chunks))
+ ;; Generate the output from the available chunks.
+ (apply #'concat (nreverse chunks)))))
+
+(defun htmlize-despam-address (string)
+ "Replace every occurrence of '@' in STRING with &#64;.
+`htmlize-make-hyperlinks' uses this to spam-protect mailto links
+without modifying their meaning."
+ ;; Suggested by Ville Skytta.
+ (while (string-match "@" string)
+ (setq string (replace-match "&#64;" nil t string)))
+ string)
+
+(defun htmlize-make-hyperlinks ()
+ "Make hyperlinks in HTML."
+ ;; Function originally submitted by Ville Skytta. Rewritten by
+ ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "&lt;\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)&gt;"
+ nil t)
+ (let ((address (match-string 3))
+ (link-text (match-string 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert "&lt;<a href=\"mailto:"
+ (htmlize-despam-address address)
+ "\">"
+ (htmlize-despam-address link-text)
+ "</a>&gt;")))
+ (goto-char (point-min))
+ (while (re-search-forward "&lt;\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)&gt;"
+ nil t)
+ (let ((url (match-string 3))
+ (link-text (match-string 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert "&lt;<a href=\"" url "\">" link-text "</a>&gt;"))))
+
+;; Tests for htmlize-make-hyperlinks:
+
+;; <mailto:hniksic@xemacs.org>
+;; <http://fly.srk.fer.hr>
+;; <URL:http://www.xemacs.org>
+;; <http://www.mail-archive.com/bbdb-info@xemacs.org/>
+;; <hniksic@xemacs.org>
+;; <xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com@xml.apache.org>
+
+(defun htmlize-defang-local-variables ()
+ ;; Juri Linkov reports that an HTML-ized "Local variables" can lead
+ ;; visiting the HTML to fail with "Local variables list is not
+ ;; properly terminated". He suggested changing the phrase to
+ ;; syntactically equivalent HTML that Emacs doesn't recognize.
+ (goto-char (point-min))
+ (while (search-forward "Local Variables:" nil t)
+ (replace-match "Local Variables&#58;" nil t)))
+
+
+;;; Color handling.
+
+(if (fboundp 'locate-file)
+ (defalias 'htmlize-locate-file 'locate-file)
+ (defun htmlize-locate-file (file path)
+ (dolist (dir path nil)
+ (when (file-exists-p (expand-file-name file dir))
+ (return (expand-file-name file dir))))))
+
+(defvar htmlize-x-library-search-path
+ '("/usr/X11R6/lib/X11/"
+ "/usr/X11R5/lib/X11/"
+ "/usr/lib/X11R6/X11/"
+ "/usr/lib/X11R5/X11/"
+ "/usr/local/X11R6/lib/X11/"
+ "/usr/local/X11R5/lib/X11/"
+ "/usr/local/lib/X11R6/X11/"
+ "/usr/local/lib/X11R5/X11/"
+ "/usr/X11/lib/X11/"
+ "/usr/lib/X11/"
+ "/usr/local/lib/X11/"
+ "/usr/X386/lib/X11/"
+ "/usr/x386/lib/X11/"
+ "/usr/XFree86/lib/X11/"
+ "/usr/unsupported/lib/X11/"
+ "/usr/athena/lib/X11/"
+ "/usr/local/x11r5/lib/X11/"
+ "/usr/lpp/Xamples/lib/X11/"
+ "/usr/openwin/lib/X11/"
+ "/usr/openwin/share/lib/X11/"))
+
+(defun htmlize-get-color-rgb-hash (&optional rgb-file)
+ "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 `rgb.txt'.
+
+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."
+ (let ((rgb-file (or rgb-file (htmlize-locate-file
+ "rgb.txt"
+ htmlize-x-library-search-path)))
+ (hash nil))
+ (when rgb-file
+ (with-temp-buffer
+ (insert-file-contents rgb-file)
+ (setq hash (make-hash-table :test 'equal))
+ (while (not (eobp))
+ (cond ((looking-at "^\\s-*\\([!#]\\|$\\)")
+ ;; Skip comments and empty lines.
+ )
+ ((looking-at
+ "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)")
+ (setf (gethash (downcase (match-string 4)) hash)
+ (format "#%02x%02x%02x"
+ (string-to-number (match-string 1))
+ (string-to-number (match-string 2))
+ (string-to-number (match-string 3)))))
+ (t
+ (error
+ "Unrecognized line in %s: %s"
+ rgb-file
+ (buffer-substring (point) (progn (end-of-line) (point))))))
+ (forward-line 1))))
+ hash))
+
+;; Compile the RGB map when loaded. On systems where rgb.txt is
+;; missing, the value of the variable will be nil, and rgb.txt will
+;; not be used.
+(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash))
+
+;;; Face handling.
+
+(defun htmlize-face-specifies-property (face prop)
+ ;; Return t if face specifies PROP, as opposed to it being inherited
+ ;; from the default face. The problem with e.g.
+ ;; `face-foreground-instance' is that it returns an instance for
+ ;; EVERY face because every face inherits from the default face.
+ ;; However, we'd like htmlize-face-{fore,back}ground to return nil
+ ;; when called with a face that doesn't specify its own foreground
+ ;; or background.
+ (or (eq face 'default)
+ (assq 'global (specifier-spec-list (face-property face prop)))))
+
+(defun htmlize-face-color-internal (face fg)
+ ;; Used only under GNU Emacs. Return the color of FACE, but don't
+ ;; return "unspecified-fg" or "unspecified-bg". If the face is
+ ;; `default' and the color is unspecified, look up the color in
+ ;; frame parameters.
+ (let* ((function (if fg #'face-foreground #'face-background))
+ color)
+ (if (>= emacs-major-version 22)
+ ;; For GNU Emacs 22+ set INHERIT to get the inherited values.
+ (setq color (funcall function face nil t))
+ (setq color (funcall function face))
+ ;; For GNU Emacs 21 (which has `face-attribute'): if the color
+ ;; is nil, recursively check for the face's parent.
+ (when (and (null color)
+ (fboundp 'face-attribute)
+ (face-attribute face :inherit)
+ (not (eq (face-attribute face :inherit) 'unspecified)))
+ (setq color (htmlize-face-color-internal
+ (face-attribute face :inherit) fg))))
+ (when (and (eq face 'default) (null color))
+ (setq color (cdr (assq (if fg 'foreground-color 'background-color)
+ (frame-parameters)))))
+ (when (or (eq color 'unspecified)
+ (equal color "unspecified-fg")
+ (equal color "unspecified-bg"))
+ (setq color nil))
+ (when (and (eq face 'default)
+ (null color))
+ ;; Assuming black on white doesn't seem right, but I can't think
+ ;; of anything better to do.
+ (setq color (if fg "black" "white")))
+ color))
+
+(defun htmlize-face-foreground (face)
+ ;; Return the name of the foreground color of FACE. If FACE does
+ ;; not specify a foreground color, return nil.
+ (cond (htmlize-running-xemacs
+ ;; XEmacs.
+ (and (htmlize-face-specifies-property face 'foreground)
+ (color-instance-name (face-foreground-instance face))))
+ (t
+ ;; GNU Emacs.
+ (htmlize-face-color-internal face t))))
+
+(defun htmlize-face-background (face)
+ ;; Return the name of the background color of FACE. If FACE does
+ ;; not specify a background color, return nil.
+ (cond (htmlize-running-xemacs
+ ;; XEmacs.
+ (and (htmlize-face-specifies-property face 'background)
+ (color-instance-name (face-background-instance face))))
+ (t
+ ;; GNU Emacs.
+ (htmlize-face-color-internal face nil))))
+
+;; Convert COLOR to the #RRGGBB string. If COLOR is already in that
+;; format, it's left unchanged.
+
+(defun htmlize-color-to-rgb (color)
+ (let ((rgb-string nil))
+ (cond ((null color)
+ ;; Ignore nil COLOR because it means that the face is not
+ ;; specifying any color. Hence (htmlize-color-to-rgb nil)
+ ;; returns nil.
+ )
+ ((string-match "\\`#" color)
+ ;; The color is already in #rrggbb format.
+ (setq rgb-string color))
+ ((and htmlize-use-rgb-txt
+ htmlize-color-rgb-hash)
+ ;; Use of rgb.txt is requested, and it's available on the
+ ;; system. Use it.
+ (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
+ (t
+ ;; We're getting the RGB components from Emacs.
+ (let ((rgb
+ ;; Here I cannot conditionalize on (fboundp ...)
+ ;; because ps-print under some versions of GNU Emacs
+ ;; defines its own dummy version of
+ ;; `color-instance-rgb-components'.
+ (if htmlize-running-xemacs
+ (mapcar (lambda (arg)
+ (/ arg 256))
+ (color-instance-rgb-components
+ (make-color-instance color)))
+ (mapcar (lambda (arg)
+ (/ arg 256))
+ (x-color-values color)))))
+ (when rgb
+ (setq rgb-string (apply #'format "#%02x%02x%02x" rgb))))))
+ ;; If RGB-STRING is still nil, it means the color cannot be found,
+ ;; for whatever reason. In that case just punt and return COLOR.
+ ;; Most browsers support a decent set of color names anyway.
+ (or rgb-string color)))
+
+;; We store the face properties we care about into an
+;; `htmlize-fstruct' type. That way we only have to analyze face
+;; properties, which can be time consuming, once per each face. The
+;; mapping between Emacs faces and htmlize-fstructs is established by
+;; htmlize-make-face-map. The name "fstruct" refers to variables of
+;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
+;; faces.
+
+(defstruct htmlize-fstruct
+ foreground ; foreground color, #rrggbb
+ background ; background color, #rrggbb
+ size ; size
+ boldp ; whether face is bold
+ italicp ; whether face is italic
+ underlinep ; whether face is underlined
+ overlinep ; whether face is overlined
+ strikep ; whether face is struck through
+ css-name ; CSS name of face
+ )
+
+(defun htmlize-face-emacs21-attr (fstruct attr value)
+ ;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
+ (case attr
+ (:foreground
+ (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
+ (:background
+ (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
+ (:height
+ (setf (htmlize-fstruct-size fstruct) value))
+ (:weight
+ (when (string-match (symbol-name value) "bold")
+ (setf (htmlize-fstruct-boldp fstruct) t)))
+ (:slant
+ (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
+ (eq value 'oblique))))
+ (:bold
+ (setf (htmlize-fstruct-boldp fstruct) value))
+ (:italic
+ (setf (htmlize-fstruct-italicp fstruct) value))
+ (:underline
+ (setf (htmlize-fstruct-underlinep fstruct) value))
+ (:overline
+ (setf (htmlize-fstruct-overlinep fstruct) value))
+ (:strike-through
+ (setf (htmlize-fstruct-strikep fstruct) value))))
+
+(defun htmlize-face-size (face)
+ ;; The size (height) of FACE, taking inheritance into account.
+ ;; Only works in Emacs 21 and later.
+ (let ((size-list
+ (loop
+ for f = face then (face-attribute f :inherit)
+ until (eq f 'unspecified)
+ for h = (face-attribute f :height)
+ collect (if (eq h 'unspecified) nil h))))
+ (reduce 'htmlize-merge-size (cons nil size-list))))
+
+(defun htmlize-face-to-fstruct (face)
+ "Convert Emacs face FACE to fstruct."
+ (let ((fstruct (make-htmlize-fstruct
+ :foreground (htmlize-color-to-rgb
+ (htmlize-face-foreground face))
+ :background (htmlize-color-to-rgb
+ (htmlize-face-background face)))))
+ (cond (htmlize-running-xemacs
+ ;; XEmacs doesn't provide a way to detect whether a face is
+ ;; bold or italic, so we need to examine the font instance.
+ ;; #### This probably doesn't work under MS Windows and/or
+ ;; GTK devices. I'll need help with those.
+ (let* ((font-instance (face-font-instance face))
+ (props (font-instance-properties font-instance)))
+ (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold")
+ (setf (htmlize-fstruct-boldp fstruct) t))
+ (when (or (equalp (cdr (assq 'SLANT props)) "i")
+ (equalp (cdr (assq 'SLANT props)) "o"))
+ (setf (htmlize-fstruct-italicp fstruct) t))
+ (setf (htmlize-fstruct-strikep fstruct)
+ (face-strikethru-p face))
+ (setf (htmlize-fstruct-underlinep fstruct)
+ (face-underline-p face))))
+ ((fboundp 'face-attribute)
+ ;; GNU Emacs 21 and further.
+ (dolist (attr '(:weight :slant :underline :overline :strike-through))
+ (let ((value (if (>= emacs-major-version 22)
+ ;; Use the INHERIT arg in GNU Emacs 22.
+ (face-attribute face attr nil t)
+ ;; Otherwise, fake it.
+ (let ((face face))
+ (while (and (eq (face-attribute face attr)
+ 'unspecified)
+ (not (eq (face-attribute face :inherit)
+ 'unspecified)))
+ (setq face (face-attribute face :inherit)))
+ (face-attribute face attr)))))
+ (when (and value (not (eq value 'unspecified)))
+ (htmlize-face-emacs21-attr fstruct attr value))))
+ (let ((size (htmlize-face-size face)))
+ (unless (eql size 1.0) ; ignore non-spec
+ (setf (htmlize-fstruct-size fstruct) size))))
+ (t
+ ;; Older GNU Emacs. Some of these functions are only
+ ;; available under Emacs 20+, hence the guards.
+ (when (fboundp 'face-bold-p)
+ (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face)))
+ (when (fboundp 'face-italic-p)
+ (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face)))
+ (setf (htmlize-fstruct-underlinep fstruct)
+ (face-underline-p face))))
+ ;; Generate the css-name property. Emacs places no restrictions
+ ;; on the names of symbols that represent faces -- any characters
+ ;; may be in the name, even ^@. We try hard to beat the face name
+ ;; into shape, both esthetically and according to CSS1 specs.
+ (setf (htmlize-fstruct-css-name fstruct)
+ (let ((name (downcase (symbol-name face))))
+ (when (string-match "\\`font-lock-" name)
+ ;; Change font-lock-FOO-face to FOO.
+ (setq name (replace-match "" t t name)))
+ (when (string-match "-face\\'" name)
+ ;; Drop the redundant "-face" suffix.
+ (setq name (replace-match "" t t name)))
+ (while (string-match "[^-a-zA-Z0-9]" name)
+ ;; Drop the non-alphanumerics.
+ (setq name (replace-match "X" t t name)))
+ (when (string-match "\\`[-0-9]" name)
+ ;; CSS identifiers may not start with a digit.
+ (setq name (concat "X" name)))
+ ;; After these transformations, the face could come
+ ;; out empty.
+ (when (equal name "")
+ (setq name "face"))
+ ;; Apply the prefix.
+ (setq name (concat htmlize-css-name-prefix name))
+ name))
+ fstruct))
+
+(defmacro htmlize-copy-attr-if-set (attr-list dest source)
+ ;; Expand the code of the type
+ ;; (and (htmlize-fstruct-ATTR source)
+ ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
+ ;; for the given list of boolean attributes.
+ (cons 'progn
+ (loop for attr in attr-list
+ for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
+ collect `(and (,attr-sym ,source)
+ (setf (,attr-sym ,dest) (,attr-sym ,source))))))
+
+(defun htmlize-merge-size (merged next)
+ ;; Calculate the size of the merge of MERGED and NEXT.
+ (cond ((null merged) next)
+ ((integerp next) next)
+ ((null next) merged)
+ ((floatp merged) (* merged next))
+ ((integerp merged) (round (* merged next)))))
+
+(defun htmlize-merge-two-faces (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)
+
+(defun htmlize-merge-faces (fstruct-list)
+ (cond ((null fstruct-list)
+ ;; Nothing to do, return a dummy face.
+ (make-htmlize-fstruct))
+ ((null (cdr fstruct-list))
+ ;; Optimize for the common case of a single face, simply
+ ;; return it.
+ (car fstruct-list))
+ (t
+ (reduce #'htmlize-merge-two-faces
+ (cons (make-htmlize-fstruct) fstruct-list)))))
+
+;; GNU Emacs 20+ supports attribute lists in `face' properties. For
+;; example, you can use `(:foreground "red" :weight bold)' as an
+;; overlay's "face", or you can even use a list of such lists, etc.
+;; We call those "attrlists".
+;;
+;; htmlize supports attrlist by converting them to fstructs, the same
+;; as with regular faces.
+
+(defun htmlize-attrlist-to-fstruct (attrlist)
+ ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
+ (let ((fstruct (make-htmlize-fstruct)))
+ (cond ((eq (car attrlist) 'foreground-color)
+ ;; ATTRLIST is (foreground-color . COLOR)
+ (setf (htmlize-fstruct-foreground fstruct)
+ (htmlize-color-to-rgb (cdr attrlist))))
+ ((eq (car attrlist) 'background-color)
+ ;; ATTRLIST is (background-color . COLOR)
+ (setf (htmlize-fstruct-background fstruct)
+ (htmlize-color-to-rgb (cdr attrlist))))
+ (t
+ ;; ATTRLIST is a plist.
+ (while attrlist
+ (let ((attr (pop attrlist))
+ (value (pop attrlist)))
+ (when (and value (not (eq value 'unspecified)))
+ (htmlize-face-emacs21-attr fstruct attr value))))))
+ (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
+ fstruct))
+
+(defun htmlize-face-list-p (face-prop)
+ "Return non-nil if FACE-PROP is a list of faces, nil otherwise."
+ ;; If not for attrlists, this would return (listp face-prop). This
+ ;; way we have to be more careful because attrlist is also a list!
+ (cond
+ ((eq face-prop nil)
+ ;; FACE-PROP being nil means empty list (no face), so return t.
+ t)
+ ((symbolp face-prop)
+ ;; A symbol other than nil means that it's only one face, so return
+ ;; nil.
+ nil)
+ ((not (consp face-prop))
+ ;; Huh? Not a symbol or cons -- treat it as a single element.
+ nil)
+ (t
+ ;; We know that FACE-PROP is a cons: check whether it looks like an
+ ;; ATTRLIST.
+ (let* ((car (car face-prop))
+ (attrlist-p (and (symbolp car)
+ (or (eq car 'foreground-color)
+ (eq car 'background-color)
+ (eq (aref (symbol-name car) 0) ?:)))))
+ ;; If FACE-PROP is not an ATTRLIST, it means it's a list of
+ ;; faces.
+ (not attrlist-p)))))
+
+(defun htmlize-make-face-map (faces)
+ ;; Return a hash table mapping Emacs faces to htmlize's fstructs.
+ ;; The keys are either face symbols or attrlists, so the test
+ ;; function must be `equal'.
+ (let ((face-map (make-hash-table :test 'equal))
+ css-names)
+ (dolist (face faces)
+ (unless (gethash face face-map)
+ ;; Haven't seen FACE yet; convert it to an fstruct and cache
+ ;; it.
+ (let ((fstruct (if (symbolp face)
+ (htmlize-face-to-fstruct face)
+ (htmlize-attrlist-to-fstruct face))))
+ (setf (gethash face face-map) fstruct)
+ (let* ((css-name (htmlize-fstruct-css-name fstruct))
+ (new-name css-name)
+ (i 0))
+ ;; Uniquify the face's css-name by using NAME-1, NAME-2,
+ ;; etc.
+ (while (member new-name css-names)
+ (setq new-name (format "%s-%s" css-name (incf i))))
+ (unless (equal new-name css-name)
+ (setf (htmlize-fstruct-css-name fstruct) new-name))
+ (push new-name css-names)))))
+ face-map))
+
+(defun htmlize-unstringify-face (face)
+ "If FACE is a string, return it interned, otherwise return it unchanged."
+ (if (stringp face)
+ (intern face)
+ face))
+
+(defun htmlize-faces-in-buffer ()
+ "Return a list of faces used in the current buffer.
+Under XEmacs, this returns the set of faces specified by the extents
+with the `face' property. (This covers text properties as well.) Under
+GNU Emacs, it returns the set of faces specified by the `face' text
+property and by buffer overlays that specify `face'."
+ (let (faces)
+ ;; Testing for (fboundp 'map-extents) doesn't work because W3
+ ;; defines `map-extents' under FSF.
+ (if htmlize-running-xemacs
+ (let (face-prop)
+ (map-extents (lambda (extent ignored)
+ (setq face-prop (extent-face extent)
+ ;; FACE-PROP can be a face or a list of
+ ;; faces.
+ faces (if (listp face-prop)
+ (union face-prop faces)
+ (adjoin face-prop faces)))
+ nil)
+ nil
+ ;; Specify endpoints explicitly to respect
+ ;; narrowing.
+ (point-min) (point-max) nil nil 'face))
+ ;; FSF Emacs code.
+ ;; Faces used by text properties.
+ (let ((pos (point-min)) face-prop next)
+ (while (< pos (point-max))
+ (setq face-prop (get-text-property pos 'face)
+ next (or (next-single-property-change pos 'face) (point-max)))
+ ;; FACE-PROP can be a face/attrlist or a list thereof.
+ (setq faces (if (htmlize-face-list-p face-prop)
+ (nunion (mapcar #'htmlize-unstringify-face face-prop)
+ faces :test 'equal)
+ (adjoin (htmlize-unstringify-face face-prop)
+ faces :test 'equal)))
+ (setq pos next)))
+ ;; Faces used by overlays.
+ (dolist (overlay (overlays-in (point-min) (point-max)))
+ (let ((face-prop (overlay-get overlay 'face)))
+ ;; FACE-PROP can be a face/attrlist or a list thereof.
+ (setq faces (if (htmlize-face-list-p face-prop)
+ (nunion (mapcar #'htmlize-unstringify-face face-prop)
+ faces :test 'equal)
+ (adjoin (htmlize-unstringify-face face-prop)
+ faces :test 'equal))))))
+ faces))
+
+;; htmlize-faces-at-point returns the faces in use at point. The
+;; faces are sorted by increasing priority, i.e. the last face takes
+;; precedence.
+;;
+;; Under XEmacs, this returns all the faces in all the extents at
+;; point. Under GNU Emacs, this returns all the faces in the `face'
+;; property and all the faces in the overlays at point.
+
+(cond (htmlize-running-xemacs
+ (defun htmlize-faces-at-point ()
+ (let (extent extent-list face-list face-prop)
+ (while (setq extent (extent-at (point) nil 'face extent))
+ (push extent extent-list))
+ ;; extent-list is in reverse display order, meaning that
+ ;; smallest ones come last. That is the order we want,
+ ;; except it can be overridden by the `priority' property.
+ (setq extent-list (stable-sort extent-list #'<
+ :key #'extent-priority))
+ (dolist (extent extent-list)
+ (setq face-prop (extent-face extent))
+ ;; extent's face-list is in reverse order from what we
+ ;; want, but the `nreverse' below will take care of it.
+ (setq face-list (if (listp face-prop)
+ (append face-prop face-list)
+ (cons face-prop face-list))))
+ (nreverse face-list))))
+ (t
+ (defun htmlize-faces-at-point ()
+ (let (all-faces)
+ ;; Faces from text properties.
+ (let ((face-prop (get-text-property (point) 'face)))
+ (setq all-faces (if (htmlize-face-list-p face-prop)
+ (nreverse (mapcar #'htmlize-unstringify-face
+ face-prop))
+ (list (htmlize-unstringify-face face-prop)))))
+ ;; Faces from overlays.
+ (let ((overlays
+ ;; Collect overlays at point that specify `face'.
+ (delete-if-not (lambda (o)
+ (overlay-get o 'face))
+ (overlays-at (point))))
+ list face-prop)
+ ;; Sort the overlays so the smaller (more specific) ones
+ ;; come later. The number of overlays at each one
+ ;; position should be very small, so the sort shouldn't
+ ;; slow things down.
+ (setq overlays (sort* overlays
+ ;; Sort by ascending...
+ #'<
+ ;; ...overlay size.
+ :key (lambda (o)
+ (- (overlay-end o)
+ (overlay-start o)))))
+ ;; Overlay priorities, if present, override the above
+ ;; established order. Larger overlay priority takes
+ ;; precedence and therefore comes later in the list.
+ (setq overlays (stable-sort
+ overlays
+ ;; Reorder (stably) by acending...
+ #'<
+ ;; ...overlay priority.
+ :key (lambda (o)
+ (or (overlay-get o 'priority) 0))))
+ (dolist (overlay overlays)
+ (setq face-prop (overlay-get overlay 'face))
+ (setq list (if (htmlize-face-list-p face-prop)
+ (nconc (nreverse (mapcar
+ #'htmlize-unstringify-face
+ face-prop))
+ list)
+ (cons (htmlize-unstringify-face face-prop) list))))
+ ;; Under "Merging Faces" the manual explicitly states
+ ;; that faces specified by overlays take precedence over
+ ;; faces specified by text properties.
+ (setq all-faces (nconc all-faces list)))
+ all-faces))))
+
+;; htmlize supports generating HTML in two several fundamentally
+;; different ways, one with the use of CSS and nested <span> tags, and
+;; the other with the use of the old <font> tags. Rather than adding
+;; a bunch of ifs to many places, we take a semi-OO approach.
+;; `htmlize-buffer-1' calls a number of "methods", which indirect to
+;; the functions that depend on `htmlize-output-type'. The currently
+;; used methods are `doctype', `insert-head', `body-tag', and
+;; `insert-text'. Not all output types define all methods.
+;;
+;; Methods are called either with (htmlize-method METHOD ARGS...)
+;; special form, or by accessing the function with
+;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
+;; The latter form is useful in tight loops because `htmlize-method'
+;; conses.
+;;
+;; Currently defined output types are `css' and `font'.
+
+(defmacro htmlize-method (method &rest args)
+ ;; Expand to (htmlize-TYPE-METHOD ...ARGS...). TYPE is the value of
+ ;; `htmlize-output-type' at run time.
+ `(funcall (htmlize-method-function ',method) ,@args))
+
+(defun htmlize-method-function (method)
+ ;; Return METHOD's function definition for the current output type.
+ ;; The returned object can be safely funcalled.
+ (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
+ (indirect-function (if (fboundp sym)
+ sym
+ (let ((default (intern (concat "htmlize-default-"
+ (symbol-name method)))))
+ (if (fboundp default)
+ default
+ 'ignore))))))
+
+(defvar htmlize-memoization-table (make-hash-table :test 'equal))
+
+(defmacro htmlize-memoize (key generator)
+ "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."
+ (let ((value (gensym)))
+ `(let ((,value (gethash ,key htmlize-memoization-table)))
+ (unless ,value
+ (setq ,value ,generator)
+ (setf (gethash ,key htmlize-memoization-table) ,value))
+ ,value)))
+
+;;; Default methods.
+
+(defun htmlize-default-doctype ()
+ nil ; no doc-string
+ ;; According to DTDs published by the W3C, it is illegal to embed
+ ;; <font> in <pre>. This makes sense in general, but is bad for
+ ;; htmlize's intended usage of <font> to specify the document color.
+
+ ;; To make generated HTML legal, htmlize's `font' mode used to
+ ;; specify the SGML declaration of "HTML Pro" DTD here. HTML Pro
+ ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
+ ;; DTD that would encompass all the incompatible HTML extensions
+ ;; procured by Netscape, MSIE, and other players in the field.
+ ;; Apparently the project got abandoned, the last available version
+ ;; being "Draft 0 Revision 11" from January 1997, as documented at
+ ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>.
+
+ ;; Since by now HTML Pro is remembered by none but the most die-hard
+ ;; early-web-days nostalgics and used by not even them, there is no
+ ;; use in specifying it. So we return the standard HTML 4.0
+ ;; declaration, which makes generated HTML technically illegal. If
+ ;; you have a problem with that, use the `css' engine designed to
+ ;; create fully conforming HTML.
+
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"
+
+ ;; Now-abandoned HTML Pro declaration.
+ ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">"
+ )
+
+(defun htmlize-default-body-tag (face-map)
+ nil ; no doc-string
+ "<body>")
+
+;;; CSS based output support.
+
+;; Internal function; not a method.
+(defun htmlize-css-specs (fstruct)
+ (let (result)
+ (when (htmlize-fstruct-foreground fstruct)
+ (push (format "color: %s;" (htmlize-fstruct-foreground fstruct))
+ result))
+ (when (htmlize-fstruct-background fstruct)
+ (push (format "background-color: %s;"
+ (htmlize-fstruct-background fstruct))
+ result))
+ (let ((size (htmlize-fstruct-size fstruct)))
+ (when (and size (not (eq htmlize-ignore-face-size t)))
+ (cond ((floatp size)
+ (push (format "font-size: %d%%;" (* 100 size)) result))
+ ((not (eq htmlize-ignore-face-size 'absolute))
+ (push (format "font-size: %spt;" (/ size 10.0)) result)))))
+ (when (htmlize-fstruct-boldp fstruct)
+ (push "font-weight: bold;" result))
+ (when (htmlize-fstruct-italicp fstruct)
+ (push "font-style: italic;" result))
+ (when (htmlize-fstruct-underlinep fstruct)
+ (push "text-decoration: underline;" result))
+ (when (htmlize-fstruct-overlinep fstruct)
+ (push "text-decoration: overline;" result))
+ (when (htmlize-fstruct-strikep fstruct)
+ (push "text-decoration: line-through;" result))
+ (nreverse result)))
+
+(defun htmlize-css-insert-head (buffer-faces face-map)
+ (insert " <style type=\"text/css\">\n <!--\n")
+ (insert " body {\n "
+ (mapconcat #'identity
+ (htmlize-css-specs (gethash 'default face-map))
+ "\n ")
+ "\n }\n")
+ (dolist (face (sort* (copy-list buffer-faces) #'string-lessp
+ :key (lambda (f)
+ (htmlize-fstruct-css-name (gethash f face-map)))))
+ (let* ((fstruct (gethash face face-map))
+ (cleaned-up-face-name
+ (let ((s
+ ;; Use `prin1-to-string' rather than `symbol-name'
+ ;; to get the face name because the "face" can also
+ ;; be an attrlist, which is not a symbol.
+ (prin1-to-string face)))
+ ;; If the name contains `--' or `*/', remove them.
+ (while (string-match "--" s)
+ (setq s (replace-match "-" t t s)))
+ (while (string-match "\\*/" s)
+ (setq s (replace-match "XX" t t s)))
+ s))
+ (specs (htmlize-css-specs fstruct)))
+ (insert " ." (htmlize-fstruct-css-name fstruct))
+ (if (null specs)
+ (insert " {")
+ (insert " {\n /* " cleaned-up-face-name " */\n "
+ (mapconcat #'identity specs "\n ")))
+ (insert "\n }\n")))
+ (insert htmlize-hyperlink-style
+ " -->\n </style>\n"))
+
+(defun htmlize-css-insert-text (text fstruct-list buffer)
+ ;; Insert TEXT colored with FACES into BUFFER. In CSS mode, this is
+ ;; easy: just nest the text in one <span class=...> tag for each
+ ;; face in FSTRUCT-LIST.
+ (dolist (fstruct fstruct-list)
+ (princ "<span class=\"" buffer)
+ (princ (htmlize-fstruct-css-name fstruct) buffer)
+ (princ "\">" buffer))
+ (princ text buffer)
+ (dolist (fstruct fstruct-list)
+ (ignore fstruct) ; shut up the byte-compiler
+ (princ "</span>" buffer)))
+
+;; `inline-css' output support.
+
+(defun htmlize-inline-css-body-tag (face-map)
+ (format "<body style=\"%s\">"
+ (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
+ " ")))
+
+(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
+ (let* ((merged (htmlize-merge-faces fstruct-list))
+ (style (htmlize-memoize
+ merged
+ (let ((specs (htmlize-css-specs merged)))
+ (and specs
+ (mapconcat #'identity (htmlize-css-specs merged) " "))))))
+ (when style
+ (princ "<span style=\"" buffer)
+ (princ style buffer)
+ (princ "\">" buffer))
+ (princ text buffer)
+ (when style
+ (princ "</span>" buffer))))
+
+;;; `font' tag based output support.
+
+(defun htmlize-font-body-tag (face-map)
+ (let ((fstruct (gethash 'default face-map)))
+ (format "<body text=\"%s\" bgcolor=\"%s\">"
+ (htmlize-fstruct-foreground fstruct)
+ (htmlize-fstruct-background fstruct))))
+
+(defun htmlize-font-insert-text (text fstruct-list buffer)
+ ;; In `font' mode, we use the traditional HTML means of altering
+ ;; presentation: <font> tag for colors, <b> for bold, <u> for
+ ;; underline, and <strike> for strike-through.
+ (let* ((merged (htmlize-merge-faces fstruct-list))
+ (markup (htmlize-memoize
+ merged
+ (cons (concat
+ (and (htmlize-fstruct-foreground merged)
+ (format "<font color=\"%s\">" (htmlize-fstruct-foreground merged)))
+ (and (htmlize-fstruct-boldp merged) "<b>")
+ (and (htmlize-fstruct-italicp merged) "<i>")
+ (and (htmlize-fstruct-underlinep merged) "<u>")
+ (and (htmlize-fstruct-strikep merged) "<strike>"))
+ (concat
+ (and (htmlize-fstruct-strikep merged) "</strike>")
+ (and (htmlize-fstruct-underlinep merged) "</u>")
+ (and (htmlize-fstruct-italicp merged) "</i>")
+ (and (htmlize-fstruct-boldp merged) "</b>")
+ (and (htmlize-fstruct-foreground merged) "</font>"))))))
+ (princ (car markup) buffer)
+ (princ text buffer)
+ (princ (cdr markup) buffer)))
+
+(defun htmlize-buffer-1 ()
+ ;; Internal function; don't call it from outside this file. Htmlize
+ ;; current buffer, writing the resulting HTML to a new buffer, and
+ ;; return it. Unlike htmlize-buffer, this doesn't change current
+ ;; buffer or use switch-to-buffer.
+ (save-excursion
+ ;; Protect against the hook changing the current buffer.
+ (save-excursion
+ (run-hooks 'htmlize-before-hook))
+ ;; Convince font-lock support modes to fontify the entire buffer
+ ;; in advance.
+ (htmlize-ensure-fontified)
+ (clrhash htmlize-extended-character-cache)
+ (clrhash htmlize-memoization-table)
+ (let* ((buffer-faces (htmlize-faces-in-buffer))
+ (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
+ ;; Generate the new buffer. It's important that it inherits
+ ;; default-directory from the current buffer.
+ (htmlbuf (generate-new-buffer (if (buffer-file-name)
+ (htmlize-make-file-name
+ (file-name-nondirectory
+ (buffer-file-name)))
+ "*html*")))
+ ;; Having a dummy value in the plist allows writing simply
+ ;; (plist-put places foo bar).
+ (places '(nil nil))
+ (title (if (buffer-file-name)
+ (file-name-nondirectory (buffer-file-name))
+ (buffer-name))))
+ ;; Initialize HTMLBUF and insert the HTML prolog.
+ (with-current-buffer htmlbuf
+ (buffer-disable-undo)
+ (insert (htmlize-method doctype) ?\n
+ (format "<!-- Created by htmlize-%s in %s mode. -->\n"
+ htmlize-version htmlize-output-type)
+ "<html>\n ")
+ (plist-put places 'head-start (point-marker))
+ (insert "<head>\n"
+ " <title>" (htmlize-protect-string title) "</title>\n"
+ (if htmlize-html-charset
+ (format (concat " <meta http-equiv=\"Content-Type\" "
+ "content=\"text/html; charset=%s\">\n")
+ htmlize-html-charset)
+ "")
+ htmlize-head-tags)
+ (htmlize-method insert-head buffer-faces face-map)
+ (insert " </head>")
+ (plist-put places 'head-end (point-marker))
+ (insert "\n ")
+ (plist-put places 'body-start (point-marker))
+ (insert (htmlize-method body-tag face-map)
+ "\n ")
+ (plist-put places 'content-start (point-marker))
+ (insert "<pre>\n"))
+ (let ((insert-text-method
+ ;; Get the inserter method, so we can funcall it inside
+ ;; the loop. Not calling `htmlize-method' in the loop
+ ;; body yields a measurable speed increase.
+ (htmlize-method-function 'insert-text))
+ ;; Declare variables used in loop body outside the loop
+ ;; because it's faster to establish `let' bindings only
+ ;; once.
+ next-change text face-list fstruct-list trailing-ellipsis)
+ ;; This loop traverses and reads the source buffer, appending
+ ;; the resulting HTML to HTMLBUF with `princ'. This method is
+ ;; fast because: 1) it doesn't require examining the text
+ ;; properties char by char (htmlize-next-change is used to
+ ;; move between runs with the same face), and 2) it doesn't
+ ;; require buffer switches, which are slow in Emacs.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq next-change (htmlize-next-change (point) 'face))
+ ;; Get faces in use between (point) and NEXT-CHANGE, and
+ ;; convert them to fstructs.
+ (setq face-list (htmlize-faces-at-point)
+ fstruct-list (delq nil (mapcar (lambda (f)
+ (gethash f face-map))
+ face-list)))
+ ;; Extract buffer text, sans the invisible parts. Then
+ ;; untabify it and escape the HTML metacharacters.
+ (setq text (htmlize-buffer-substring-no-invisible
+ (point) next-change))
+ (when trailing-ellipsis
+ (setq text (htmlize-trim-ellipsis text)))
+ ;; If TEXT ends up empty, don't change trailing-ellipsis.
+ (when (> (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-protect-string text))
+ ;; Don't bother writing anything if there's no text (this
+ ;; happens in invisible regions).
+ (when (> (length text) 0)
+ ;; Insert the text, along with the necessary markup to
+ ;; represent faces in FSTRUCT-LIST.
+ (funcall insert-text-method text fstruct-list htmlbuf))
+ (goto-char next-change)))
+
+ ;; Insert the epilog and post-process the buffer.
+ (with-current-buffer htmlbuf
+ (insert "</pre>")
+ (plist-put places 'content-end (point-marker))
+ (insert "\n </body>")
+ (plist-put places 'body-end (point-marker))
+ (insert "\n</html>\n")
+ (when htmlize-generate-hyperlinks
+ (htmlize-make-hyperlinks))
+ (htmlize-defang-local-variables)
+ (when htmlize-replace-form-feeds
+ ;; Change each "\n^L" to "<hr />".
+ (goto-char (point-min))
+ (let ((source
+ ;; ^L has already been escaped, so search for that.
+ (htmlize-protect-string "\n\^L"))
+ (replacement
+ (if (stringp htmlize-replace-form-feeds)
+ htmlize-replace-form-feeds
+ "</pre><hr /><pre>")))
+ (while (search-forward source nil t)
+ (replace-match replacement t t))))
+ (goto-char (point-min))
+ (when htmlize-html-major-mode
+ ;; What sucks about this is that the minor modes, most notably
+ ;; font-lock-mode, won't be initialized. Oh well.
+ (funcall htmlize-html-major-mode))
+ (set (make-local-variable 'htmlize-buffer-places) places)
+ (run-hooks 'htmlize-after-hook)
+ (buffer-enable-undo))
+ htmlbuf)))
+
+;; Utility functions.
+
+(defmacro htmlize-with-fontify-message (&rest body)
+ ;; When forcing fontification of large buffers in
+ ;; htmlize-ensure-fontified, inform the user that he is waiting for
+ ;; font-lock, not for htmlize to finish.
+ `(progn
+ (if (> (buffer-size) 65536)
+ (message "Forcing fontification of %s..."
+ (buffer-name (current-buffer))))
+ ,@body
+ (if (> (buffer-size) 65536)
+ (message "Forcing fontification of %s...done"
+ (buffer-name (current-buffer))))))
+
+(defun htmlize-ensure-fontified ()
+ ;; If font-lock is being used, ensure that the "support" modes
+ ;; actually fontify the buffer. If font-lock is not in use, we
+ ;; don't care because, except in htmlize-file, we don't force
+ ;; font-lock on the user.
+ (when (and (boundp 'font-lock-mode)
+ font-lock-mode)
+ ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21.
+ (cond
+ ((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
+ ;; lazy-shot is amazing in that it must *refontify* the region,
+ ;; even if the whole buffer has already been fontified. <sigh>
+ (lazy-shot-fontify-region (point-min) (point-max))))
+ ;; There's also fast-lock, but we don't need to handle specially,
+ ;; I think. fast-lock doesn't really defer fontification, it
+ ;; just saves it to an external cache so it's not done twice.
+ )))
+
+
+;;;###autoload
+(defun htmlize-buffer (&optional buffer)
+ "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."
+ (interactive)
+ (let ((htmlbuf (with-current-buffer (or buffer (current-buffer))
+ (htmlize-buffer-1))))
+ (when (interactive-p)
+ (switch-to-buffer htmlbuf))
+ htmlbuf))
+
+;;;###autoload
+(defun htmlize-region (beg end)
+ "Convert the region to HTML, preserving colors and decorations.
+See `htmlize-buffer' for details."
+ (interactive "r")
+ ;; Don't let zmacs region highlighting end up in HTML.
+ (when (fboundp 'zmacs-deactivate-region)
+ (zmacs-deactivate-region))
+ (let ((htmlbuf (save-restriction
+ (narrow-to-region beg end)
+ (htmlize-buffer-1))))
+ (when (interactive-p)
+ (switch-to-buffer htmlbuf))
+ htmlbuf))
+
+(defun htmlize-region-for-paste (beg end)
+ "Htmlize the region and return just the HTML as a string.
+This forces the `inline-css' 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."
+ (let* ((htmlize-output-type 'inline-css)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
+
+(defun htmlize-make-file-name (file)
+ "Make an HTML file name from FILE.
+
+In its default implementation, this simply appends `.html' to FILE.
+This function is called by htmlize to create the buffer file name, and
+by `htmlize-file' to create the target file name.
+
+More elaborate transformations are conceivable, such as changing FILE's
+extension to `.html' (\"file.c\" -> \"file.html\"). If you want them,
+overload this function to do it and htmlize will comply."
+ (concat file ".html"))
+
+;; Older implementation of htmlize-make-file-name that changes FILE's
+;; extension to ".html".
+;(defun htmlize-make-file-name (file)
+; (let ((extension (file-name-extension file))
+; (sans-extension (file-name-sans-extension file)))
+; (if (or (equal extension "html")
+; (equal extension "htm")
+; (equal sans-extension ""))
+; (concat file ".html")
+; (concat sans-extension ".html"))))
+
+;;;###autoload
+(defun htmlize-file (file &optional target)
+ "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 `normal-mode' as appropriate for the file type. The buffer
+is subsequently fontified with `font-lock' and converted to HTML. Note
+that, unlike `htmlize-buffer', this function explicitly turns on
+font-lock. If a form of highlighting other than font-lock is desired,
+please use `htmlize-buffer' 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."
+ (interactive (list (read-file-name
+ "HTML-ize file: "
+ nil nil nil (and (buffer-file-name)
+ (file-name-nondirectory
+ (buffer-file-name))))))
+ (let ((output-file (if (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)))))
+ ;; Try to prevent `find-file-noselect' from triggering
+ ;; font-lock because we'll fontify explicitly below.
+ (font-lock-mode nil)
+ (font-lock-auto-fontify nil)
+ (global-font-lock-mode nil)
+ ;; Ignore the size limit for the purposes of htmlization.
+ (font-lock-maximum-size nil)
+ ;; Disable font-lock support modes. This will only work in
+ ;; more recent Emacs versions, so htmlize-buffer-1 still needs
+ ;; to call htmlize-ensure-fontified.
+ (font-lock-support-mode nil))
+ (with-temp-buffer
+ ;; Insert FILE into the temporary buffer.
+ (insert-file-contents file)
+ ;; Set the file name so normal-mode and htmlize-buffer-1 pick it
+ ;; up. Restore it afterwards so with-temp-buffer's kill-buffer
+ ;; doesn't complain about killing a modified buffer.
+ (let ((buffer-file-name file))
+ ;; Set the major mode for the sake of font-lock.
+ (normal-mode)
+ (font-lock-mode 1)
+ (unless font-lock-mode
+ ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
+ ;; contrary to the documentation. This seems to work.
+ (font-lock-fontify-buffer))
+ ;; htmlize the buffer and save the HTML.
+ (with-current-buffer (htmlize-buffer-1)
+ (unwind-protect
+ (progn
+ (run-hooks 'htmlize-file-hook)
+ (write-region (point-min) (point-max) output-file))
+ (kill-buffer (current-buffer)))))))
+ ;; I haven't decided on a useful return value yet, so just return
+ ;; nil.
+ nil)
+
+;;;###autoload
+(defun htmlize-many-files (files &optional target-directory)
+ "Convert FILES to HTML and save the corresponding HTML versions.
+
+FILES should be a list of file names to convert. This function calls
+`htmlize-file' 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."
+ (interactive
+ (list
+ (let (list file)
+ ;; Use empty string as DEFAULT because setting DEFAULT to nil
+ ;; defaults to the directory name, which is not what we want.
+ (while (not (equal (setq file (read-file-name
+ "HTML-ize file (RET to finish): "
+ (and list (file-name-directory
+ (car list)))
+ "" t))
+ ""))
+ (push file list))
+ (nreverse list))))
+ ;; Verify that TARGET-DIRECTORY is indeed a directory. If it's a
+ ;; file, htmlize-file will use it as target, and that doesn't make
+ ;; sense.
+ (and target-directory
+ (not (file-directory-p target-directory))
+ (error "target-directory must name a directory: %s" target-directory))
+ (dolist (file files)
+ (htmlize-file file target-directory)))
+
+;;;###autoload
+(defun htmlize-many-files-dired (arg &optional target-directory)
+ "HTMLize dired-marked files."
+ (interactive "P")
+ (htmlize-many-files (dired-get-marked-files nil arg) target-directory))
+
+(provide 'htmlize)
+
+;;; htmlize.el ends here
View
1,338 lua-mode.el
@@ -0,0 +1,1338 @@
+;;; lua-mode.el --- a major-mode for editing Lua scripts
+
+;; Copyright (C) 1997, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
+
+;; Author: 2006 Juergen Hoetzel <juergen@hoetzel.info>
+;; 2004 various (support for Lua 5 and byte compilation)
+;; 2001 Christian Vogler <cvogler@gradient.cis.upenn.edu>
+;; 1997 Bret Mogilefsky <mogul-lua@gelatinous.com> starting from
+;; tcl-mode by Gregor Schmid <schmid@fb3-s7.math.tu-berlin.de>
+;; with tons of assistance from
+;; Paul Du Bois <pld-lua@gelatinous.com> and
+;; Aaron Smith <aaron-lua@gelatinous.com>.
+;; URL: http://lua-mode.luaforge.net/
+;; Version: 20070703
+;; This file is NOT part of Emacs.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
+
+(defconst lua-version "20071122"
+ "Lua Mode version number.")
+
+;; Keywords: languages, processes, tools
+
+
+;;; Commentary:
+
+;; Thanks to Tobias Polzin <polzin<at>gmx.de> for function indenting
+;; patch: Indent "(" like "{"
+
+;; Thanks to Fabien <fleutot<at>gmail.com> for imenu patches.
+
+;; Special Thanks to Simon Marshall <simonm@mail.esrin.esa.it> for
+;; font-lock patches.
+
+;; Additional font-lock highlighting and indentation tweaks by
+;; Adam D. Moss <adam@gimp.org> <aspirin@icculus.org>
+
+;; This file was written with emacs using Jamie Lokier's folding mode
+;; That's what the funny ;;{{{ ;;}}} marks are there for
+
+;;{{{ INSTALLATION:
+
+;; To install, just drop this file into a directory on your load-path (and
+;; byte-compile it). To set up Emacs to automatically edit files ending in
+;; ".lua" using lua-mode add the following to your ~/.emacs file (GNU
+;; Emacs) or ~/.xemacs/init.el file (XEmacs):
+;; (setq auto-mode-alist (cons '("\\.lua$" . lua-mode) auto-mode-alist))
+;; (autoload 'lua-mode "lua-mode" "Lua editing mode." t)
+
+;;}}}
+;;{{{ Usage
+
+;; Lua-mode supports c-mode style formatting and sending of
+;; lines/regions/files to a Lua interpreter. An interpreter (see
+;; variable `lua-default-application') will be started if you try to
+;; send some code and none is running. You can use the process-buffer
+;; (named after the application you chose) as if it were an
+;; interactive shell. See the documentation for `comint.el' for
+;; details.
+
+;;}}}
+;;{{{ Key-bindings
+
+;; To see all the keybindings for Lua mode, look at `lua-setup-keymap'
+;; or start `lua-mode' and type `\C-h m'.
+;; The keybindings may seem strange, since I prefer to use them with
+;; lua-prefix-key set to nil, but since those keybindings are already used
+;; the default for `lua-prefix-key' is `\C-c', which is the conventional
+;; prefix for major-mode commands.
+
+;; You can customise the keybindings either by setting `lua-prefix-key'
+;; or by putting the following in your .emacs
+;; (setq lua-mode-map (make-sparse-keymap))
+;; and
+;; (define-key lua-mode-map <your-key> <function>)
+;; for all the functions you need.
+
+;;}}}
+
+;;; Code:
+(defconst lua-using-xemacs (string-match "XEmacs" emacs-version)
+ "Nil unless using XEmacs).")
+
+;; We need that !
+(require 'comint)
+
+;;{{{ variables
+
+;; Local variables
+(defgroup lua nil
+ "Major mode for editing lua code."
+ :prefix "lua-"
+ :group 'languages)
+
+(defcustom lua-default-application "lua"
+ "Default application to run in lua subprocess."
+ :type 'string
+ :group 'lua)
+
+(defcustom lua-default-command-switches (list "-i")
+ "Command switches for `lua-default-application'.
+Should be a list of strings."
+ :type '(repeat string)
+ :group 'lua)
+
+(defcustom lua-always-show t
+ "*Non-nil means display lua-process-buffer after sending a command."
+ :type 'boolean
+ :group 'lua)
+
+(defcustom lua-search-url-prefix "http://www.lua.org/manual/5.1/manual.html#pdf-"
+ "*URL at which to search for documentation on a word"
+ :type 'string
+ :group 'lua)
+
+(defvar lua-process nil
+ "The active Lua subprocess")
+
+(defvar lua-process-buffer nil
+ "Buffer used for communication with Lua subprocess")
+
+(defvar lua-mode-map nil
+ "Keymap used with lua-mode.")
+
+(defvar lua-electric-flag t
+"If t, electric actions (like automatic reindentation) will happen when an electric
+ key like `{' is pressed")
+(make-variable-buffer-local 'lua-electric-flag)
+
+(defcustom lua-prefix-key "\C-c"
+ "Prefix for all lua-mode commands."
+ :type 'string
+ :group 'lua)
+
+(defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$"
+ "Regexp which matches the Lua program's prompt."
+ :group 'lua
+ :type 'regexp
+ )
+
+(defcustom lua-traceback-line-re
+ "^\\(?:[\t ]*\\|.*>[\t ]+\\)\\([^\n\t ]+\\):\\([0-9]+\\):"
+ "Regular expression that describes tracebacks and errors."
+ :group 'lua
+ :type 'regexp
+ )
+
+(defcustom lua-jump-on-traceback t
+ "*Jump to innermost traceback location in *lua* buffer. When this
+variable is non-nil and a traceback occurs when running Lua code in a
+subprocess, jump immediately to the source code of the innermost
+traceback location."
+ :group 'lua
+ :type 'boolean
+ )
+
+(defvar lua-mode-hook nil
+ "Hooks called when Lua mode fires up.")
+
+(defvar lua-region-start (make-marker)
+ "Start of special region for Lua communication.")
+
+(defvar lua-region-end (make-marker)
+ "End of special region for Lua communication.")
+
+(defvar lua-indent-level 3
+ "Amount by which Lua subexpressions are indented.")
+
+(defvar lua-mode-menu (make-sparse-keymap "Lua")
+ "Keymap for lua-mode's menu.")
+
+(defvar lua-xemacs-menu
+ '(["Restart With Whole File" lua-restart-with-whole-file t]
+ ["Kill Process" lua-kill-process t]
+ ["Hide Process Buffer" lua-hide-process-buffer t]
+ ["Show Process Buffer" lua-show-process-buffer t]
+ ["Beginning Of Proc" lua-beginning-of-proc t]
+ ["End Of Proc" lua-end-of-proc t]
+ ["Set Lua-Region Start" lua-set-lua-region-start t]
+ ["Set Lua-Region End" lua-set-lua-region-end t]
+ ["Send Lua-Region" lua-send-lua-region t]
+ ["Send Current Line" lua-send-current-line t]
+ ["Send Region" lua-send-region t]
+ ["Send Proc" lua-send-proc t]
+ ["Send Buffer" lua-send-buffer t]
+ ["Search Documentation" lua-search-documentation t])
+ "XEmacs menu for Lua mode.")
+
+(defvar lua-font-lock-keywords
+ (eval-when-compile
+ (list
+ ;;
+ ;; Function name declarations.
+ '("^[ \t]*\\<\\(\\(local[ \t]+\\)?function\\)\\>[ \t]+\\(\\(\\sw:\\|\\sw\\.\\|\\sw_\\|\\sw\\)+\\)"
+ (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
+
+ ;; Handle function names in assignments
+ '("\\(\\(\\sw:\\|\\sw\\.\\|\\sw_\\|\\sw\\)+\\)[ \t]*=[ \t]*\\(function\\)\\>"
+ (1 font-lock-function-name-face nil t) (3 font-lock-keyword-face))
+
+ ; Highlight multi-line comment blocks; since font-lock-mode doesn't
+ ; claim to handle the highlighting of multi-line expressions elegantly
+ ; this works best with lazy-lock-mode if your Emacs supports it, e.g.
+ ; try (setq font-lock-support-mode 'lazy-lock-mode) in your ~/.emacs
+
+ ;; Multi-line comment blocks.
+ `("\\(?:^\\|[^-]\\)\\(--\\[\\(=*\\)\\[\\(?:.\\|\n\\)*?\\]\\2\\]\\)"
+ (1 font-lock-comment-face t))
+
+ ;;
+ ;; Keywords.
+ ;; (concat "\\<"
+ ;; (regexp-opt '("and" "break" "do" "else" "elseif" "end" "false"
+ ;; "for" "function" "if" "in" "local" "nil" "not"
+ ;; "or" "repeat" "return" "then" "true" "until"
+ ;; "while") t)
+ ;; "\\>")
+
+ ; Insert expanded regexp-opt here for the benefit of those who
+ ; don't have regexp-opt available.
+
+ "\\<\\(and\\|break\\|do\\|e\\(lse\\(if\\)?\\|nd\\)\\|f\\(alse\\|or\\|unction\\)\\|i[fn]\\|local\\|n\\(il\\|ot\\)\\|or\\|re\\(peat\\|turn\\)\\|t\\(hen\\|rue\\)\\|until\\|while\\)\\>"
+
+ "Default expressions to highlight in Lua mode.")))
+
+(defvar lua-imenu-generic-expression
+ '((nil "^[ \t]*\\(?:local[ \t]+\\)?function[ \t]+\\(\\(\\sw:\\|\\sw_\\|\\sw\\.\\|\\sw\\)+\\)" 1))
+ "Imenu generic expression for lua-mode. See `imenu-generic-expression'.")
+
+(defvar lua-mode-abbrev-table nil
+ "Abbreviation table used in lua-mode buffers.")
+
+(defvar lua-sexp-alist '(("then" . "end")
+ ("function" . "end")
+ ("do" . "end")))
+
+(define-abbrev-table 'lua-mode-abbrev-table
+ '(
+ ("end" "end" lua-indent-line 0)
+ ("else" "else" lua-indent-line 0)
+ ("elseif" "elseif" lua-indent-line 0)
+ ))
+
+(defconst lua-indent-whitespace " \t"
+ "Character set that constitutes whitespace for indentation in lua.")
+
+;;}}}
+;;{{{ lua-make-temp-file
+
+(eval-and-compile
+ (defalias 'lua-make-temp-file
+ (if (fboundp 'make-temp-file)
+ 'make-temp-file
+ (lambda (prefix &optional dir-flag) ;; Simple implementation
+ (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))))
+
+;;}}}
+;;{{{ replace-in-string
+
+(eval-and-compile
+ (if (not (fboundp 'replace-in-string)) ;GNU emacs doesn't have it
+ (defun replace-in-string (string regexp newtext &optional literal)
+ (replace-regexp-in-string regexp newtext string nil literal))))
+
+;;}}}
+;;{{{ lua-mode
+
+;;;###autoload
+(defun lua-mode ()
+ "Major mode for editing Lua code.
+The following keys are bound:
+\\{lua-mode-map}
+"
+ (interactive)
+ (let ((switches nil)
+ s)
+ (kill-all-local-variables)
+ (setq major-mode 'lua-mode)
+ (setq mode-name "Lua")
+ (setq comint-prompt-regexp lua-prompt-regexp)
+ (make-local-variable 'lua-default-command-switches)
+ (set (make-local-variable 'indent-line-function) 'lua-indent-line)
+ (set (make-local-variable 'comment-start) "--")
+ (set (make-local-variable 'comment-start-skip) "--")
+ (set (make-local-variable 'font-lock-defaults)
+ '(lua-font-lock-keywords nil nil ((?_ . "w"))))
+ (set (make-local-variable 'imenu-generic-expression)
+ lua-imenu-generic-expression)
+ (setq local-abbrev-table lua-mode-abbrev-table)
+ (abbrev-mode 1)
+ (make-local-variable 'lua-default-eval)
+ (or lua-mode-map
+ (lua-setup-keymap))
+ (use-local-map lua-mode-map)
+ (set-syntax-table (copy-syntax-table))
+ (modify-syntax-entry ?+ ".")
+ (modify-syntax-entry ?- ". 12")
+ (modify-syntax-entry ?* ".")
+ (modify-syntax-entry ?/ ".")
+ (modify-syntax-entry ?^ ".")
+ ;; This might be better as punctuation, as for C, but this way you
+ ;; can treat table index as symbol.
+ (modify-syntax-entry ?. "_") ; e.g. `io.string'
+ (modify-syntax-entry ?> ".")
+ (modify-syntax-entry ?< ".")
+ (modify-syntax-entry ?= ".")
+ (modify-syntax-entry ?~ ".")
+ (modify-syntax-entry ?\n ">")
+ (modify-syntax-entry ?\' "\"")
+ (modify-syntax-entry ?\" "\"")
+ ;; _ needs to be part of a word, or the regular expressions will
+ ;; incorrectly regognize end_ to be matched by "\\<end\\>"!
+ (modify-syntax-entry ?_ "w")
+ (if (and lua-using-xemacs
+ (featurep 'menubar)
+ current-menubar
+ (not (assoc "Lua" current-menubar)))
+ (progn
+ (set-buffer-menubar (copy-sequence current-menubar))
+ (add-menu nil "Lua" lua-xemacs-menu)))
+ ;; Append Lua menu to popup menu for XEmacs.
+ (if (and lua-using-xemacs (boundp 'mode-popup-menu))
+ (setq mode-popup-menu
+ (cons (concat mode-name " Mode Commands") lua-xemacs-menu)))
+
+ ;; hideshow setup
+ (unless (assq 'lua-mode hs-special-modes-alist)
+ (add-to-list 'hs-special-modes-alist
+ `(lua-mode
+ ,(regexp-opt (mapcar 'car lua-sexp-alist) 'words);start
+ ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ;end
+ nil lua-forward-sexp)))
+ (run-hooks 'lua-mode-hook)))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode))
+
+;;}}}
+;;{{{ lua-setup-keymap
+
+(defun lua-setup-keymap ()
+ "Set up keymap for Lua mode.
+If the variable `lua-prefix-key' is nil, the bindings go directly
+to `lua-mode-map', otherwise they are prefixed with `lua-prefix-key'."
+ (setq lua-mode-map (make-sparse-keymap))
+ (define-key lua-mode-map [menu-bar lua-mode]
+ (cons "Lua" lua-mode-menu))
+ (define-key lua-mode-map "}" 'lua-electric-match)
+ (define-key lua-mode-map "]" 'lua-electric-match)
+ (define-key lua-mode-map ")" 'lua-electric-match)
+ (let ((map (if lua-prefix-key
+ (make-sparse-keymap)
+ lua-mode-map)))
+
+ ;; communication
+ (define-key map "\M-[" 'lua-beginning-of-proc)
+ (define-key map "\M-]" 'lua-end-of-proc)
+ (define-key map "\C-c" 'comment-region)
+ (define-key map "\C-l" 'lua-send-buffer)
+ (define-key map "\C-f" 'lua-search-documentation)
+ (if lua-prefix-key
+ (define-key lua-mode-map lua-prefix-key map))
+ ))
+
+;;}}}
+;;{{{ lua-electric-match
+
+(defun lua-electric-match (arg)
+ "Insert character and adjust indentation."
+ (interactive "P")
+ (insert-char last-command-char (prefix-numeric-value arg))
+ (if lua-electric-flag
+ (lua-indent-line))
+ (blink-matching-open))
+
+;;}}}
+
+;;{{{ private functions
+(defun lua-syntax-status ()
+ "Returns the syntactic status of the character after the point."
+ (parse-partial-sexp (save-excursion (beginning-of-line) (point))
+ (point)))
+
+
+(defun lua-string-p ()
+ "Returns true if the point is in a string."
+ (elt (lua-syntax-status) 3))
+
+(defun lua-comment-p ()
+ "Returns true if the point is in a comment."
+ (elt (lua-syntax-status) 4))
+
+(defun lua-comment-or-string-p ()
+ "Returns true if the point is in a comment or string."
+ (let ((parse-result (lua-syntax-status)))
+ (or (elt parse-result 3) (elt parse-result 4))))
+
+;;}}}
+;;{{{ lua-indent-line
+
+(defun lua-indent-line ()
+ "Indent current line for Lua mode.
+Return the amount the indentation changed by."
+ (let ((indent (max 0 (- (lua-calculate-indentation nil)
+ (lua-calculate-indentation-left-shift))))
+ beg shift-amt
+ (case-fold-search nil)
+ (pos (- (point-max) (point))))
+ (beginning-of-line)
+ (setq beg (point))
+ (skip-chars-forward lua-indent-whitespace)
+ (setq shift-amt (- indent (current-column)))
+ (when (not (zerop shift-amt))
+ (delete-region beg (point))
+ (indent-to indent))
+ ;; If initial point was within line's indentation,
+ ;; position after the indentation. Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))
+ shift-amt
+ indent))
+
+;;}}}
+;;{{{ lua-find-regexp
+
+(defun lua-find-regexp (direction regexp &optional limit ignore-p)
+ "Searches for a regular expression in the direction specified.
+Direction is one of 'forward and 'backward.
+By default, matches in comments and strings are ignored, but what to ignore is
+configurable by specifying ignore-p. If the regexp is found, returns point
+position, nil otherwise.
+ignore-p returns true if the match at the current point position should be
+ignored, nil otherwise."
+ (let ((ignore-func (or ignore-p 'lua-comment-or-string-p))
+ (search-func (if (eq direction 'forward)
+ 're-search-forward 're-search-backward))
+ (case-fold-search nil))
+ (catch 'found
+ (while (funcall search-func regexp limit t)
+ (if (not (funcall ignore-func))
+ (throw 'found (point)))))))
+
+;;}}}
+;;{{{ lua-backwards-to-block-begin-or-end
+
+(defun lua-backwards-to-block-begin-or-end ()
+ "Move backwards to nearest block begin or end. Returns nil if not successful."
+ (interactive)
+ (lua-find-regexp 'backward lua-block-regexp))
+
+;;}}}
+;;{{{ var. constants
+
+(defconst lua-block-regexp
+ (eval-when-compile
+ ;; This is the code we used to generate the regexp:
+ (concat
+ "\\(\\<"
+ (regexp-opt '("do" "function" "repeat" "then"
+ "else" "elseif" "end" "until") t)
+ "\\>\\)\\|"
+ (regexp-opt '("{" "(" "[" "]" ")" "}") t))
+
+ ))
+
+(defconst lua-block-token-alist
+ ;; The absence of "else" is deliberate. This construct in a way both
+ ;; opens and closes a block. As a result, it is difficult to handle
+ ;; cleanly. It is also ambiguous - if we are looking for the match
+ ;; of "else", should we look backward for "then/elseif" or forward
+ ;; for "end"?
+ ;; Maybe later we will find a way to handle it.
+ '(("do" "\\<end\\>" open)
+ ("function" "\\<end\\>" open)
+ ("repeat" "\\<until\\>" open)
+ ("then" "\\<\\(e\\(lseif\\|nd\\)\\)\\>" open)
+ ("{" "}" open)
+ ("[" "]" open)
+ ("(" ")" open)
+ ("elseif" "\\<then\\>" close)
+ ("end" "\\<\\(do\\|function\\|then\\)\\>" close)
+ ("until" "\\<repeat\\>" close)
+ ("}" "{" close)
+ ("]" "\\[" close)
+ (")" "(" close)))
+
+
+(defconst lua-indentation-modifier-regexp
+ ;; The absence of else is deliberate, since it does not modify the
+ ;; indentation level per se. It only may cause the line, in which the
+ ;; else is, to be shifted to the left.
+ ;; This is the code we used to generate the regexp:
+ (concat
+ "\\(\\<"
+ ; n.b. "local function" is a bit of a hack, allowing only a single space
+ (regexp-opt '("do" "local function" "function" "repeat" "then") t)
+ "\\>\\|"
+ (regexp-opt '("{" "(" "["))
+ "\\)\\|\\(\\<"
+ (regexp-opt '("elseif" "end" "until") t)
+ "\\>\\|"
+ (regexp-opt '("]" ")" "}"))
+ "\\)")
+
+ )
+
+;;}}}
+;;{{{ lua-find-matching-token-word
+
+(defun lua-find-matching-token-word (token search-start)
+ (let* ((token-info (assoc token lua-block-token-alist))
+ (match (car (cdr token-info)))
+ (match-type (car (cdr (cdr token-info))))
+ (search-direction (if (eq match-type 'open) 'forward 'backward)))
+ ;; if we are searching forward from the token at the current point
+ ;; (i.e. for a closing token), need to step one character forward
+ ;; first, or the regexp will match the opening token.
+ (if (eq match-type 'open) (forward-char 1))
+ (if search-start (goto-char search-start))
+ (catch 'found
+ (while (lua-find-regexp search-direction lua-indentation-modifier-regexp)
+ ;; have we found a valid matching token?
+ (let ((found-token (match-string 0))
+ (found-pos (match-beginning 0)))
+ (if (string-match match found-token)
+ (throw 'found found-pos))
+ ;; no - then there is a nested block. If we were looking for
+ ;; a block begin token, found-token must be a block end
+ ;; token; likewise, if we were looking for a block end token,
+ ;; found-token must be a block begin token, otherwise there
+ ;; is a grammatical error in the code.
+ (if (not (and
+ (eq (car (cdr (cdr (assoc found-token lua-block-token-alist))))
+ match-type)
+ (lua-find-matching-token-word found-token nil)))
+ (throw 'found nil)))))))
+
+;;}}}
+;;{{{ lua-goto-matching-block-token
+
+(defun lua-goto-matching-block-token (&optional search-start parse-start)
+ "Find block begion/end token matching the one at the point.
+This function moves the point to the token that matches the one
+at the current point. Returns the point position of the first character of
+the matching token if successful, nil otherwise."
+ (if parse-start (goto-char parse-start))
+ (let ((case-fold-search nil))
+ (if (looking-at lua-indentation-modifier-regexp)
+ (let ((position (lua-find-matching-token-word (match-string 0)
+ search-start)))
+ (and position
+ (goto-char position))))))
+
+
+;; The following may be useful to speed up the search in the future.
+; (let ((token-type (char-syntax (string-to-char token-to-match)))
+; matching-pos)
+; (cond ((eq token-type ?\()
+; (setq matching-pos (scan-sexps (point) 1 (current-buffer) t))
+; (when matching-pos (goto-char matching-pos)))
+
+; ((eq token-type ?\))
+; ;; need to move one char forward, because scan-sexps
+; ;; expects the point to be one past the closing parenthesis
+; (forward-char 1)
+; (setq matching-pos (scan-sexps (point) -1 (current-buffer) t))
+; (when matching-pos (goto-char matching-pos)))
+
+; (t
+; (lua-goto-matching-token-word token-to-match search-start)))))))
+
+
+;;}}}
+;;{{{ lua-goto-matching-block
+
+(defun lua-goto-matching-block (&optional noreport)
+ "Go to the keyword balancing the one under the point.
+If the point is on a keyword/brace that starts a block, go to the
+matching keyword that ends the block, and vice versa."
+ (interactive)
+ ;; search backward to the beginning of the keyword if necessary
+ (if (eq (char-syntax (following-char)) ?w)
+ (re-search-backward "\\<" nil t))
+ (let ((position (lua-goto-matching-block-token)))
+ (if (and (not position)
+ (not noreport))
+ (error "Not on a block control keyword or brace.")
+ position)))
+
+;;}}}
+;;{{{ lua-goto-nonblank-previous-line
+
+(defun lua-goto-nonblank-previous-line ()
+ "Puts the point at the first previous line that is not blank.
+Returns the point, or nil if it reached the beginning of the buffer"
+ (catch 'found
+ (beginning-of-line)
+ (while t
+ (if (bobp) (throw 'found nil))
+ (forward-char -1)
+ (beginning-of-line)
+ (if (not (looking-at "\\s *\\(--.*\\)?$")) (throw 'found (point))))))
+
+;;}}}
+;;{{{ lua-goto-nonblank-next-line
+
+(defun lua-goto-nonblank-next-line ()
+ "Puts the point at the first next line that is not blank.
+Returns the point, or nil if it reached the end of the buffer"
+ (catch 'found
+ (end-of-line)
+ (while t
+ (forward-line)
+ (if (eobp) (throw 'found nil))
+ (beginning-of-line)
+ (if (not (looking-at "\\s *\\(--.*\\)?$")) (throw 'found (point))))))
+
+(eval-when-compile
+ (defconst lua-operator-class
+ "-+*/^.=<>~"))
+
+;;}}}
+;;{{{ var. constans
+
+(defconst lua-cont-eol-regexp
+ (eval-when-compile
+ ;; expression used to generate the regexp
+ (concat
+ "\\(\\<"
+ (regexp-opt '("and" "or" "not" "in" "for" "while"
+ "local" "function") t)
+ "\\>\\|"
+ "\\(^\\|[^" lua-operator-class "]\\)"
+ (regexp-opt '("+" "-" "*" "/" "^" ".." "==" "=" "<" ">" "<=" ">=" "~=") t)
+ "\\)"
+ "\\s *\\=")
+
+ ))
+
+
+(defconst lua-cont-bol-regexp
+ (eval-when-compile
+ ;; expression used to generate the regexp
+ (concat
+ "\\=\\s *"
+ "\\(\\<"
+ (regexp-opt '("and" "or" "not") t)
+ "\\>\\|"
+ (regexp-opt '("+" "-" "*" "/" "^" ".." "==" "=" "<" ">" "<=" ">=" "~=") t)
+ "\\($\\|[^" lua-operator-class "]\\)"
+ "\\)")
+
+ ))
+
+;;}}}
+;;{{{ lua-last-token-continues-p
+
+(defun lua-last-token-continues-p ()
+ "Returns true if the last token on this line is a continuation token."
+ (let (line-begin
+ line-end)
+ (save-excursion
+ (beginning-of-line)
+ (setq line-begin (point))
+ (end-of-line)
+ (setq line-end (point))
+ ;; we need to check whether the line ends in a comment and
+ ;; skip that one.
+ (while (lua-find-regexp 'backward "-" line-begin 'lua-string-p)
+ (if (looking-at "--")
+ (setq line-end (point))))
+ (goto-char line-end)
+ (re-search-backward lua-cont-eol-regexp line-begin t))))
+
+;;}}}
+;;{{{ lua-first-token-continues-p
+
+(defun lua-first-token-continues-p ()
+ "Returns true if the first token on this line is a continuation token."
+ (let (line-end)
+ (save-excursion
+ (end-of-line)
+ (setq line-end (point))
+ (beginning-of-line)
+ (re-search-forward lua-cont-bol-regexp line-end t))))
+
+;;}}}
+;;{{{ lua-is-continuing-statement-p
+
+(defun lua-is-continuing-statement-p (&optional parse-start)
+ "Return nonnil if the line continues a statement.
+More specifically, return the point in the line that is continued.
+The criteria for a continuing statement are:
+
+* the last token of the previous line is a continuing op,
+ OR the first token of the current line is a continuing op
+
+"
+ (let ((prev-line nil))
+ (save-excursion
+ (if parse-start (goto-char parse-start))
+ (save-excursion (setq prev-line (lua-goto-nonblank-previous-line)))
+ (and prev-line
+ (or (lua-first-token-continues-p)
+ (and (goto-char prev-line)
+ ;; check last token of previous nonblank line
+ (lua-last-token-continues-p)))))))
+
+;;}}}
+;;{{{ lua-make-indentation-info-pair
+
+(defun lua-make-indentation-info-pair ()
+ "This is a helper function to lua-calculate-indentation-info. Don't
+use standalone."
+ (cond ((string-equal found-token "function")
+ ;; this is the location where we need to start searching for the
+ ;; matching opening token, when we encounter the next closing token.
+ ;; It is primarily an optimization to save some searchingt ime.
+ (cons 'absolute (+ (save-excursion (goto-char found-pos)
+ (current-column))
+ lua-indent-level)))
+ ((or (string-equal found-token "{")
+ (string-equal found-token "("))
+ (save-excursion
+ ;; expression follows -> indent at start of next expression
+ (if (and (not (search-forward-regexp "[[:space:]]--" (line-end-position) t))
+ (search-forward-regexp "[^[:space:]]" (line-end-position) t))
+ (cons 'absolute (1- (current-column)))
+ (cons 'relative lua-indent-level))))
+ ;; closing tokens follow
+ ((string-equal found-token "end")
+ (save-excursion