Text-EmacsColor

 view release on metacpan or  search on metacpan

share/lisp/htmlize.el  view on Meta::CPAN

	`(let ((,temp-buffer
		(get-buffer-create (generate-new-buffer-name " *temp*"))))
	   (unwind-protect
	       (with-current-buffer ,temp-buffer
		 ,@forms)
	     (and (buffer-live-p ,temp-buffer)
		  (kill-buffer ,temp-buffer))))))))

;; We need a function that efficiently finds the next change of a
;; property (usually `face'), preferably regardless of whether the
;; change occurred because of a text property or an extent/overlay.
;; As it turns out, it is not easy to do that compatibly.
;;
;; Under XEmacs, `next-single-property-change' does that.  Under GNU
;; Emacs beginning with version 21, `next-single-char-property-change'
;; is available and does the same.  GNU Emacs 20 had
;; `next-char-property-change', which we can use.  GNU Emacs 19 didn't
;; provide any means for simultaneously examining overlays and text
;; properties, so when using Emacs 19.34, we punt and fall back to
;; `next-single-property-change', thus ignoring overlays altogether.

(cond
 (htmlize-running-xemacs
  ;; XEmacs: good.
  (defun htmlize-next-change (pos prop &optional limit)
    (next-single-property-change pos prop nil (or limit (point-max)))))
 ((fboundp 'next-single-char-property-change)
  ;; GNU Emacs 21: good.
  (defun htmlize-next-change (pos prop &optional limit)
    (next-single-char-property-change pos prop nil limit)))

share/lisp/htmlize.el  view on Meta::CPAN

	       ;; Possibly at EOB?  Whatever, just don't infloop.
	       (setq done t))
	      ((eq next-value current-value)
	       ;; PROP hasn't changed -- keep looping.
	       )
	      (t
	       (setq done t)))
	(setq pos newpos))
      pos)))
 (t
  ;; GNU Emacs 19.34: hopeless, cannot properly support overlays.
  (defun htmlize-next-change (pos prop &optional limit)
    (unless limit
      (setq limit (point-max)))
    (let ((res (next-single-property-change pos prop)))
      (if (or (null res)
	      (> res limit))
	  limit
	res)))))

;;; Transformation of buffer text: HTML escapes, untabification, etc.

share/lisp/htmlize.el  view on Meta::CPAN

	((null (cdr fstruct-list))
	 ;; Optimize for the common case of a single face, simply
	 ;; return it.
	 (car fstruct-list))
	(t
	 (reduce #'htmlize-merge-two-faces
		 (cons (make-htmlize-fstruct) fstruct-list)))))

;; GNU Emacs 20+ supports attribute lists in `face' properties.  For
;; example, you can use `(:foreground "red" :weight bold)' as an
;; overlay's "face", or you can even use a list of such lists, etc.
;; We call those "attrlists".
;;
;; htmlize supports attrlist by converting them to fstructs, the same
;; as with regular faces.

(defun htmlize-attrlist-to-fstruct (attrlist)
  ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
  (let ((fstruct (make-htmlize-fstruct)))
    (cond ((eq (car attrlist) 'foreground-color)
	   ;; ATTRLIST is (foreground-color . COLOR)

share/lisp/htmlize.el  view on Meta::CPAN

  "If FACE is a string, return it interned, otherwise return it unchanged."
  (if (stringp face)
      (intern face)
    face))

(defun htmlize-faces-in-buffer ()
  "Return a list of faces used in the current buffer.
Under XEmacs, this returns the set of faces specified by the extents
with the `face' property.  (This covers text properties as well.)  Under
GNU Emacs, it returns the set of faces specified by the `face' text
property and by buffer overlays that specify `face'."
  (let (faces)
    ;; Testing for (fboundp 'map-extents) doesn't work because W3
    ;; defines `map-extents' under FSF.
    (if htmlize-running-xemacs
	(let (face-prop)
	  (map-extents (lambda (extent ignored)
			 (setq face-prop (extent-face extent)
			       ;; FACE-PROP can be a face or a list of
			       ;; faces.
			       faces (if (listp face-prop)

share/lisp/htmlize.el  view on Meta::CPAN

	(while (< pos (point-max))
	  (setq face-prop (get-text-property pos 'face)
		next (or (next-single-property-change pos 'face) (point-max)))
	  ;; FACE-PROP can be a face/attrlist or a list thereof.
	  (setq faces (if (htmlize-face-list-p face-prop)
			  (nunion (mapcar #'htmlize-unstringify-face face-prop)
				  faces :test 'equal)
			(adjoin (htmlize-unstringify-face face-prop)
				faces :test 'equal)))
	  (setq pos next)))
      ;; Faces used by overlays.
      (dolist (overlay (overlays-in (point-min) (point-max)))
	(let ((face-prop (overlay-get overlay 'face)))
	  ;; FACE-PROP can be a face/attrlist or a list thereof.
	  (setq faces (if (htmlize-face-list-p face-prop)
			  (nunion (mapcar #'htmlize-unstringify-face face-prop)
				  faces :test 'equal)
			(adjoin (htmlize-unstringify-face face-prop)
				faces :test 'equal))))))
    faces))

;; htmlize-faces-at-point returns the faces in use at point.  The
;; faces are sorted by increasing priority, i.e. the last face takes
;; precedence.
;;
;; Under XEmacs, this returns all the faces in all the extents at
;; point.  Under GNU Emacs, this returns all the faces in the `face'
;; property and all the faces in the overlays at point.

(cond (htmlize-running-xemacs
       (defun htmlize-faces-at-point ()
	 (let (extent extent-list face-list face-prop)
	   (while (setq extent (extent-at (point) nil 'face extent))
	     (push extent extent-list))
	   ;; extent-list is in reverse display order, meaning that
	   ;; smallest ones come last.  That is the order we want,
	   ;; except it can be overridden by the `priority' property.
	   (setq extent-list (stable-sort extent-list #'<

share/lisp/htmlize.el  view on Meta::CPAN

	   (nreverse face-list))))
      (t
       (defun htmlize-faces-at-point ()
	 (let (all-faces)
	   ;; Faces from text properties.
	   (let ((face-prop (get-text-property (point) 'face)))
	     (setq all-faces (if (htmlize-face-list-p face-prop)
				 (nreverse (mapcar #'htmlize-unstringify-face
						   face-prop))
			       (list (htmlize-unstringify-face face-prop)))))
	   ;; Faces from overlays.
	   (let ((overlays
		  ;; Collect overlays at point that specify `face'.
		  (delete-if-not (lambda (o)
				   (overlay-get o 'face))
				 (overlays-at (point))))
		 list face-prop)
	     ;; Sort the overlays so the smaller (more specific) ones
	     ;; come later.  The number of overlays at each one
	     ;; position should be very small, so the sort shouldn't
	     ;; slow things down.
	     (setq overlays (sort* overlays
				   ;; Sort by ascending...
				   #'<
				   ;; ...overlay size.
				   :key (lambda (o)
					  (- (overlay-end o)
					     (overlay-start o)))))
	     ;; Overlay priorities, if present, override the above
	     ;; established order.  Larger overlay priority takes
	     ;; precedence and therefore comes later in the list.
	     (setq overlays (stable-sort
			     overlays
			     ;; Reorder (stably) by acending...
			     #'<
			     ;; ...overlay priority.
			     :key (lambda (o)
				    (or (overlay-get o 'priority) 0))))
	     (dolist (overlay overlays)
	       (setq face-prop (overlay-get overlay 'face))
	       (setq list (if (htmlize-face-list-p face-prop)
			      (nconc (nreverse (mapcar
						#'htmlize-unstringify-face
						face-prop))
				     list)
			    (cons (htmlize-unstringify-face face-prop) list))))
	     ;; Under "Merging Faces" the manual explicitly states
	     ;; that faces specified by overlays take precedence over
	     ;; faces specified by text properties.
	     (setq all-faces (nconc all-faces list)))
	   all-faces))))

;; htmlize supports generating HTML in two several fundamentally
;; different ways, one with the use of CSS and nested <span> tags, and
;; the other with the use of the old <font> tags.  Rather than adding
;; a bunch of ifs to many places, we take a semi-OO approach.
;; `htmlize-buffer-1' calls a number of "methods", which indirect to
;; the functions that depend on `htmlize-output-type'.  The currently