From mboxrd@z Thu Jan 1 00:00:00 1970 From: Jambunathan K Subject: Re: [odt] htmlfontify + Support for src blockfontification Date: Fri, 19 Aug 2011 17:56:24 +0530 Message-ID: <81liupk2of.fsf@gmail.com> References: <81ty9i1kg5.fsf@gmail.com> <877h6cfk68.fsf@altern.org> <814o1elfkj.fsf@gmail.com> <87ei0hrgcz.fsf@altern.org> <81wre9yfmx.fsf@gmail.com> <87pqk1ohma.fsf@altern.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([140.186.70.92]:35123) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QuOB9-0008Uq-C5 for emacs-orgmode@gnu.org; Fri, 19 Aug 2011 08:28:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QuOB0-0004PE-4t for emacs-orgmode@gnu.org; Fri, 19 Aug 2011 08:28:03 -0400 Received: from mail-pz0-f44.google.com ([209.85.210.44]:64175) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QuOAy-0004P8-Sj for emacs-orgmode@gnu.org; Fri, 19 Aug 2011 08:27:54 -0400 Received: by pzk36 with SMTP id 36so5687308pzk.17 for ; Fri, 19 Aug 2011 05:27:51 -0700 (PDT) In-Reply-To: <87pqk1ohma.fsf@altern.org> (Bastien's message of "Fri, 19 Aug 2011 11:50:05 +0200") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Bastien Cc: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain > Hi Jambunathan, > > we are discussing in abstract terms, and that might distract us from > DTRT together: can you show the patched version of htmlfontify.el? Here you go. Patch numbered 1 is the base htmlfontify.el (same as that in emacs-24 trunk). I am also attaching a final copy of htmlfontify.el after it has gone through the series of 5 patches. Jambunathan K. -- --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-contrib-lisp-htmlfontify.el-Added-from-emacs-24-trun.patch Content-Transfer-Encoding: quoted-printable >From ebccd804aa39215c67ebc7a2176575fd7e4c4284 Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 19 Aug 2011 01:40:55 +0530 Subject: [PATCH 1/6] * contrib/lisp/htmlfontify.el: Added from emacs-24 tru= nk --- contrib/lisp/htmlfontify.el | 2343 +++++++++++++++++++++++++++++++++++++++= ++++ 1 files changed, 2343 insertions(+), 0 deletions(-) create mode 100755 contrib/lisp/htmlfontify.el diff --git a/contrib/lisp/htmlfontify.el b/contrib/lisp/htmlfontify.el new file mode 100755 index 0000000..c8e9558 --- /dev/null +++ b/contrib/lisp/htmlfontify.el @@ -0,0 +1,2343 @@ +;;; htmlfontify.el --- htmlise a buffer/source tree with optional hyperlin= ks + +;; Copyright (C) 2002-2003, 2009-2011 Free Software Foundation, Inc. + +;; Emacs Lisp Archive Entry +;; Package: htmlfontify +;; Filename: htmlfontify.el +;; Version: 0.21 +;; Keywords: html, hypermedia, markup, etags +;; Author: Vivek Dasmohapatra +;; Maintainer: Vivek Dasmohapatra +;; Created: 2002-01-05 +;; Description: htmlise a buffer/source tree with optional hyperlinks +;; URL: http://rtfm.etla.org/emacs/htmlfontify/ +;; Compatibility: Emacs23, Emacs22 +;; Incompatibility: Emacs19, Emacs20, Emacs21 +;; Last Updated: Thu 2009-11-19 01:31:21 +0000 +;; Version: 0.21 + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; I have made some changes to make it work for Emacs 22. A lot of +;; small bug fixes related to the format of text and overlay +;; properties (which might have changed since the beginning of 2003 +;; when this file was originally written). +;; +;; The function `hfy-face-at' currently carries much of the burden of +;; my lacking understanding of the formats mentioned above and should +;; need some knowledgeable help. +;; +;; Another thing that maybe could be fixed is that overlay background +;; colors which are now only seen where there is text (in the XHTML +;; output). A bit of CSS tweaking is necessary there. +;; +;; The face 'default has a value :background "SystemWindow" for the +;; background color. There is no explicit notion that this should be +;; considered transparent, but I have assumed that it could be handled +;; like if it was here. (I am unsure that background and foreground +;; priorities are handled ok, but it looks ok in my tests now.) +;; +;; 2007-12-27 Lennart Borgman +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Here's some elisp code to html-pretty-print an Emacs buffer, preserving +;; the Emacs syntax/whatever highlighting. It also knows how to drive eta= gs +;; (exuberant-ctags or Emacs etags) and hyperlink the code according +;; to its (etags') output. + +;; NOTE: Currently the hyperlinking code only knows how to drive GNU find +;; and the exuberant and GNU variants of etags : I do not know of any other +;; etags variants, but mechanisms have been provided to allow htmlfontify +;; to be taught how to drive them. As long as your version of find has +;; the -path test and is reasonably sane, you should be fine. + +;; A sample of the htmlfontified / hyperlinked output of this module can be +;; found at http://rtfm.etla.org/sql/dbishell/src/ - it's not perfect, but +;; it's a hell of a lot faster and more thorough than I could hope to be +;; doing this by hand. + +;; some user / horrified onlooker comments: +;; What? No! There's something deeply wrong here... (R. Shufflebotham) +;; You're a freak. (D. Silverstone) +;; Aren't we giving you enough to do? (J. Busuttil) +;; You're almost as messed up as Lexx is! (N. Graves-Morris) + +;;; History: +;; Changes: moved to changelog (CHANGES) file. + +;;; Code: +(eval-when-compile (require 'cl)) +(require 'faces) +;; (`facep' `face-attr-construct' `x-color-values' `color-values' `face-n= ame') +(require 'custom) +;; (`defgroup' `defcustom') +(require 'font-lock) +;; (`font-lock-fontify-region') +(require 'cus-edit) + +(defconst htmlfontify-version 0.21) + +(defconst hfy-meta-tags + (format "" + emacs-version htmlfontify-version) + "The generator meta tag for this version of htmlfontify.") + +(defconst htmlfontify-manual "Htmlfontify Manual" + "Copy and convert buffers and files to HTML, adding hyperlinks between f= iles +\(driven by etags) if requested. +\nInteractive functions: + `htmlfontify-buffer' + `htmlfontify-run-etags' + `htmlfontify-copy-and-link-dir' + `htmlfontify-load-rgb-file' + `htmlfontify-unload-rgb-file'\n +In order to:\n +fontify a file you have open: \\[htmlfontify-buffer] +prepare the etags map for a directory: \\[htmlfontify-run-etags] +copy a directory, fontifying as you go: \\[htmlfontify-copy-and-link-dir]\n +The following might be useful when running non-windowed or in batch mode: +\(note that they shouldn't be necessary - we have a built in map)\n +load an X11 style rgb.txt file: \\[htmlfontify-load-rgb-file] +unload the current rgb.txt file: \\[htmlfontify-unload-rgb-file]\n +And here's a programmatic example:\n +\(defun rtfm-build-page-header (file style) + (format \"#define TEMPLATE red+black.html +#define DEBUG 1 +#include \\n +html-css-url :=3D /css/red+black.css +title :=3D rtfm.etla.org ( %s / src/%s ) +bodytag :=3D +head <=3DSTYLESHEET;\\n +%s +STYLESHEET +main-title :=3D rtfm / %s / src/%s\\n +main-content <=3DMAIN_CONTENT;\\n\" rtfm-section file style rtfm-section f= ile)) + +\(defun rtfm-build-page-footer (file) \"\\nMAIN_CONTENT\\n\") + +\(defun rtfm-build-source-docs (section srcdir destdir) + (interactive + \"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \") + (require 'htmlfontify) + (hfy-load-tags-cache srcdir) + (let ((hfy-page-header 'rtfm-build-page-header) + (hfy-page-footer 'rtfm-build-page-footer) + (rtfm-section section) + (hfy-index-file \"index\")) + (htmlfontify-run-etags srcdir) + (htmlfontify-copy-and-link-dir srcdir destdir \".src\" \".html\")))") + +(defgroup htmlfontify nil + "Convert buffers and files to HTML." + :group 'applications + :link '(variable-link htmlfontify-manual) + :prefix "hfy-") + +(defcustom hfy-page-header 'hfy-default-header + "Function called to build the header of the html source. +This is called with two arguments (the filename relative to the top +level source directory being etag'd and fontified), and a string containing +the text to embed in the document. +It should return the string returned will be used as the header for the +htmlfontified version of the source file.\n +See also `hfy-page-footer'." + :group 'htmlfontify + ;; FIXME: Why place such a :tag everywhere? Isn't it imposing your + ;; own Custom preference on your users? --Stef + :tag "page-header" + :type '(function)) + +(defcustom hfy-split-index nil + "Whether or not to split the index `hfy-index-file' alphabetically. +If non-nil, the index is split on the first letter of each tag. +Useful when the index would otherwise +be large and take a long time to render or be difficult to navigate." + :group 'htmlfontify + :tag "split-index" + :type '(boolean)) + +(defcustom hfy-page-footer 'hfy-default-footer + "As `hfy-page-header', but generates the output footer. +It takes only one argument, the filename." + :group 'htmlfontify + :tag "page-footer" + :type '(function)) + +(defcustom hfy-extn ".html" + "File extension used for output files." + :group 'htmlfontify + :tag "extension" + :type '(string)) + +(defcustom hfy-src-doc-link-style "text-decoration: underline;" + "String to add to the '\n"))) + (funcall hfy-page-header file stylesheet))) + +;; tag all the dangerous characters we want to escape +;; (ie any "<> chars we _didn't_ put there explicitly for css markup) +(defun hfy-html-enkludge-buffer () + "Mark dangerous [\"<>] characters with the `hfy-quoteme' property.\n +See also `hfy-html-dekludge-buffer'." + ;;(message "hfy-html-enkludge-buffer");;DBUG + (save-excursion + (goto-char (point-min)) + (while (re-search-forward hfy-html-quote-regex nil t) + (put-text-property (match-beginning 0) (point) 'hfy-quoteme t))) ) + +;; dangerous char -> &entity; +(defun hfy-html-quote (char-string) + "Map CHAR-STRING to an HTML safe string (entity) if need be." + ;;(message "hfy-html-quote");;DBUG + (or (cadr (assoc char-string hfy-html-quote-map)) char-string) ) + +;; actually entity-ise dangerous chars. +;; note that we can't do this until _after_ we have inserted the css +;; markup, since we use a position-based map to insert this, and if we +;; enter any other text before we do this, we'd have to track another +;; map of offsets, which would be tedious... +(defun hfy-html-dekludge-buffer () + "Transform all dangerous characters marked with the `hfy-quoteme' proper= ty +using `hfy-html-quote'.\n +See also `hfy-html-enkludge-buffer'." + ;;(message "hfy-html-dekludge-buffer");;DBUG + (save-excursion + (goto-char (point-min)) + (while (re-search-forward hfy-html-quote-regex nil t) + (if (get-text-property (match-beginning 0) 'hfy-quoteme) + (replace-match (hfy-html-quote (match-string 1))) )) )) + +;; Borrowed from font-lock.el +(defmacro hfy-save-buffer-state (varlist &rest body) + "Bind variables according to VARLIST and eval BODY restoring buffer stat= e. +Do not record undo information during evaluation of BODY." + (declare (indent 1) (debug let)) + (let ((modified (make-symbol "modified"))) + `(let* ,(append varlist + `((,modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + deactivate-mark + buffer-file-name + buffer-file-truename)) + (progn + ,@body) + (unless ,modified + (restore-buffer-modified-p nil))))) + +(defun hfy-mark-trailing-whitespace () + "Tag trailing whitespace with a hfy property if it is currently highligh= ted." + (when show-trailing-whitespace + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (hfy-save-buffer-state nil + (while (re-search-forward "[ \t]+$" nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'hfy-show-trailing-whitespace t))))))) + +(defun hfy-unmark-trailing-whitespace () + "Undo the effect of `hfy-mark-trailing-whitespace'." + (when show-trailing-whitespace + (hfy-save-buffer-state nil + (remove-text-properties (point-min) (point-max) + '(hfy-show-trailing-whitespace))))) + +(defun hfy-fontify-buffer (&optional srcdir file) + "Implement the guts of `htmlfontify-buffer'. +SRCDIR, if set, is the directory being htmlfontified. +FILE, if set, is the file name." + (if srcdir (setq srcdir (directory-file-name srcdir))) + (let* ( (html-buffer (hfy-buffer)) + (css-sheet nil) + (css-map nil) + (invis-ranges nil) + (rovl nil) + (orig-ovls (overlays-in (point-min) (point-max))) + (rmin (when mark-active (region-beginning))) + (rmax (when mark-active (region-end ))) ) + (when (and mark-active + transient-mark-mode) + (unless (and (=3D rmin (point-min)) + (=3D rmax (point-max))) + (setq rovl (make-overlay rmin rmax)) + (overlay-put rovl 'priority 1000) + (overlay-put rovl 'face 'region))) + ;; copy the buffer, including fontification, and switch to it: + (hfy-mark-trailing-whitespace) + (setq css-sheet (hfy-compile-stylesheet ) + css-map (hfy-compile-face-map ) + invis-ranges (hfy-find-invisible-ranges)) + (hfy-unmark-trailing-whitespace) + (when rovl + (delete-overlay rovl)) + (copy-to-buffer html-buffer (point-min) (point-max)) + (set-buffer html-buffer) + ;; rip out props that could interfere with our htmlisation of the buff= er: + (remove-text-properties (point-min) (point-max) hfy-ignored-properties) + ;; Apply overlay invisible spec + (setq orig-ovls + (sort orig-ovls + (lambda (A B) + (> (or (cadr (memq 'priority (overlay-properties A))) 0) + (or (cadr (memq 'priority (overlay-properties B))) 0)= )))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;;; + ;; at this point, html-buffer retains the fontification of the parent: + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;;; + ;; we don't really need or want text in the html buffer to be invisibl= e, as + ;; that can make it look like we've rendered invalid xhtml when all th= at's + ;; happened is some tags are in the invisible portions of the buffer: + (setq buffer-invisibility-spec nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;;; + ;; ###################################################################= ## + ;; if we are in etags mode, add properties to mark the anchors and lin= ks + (if (and srcdir file) + (progn + (hfy-mark-tag-names srcdir file) ;; mark anchors + (hfy-mark-tag-hrefs srcdir file))) ;; mark links + ;; ###################################################################= ## + ;; mark the 'dangerous' characters + ;;(message "marking dangerous characters") + (hfy-html-enkludge-buffer) + ;; trawl the position-based face-map, inserting span tags as we go + ;; note that we cannot change any character positions before this point + ;; or we will invalidate the map: + ;; NB: This also means we have to trawl the map in descending file-off= set + ;; order, obviously. + ;; -------------------------------------------------------------------= -- + ;; Remember, inserting pushes properties to the right, which we don't + ;; actually want to happen for link properties, so we have to flag + ;; them and move them by hand - if you don't, you end up with + ;; + ;; texta... + ;; + ;; instead of: + ;; + ;; texta... + ;; + ;; If my analysis of the problem is correct, we can detect link-ness by + ;; either hfy-linkp or hfy-endl properties at the insertion point, but= I + ;; think we only need to relocate the hfy-endl property, as the hfy-li= nkp + ;; property has already served its main purpose by this point. + ;;(message "mapcar over the CSS-MAP") + (message "invis-ranges:\n%S" invis-ranges) + (dolist (point-face css-map) + (let ((pt (car point-face)) + (fn (cdr point-face)) + (move-link nil)) + (goto-char pt) + (setq move-link + (or (get-text-property pt 'hfy-linkp) + (get-text-property pt 'hfy-endl ))) + (if (eq 'end fn) + (insert "") + (if (not (and srcdir file)) + nil + (when move-link + (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) + (put-text-property pt (1+ pt) 'hfy-endl t) )) + ;; if we have invisible blocks, we need to do some extra magic: + (if invis-ranges + (let ((iname (hfy-invisible-name pt invis-ranges)) + (fname (hfy-lookup fn css-sheet ))) + (when (assq pt invis-ranges) + (insert + (format "" inam= e)) + (insert "=E2=80=A6")) + (insert + (format "" fname inam= e pt))) + (insert (format "" (hfy-lookup fn css-she= et)))) + (if (not move-link) nil + ;;(message "removing prop2 @ %d" (point)) + (if (remove-text-properties (point) (1+ (point)) '(hfy-endl ni= l)) + (put-text-property pt (1+ pt) 'hfy-endl t)))))) + ;; ###################################################################= ## + ;; Invisibility + ;; Maybe just make the text invisible in XHTML? + ;; DONE -- big block of obsolete invisibility code elided here -- v + ;; ###################################################################= ## + ;; (message "checking to see whether we should link...") + (if (and srcdir file) + (let ((lp 'hfy-link) + (pt (point-min)) + (pr nil) + (rr nil)) + ;; (message " yes we should.") + ;; translate 'hfy-anchor properties to anchors + (while (setq pt (next-single-property-change pt 'hfy-anchor)) + (if (setq pr (get-text-property pt 'hfy-anchor)) + (progn (goto-char pt) + (remove-text-properties pt (1+ pt) '(hfy-anchor nil= )) + (insert (concat ""))))) + ;; translate alternate 'hfy-link and 'hfy-endl props to opening + ;; and closing links. (this should avoid those spurious closes + ;; we sometimes get by generating only paired tags) + (setq pt (point-min)) + (while (setq pt (next-single-property-change pt lp)) + (if (not (setq pr (get-text-property pt lp))) nil + (goto-char pt) + (remove-text-properties pt (1+ pt) (list lp nil)) + (case lp + (hfy-link + (if (setq rr (get-text-property pt 'hfy-inst)) + (insert (format "" rr))) + (insert (format "" pr)) + (setq lp 'hfy-endl)) + (hfy-endl + (insert "") (setq lp 'hfy-link)) ))) )) + + ;; ###################################################################= ## + ;; transform the dangerous chars. This changes character positions + ;; since entities have > char length. + ;; note that this deletes the dangerous characters, and therefore + ;; destroys any properties they may contain (such as 'hfy-endl), + ;; so we have to do this after we use said properties: + ;; (message "munging dangerous characters") + (hfy-html-dekludge-buffer) + ;; insert the stylesheet at the top: + (goto-char (point-min)) + ;;(message "inserting stylesheet") + (insert (hfy-sprintf-stylesheet css-sheet file)) + (if (hfy-opt 'div-wrapper) (insert "
")) + (insert "\n
")
+    (goto-char (point-max))
+    (insert "
\n") + (if (hfy-opt 'div-wrapper) (insert "
")) + ;;(message "inserting footer") + (insert (funcall hfy-page-footer file)) + ;; call any post html-generation hooks: + (run-hooks 'hfy-post-html-hooks) + ;; return the html buffer + (set-buffer-modified-p nil) + html-buffer)) + +(defun hfy-force-fontification () + "Try to force font-locking even when it is optimized away." + (run-hooks 'hfy-init-kludge-hook) + (eval-and-compile (require 'font-lock)) + (if (boundp 'font-lock-cache-position) + (or font-lock-cache-position + (set 'font-lock-cache-position (make-marker)))) + (if (not noninteractive) + (progn + (message "hfy interactive mode (%S %S)" window-system major-mode) + (when (and font-lock-defaults + font-lock-mode) + (font-lock-fontify-region (point-min) (point-max) nil))) + (message "hfy batch mode (%s:%S)" + (or (buffer-file-name) (buffer-name)) major-mode) + (when font-lock-defaults + (font-lock-fontify-buffer)) )) + +;;;###autoload +(defun htmlfontify-buffer (&optional srcdir file) + "Create a new buffer, named for the current buffer + a .html extension, +containing an inline CSS-stylesheet and formatted CSS-markup HTML +that reproduces the look of the current Emacs buffer as closely +as possible. + +Dangerous characters in the existing buffer are turned into HTML +entities, so you should even be able to do HTML-within-HTML +fontified display. + +You should, however, note that random control or eight-bit +characters such as ^L (\x0c) or =C2=A4 (\xa4) won't get mapped yet. + +If the SRCDIR and FILE arguments are set, lookup etags derived +entries in the `hfy-tags-cache' and add HTML anchors and +hyperlinks as appropriate." + (interactive) + ;; pick up the file name in case we didn't receive it + (if (not file) + (progn (setq file (or (buffer-file-name) (buffer-name))) + (if (string-match "/\\([^/]*\\)\\'" file) + (setq file (match-string 1 file)))) ) + + (if (not (hfy-opt 'skip-refontification)) + (save-excursion ;; Keep region + (hfy-force-fontification))) + (if (called-interactively-p 'any) ;; display the buffer in interactive m= ode: + (switch-to-buffer (hfy-fontify-buffer srcdir file)) + (hfy-fontify-buffer srcdir file))) + +;; recursive file listing +(defun hfy-list-files (directory) + "Return a list of files under DIRECTORY. +Strips any leading \"./\" from each filename." + ;;(message "hfy-list-files");;DBUG + ;; FIXME: this changes the dir of the currrent buffer. Is that right?? + (cd directory) + (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F= ) F)) + (split-string (shell-command-to-string hfy-find-cmd))) ) + +;; strip the filename off, return a directiry name +;; not a particularly thorough implementaion, but it will be +;; fed pretty carefully, so it should be Ok: +(defun hfy-dirname (file) + "Return everything preceding the last \"/\" from a relative filename FIL= E, +on the assumption that this will produce a relative directory name. +Hardly bombproof, but good enough in the context in which it is being used= ." + ;;(message "hfy-dirname");;DBUG + (let ((f (directory-file-name file))) + (and (string-match "^\\(.*\\)/" f) (match-string 1 f)))) + +;; create a directory, cf mkdir -p +(defun hfy-make-directory (dir) + "Approx. equivalent of mkdir -p DIR." + ;;(message "hfy-make-directory");;DBUG + (if (file-exists-p dir) + (if (file-directory-p dir) t) + (make-directory dir t))) + +(defun hfy-text-p (srcdir file) + "Is SRCDIR/FILE text? Uses `hfy-istext-command' to determine this." + (let* ((cmd (format hfy-istext-command (expand-file-name file srcdir))) + (rsp (shell-command-to-string cmd))) + (string-match "text" rsp))) + +;; open a file, check fontification, if fontified, write a fontified copy +;; to the destination directory, otherwise just copy the file: +(defun hfy-copy-and-fontify-file (srcdir dstdir file) + "Open FILE in SRCDIR - if fontified, write a fontified copy to DSTDIR +adding an extension of `hfy-extn'. Fontification is actually done by +`htmlfontify-buffer'. If the buffer is not fontified, just copy it." + ;;(message "hfy-copy-and-fontify-file");;DBUG + (let (;;(fast-lock-minimum-size hfy-fast-lock-save) + ;;(font-lock-support-mode 'fast-lock-mode) + ;;(window-system (or window-system 'htmlfontify)) + (target nil) + (source nil) + (html nil)) + (cd srcdir) + (with-current-buffer (setq source (find-file-noselect file)) + ;; FIXME: Shouldn't this use expand-file-name? --Stef + (setq target (concat dstdir "/" file)) + (hfy-make-directory (hfy-dirname target)) + (if (not (hfy-opt 'skip-refontification)) (hfy-force-fontification)) + (if (or (hfy-fontified-p) (hfy-text-p srcdir file)) + (progn (setq html (hfy-fontify-buffer srcdir file)) + (set-buffer html) + (write-file (concat target hfy-extn)) + (kill-buffer html)) + ;; #o0200 =3D=3D 128, but emacs20 doesn't know that + (if (and (file-exists-p target) (not (file-writable-p target))) + (set-file-modes target (logior (file-modes target) 128))) + (copy-file (buffer-file-name source) target 'overwrite)) + (kill-buffer source)) )) + +;; list of tags in file in srcdir +(defun hfy-tags-for-file (cache-hash file) + "List of etags tags that have definitions in this FILE. +CACHE-HASH is the tags cache." + ;;(message "hfy-tags-for-file");;DBUG + (let* ((tag-list nil)) + (if cache-hash + (maphash + (lambda (K V) + (if (assoc file V) + (setq tag-list (cons K tag-list)))) + cache-hash)) + tag-list)) + +;; mark the tags native to this file for anchors +(defun hfy-mark-tag-names (srcdir file) + "Mark tags in FILE (lookup SRCDIR in `hfy-tags-cache') with the `hfy-anc= hor' +property, with a value of \"tag.line-number\"." + ;;(message "(hfy-mark-tag-names %s %s)" srcdir file);;DBUG + (let* ((cache-entry (assoc srcdir hfy-tags-cache)) + (cache-hash (cadr cache-entry))) + (if cache-hash + (mapcar + (lambda (TAG) + (mapcar + (lambda (TLIST) + (if (string=3D file (car TLIST)) + (let* ((line (cadr TLIST) ) + (chr (caddr TLIST) ) + (link (format "%s.%d" TAG line) )) + (put-text-property (+ 1 chr) + (+ 2 chr) + 'hfy-anchor link)))) + (gethash TAG cache-hash))) + (hfy-tags-for-file cache-hash file))))) + +(defun hfy-relstub (file &optional start) + "Return a \"../\" stub of the appropriate length for the current source +tree depth, as determined from FILE (a filename). +START is the offset at which to start looking for the / character in FILE." + ;;(message "hfy-relstub");;DBUG + (let ((c "")) + (while (setq start (string-match "/" file start)) + (setq start (1+ start)) (setq c (concat c "../"))) + c)) + +(defun hfy-href-stub (this-file def-files tag) + "Return an href stub for a tag href in THIS-FILE. +If DEF-FILES (list of files containing definitions for the tag in question) +contains only one entry, the href should link straight to that file. +Otherwise, the link should be to the index file.\n +We are not yet concerned with the file extensions/tag line number and so o= n at +this point.\n +If `hfy-split-index' is set, and the href wil be to an index file rather t= han +a source file, append a .X to `hfy-index-file', where X is the uppercased +first character of TAG.\n +See also `hfy-relstub', `hfy-index-file'." + ;;(message "hfy-href-stub");;DBUG + ;; FIXME: Why not use something like + ;; (file-relative-name (if ...) (file-name-directory this-file)) ? --St= ef + (concat + (hfy-relstub this-file) + (if (=3D 1 (length def-files)) (car def-files) + (if (not hfy-split-index) hfy-index-file + (concat hfy-index-file "." (upcase (substring tag 0 1)))))) ) + +(defun hfy-href (this-file def-files tag tag-map) + "Return a relative href to the tag in question, based on\n +THIS-FILE `hfy-link-extn' `hfy-extn' DEF-FILES TAG and TAG-MAP\n +THIS-FILE is the current source file +DEF-FILES is a list of file containing possible link endpoints for TAG +TAG is the tag in question +TAG-MAP is the entry in `hfy-tags-cache'." + ;;(message "hfy-href");;DBUG + (concat + (hfy-href-stub this-file def-files tag) + (or hfy-link-extn hfy-extn) "#" tag ;;(.src -> .html) + (if (=3D 1 (length def-files)) + (concat "." (format "%d" (cadr (assoc (car def-files) tag-map))))))= ) + +(defun hfy-word-regex (string) + "Return a regex that matches STRING as the first `match-string', with non +word characters on either side." + ;; FIXME: Should this use [^$[:alnum:]_] instead? --Stef + (concat "[^$A-Za-z_0-9]\\(" (regexp-quote string) "\\)[^A-Za-z_0-9]")) + +;; mark all tags for hyperlinking, except the tags at +;; their own points of definition, iyswim: +(defun hfy-mark-tag-hrefs (srcdir file) + "Mark href start points with the `hfy-link' prop (value: href string).\n +Mark href end points with the `hfy-endl' prop (value t).\n +Avoid overlapping links, and mark links in descending length of +tag name in order to prevent subtags from usurping supertags, +\(eg \"term\" for \"terminal\"). +SRCDIR is the directory being \"published\". +FILE is the specific file we are rendering." + ;;(message "hfy-mark-tag-hrefs");;DBUG + (let ((cache-entry (assoc srcdir hfy-tags-cache)) + (list-cache (assoc srcdir hfy-tags-sortl)) + (rmap-cache (assoc srcdir hfy-tags-rmap )) + (no-comment (hfy-opt 'zap-comment-links)) + (no-strings (hfy-opt 'zap-string-links )) + (cache-hash nil) + (tags-list nil) + (tags-rmap nil) + (case-fold-search nil)) + ;; extract the tag mapping hashes (fwd and rev) and the tag list: + (if (and (setq cache-hash (cadr cache-entry)) + (setq tags-rmap (cadr rmap-cache )) + (setq tags-list (cadr list-cache ))) + (mapcar + (lambda (TAG) + (let* ((start nil) + (stop nil) + (href nil) + (name nil) + (case-fold-search nil) + (tmp-point nil) + (maybe-start nil) + (face-at nil) + (rmap-entry nil) + (rnew-elt nil) + (rmap-line nil) + (tag-regex (hfy-word-regex TAG)) + (tag-map (gethash TAG cache-hash)) + (tag-files (mapcar #'car tag-map))) + ;; find instances of TAG and do what needs to be done: + (goto-char (point-min)) + (while (search-forward TAG nil 'NOERROR) + (setq tmp-point (point) + maybe-start (- (match-beginning 0) 1)) + (goto-char maybe-start) + (if (not (looking-at tag-regex)) + nil + (setq start (match-beginning 1)) + (setq stop (match-end 1)) + (setq face-at + (and (or no-comment no-strings) (hfy-face-at start)= )) + (if (listp face-at) + (setq face-at (cadr (memq :inherit face-at)))) + (if (or (text-property-any start (1+ stop) 'hfy-linkp= t) + (and no-comment (eq 'font-lock-comment-face face-= at)) + (and no-strings (eq 'font-lock-string-face face-= at))) + nil ;; already a link, NOOP + + ;; set a reverse map entry: + (setq rmap-line (line-number-at-pos) + rmap-entry (gethash TAG tags-rmap) + rnew-elt (list file rmap-line start) + rmap-entry (cons rnew-elt rmap-entry) + name (format "%s.%d" TAG rmap-line)) + (put-text-property start (1+ start) 'hfy-inst name) + (puthash TAG rmap-entry tags-rmap) + + ;; mark the link. link to index if the tag has > 1 def + ;; add the line number to the #name if it does not: + (setq href (hfy-href file tag-files TAG tag-map)) + (put-text-property start (1+ start) 'hfy-link href) + (put-text-property stop (1+ stop ) 'hfy-endl t ) + (put-text-property start (1+ stop ) 'hfy-linkp t ))) + (goto-char tmp-point)) )) + tags-list) ))) + +(defun hfy-shell () + "Return `shell-file-name', or \"/bin/sh\" if it is a non-bourne shell." + (if (string-match "\\\\|\\\\|\\" shell-file-name) + shell-file-name + (or hfy-shell-file-name "/bin/sh"))) + +;; cache the #(tag =3D> file line point) entries for files under srcdir +;; and cache the descending sorted list of tags in the relevant alist, +;; also keyed by srcdir: +(defun hfy-load-tags-cache (srcdir) + "Run `hfy-etags-cmd' on SRCDIR, then call `hfy-parse-tags-buffer'." + ;;(message "hfy-load-tags-cache");;DBUG + (let ((etags-buffer (get-buffer-create "*hfy-tags*")) + (etags-command (format hfy-etags-cmd hfy-etags-bin)) + (shell-file-name (hfy-shell))) + (cd srcdir) + (shell-command etags-command etags-buffer) + (hfy-parse-tags-buffer srcdir etags-buffer)) ) + +;; break this out from `hfy-load-tags-cache' to make the tar file +;; functionality easier to implement. +;; ( tar file functionality not merged here because it requires a +;; hacked copy of etags capable of tagging stdin: if Francesco +;; Potorti accepts a patch, or otherwise implements stdin tagging, +;; then I will provide a `htmlfontify-tar-file' defun ) +(defun hfy-parse-tags-buffer (srcdir buffer) + "Parse a BUFFER containing etags formatted output, loading the +`hfy-tags-cache' and `hfy-tags-sortl' entries for SRCDIR." + (let ((cache-entry (assoc srcdir hfy-tags-cache)) + (tlist-cache (assoc srcdir hfy-tags-sortl)) + (trmap-cache (assoc srcdir hfy-tags-rmap )) + (cache-hash nil) (trmap-hash nil) (tags-list nil) + (hash-entry nil) (tag-string nil) (tag-line nil) + (tag-point nil) (new-entry nil) (etags-file nil)) + + ;; (re)initialise the tag reverse map: + (if trmap-cache (setq trmap-hash (cadr trmap-cache)) + (setq trmap-hash (make-hash-table :test 'equal)) + (setq hfy-tags-rmap (list (list srcdir trmap-hash) hfy-tags-rmap))) + (clrhash trmap-hash) + + ;; (re)initialise the tag cache: + (if cache-entry (setq cache-hash (cadr cache-entry)) + (setq cache-hash (make-hash-table :test 'equal)) + (setq hfy-tags-cache (list (list srcdir cache-hash) hfy-tags-cache))) + (clrhash cache-hash) + + ;; cache the TAG =3D> ((file line point) (file line point) ... ) entri= es: + (with-current-buffer buffer + (goto-char (point-min)) + + (while (and (looking-at "^\x0c") (=3D 0 (forward-line 1))) + ;;(message "^L boundary") + (if (and (looking-at "^\\(.+\\),\\([0-9]+\\)$") + (=3D 0 (forward-line 1))) + (progn + (setq etags-file (match-string 1)) + ;;(message "TAGS for file: %s" etags-file) + (while (and (looking-at hfy-etag-regex) (=3D 0 (forward-line= 1))) + (setq tag-string (match-string 1)) + (if (=3D 0 (length tag-string)) nil ;; noop + (setq tag-line (round (string-to-number (match-string = 2)))) + (setq tag-point (round (string-to-number (match-string = 3)))) + (setq hash-entry (gethash tag-string cache-hash)) + (setq new-entry (list etags-file tag-line tag-point)) + (push new-entry hash-entry) + ;;(message "HASH-ENTRY %s %S" tag-string new-entry) + (puthash tag-string hash-entry cache-hash)))) ))) + + ;; cache a list of tags in descending length order: + (maphash (lambda (K _V) (push K tags-list)) cache-hash) + (setq tags-list (sort tags-list (lambda (A B) (< (length B) (length A)= )))) + + ;; put the tag list into the cache: + (if tlist-cache (setcar (cdr tlist-cache) tags-list) + (push (list srcdir tags-list) hfy-tags-sortl)) + + ;; return the number of tags found: + (length tags-list) )) + +(defun hfy-prepare-index-i (srcdir dstdir filename &optional stub map) + "Prepare a tags index buffer for SRCDIR. +`hfy-tags-cache' must already have an entry for SRCDIR for this to work. +`hfy-page-header', `hfy-page-footer', `hfy-link-extn' and `hfy-extn' +all play a part here.\n +If STUB is set, prepare an (appropriately named) index buffer +specifically for entries beginning with STUB.\n +If MAP is set, use that instead of `hfy-tags-cache'. +FILENAME is the name of the file being indexed. +DSTDIR is the output directory, where files will be written." + ;;(message "hfy-write-index");;DBUG + (let ((cache-entry (assoc srcdir (or map hfy-tags-cache))) + (cache-hash nil) + (tag-list nil) + (index-file + (concat filename (if stub (concat "." stub) "") hfy-extn)) + (index-buf nil)) + (if (not (and cache-entry + (setq cache-hash (cadr cache-entry)) + (setq index-buf (get-buffer-create index-file)))) + nil ;; noop + (maphash (lambda (K _V) (push K tag-list)) cache-hash) + (setq tag-list (sort tag-list 'string<)) + (set-buffer index-buf) + (erase-buffer) + (insert (funcall hfy-page-header filename "")) + (insert "\n") + + (dolist (TAG tag-list) + (let ((tag-started nil)) + (dolist (DEF (gethash TAG cache-hash)) + (if (and stub (not (string-match (concat "^" stub) TAG))) + nil ;; we have a stub and it didn't match: NOOP + (let ((file (car DEF)) + (line (cadr DEF))) + (insert + (format + (concat + " \n" + " \n" + " \n" + " \n" + " \n") + (if (string=3D TAG tag-started) " " + (format "%s" TAG TAG)) + file (or hfy-link-extn hfy-extn) file + file (or hfy-link-extn hfy-extn) TAG line line)) + (setq tag-started TAG)))))) + (insert "
%s%s%d
\n") + (insert (funcall hfy-page-footer filename)) + (and dstdir (cd dstdir)) + (set-visited-file-name index-file) + index-buf) )) + +(defun hfy-prepare-index (srcdir dstdir) + "Return a list of index buffer(s), as determined by `hfy-split-index'. +SRCDIR and DSTDIR are the source and output directories respectively." + (if (not hfy-split-index) + (list (hfy-prepare-index-i srcdir dstdir hfy-index-file nil)) + (let ((stub-list nil) + (cache-hash nil) + (index-list nil) + (cache-entry (assoc srcdir hfy-tags-cache))) + (if (and cache-entry (setq cache-hash (cadr cache-entry))) + (maphash + (lambda (K _V) + (let ((stub (upcase (substring K 0 1)))) + (if (member stub stub-list) + nil ;; seen this already: NOOP + (setq + stub-list (cons stub stub-list) + index-list (cons (hfy-prepare-index-i srcdir + dstdir + hfy-index-file + stub) + index-list)) ))) + cache-hash) ) + index-list))) + +(defun hfy-prepare-tag-map (srcdir dstdir) + "Prepare the counterpart(s) to the index buffer(s) - a list of buffers +with the same structure, but listing (and linking to) instances of tags +\(as opposed to their definitions).\n +SRCDIR and DSTDIR are the source and output directories respectively. +See also `hfy-prepare-index', `hfy-split-index'." + (if (not hfy-split-index) + (list (hfy-prepare-index-i srcdir + dstdir + hfy-instance-file + nil + hfy-tags-rmap)) + (let ((stub-list nil) + (cache-hash nil) + (index-list nil) + (cache-entry (assoc srcdir hfy-tags-rmap))) + + (if (and cache-entry (setq cache-hash (cadr cache-entry))) + (maphash + (lambda (K _V) + (let ((stub (upcase (substring K 0 1)))) + (if (member stub stub-list) + nil ;; seen this already: NOOP + (setq + stub-list (cons stub stub-list) + index-list (cons (hfy-prepare-index-i srcdir + dstdir + hfy-instance-file + stub + hfy-tags-rmap) + index-list)) ))) + cache-hash) ) + index-list))) + +(defun hfy-subtract-maps (srcdir) + "Internal function - strips definitions of tags from the instance map. +SRCDIR is the directory being \"published\". +See also `hfy-tags-cache', `hfy-tags-rmap'." + (let ((new-list nil) + (old-list nil) + (def-list nil) + (exc-list nil) + (fwd-map (cadr (assoc srcdir hfy-tags-cache))) + (rev-map (cadr (assoc srcdir hfy-tags-rmap ))) + (taglist (cadr (assoc srcdir hfy-tags-sortl)))) + (dolist (TAG taglist) + (setq def-list (gethash TAG fwd-map) + old-list (gethash TAG rev-map) + exc-list (mapcar (lambda (P) (list (car P) (cadr P))) def-list) + new-list nil) + (dolist (P old-list) + (or (member (list (car P) (cadr P)) exc-list) + (push P new-list))) + (puthash TAG new-list rev-map)))) + +(defun htmlfontify-run-etags (srcdir) + "Load the etags cache for SRCDIR. +See also `hfy-load-tags-cache'." + (interactive "D source directory: ") + (hfy-load-tags-cache (directory-file-name srcdir))) + +;;(defun hfy-test-read-args (foo bar) +;; (interactive "D source directory: \nD target directory: ") +;; (message "foo: %S\nbar: %S" foo bar)) + +(defun hfy-save-kill-buffers (buffer-list &optional dstdir) + (dolist (B buffer-list) + (set-buffer B) + (and dstdir (file-directory-p dstdir) (cd dstdir)) + (save-buffer) + (kill-buffer B))) + +;;;###autoload +(defun htmlfontify-copy-and-link-dir (srcdir dstdir &optional f-ext l-ext) + "Trawl SRCDIR and write fontified-and-hyperlinked output in DSTDIR. +F-EXT and L-EXT specify values for `hfy-extn' and `hfy-link-extn'.\n +You may also want to set `hfy-page-header' and `hfy-page-footer'." + (interactive "D source directory: \nD output directory: ") + ;;(message "htmlfontify-copy-and-link-dir") + (setq srcdir (directory-file-name srcdir)) + (setq dstdir (directory-file-name dstdir)) + (let ((source-files "SETME: list of source files, relative to srcdir") + (tr-cache (assoc srcdir hfy-tags-rmap)) + (hfy-extn (or f-ext ".html")) + (hfy-link-extn (or l-ext ".html"))) + ;; oops, forgot to load etags for srcdir: + (if tr-cache nil + (message "autoload of tags cache") + (hfy-load-tags-cache srcdir) + (setq tr-cache (assoc srcdir hfy-tags-rmap))) + ;; clear out the old cache: + (clrhash (cadr tr-cache)) + (hfy-make-directory dstdir) + (setq source-files (hfy-list-files srcdir)) + (dolist (file source-files) + (hfy-copy-and-fontify-file srcdir dstdir file)) + (hfy-subtract-maps srcdir) + (hfy-save-kill-buffers (hfy-prepare-index srcdir dstdir) dstdir) + (hfy-save-kill-buffers (hfy-prepare-tag-map srcdir dstdir) dstdir) )) + +;; name of the init file we want: +(defun hfy-initfile () + "Return the expected location of the htmlfontify specific init/custom fi= le." + (let* ((file (or (getenv "HFY_INITFILE") ".hfy.el"))) + (expand-file-name file "~") )) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;; +;; incomplete as yet : transfer hook settings to hfy init file: +;; (defalias 'hfy-set-hooks 'custom-set-variables) + +;; (defun hfy-pp-hook (H) +;; (and (string-match "-hook\\'" (symbol-name H)) +;; (boundp H) +;; (symbol-value H) +;; (insert (format "\n '(%S %S)" H (symbol-value H))) +;; ) +;; ) + +;; (defun hfy-save-hooks () +;; (let ((custom-file (hfy-initfile))) +;; (custom-save-delete 'hfy-set-hooks) +;; (let ((standard-output (current-buffer))) +;; (princ "(hfy-set-hooks\n;;auto-generated, only one copy allowed\n= ") +;; (mapatoms 'hfy-pp-hook) +;; (insert "\n)") +;; ) +;; ) +;; ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;; + +(defalias 'hfy-init-progn 'progn) + +(defun hfy-save-initvar (sym) + (princ (format "(setq %s\n '" sym)) + (pp (symbol-value sym)) + (princ ")\n")) + +(defun htmlfontify-save-initfile () + "Save the htmlfontify settings to the htmlfontify init file." + (interactive) + (let* ((start-pos nil) + (custom-file (hfy-initfile)) + (standard-output (find-file-noselect custom-file 'nowarn))) + (save-excursion + (custom-save-delete 'hfy-init-progn) + (setq start-pos (point)) + (princ "(hfy-init-progn\n;;auto-generated, only one copy allowed\n") + ;; FIXME: This saving&restoring of global customization + ;; variables can interfere with other customization settings for + ;; those vars (in .emacs or in Customize). + (mapc 'hfy-save-initvar + '(auto-mode-alist interpreter-mode-alist)) + (princ ")\n") + (indent-region start-pos (point) nil)) + (custom-save-all) )) + +(defun htmlfontify-load-initfile () + "Load the htmlfontify specific init/custom file." + (interactive) + (let ((file (hfy-initfile))) + (load file 'NOERROR nil nil) )) + + +;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) +;;;;;; "hfy-cmap" "hfy-cmap.el" "8dce008297f15826cc6ab82203c46fa6") +;;; Generated autoloads from hfy-cmap.el + +(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ +Load an X11 style rgb.txt FILE. +Search `hfy-rgb-load-path' if FILE is not specified. +Loads the variable `hfy-rgb-txt-colour-map', which is used by +`hfy-fallback-colour-values'. + +\(fn &optional FILE)" t nil) + +(autoload 'hfy-fallback-colour-values "hfy-cmap" "\ +Use a fallback method for obtaining the rgb values for a color. + +\(fn COLOUR-STRING)" nil nil) + +;;;*** + + +(provide 'htmlfontify) + +;; Local Variables: +;; coding: utf-8 +;; End: + +;;; htmlfontify.el ends here --=20 1.7.2.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-htmlfontify.el-Add-new-output-option-body-text-only.patch >From 4cb861303e3b8cf986cf41748e86b10f8f4c52af Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 19 Aug 2011 01:44:19 +0530 Subject: [PATCH 2/6] htmlfontify.el: Add new output option - `body-text-only' * contrib/lisp/htmlfontify.el (hfy-optimisations): Define new option `body-text-only' (hfy-fontify-buffer): Honor above setting. --- contrib/lisp/htmlfontify.el | 34 ++++++++++++++++++++++------------ 1 files changed, 22 insertions(+), 12 deletions(-) diff --git a/contrib/lisp/htmlfontify.el b/contrib/lisp/htmlfontify.el index c8e9558..5415e58 100755 --- a/contrib/lisp/htmlfontify.el +++ b/contrib/lisp/htmlfontify.el @@ -450,6 +450,12 @@ and so on." keep-overlays : More of a bell (or possibly whistle) than an optimization - If on, preserve overlay highlighting (cf ediff or goo-font-lock) as well as basic faces.\n + body-text-only : Emit only body-text. In concrete terms, + 1. Suppress calls to `hfy-page-header'and + `hfy-page-footer' + 2. Pretend that `div-wrapper' option above is + turned off + 3. Don't enclose output in
tags And the following are planned but not yet available:\n kill-context-leak : Suppress hyperlinking between files highlighted by different modes.\n @@ -463,7 +469,8 @@ which can never slow you down, but may result in incomplete fontification." (const :tag "skip-refontification" skip-refontification) (const :tag "kill-context-leak" kill-context-leak ) (const :tag "div-wrapper" div-wrapper ) - (const :tag "keep-overlays" keep-overlays )) + (const :tag "keep-overlays" keep-overlays ) + (const :tag "body-text-only" body-text-only )) :group 'htmlfontify :tag "optimizations") @@ -1697,17 +1704,20 @@ FILE, if set, is the file name." ;; so we have to do this after we use said properties: ;; (message "munging dangerous characters") (hfy-html-dekludge-buffer) - ;; insert the stylesheet at the top: - (goto-char (point-min)) - ;;(message "inserting stylesheet") - (insert (hfy-sprintf-stylesheet css-sheet file)) - (if (hfy-opt 'div-wrapper) (insert "
")) - (insert "\n
")
-    (goto-char (point-max))
-    (insert "
\n") - (if (hfy-opt 'div-wrapper) (insert "
")) - ;;(message "inserting footer") - (insert (funcall hfy-page-footer file)) + (unless (hfy-opt 'body-text-only) + ;; insert the stylesheet at the top: + (goto-char (point-min)) + + ;;(message "inserting stylesheet") + (insert (hfy-sprintf-stylesheet css-sheet file)) + + (if (hfy-opt 'div-wrapper) (insert "
")) + (insert "\n
")
+      (goto-char (point-max))
+      (insert "
\n") + (if (hfy-opt 'div-wrapper) (insert "
")) + ;;(message "inserting footer") + (insert (funcall hfy-page-footer file))) ;; call any post html-generation hooks: (run-hooks 'hfy-post-html-hooks) ;; return the html buffer -- 1.7.2.3 --=-=-= Content-Type: text/x-patch; charset=gb2312 Content-Disposition: attachment; filename=0003-htmlfontify.el-Allow-customization-of-begin-and-end-.patch Content-Transfer-Encoding: quoted-printable >From 73aab009c52f6afec2b8eed2899400b70e17c47d Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 19 Aug 2011 01:45:59 +0530 Subject: [PATCH 3/6] htmlfontify.el: Allow customization of begin and end s= pan markers * contrib/lisp/htmlfontify.el (hfy-begin-span, hfy-end-span): New routines factored out form hfy-fontify-buffer. (hfy-begin-span-handler, hfy-end-span-handler): New variables that permit insertion of custom tags. (hfy-fontify-buffer): Use above handlers. --- contrib/lisp/htmlfontify.el | 73 ++++++++++++++++++++++++++++++++++++---= --- 1 files changed, 62 insertions(+), 11 deletions(-) diff --git a/contrib/lisp/htmlfontify.el b/contrib/lisp/htmlfontify.el index 5415e58..b4b1af2 100755 --- a/contrib/lisp/htmlfontify.el +++ b/contrib/lisp/htmlfontify.el @@ -1553,6 +1553,61 @@ Do not record undo information during evaluation of = BODY." (remove-text-properties (point-min) (point-max) '(hfy-show-trailing-whitespace))))) =20 +(defun hfy-begin-span (style text-block text-id text-begins-block-p) + "Default handler to begin a span of text. +Insert \"\". See +`hfy-begin-span-handler' for more information." + (when text-begins-block-p + (insert + (format "=A1=AD" text-= block))) + + (insert + (if text-block + (format "" style text-block tex= t-id) + (format "" style)))) + +(defun hfy-end-span () + "Default handler to end a span of text. +Insert \"\". See `hfy-end-span-handler' for more +information." + (insert "")) + +(defvar hfy-begin-span-handler 'hfy-begin-span + "Handler to begin a span of text. +The signature of the handler is \(lambda (STYLE TEXT-BLOCK +TEXT-ID TEXT-BEGINS-BLOCK-P) ...\). The handler must insert +appropriate tags to begin a span of text. + +STYLE is the name of the style that begins at point. It is +derived from the face attributes as part of `hfy-face-to-css' +callback. The other arguments TEXT-BLOCK, TEXT-ID, +TEXT-BEGINS-BLOCK-P are non-nil only if the buffer contains +invisible text. + +TEXT-BLOCK is a string that identifies a single chunk of visible +or invisible text of which the current position is a part. For +visible portions, it's value is \"nil\". For invisible portions, +it's value is computed as part of `hfy-invisible-name'. + +TEXT-ID marks a unique position within a block. It is set to +value of `point' at the current buffer position. + +TEXT-BEGINS-BLOCK-P is a boolean and is non-nil if the current +span also begins a invisible portion of text. + +An implementation can use TEXT-BLOCK, TEXT-ID, +TEXT-BEGINS-BLOCK-P to implement fold/unfold-on-mouse-click like +behaviour. + +The default handler is `hfy-begin-span'.") + +(defvar hfy-end-span-handler 'hfy-end-span + "Handler to end a span of text. +The signature of the handler is \(lambda () ...\). The handler +must insert appropriate tags to end a span of text. + +The default handler is `hfy-end-span'.") + (defun hfy-fontify-buffer (&optional srcdir file) "Implement the guts of `htmlfontify-buffer'. SRCDIR, if set, is the directory being htmlfontified. @@ -1640,23 +1695,19 @@ FILE, if set, is the file name." (or (get-text-property pt 'hfy-linkp) (get-text-property pt 'hfy-endl ))) (if (eq 'end fn) - (insert "") + (funcall hfy-end-span-handler) (if (not (and srcdir file)) nil (when move-link (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) (put-text-property pt (1+ pt) 'hfy-endl t) )) ;; if we have invisible blocks, we need to do some extra magic: - (if invis-ranges - (let ((iname (hfy-invisible-name pt invis-ranges)) - (fname (hfy-lookup fn css-sheet ))) - (when (assq pt invis-ranges) - (insert - (format "" inam= e)) - (insert "=A1=AD")) - (insert - (format "" fname inam= e pt))) - (insert (format "" (hfy-lookup fn css-she= et)))) + (funcall hfy-begin-span-handler + (hfy-lookup fn css-sheet) + (and invis-ranges + (format "%s" (hfy-invisible-name pt invis-ranges))) + (and invis-ranges pt) + (and invis-ranges (assq pt invis-ranges))) (if (not move-link) nil ;;(message "removing prop2 @ %d" (point)) (if (remove-text-properties (point) (1+ (point)) '(hfy-endl ni= l)) --=20 1.7.2.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-htmlfontify.el-Allow-customization-of-face-to-style-.patch >From 75eaebfba8023ac09832bdc56b40b31f36ba0c99 Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 19 Aug 2011 01:47:48 +0530 Subject: [PATCH 4/6] htmlfontify.el: Allow customization of face to style mappings * contrib/lisp/htmlfontify.el (hfy-face-to-css-default): Same as the earlier hfy-face-to-css. (hfy-face-to-css): Re-defined to be a variable. (hfy-compile-stylesheet): Related changes. --- contrib/lisp/htmlfontify.el | 22 ++++++++++++++++------ 1 files changed, 16 insertions(+), 6 deletions(-) diff --git a/contrib/lisp/htmlfontify.el b/contrib/lisp/htmlfontify.el index b4b1af2..3f5bdbd 100755 --- a/contrib/lisp/htmlfontify.el +++ b/contrib/lisp/htmlfontify.el @@ -1114,10 +1114,9 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'." ;; construct an assoc of (stripped-name . "{ css-stuff-here }") pairs ;; from a face: -(defun hfy-face-to-css (fn) - "Take FN, a font or `defface' specification (cf `face-attr-construct') -and return a CSS style specification.\n -See also `hfy-face-to-style'." +(defun hfy-face-to-css-default (fn) + "Default handler for mapping faces to styles. +See also `hfy-face-to-css'." ;;(message "hfy-face-to-css");;DBUG (let* ((css-list (hfy-face-to-style fn)) (seen nil) @@ -1131,6 +1130,17 @@ See also `hfy-face-to-style'." css-list))) (cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) ) +(defvar hfy-face-to-css 'hfy-face-to-css-default + "Handler for mapping faces to styles. +The signature of the handler is of the form \(lambda (FN) ...\). +FN is a font or `defface' specification (cf +`face-attr-construct'). The handler should return a cons cell of +the form (STYLE-NAME . STYLE-SPEC). + +The default handler is `hfy-face-to-css-default'. + +See also `hfy-face-to-style'.") + (defalias 'hfy-prop-invisible-p (if (fboundp 'invisible-p) #'invisible-p (lambda (prop) @@ -1328,9 +1338,9 @@ The plists are returned in descending priority order." (goto-char pt) (while (< pt (point-max)) (if (and (setq fn (hfy-face-at pt)) (not (assoc fn style))) - (push (cons fn (hfy-face-to-css fn)) style)) + (push (cons fn (funcall hfy-face-to-css fn)) style)) (setq pt (next-char-property-change pt))) ) - (push (cons 'default (hfy-face-to-css 'default)) style))) + (push (cons 'default (funcall hfy-face-to-css 'default)) style))) (defun hfy-fontified-p () "`font-lock' doesn't like to say it's been fontified when in batch -- 1.7.2.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-htmlfontify.el-Add-support-for-building-stylesheet-o.patch >From f6c70dfbf1f75cb5da50369e30202b8aefc2f99a Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 19 Aug 2011 01:49:05 +0530 Subject: [PATCH 5/6] htmlfontify.el: Add support for building stylesheet over multiple runs * contrib/lisp/htmlfontify.el (hfy-compile-stylesheet): Modified. Allow stylesheet to be built over multiple runs. This is made possible by having the caller let bind a special variable hfy-user-sheet-assoc. --- contrib/lisp/htmlfontify.el | 15 +++++++++++---- 1 files changed, 11 insertions(+), 4 deletions(-) diff --git a/contrib/lisp/htmlfontify.el b/contrib/lisp/htmlfontify.el index 3f5bdbd..6a4d62f 100755 --- a/contrib/lisp/htmlfontify.el +++ b/contrib/lisp/htmlfontify.el @@ -1327,20 +1327,27 @@ The plists are returned in descending priority order." ;; construct an assoc of (face-name . (css-name . "{ css-style }")) elements: (defun hfy-compile-stylesheet () - "Trawl the current buffer, construct and return a `hfy-sheet-assoc'." + "Trawl the current buffer, construct and return a `hfy-sheet-assoc'. +If `hfy-user-sheet-assoc' is currently bound then use it to +collect new styles discovered during this run. Otherwise create +a new assoc." ;;(message "hfy-compile-stylesheet");;DBUG (let ((pt (point-min)) ;; Make the font stack stay: ;;(hfy-tmpfont-stack nil) (fn nil) - (style nil)) + (style (and (boundp 'hfy-user-sheet-assoc) hfy-user-sheet-assoc))) (save-excursion (goto-char pt) (while (< pt (point-max)) (if (and (setq fn (hfy-face-at pt)) (not (assoc fn style))) (push (cons fn (funcall hfy-face-to-css fn)) style)) - (setq pt (next-char-property-change pt))) ) - (push (cons 'default (funcall hfy-face-to-css 'default)) style))) + (setq pt (next-char-property-change pt)))) + (unless (assoc 'default style) + (push (cons 'default (funcall hfy-face-to-css 'default)) style)) + (when (boundp 'hfy-user-sheet-assoc) + (setq hfy-user-sheet-assoc style)) + style)) (defun hfy-fontified-p () "`font-lock' doesn't like to say it's been fontified when in batch -- 1.7.2.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-htmlfontify.el-Add-htmlfontify-string-fix-a-bug-in-f.patch >From e6908d75832dc3cbc8573119a5b32d9a66c90a6f Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 19 Aug 2011 01:50:23 +0530 Subject: [PATCH 6/6] htmlfontify.el: Add htmlfontify-string & fix a bug in fontification * contrib/lisp/htmlfontify.el (htmlfontify-string): New defun. (hfy-compile-face-map): Make sure that the last char in the buffer is correctly fontified. --- contrib/lisp/htmlfontify.el | 17 ++++++++++++++++- 1 files changed, 16 insertions(+), 1 deletions(-) diff --git a/contrib/lisp/htmlfontify.el b/contrib/lisp/htmlfontify.el index 6a4d62f..5b86d98 100755 --- a/contrib/lisp/htmlfontify.el +++ b/contrib/lisp/htmlfontify.el @@ -1448,7 +1448,7 @@ Returns a modified copy of FACE-MAP." (setq pt (next-char-property-change pt)) (setq pt-narrow (+ offset pt))) (if (and map (not (eq 'end (cdar map)))) - (push (cons (- (point-max) (point-min)) 'end) map))) + (push (cons (1+ (- (point-max) (point-min))) 'end) map))) (if (hfy-opt 'merge-adjacent-tags) (hfy-merge-adjacent-spans map) map))) (defun hfy-buffer () @@ -1792,6 +1792,21 @@ FILE, if set, is the file name." (set-buffer-modified-p nil) html-buffer)) +(defun htmlfontify-string (string) + "Take a STRING and return a fontified version of it. +It is assumed that STRING has text properties that allow it to be +fontified. This is a simple convenience wrapper around +`htmlfontify-buffer'." + (let* ((hfy-optimisations-1 (copy-list hfy-optimisations)) + (hfy-optimisations (add-to-list 'hfy-optimisations-1 + 'skip-refontification))) + (with-temp-buffer + (insert string) + (htmlfontify-buffer) + (prog1 (buffer-string) + (setq buffer-modified-p nil) + (kill-buffer))))) + (defun hfy-force-fontification () "Try to force font-locking even when it is optimized away." (run-hooks 'hfy-init-kludge-hook) -- 1.7.2.3 --=-=-= Content-Type: application/emacs-lisp; charset=utf-8 Content-Disposition: attachment; filename=htmlfontify.el Content-Transfer-Encoding: quoted-printable ;;; htmlfontify.el --- htmlise a buffer/source tree with optional hyperlinks ;; Copyright (C) 2002-2003, 2009-2011 Free Software Foundation, Inc. ;; Emacs Lisp Archive Entry ;; Package: htmlfontify ;; Filename: htmlfontify.el ;; Version: 0.21 ;; Keywords: html, hypermedia, markup, etags ;; Author: Vivek Dasmohapatra ;; Maintainer: Vivek Dasmohapatra ;; Created: 2002-01-05 ;; Description: htmlise a buffer/source tree with optional hyperlinks ;; URL: http://rtfm.etla.org/emacs/htmlfontify/ ;; Compatibility: Emacs23, Emacs22 ;; Incompatibility: Emacs19, Emacs20, Emacs21 ;; Last Updated: Thu 2009-11-19 01:31:21 +0000 ;; Version: 0.21 ;; This file is part of GNU Emacs. ;; GNU Emacs 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 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs 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 GNU Emacs. If not, see . ;;; Commentary: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; I have made some changes to make it work for Emacs 22. A lot of ;; small bug fixes related to the format of text and overlay ;; properties (which might have changed since the beginning of 2003 ;; when this file was originally written). ;; ;; The function `hfy-face-at' currently carries much of the burden of ;; my lacking understanding of the formats mentioned above and should ;; need some knowledgeable help. ;; ;; Another thing that maybe could be fixed is that overlay background ;; colors which are now only seen where there is text (in the XHTML ;; output). A bit of CSS tweaking is necessary there. ;; ;; The face 'default has a value :background "SystemWindow" for the ;; background color. There is no explicit notion that this should be ;; considered transparent, but I have assumed that it could be handled ;; like if it was here. (I am unsure that background and foreground ;; priorities are handled ok, but it looks ok in my tests now.) ;; ;; 2007-12-27 Lennart Borgman ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Here's some elisp code to html-pretty-print an Emacs buffer, preserving ;; the Emacs syntax/whatever highlighting. It also knows how to drive etags ;; (exuberant-ctags or Emacs etags) and hyperlink the code according ;; to its (etags') output. ;; NOTE: Currently the hyperlinking code only knows how to drive GNU find ;; and the exuberant and GNU variants of etags : I do not know of any other ;; etags variants, but mechanisms have been provided to allow htmlfontify ;; to be taught how to drive them. As long as your version of find has ;; the -path test and is reasonably sane, you should be fine. ;; A sample of the htmlfontified / hyperlinked output of this module can be ;; found at http://rtfm.etla.org/sql/dbishell/src/ - it's not perfect, but ;; it's a hell of a lot faster and more thorough than I could hope to be ;; doing this by hand. ;; some user / horrified onlooker comments: ;; What? No! There's something deeply wrong here... (R. Shufflebotham) ;; You're a freak. (D. Silverstone) ;; Aren't we giving you enough to do? (J. Busuttil) ;; You're almost as messed up as Lexx is! (N. Graves-Morris) ;;; History: ;; Changes: moved to changelog (CHANGES) file. ;;; Code: (eval-when-compile (require 'cl)) (require 'faces) ;; (`facep' `face-attr-construct' `x-color-values' `color-values' `face-na= me') (require 'custom) ;; (`defgroup' `defcustom') (require 'font-lock) ;; (`font-lock-fontify-region') (require 'cus-edit) (defconst htmlfontify-version 0.21) (defconst hfy-meta-tags (format "" emacs-version htmlfontify-version) "The generator meta tag for this version of htmlfontify.") (defconst htmlfontify-manual "Htmlfontify Manual" "Copy and convert buffers and files to HTML, adding hyperlinks between fi= les \(driven by etags) if requested. \nInteractive functions: `htmlfontify-buffer' `htmlfontify-run-etags' `htmlfontify-copy-and-link-dir' `htmlfontify-load-rgb-file' `htmlfontify-unload-rgb-file'\n In order to:\n fontify a file you have open: \\[htmlfontify-buffer] prepare the etags map for a directory: \\[htmlfontify-run-etags] copy a directory, fontifying as you go: \\[htmlfontify-copy-and-link-dir]\n The following might be useful when running non-windowed or in batch mode: \(note that they shouldn't be necessary - we have a built in map)\n load an X11 style rgb.txt file: \\[htmlfontify-load-rgb-file] unload the current rgb.txt file: \\[htmlfontify-unload-rgb-file]\n And here's a programmatic example:\n \(defun rtfm-build-page-header (file style) (format \"#define TEMPLATE red+black.html #define DEBUG 1 #include \\n html-css-url :=3D /css/red+black.css title :=3D rtfm.etla.org ( %s / src/%s ) bodytag :=3D head <=3DSTYLESHEET;\\n %s STYLESHEET main-title :=3D rtfm / %s / src/%s\\n main-content <=3DMAIN_CONTENT;\\n\" rtfm-section file style rtfm-section fi= le)) \(defun rtfm-build-page-footer (file) \"\\nMAIN_CONTENT\\n\") \(defun rtfm-build-source-docs (section srcdir destdir) (interactive \"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \") (require 'htmlfontify) (hfy-load-tags-cache srcdir) (let ((hfy-page-header 'rtfm-build-page-header) (hfy-page-footer 'rtfm-build-page-footer) (rtfm-section section) (hfy-index-file \"index\")) (htmlfontify-run-etags srcdir) (htmlfontify-copy-and-link-dir srcdir destdir \".src\" \".html\")))") (defgroup htmlfontify nil "Convert buffers and files to HTML." :group 'applications :link '(variable-link htmlfontify-manual) :prefix "hfy-") (defcustom hfy-page-header 'hfy-default-header "Function called to build the header of the html source. This is called with two arguments (the filename relative to the top level source directory being etag'd and fontified), and a string containing the text to embed in the document. It should return the string returned will be used as the header for the htmlfontified version of the source file.\n See also `hfy-page-footer'." :group 'htmlfontify ;; FIXME: Why place such a :tag everywhere? Isn't it imposing your ;; own Custom preference on your users? --Stef :tag "page-header" :type '(function)) (defcustom hfy-split-index nil "Whether or not to split the index `hfy-index-file' alphabetically. If non-nil, the index is split on the first letter of each tag. Useful when the index would otherwise be large and take a long time to render or be difficult to navigate." :group 'htmlfontify :tag "split-index" :type '(boolean)) (defcustom hfy-page-footer 'hfy-default-footer "As `hfy-page-header', but generates the output footer. It takes only one argument, the filename." :group 'htmlfontify :tag "page-footer" :type '(function)) (defcustom hfy-extn ".html" "File extension used for output files." :group 'htmlfontify :tag "extension" :type '(string)) (defcustom hfy-src-doc-link-style "text-decoration: underline;" "String to add to the '\n"))) (funcall hfy-page-header file stylesheet))) ;; tag all the dangerous characters we want to escape ;; (ie any "<> chars we _didn't_ put there explicitly for css markup) (defun hfy-html-enkludge-buffer () "Mark dangerous [\"<>] characters with the `hfy-quoteme' property.\n See also `hfy-html-dekludge-buffer'." ;;(message "hfy-html-enkludge-buffer");;DBUG (save-excursion (goto-char (point-min)) (while (re-search-forward hfy-html-quote-regex nil t) (put-text-property (match-beginning 0) (point) 'hfy-quoteme t))) ) ;; dangerous char -> &entity; (defun hfy-html-quote (char-string) "Map CHAR-STRING to an HTML safe string (entity) if need be." ;;(message "hfy-html-quote");;DBUG (or (cadr (assoc char-string hfy-html-quote-map)) char-string) ) ;; actually entity-ise dangerous chars. ;; note that we can't do this until _after_ we have inserted the css ;; markup, since we use a position-based map to insert this, and if we ;; enter any other text before we do this, we'd have to track another ;; map of offsets, which would be tedious... (defun hfy-html-dekludge-buffer () "Transform all dangerous characters marked with the `hfy-quoteme' property using `hfy-html-quote'.\n See also `hfy-html-enkludge-buffer'." ;;(message "hfy-html-dekludge-buffer");;DBUG (save-excursion (goto-char (point-min)) (while (re-search-forward hfy-html-quote-regex nil t) (if (get-text-property (match-beginning 0) 'hfy-quoteme) (replace-match (hfy-html-quote (match-string 1))) )) )) ;; Borrowed from font-lock.el (defmacro hfy-save-buffer-state (varlist &rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state. Do not record undo information during evaluation of BODY." (declare (indent 1) (debug let)) (let ((modified (make-symbol "modified"))) `(let* ,(append varlist `((,modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename)) (progn ,@body) (unless ,modified (restore-buffer-modified-p nil))))) (defun hfy-mark-trailing-whitespace () "Tag trailing whitespace with a hfy property if it is currently highlight= ed." (when show-trailing-whitespace (let ((inhibit-read-only t)) (save-excursion (goto-char (point-min)) (hfy-save-buffer-state nil (while (re-search-forward "[ \t]+$" nil t) (put-text-property (match-beginning 0) (match-end 0) 'hfy-show-trailing-whitespace t))))))) (defun hfy-unmark-trailing-whitespace () "Undo the effect of `hfy-mark-trailing-whitespace'." (when show-trailing-whitespace (hfy-save-buffer-state nil (remove-text-properties (point-min) (point-max) '(hfy-show-trailing-whitespace))))) (defun hfy-begin-span (style text-block text-id text-begins-block-p) "Default handler to begin a span of text. Insert \"\". See `hfy-begin-span-handler' for more information." (when text-begins-block-p (insert (format "=E2=80=A6" tex= t-block))) (insert (if text-block (format "" style text-block text= -id) (format "" style)))) (defun hfy-end-span () "Default handler to end a span of text. Insert \"\". See `hfy-end-span-handler' for more information." (insert "")) (defvar hfy-begin-span-handler 'hfy-begin-span "Handler to begin a span of text. The signature of the handler is \(lambda (STYLE TEXT-BLOCK TEXT-ID TEXT-BEGINS-BLOCK-P) ...\). The handler must insert appropriate tags to begin a span of text. STYLE is the name of the style that begins at point. It is derived from the face attributes as part of `hfy-face-to-css' callback. The other arguments TEXT-BLOCK, TEXT-ID, TEXT-BEGINS-BLOCK-P are non-nil only if the buffer contains invisible text. TEXT-BLOCK is a string that identifies a single chunk of visible or invisible text of which the current position is a part. For visible portions, it's value is \"nil\". For invisible portions, it's value is computed as part of `hfy-invisible-name'. TEXT-ID marks a unique position within a block. It is set to value of `point' at the current buffer position. TEXT-BEGINS-BLOCK-P is a boolean and is non-nil if the current span also begins a invisible portion of text. An implementation can use TEXT-BLOCK, TEXT-ID, TEXT-BEGINS-BLOCK-P to implement fold/unfold-on-mouse-click like behaviour. The default handler is `hfy-begin-span'.") (defvar hfy-end-span-handler 'hfy-end-span "Handler to end a span of text. The signature of the handler is \(lambda () ...\). The handler must insert appropriate tags to end a span of text. The default handler is `hfy-end-span'.") (defun hfy-fontify-buffer (&optional srcdir file) "Implement the guts of `htmlfontify-buffer'. SRCDIR, if set, is the directory being htmlfontified. FILE, if set, is the file name." (if srcdir (setq srcdir (directory-file-name srcdir))) (let* ( (html-buffer (hfy-buffer)) (css-sheet nil) (css-map nil) (invis-ranges nil) (rovl nil) (orig-ovls (overlays-in (point-min) (point-max))) (rmin (when mark-active (region-beginning))) (rmax (when mark-active (region-end ))) ) (when (and mark-active transient-mark-mode) (unless (and (=3D rmin (point-min)) (=3D rmax (point-max))) (setq rovl (make-overlay rmin rmax)) (overlay-put rovl 'priority 1000) (overlay-put rovl 'face 'region))) ;; copy the buffer, including fontification, and switch to it: (hfy-mark-trailing-whitespace) (setq css-sheet (hfy-compile-stylesheet ) css-map (hfy-compile-face-map ) invis-ranges (hfy-find-invisible-ranges)) (hfy-unmark-trailing-whitespace) (when rovl (delete-overlay rovl)) (copy-to-buffer html-buffer (point-min) (point-max)) (set-buffer html-buffer) ;; rip out props that could interfere with our htmlisation of the buffe= r: (remove-text-properties (point-min) (point-max) hfy-ignored-properties) ;; Apply overlay invisible spec (setq orig-ovls (sort orig-ovls (lambda (A B) (> (or (cadr (memq 'priority (overlay-properties A))) 0) (or (cadr (memq 'priority (overlay-properties B))) 0))= ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;; ;; at this point, html-buffer retains the fontification of the parent: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;; ;; we don't really need or want text in the html buffer to be invisible= , as ;; that can make it look like we've rendered invalid xhtml when all tha= t's ;; happened is some tags are in the invisible portions of the buffer: (setq buffer-invisibility-spec nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;; ;; ##################################################################### ;; if we are in etags mode, add properties to mark the anchors and links (if (and srcdir file) (progn (hfy-mark-tag-names srcdir file) ;; mark anchors (hfy-mark-tag-hrefs srcdir file))) ;; mark links ;; ##################################################################### ;; mark the 'dangerous' characters ;;(message "marking dangerous characters") (hfy-html-enkludge-buffer) ;; trawl the position-based face-map, inserting span tags as we go ;; note that we cannot change any character positions before this point ;; or we will invalidate the map: ;; NB: This also means we have to trawl the map in descending file-offs= et ;; order, obviously. ;; --------------------------------------------------------------------- ;; Remember, inserting pushes properties to the right, which we don't ;; actually want to happen for link properties, so we have to flag ;; them and move them by hand - if you don't, you end up with ;; ;; texta... ;; ;; instead of: ;; ;; texta... ;; ;; If my analysis of the problem is correct, we can detect link-ness by ;; either hfy-linkp or hfy-endl properties at the insertion point, but I ;; think we only need to relocate the hfy-endl property, as the hfy-lin= kp ;; property has already served its main purpose by this point. ;;(message "mapcar over the CSS-MAP") (message "invis-ranges:\n%S" invis-ranges) (dolist (point-face css-map) (let ((pt (car point-face)) (fn (cdr point-face)) (move-link nil)) (goto-char pt) (setq move-link (or (get-text-property pt 'hfy-linkp) (get-text-property pt 'hfy-endl ))) (if (eq 'end fn) (funcall hfy-end-span-handler) (if (not (and srcdir file)) nil (when move-link (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) (put-text-property pt (1+ pt) 'hfy-endl t) )) ;; if we have invisible blocks, we need to do some extra magic: (funcall hfy-begin-span-handler (hfy-lookup fn css-sheet) (and invis-ranges (format "%s" (hfy-invisible-name pt invis-ranges))) (and invis-ranges pt) (and invis-ranges (assq pt invis-ranges))) (if (not move-link) nil ;;(message "removing prop2 @ %d" (point)) (if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil= )) (put-text-property pt (1+ pt) 'hfy-endl t)))))) ;; ##################################################################### ;; Invisibility ;; Maybe just make the text invisible in XHTML? ;; DONE -- big block of obsolete invisibility code elided here -- v ;; ##################################################################### ;; (message "checking to see whether we should link...") (if (and srcdir file) (let ((lp 'hfy-link) (pt (point-min)) (pr nil) (rr nil)) ;; (message " yes we should.") ;; translate 'hfy-anchor properties to anchors (while (setq pt (next-single-property-change pt 'hfy-anchor)) (if (setq pr (get-text-property pt 'hfy-anchor)) (progn (goto-char pt) (remove-text-properties pt (1+ pt) '(hfy-anchor nil)) (insert (concat ""))))) ;; translate alternate 'hfy-link and 'hfy-endl props to opening ;; and closing links. (this should avoid those spurious closes ;; we sometimes get by generating only paired tags) (setq pt (point-min)) (while (setq pt (next-single-property-change pt lp)) (if (not (setq pr (get-text-property pt lp))) nil (goto-char pt) (remove-text-properties pt (1+ pt) (list lp nil)) (case lp (hfy-link (if (setq rr (get-text-property pt 'hfy-inst)) (insert (format "" rr))) (insert (format "" pr)) (setq lp 'hfy-endl)) (hfy-endl (insert "") (setq lp 'hfy-link)) ))) )) ;; ##################################################################### ;; transform the dangerous chars. This changes character positions ;; since entities have > char length. ;; note that this deletes the dangerous characters, and therefore ;; destroys any properties they may contain (such as 'hfy-endl), ;; so we have to do this after we use said properties: ;; (message "munging dangerous characters") (hfy-html-dekludge-buffer) (unless (hfy-opt 'body-text-only) ;; insert the stylesheet at the top: (goto-char (point-min)) ;;(message "inserting stylesheet") (insert (hfy-sprintf-stylesheet css-sheet file)) (if (hfy-opt 'div-wrapper) (insert "
")) (insert "\n
")
      (goto-char (point-max))
      (insert "
\n") (if (hfy-opt 'div-wrapper) (insert "
")) ;;(message "inserting footer") (insert (funcall hfy-page-footer file))) ;; call any post html-generation hooks: (run-hooks 'hfy-post-html-hooks) ;; return the html buffer (set-buffer-modified-p nil) html-buffer)) (defun htmlfontify-string (string) "Take a STRING and return a fontified version of it. It is assumed that STRING has text properties that allow it to be fontified. This is a simple convenience wrapper around `htmlfontify-buffer'." (let* ((hfy-optimisations-1 (copy-list hfy-optimisations)) (hfy-optimisations (add-to-list 'hfy-optimisations-1 'skip-refontification))) (with-temp-buffer (insert string) (htmlfontify-buffer) (prog1 (buffer-string) (setq buffer-modified-p nil) (kill-buffer))))) (defun hfy-force-fontification () "Try to force font-locking even when it is optimized away." (run-hooks 'hfy-init-kludge-hook) (eval-and-compile (require 'font-lock)) (if (boundp 'font-lock-cache-position) (or font-lock-cache-position (set 'font-lock-cache-position (make-marker)))) (if (not noninteractive) (progn (message "hfy interactive mode (%S %S)" window-system major-mode) (when (and font-lock-defaults font-lock-mode) (font-lock-fontify-region (point-min) (point-max) nil))) (message "hfy batch mode (%s:%S)" (or (buffer-file-name) (buffer-name)) major-mode) (when font-lock-defaults (font-lock-fontify-buffer)) )) ;;;###autoload (defun htmlfontify-buffer (&optional srcdir file) "Create a new buffer, named for the current buffer + a .html extension, containing an inline CSS-stylesheet and formatted CSS-markup HTML that reproduces the look of the current Emacs buffer as closely as possible. Dangerous characters in the existing buffer are turned into HTML entities, so you should even be able to do HTML-within-HTML fontified display. You should, however, note that random control or eight-bit characters such as ^L (\x0c) or =C2=A4 (\xa4) won't get mapped yet. If the SRCDIR and FILE arguments are set, lookup etags derived entries in the `hfy-tags-cache' and add HTML anchors and hyperlinks as appropriate." (interactive) ;; pick up the file name in case we didn't receive it (if (not file) (progn (setq file (or (buffer-file-name) (buffer-name))) (if (string-match "/\\([^/]*\\)\\'" file) (setq file (match-string 1 file)))) ) (if (not (hfy-opt 'skip-refontification)) (save-excursion ;; Keep region (hfy-force-fontification))) (if (called-interactively-p 'any) ;; display the buffer in interactive mo= de: (switch-to-buffer (hfy-fontify-buffer srcdir file)) (hfy-fontify-buffer srcdir file))) ;; recursive file listing (defun hfy-list-files (directory) "Return a list of files under DIRECTORY. Strips any leading \"./\" from each filename." ;;(message "hfy-list-files");;DBUG ;; FIXME: this changes the dir of the currrent buffer. Is that right?? (cd directory) (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F)= F)) (split-string (shell-command-to-string hfy-find-cmd))) ) ;; strip the filename off, return a directiry name ;; not a particularly thorough implementaion, but it will be ;; fed pretty carefully, so it should be Ok: (defun hfy-dirname (file) "Return everything preceding the last \"/\" from a relative filename FILE, on the assumption that this will produce a relative directory name. Hardly bombproof, but good enough in the context in which it is being used." ;;(message "hfy-dirname");;DBUG (let ((f (directory-file-name file))) (and (string-match "^\\(.*\\)/" f) (match-string 1 f)))) ;; create a directory, cf mkdir -p (defun hfy-make-directory (dir) "Approx. equivalent of mkdir -p DIR." ;;(message "hfy-make-directory");;DBUG (if (file-exists-p dir) (if (file-directory-p dir) t) (make-directory dir t))) (defun hfy-text-p (srcdir file) "Is SRCDIR/FILE text? Uses `hfy-istext-command' to determine this." (let* ((cmd (format hfy-istext-command (expand-file-name file srcdir))) (rsp (shell-command-to-string cmd))) (string-match "text" rsp))) ;; open a file, check fontification, if fontified, write a fontified copy ;; to the destination directory, otherwise just copy the file: (defun hfy-copy-and-fontify-file (srcdir dstdir file) "Open FILE in SRCDIR - if fontified, write a fontified copy to DSTDIR adding an extension of `hfy-extn'. Fontification is actually done by `htmlfontify-buffer'. If the buffer is not fontified, just copy it." ;;(message "hfy-copy-and-fontify-file");;DBUG (let (;;(fast-lock-minimum-size hfy-fast-lock-save) ;;(font-lock-support-mode 'fast-lock-mode) ;;(window-system (or window-system 'htmlfontify)) (target nil) (source nil) (html nil)) (cd srcdir) (with-current-buffer (setq source (find-file-noselect file)) ;; FIXME: Shouldn't this use expand-file-name? --Stef (setq target (concat dstdir "/" file)) (hfy-make-directory (hfy-dirname target)) (if (not (hfy-opt 'skip-refontification)) (hfy-force-fontification)) (if (or (hfy-fontified-p) (hfy-text-p srcdir file)) (progn (setq html (hfy-fontify-buffer srcdir file)) (set-buffer html) (write-file (concat target hfy-extn)) (kill-buffer html)) ;; #o0200 =3D=3D 128, but emacs20 doesn't know that (if (and (file-exists-p target) (not (file-writable-p target))) (set-file-modes target (logior (file-modes target) 128))) (copy-file (buffer-file-name source) target 'overwrite)) (kill-buffer source)) )) ;; list of tags in file in srcdir (defun hfy-tags-for-file (cache-hash file) "List of etags tags that have definitions in this FILE. CACHE-HASH is the tags cache." ;;(message "hfy-tags-for-file");;DBUG (let* ((tag-list nil)) (if cache-hash (maphash (lambda (K V) (if (assoc file V) (setq tag-list (cons K tag-list)))) cache-hash)) tag-list)) ;; mark the tags native to this file for anchors (defun hfy-mark-tag-names (srcdir file) "Mark tags in FILE (lookup SRCDIR in `hfy-tags-cache') with the `hfy-anch= or' property, with a value of \"tag.line-number\"." ;;(message "(hfy-mark-tag-names %s %s)" srcdir file);;DBUG (let* ((cache-entry (assoc srcdir hfy-tags-cache)) (cache-hash (cadr cache-entry))) (if cache-hash (mapcar (lambda (TAG) (mapcar (lambda (TLIST) (if (string=3D file (car TLIST)) (let* ((line (cadr TLIST) ) (chr (caddr TLIST) ) (link (format "%s.%d" TAG line) )) (put-text-property (+ 1 chr) (+ 2 chr) 'hfy-anchor link)))) (gethash TAG cache-hash))) (hfy-tags-for-file cache-hash file))))) (defun hfy-relstub (file &optional start) "Return a \"../\" stub of the appropriate length for the current source tree depth, as determined from FILE (a filename). START is the offset at which to start looking for the / character in FILE." ;;(message "hfy-relstub");;DBUG (let ((c "")) (while (setq start (string-match "/" file start)) (setq start (1+ start)) (setq c (concat c "../"))) c)) (defun hfy-href-stub (this-file def-files tag) "Return an href stub for a tag href in THIS-FILE. If DEF-FILES (list of files containing definitions for the tag in question) contains only one entry, the href should link straight to that file. Otherwise, the link should be to the index file.\n We are not yet concerned with the file extensions/tag line number and so on= at this point.\n If `hfy-split-index' is set, and the href wil be to an index file rather th= an a source file, append a .X to `hfy-index-file', where X is the uppercased first character of TAG.\n See also `hfy-relstub', `hfy-index-file'." ;;(message "hfy-href-stub");;DBUG ;; FIXME: Why not use something like ;; (file-relative-name (if ...) (file-name-directory this-file)) ? --Stef (concat (hfy-relstub this-file) (if (=3D 1 (length def-files)) (car def-files) (if (not hfy-split-index) hfy-index-file (concat hfy-index-file "." (upcase (substring tag 0 1)))))) ) (defun hfy-href (this-file def-files tag tag-map) "Return a relative href to the tag in question, based on\n THIS-FILE `hfy-link-extn' `hfy-extn' DEF-FILES TAG and TAG-MAP\n THIS-FILE is the current source file DEF-FILES is a list of file containing possible link endpoints for TAG TAG is the tag in question TAG-MAP is the entry in `hfy-tags-cache'." ;;(message "hfy-href");;DBUG (concat (hfy-href-stub this-file def-files tag) (or hfy-link-extn hfy-extn) "#" tag ;;(.src -> .html) (if (=3D 1 (length def-files)) (concat "." (format "%d" (cadr (assoc (car def-files) tag-map)))))) ) (defun hfy-word-regex (string) "Return a regex that matches STRING as the first `match-string', with non word characters on either side." ;; FIXME: Should this use [^$[:alnum:]_] instead? --Stef (concat "[^$A-Za-z_0-9]\\(" (regexp-quote string) "\\)[^A-Za-z_0-9]")) ;; mark all tags for hyperlinking, except the tags at ;; their own points of definition, iyswim: (defun hfy-mark-tag-hrefs (srcdir file) "Mark href start points with the `hfy-link' prop (value: href string).\n Mark href end points with the `hfy-endl' prop (value t).\n Avoid overlapping links, and mark links in descending length of tag name in order to prevent subtags from usurping supertags, \(eg \"term\" for \"terminal\"). SRCDIR is the directory being \"published\". FILE is the specific file we are rendering." ;;(message "hfy-mark-tag-hrefs");;DBUG (let ((cache-entry (assoc srcdir hfy-tags-cache)) (list-cache (assoc srcdir hfy-tags-sortl)) (rmap-cache (assoc srcdir hfy-tags-rmap )) (no-comment (hfy-opt 'zap-comment-links)) (no-strings (hfy-opt 'zap-string-links )) (cache-hash nil) (tags-list nil) (tags-rmap nil) (case-fold-search nil)) ;; extract the tag mapping hashes (fwd and rev) and the tag list: (if (and (setq cache-hash (cadr cache-entry)) (setq tags-rmap (cadr rmap-cache )) (setq tags-list (cadr list-cache ))) (mapcar (lambda (TAG) (let* ((start nil) (stop nil) (href nil) (name nil) (case-fold-search nil) (tmp-point nil) (maybe-start nil) (face-at nil) (rmap-entry nil) (rnew-elt nil) (rmap-line nil) (tag-regex (hfy-word-regex TAG)) (tag-map (gethash TAG cache-hash)) (tag-files (mapcar #'car tag-map))) ;; find instances of TAG and do what needs to be done: (goto-char (point-min)) (while (search-forward TAG nil 'NOERROR) (setq tmp-point (point) maybe-start (- (match-beginning 0) 1)) (goto-char maybe-start) (if (not (looking-at tag-regex)) nil (setq start (match-beginning 1)) (setq stop (match-end 1)) (setq face-at (and (or no-comment no-strings) (hfy-face-at start))) (if (listp face-at) (setq face-at (cadr (memq :inherit face-at)))) (if (or (text-property-any start (1+ stop) 'hfy-linkp = t) (and no-comment (eq 'font-lock-comment-face face-a= t)) (and no-strings (eq 'font-lock-string-face face-a= t))) nil ;; already a link, NOOP ;; set a reverse map entry: (setq rmap-line (line-number-at-pos) rmap-entry (gethash TAG tags-rmap) rnew-elt (list file rmap-line start) rmap-entry (cons rnew-elt rmap-entry) name (format "%s.%d" TAG rmap-line)) (put-text-property start (1+ start) 'hfy-inst name) (puthash TAG rmap-entry tags-rmap) ;; mark the link. link to index if the tag has > 1 def ;; add the line number to the #name if it does not: (setq href (hfy-href file tag-files TAG tag-map)) (put-text-property start (1+ start) 'hfy-link href) (put-text-property stop (1+ stop ) 'hfy-endl t ) (put-text-property start (1+ stop ) 'hfy-linkp t ))) (goto-char tmp-point)) )) tags-list) ))) (defun hfy-shell () "Return `shell-file-name', or \"/bin/sh\" if it is a non-bourne shell." (if (string-match "\\\\|\\\\|\\" shell-file-name) shell-file-name (or hfy-shell-file-name "/bin/sh"))) ;; cache the #(tag =3D> file line point) entries for files under srcdir ;; and cache the descending sorted list of tags in the relevant alist, ;; also keyed by srcdir: (defun hfy-load-tags-cache (srcdir) "Run `hfy-etags-cmd' on SRCDIR, then call `hfy-parse-tags-buffer'." ;;(message "hfy-load-tags-cache");;DBUG (let ((etags-buffer (get-buffer-create "*hfy-tags*")) (etags-command (format hfy-etags-cmd hfy-etags-bin)) (shell-file-name (hfy-shell))) (cd srcdir) (shell-command etags-command etags-buffer) (hfy-parse-tags-buffer srcdir etags-buffer)) ) ;; break this out from `hfy-load-tags-cache' to make the tar file ;; functionality easier to implement. ;; ( tar file functionality not merged here because it requires a ;; hacked copy of etags capable of tagging stdin: if Francesco ;; Potorti accepts a patch, or otherwise implements stdin tagging, ;; then I will provide a `htmlfontify-tar-file' defun ) (defun hfy-parse-tags-buffer (srcdir buffer) "Parse a BUFFER containing etags formatted output, loading the `hfy-tags-cache' and `hfy-tags-sortl' entries for SRCDIR." (let ((cache-entry (assoc srcdir hfy-tags-cache)) (tlist-cache (assoc srcdir hfy-tags-sortl)) (trmap-cache (assoc srcdir hfy-tags-rmap )) (cache-hash nil) (trmap-hash nil) (tags-list nil) (hash-entry nil) (tag-string nil) (tag-line nil) (tag-point nil) (new-entry nil) (etags-file nil)) ;; (re)initialise the tag reverse map: (if trmap-cache (setq trmap-hash (cadr trmap-cache)) (setq trmap-hash (make-hash-table :test 'equal)) (setq hfy-tags-rmap (list (list srcdir trmap-hash) hfy-tags-rmap))) (clrhash trmap-hash) ;; (re)initialise the tag cache: (if cache-entry (setq cache-hash (cadr cache-entry)) (setq cache-hash (make-hash-table :test 'equal)) (setq hfy-tags-cache (list (list srcdir cache-hash) hfy-tags-cache))) (clrhash cache-hash) ;; cache the TAG =3D> ((file line point) (file line point) ... ) entrie= s: (with-current-buffer buffer (goto-char (point-min)) (while (and (looking-at "^\x0c") (=3D 0 (forward-line 1))) ;;(message "^L boundary") (if (and (looking-at "^\\(.+\\),\\([0-9]+\\)$") (=3D 0 (forward-line 1))) (progn (setq etags-file (match-string 1)) ;;(message "TAGS for file: %s" etags-file) (while (and (looking-at hfy-etag-regex) (=3D 0 (forward-line = 1))) (setq tag-string (match-string 1)) (if (=3D 0 (length tag-string)) nil ;; noop (setq tag-line (round (string-to-number (match-string 2= )))) (setq tag-point (round (string-to-number (match-string 3= )))) (setq hash-entry (gethash tag-string cache-hash)) (setq new-entry (list etags-file tag-line tag-point)) (push new-entry hash-entry) ;;(message "HASH-ENTRY %s %S" tag-string new-entry) (puthash tag-string hash-entry cache-hash)))) ))) ;; cache a list of tags in descending length order: (maphash (lambda (K _V) (push K tags-list)) cache-hash) (setq tags-list (sort tags-list (lambda (A B) (< (length B) (length A))= ))) ;; put the tag list into the cache: (if tlist-cache (setcar (cdr tlist-cache) tags-list) (push (list srcdir tags-list) hfy-tags-sortl)) ;; return the number of tags found: (length tags-list) )) (defun hfy-prepare-index-i (srcdir dstdir filename &optional stub map) "Prepare a tags index buffer for SRCDIR. `hfy-tags-cache' must already have an entry for SRCDIR for this to work. `hfy-page-header', `hfy-page-footer', `hfy-link-extn' and `hfy-extn' all play a part here.\n If STUB is set, prepare an (appropriately named) index buffer specifically for entries beginning with STUB.\n If MAP is set, use that instead of `hfy-tags-cache'. FILENAME is the name of the file being indexed. DSTDIR is the output directory, where files will be written." ;;(message "hfy-write-index");;DBUG (let ((cache-entry (assoc srcdir (or map hfy-tags-cache))) (cache-hash nil) (tag-list nil) (index-file (concat filename (if stub (concat "." stub) "") hfy-extn)) (index-buf nil)) (if (not (and cache-entry (setq cache-hash (cadr cache-entry)) (setq index-buf (get-buffer-create index-file)))) nil ;; noop (maphash (lambda (K _V) (push K tag-list)) cache-hash) (setq tag-list (sort tag-list 'string<)) (set-buffer index-buf) (erase-buffer) (insert (funcall hfy-page-header filename "")) (insert "\n") (dolist (TAG tag-list) (let ((tag-started nil)) (dolist (DEF (gethash TAG cache-hash)) (if (and stub (not (string-match (concat "^" stub) TAG))) nil ;; we have a stub and it didn't match: NOOP (let ((file (car DEF)) (line (cadr DEF))) (insert (format (concat " \n" " \n" " \n" " \n" " \n") (if (string=3D TAG tag-started) " " (format "%s" TAG TAG)) file (or hfy-link-extn hfy-extn) file file (or hfy-link-extn hfy-extn) TAG line line)) (setq tag-started TAG)))))) (insert "
%s%s%d
\n") (insert (funcall hfy-page-footer filename)) (and dstdir (cd dstdir)) (set-visited-file-name index-file) index-buf) )) (defun hfy-prepare-index (srcdir dstdir) "Return a list of index buffer(s), as determined by `hfy-split-index'. SRCDIR and DSTDIR are the source and output directories respectively." (if (not hfy-split-index) (list (hfy-prepare-index-i srcdir dstdir hfy-index-file nil)) (let ((stub-list nil) (cache-hash nil) (index-list nil) (cache-entry (assoc srcdir hfy-tags-cache))) (if (and cache-entry (setq cache-hash (cadr cache-entry))) (maphash (lambda (K _V) (let ((stub (upcase (substring K 0 1)))) (if (member stub stub-list) nil ;; seen this already: NOOP (setq stub-list (cons stub stub-list) index-list (cons (hfy-prepare-index-i srcdir dstdir hfy-index-file stub) index-list)) ))) cache-hash) ) index-list))) (defun hfy-prepare-tag-map (srcdir dstdir) "Prepare the counterpart(s) to the index buffer(s) - a list of buffers with the same structure, but listing (and linking to) instances of tags \(as opposed to their definitions).\n SRCDIR and DSTDIR are the source and output directories respectively. See also `hfy-prepare-index', `hfy-split-index'." (if (not hfy-split-index) (list (hfy-prepare-index-i srcdir dstdir hfy-instance-file nil hfy-tags-rmap)) (let ((stub-list nil) (cache-hash nil) (index-list nil) (cache-entry (assoc srcdir hfy-tags-rmap))) (if (and cache-entry (setq cache-hash (cadr cache-entry))) (maphash (lambda (K _V) (let ((stub (upcase (substring K 0 1)))) (if (member stub stub-list) nil ;; seen this already: NOOP (setq stub-list (cons stub stub-list) index-list (cons (hfy-prepare-index-i srcdir dstdir hfy-instance-file stub hfy-tags-rmap) index-list)) ))) cache-hash) ) index-list))) (defun hfy-subtract-maps (srcdir) "Internal function - strips definitions of tags from the instance map. SRCDIR is the directory being \"published\". See also `hfy-tags-cache', `hfy-tags-rmap'." (let ((new-list nil) (old-list nil) (def-list nil) (exc-list nil) (fwd-map (cadr (assoc srcdir hfy-tags-cache))) (rev-map (cadr (assoc srcdir hfy-tags-rmap ))) (taglist (cadr (assoc srcdir hfy-tags-sortl)))) (dolist (TAG taglist) (setq def-list (gethash TAG fwd-map) old-list (gethash TAG rev-map) exc-list (mapcar (lambda (P) (list (car P) (cadr P))) def-list) new-list nil) (dolist (P old-list) (or (member (list (car P) (cadr P)) exc-list) (push P new-list))) (puthash TAG new-list rev-map)))) (defun htmlfontify-run-etags (srcdir) "Load the etags cache for SRCDIR. See also `hfy-load-tags-cache'." (interactive "D source directory: ") (hfy-load-tags-cache (directory-file-name srcdir))) ;;(defun hfy-test-read-args (foo bar) ;; (interactive "D source directory: \nD target directory: ") ;; (message "foo: %S\nbar: %S" foo bar)) (defun hfy-save-kill-buffers (buffer-list &optional dstdir) (dolist (B buffer-list) (set-buffer B) (and dstdir (file-directory-p dstdir) (cd dstdir)) (save-buffer) (kill-buffer B))) ;;;###autoload (defun htmlfontify-copy-and-link-dir (srcdir dstdir &optional f-ext l-ext) "Trawl SRCDIR and write fontified-and-hyperlinked output in DSTDIR. F-EXT and L-EXT specify values for `hfy-extn' and `hfy-link-extn'.\n You may also want to set `hfy-page-header' and `hfy-page-footer'." (interactive "D source directory: \nD output directory: ") ;;(message "htmlfontify-copy-and-link-dir") (setq srcdir (directory-file-name srcdir)) (setq dstdir (directory-file-name dstdir)) (let ((source-files "SETME: list of source files, relative to srcdir") (tr-cache (assoc srcdir hfy-tags-rmap)) (hfy-extn (or f-ext ".html")) (hfy-link-extn (or l-ext ".html"))) ;; oops, forgot to load etags for srcdir: (if tr-cache nil (message "autoload of tags cache") (hfy-load-tags-cache srcdir) (setq tr-cache (assoc srcdir hfy-tags-rmap))) ;; clear out the old cache: (clrhash (cadr tr-cache)) (hfy-make-directory dstdir) (setq source-files (hfy-list-files srcdir)) (dolist (file source-files) (hfy-copy-and-fontify-file srcdir dstdir file)) (hfy-subtract-maps srcdir) (hfy-save-kill-buffers (hfy-prepare-index srcdir dstdir) dstdir) (hfy-save-kill-buffers (hfy-prepare-tag-map srcdir dstdir) dstdir) )) ;; name of the init file we want: (defun hfy-initfile () "Return the expected location of the htmlfontify specific init/custom fil= e." (let* ((file (or (getenv "HFY_INITFILE") ".hfy.el"))) (expand-file-name file "~") )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; incomplete as yet : transfer hook settings to hfy init file: ;; (defalias 'hfy-set-hooks 'custom-set-variables) ;; (defun hfy-pp-hook (H) ;; (and (string-match "-hook\\'" (symbol-name H)) ;; (boundp H) ;; (symbol-value H) ;; (insert (format "\n '(%S %S)" H (symbol-value H))) ;; ) ;; ) ;; (defun hfy-save-hooks () ;; (let ((custom-file (hfy-initfile))) ;; (custom-save-delete 'hfy-set-hooks) ;; (let ((standard-output (current-buffer))) ;; (princ "(hfy-set-hooks\n;;auto-generated, only one copy allowed\n") ;; (mapatoms 'hfy-pp-hook) ;; (insert "\n)") ;; ) ;; ) ;; ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defalias 'hfy-init-progn 'progn) (defun hfy-save-initvar (sym) (princ (format "(setq %s\n '" sym)) (pp (symbol-value sym)) (princ ")\n")) (defun htmlfontify-save-initfile () "Save the htmlfontify settings to the htmlfontify init file." (interactive) (let* ((start-pos nil) (custom-file (hfy-initfile)) (standard-output (find-file-noselect custom-file 'nowarn))) (save-excursion (custom-save-delete 'hfy-init-progn) (setq start-pos (point)) (princ "(hfy-init-progn\n;;auto-generated, only one copy allowed\n") ;; FIXME: This saving&restoring of global customization ;; variables can interfere with other customization settings for ;; those vars (in .emacs or in Customize). (mapc 'hfy-save-initvar '(auto-mode-alist interpreter-mode-alist)) (princ ")\n") (indent-region start-pos (point) nil)) (custom-save-all) )) (defun htmlfontify-load-initfile () "Load the htmlfontify specific init/custom file." (interactive) (let ((file (hfy-initfile))) (load file 'NOERROR nil nil) )) ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) ;;;;;; "hfy-cmap" "hfy-cmap.el" "8dce008297f15826cc6ab82203c46fa6") ;;; Generated autoloads from hfy-cmap.el (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ Load an X11 style rgb.txt FILE. Search `hfy-rgb-load-path' if FILE is not specified. Loads the variable `hfy-rgb-txt-colour-map', which is used by `hfy-fallback-colour-values'. \(fn &optional FILE)" t nil) (autoload 'hfy-fallback-colour-values "hfy-cmap" "\ Use a fallback method for obtaining the rgb values for a color. \(fn COLOUR-STRING)" nil nil) ;;;*** (provide 'htmlfontify) ;; Local Variables: ;; coding: utf-8 ;; End: ;;; htmlfontify.el ends here --=-=-=--