Function: hfy-merge-adjacent-spans

hfy-merge-adjacent-spans is a byte-compiled function defined in htmlfontify.el.gz.

Signature

(hfy-merge-adjacent-spans FACE-MAP)

Documentation

Where FACE-MAP is a hfy-facemap-assoc for the current buffer, this function merges adjacent style blocks which are of the same value and are separated by nothing more interesting than whitespace.

  <span class="foo">narf</span> <span class="foo">brain</span>

(as interpreted from FACE-MAP) would become:

  <span class="foo">narf brain</span>

Returns a modified copy of FACE-MAP.

Source Code

;; Defined in /usr/src/emacs/lisp/htmlfontify.el.gz
;; remember, the map is in reverse point order:
;; I wrote this while suffering the effects of a cold, and maybe a
;; mild fever - I think it's correct, but it might be a little warped
;; as my minfd keeps ... where was I? Oh yes, the bunnies...
(defun hfy-merge-adjacent-spans (face-map)
  "Where FACE-MAP is a `hfy-facemap-assoc' for the current buffer,
this function merges adjacent style blocks which are of the same value
and are separated by nothing more interesting than whitespace.

  <span class=\"foo\">narf</span> <span class=\"foo\">brain</span>

\(as interpreted from FACE-MAP) would become:

  <span class=\"foo\">narf brain</span>

Returns a modified copy of FACE-MAP."
  (let ((tmp-map face-map)
        (map-buf      nil)
        (first-start  nil)
        (first-stop   nil)
        (last-start   nil)
        (last-stop    nil)
        (span-stop    nil)
        (span-start   nil)
        (reduced-map  nil))
    ;;(push (car  tmp-map) reduced-map)
    ;;(push (cadr tmp-map) reduced-map)
    (while tmp-map
      (setq first-start (cadddr tmp-map)
            first-stop (caddr tmp-map)
            last-start  (cadr   tmp-map)
            last-stop   (car    tmp-map)
            map-buf      tmp-map
            span-start   last-start
            span-stop    last-stop      )
      (while (and (equal (cdr first-start)
                         (cdr  last-start))
                  (save-excursion
                    (goto-char (car first-stop))
                    (not (re-search-forward "[^ \t\n\r]" (car last-start) t))))
        (setq map-buf     (cddr map-buf)
              span-start  first-start
              first-start (cadddr map-buf)
              first-stop (caddr map-buf)
              last-start  (cadr   map-buf)
              last-stop   (car    map-buf)))
      (push span-stop  reduced-map)
      (push span-start reduced-map)
      (setq tmp-map (memq last-start tmp-map))
      (setq tmp-map (cdr tmp-map)))
    (setq reduced-map (nreverse reduced-map))))