"))
+ (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 ¤ (\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 mode:
+ (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 == 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-anchor'
+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= 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 than
+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 (= 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 (= 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 "\\