Function: hfy-fontify-buffer
hfy-fontify-buffer is a byte-compiled function defined in
htmlfontify.el.gz.
Signature
(hfy-fontify-buffer &optional SRCDIR FILE)
Documentation
Implement the guts of htmlfontify-buffer.
SRCDIR, if set, is the directory being htmlfontified. FILE, if set, is the file name.
Source Code
;; Defined in /usr/src/emacs/lisp/htmlfontify.el.gz
(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* ( (inhibit-read-only t)
(html-buffer (hfy-buffer))
(css-sheet nil)
(css-map nil)
(invis-ranges nil)
(rovl nil)
(rmin (when mark-active (region-beginning)))
(rmax (when mark-active (region-end ))) )
(when (and mark-active
transient-mark-mode)
(unless (and (= rmin (point-min))
(= 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 htmlization of the buffer:
(remove-list-of-text-properties (point-min) (point-max)
hfy-ignored-properties)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 that'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-offset
;; 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
;;
;; <span class="foo"><a href="bar">texta</span><span class="bletch"></a>...
;;
;; instead of:
;;
;; <span class="foo"><a href="bar">texta</a></span><span class="bletch">...
;;
;; 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-linkp
;; 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 "<a name=\"" pr "\"></a>")))))
;; 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))
(cl-case lp
(hfy-link
(if (setq rr (get-text-property pt 'hfy-inst))
(insert (format "<a name=\"%s\"></a>" rr)))
(insert (format "<a href=\"%s\">" pr))
(setq lp 'hfy-endl))
(hfy-endl
(insert "</a>") (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 "<div class=\"default\">"))
(insert "\n<pre>")
(goto-char (point-max))
(insert "</pre>\n")
(if (hfy-opt 'div-wrapper) (insert "</div>"))
;;(message "inserting footer")
(insert (funcall hfy-page-footer file)))
;; call any post html-generation hooks:
(run-hooks 'hfy-post-html-hook)
;; return the html buffer
(set-buffer-modified-p nil)
html-buffer))