123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225 |
- (defun ps-generate-postscript-with-faces (from to)
-
- (setq ps-current-effect 0)
-
- (when (or ps-always-build-face-reference
- ps-build-face-reference)
- (message "Collecting face information...")
- (ps-build-reference-face-lists))
-
- (setq ps-black-white-faces-alist nil)
- (and (eq ps-print-color-p 'black-white)
- (ps-extend-face-list ps-black-white-faces nil
- 'ps-black-white-faces-alist))
-
- (save-restriction
- (narrow-to-region from to)
- (ps-print-ensure-fontified from to)
- (let ((face 'default)
- (position to))
- (cond
- ((memq ps-print-emacs-type '(xemacs lucid))
-
-
- (let ((a (cons 'dummy nil))
- record type extent extent-list
- (list-invisible (ps-print-find-invisible-xmas from to)))
- (ps-x-map-extents 'ps-mapper nil from to a)
- (setq a (sort (cdr a) 'car-less-than-car)
- extent-list nil)
-
-
- (while a
- (setq record (car a)
- position (car record)
-
- record (cdr record)
- type (car record)
-
- record (cdr record)
- extent (car record))
-
-
-
-
-
-
-
- (and (>= from (point-min))
- (ps-plot-with-face from (min position (point-max)) face))
-
- (cond
- ((eq type 'push)
- (and (or (ps-x-extent-face extent)
- (extent-property extent 'invisible))
- (setq extent-list (sort (cons extent extent-list)
- 'ps-extent-sorter))))
-
- ((eq type 'pull)
- (setq extent-list (sort (delq extent extent-list)
- 'ps-extent-sorter))))
-
-
- (setq face (if extent-list
- (let ((prop (extent-property (car extent-list) 'invisible)))
- (if (or (and (eq buffer-invisibility-spec t)
- (not (null prop)))
- (and (consp buffer-invisibility-spec)
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec))))
- 'emacs--invisible--face
- (ps-x-extent-face (car extent-list))))
- 'default)
- from position
- a (cdr a)))))
- ((eq ps-print-emacs-type 'emacs)
- (let ((property-change from)
- (overlay-change from)
- (save-buffer-invisibility-spec buffer-invisibility-spec)
- (buffer-invisibility-spec nil)
- before-string after-string)
- (while (< from to)
- (and (< property-change to)
-
- (setq property-change (next-property-change from nil to)))
- (and (< overlay-change to)
-
- (setq overlay-change (min (ps-e-next-overlay-change from)
- to)))
- (setq position (min property-change overlay-change)
- before-string nil
- after-string nil)
-
-
-
-
-
- (setq face
- (cond ((let ((prop (get-text-property from 'invisible)))
-
-
- (if (eq save-buffer-invisibility-spec t)
- (not (null prop))
- (or (memq prop save-buffer-invisibility-spec)
- (assq prop save-buffer-invisibility-spec))))
- 'emacs--invisible--face)
- ((get-text-property from 'face))
- (t 'default)))
- (let ((overlays (ps-e-overlays-at from))
- (face-priority -1))
- (while (and overlays
- (not (eq face 'emacs--invisible--face)))
- (let* ((overlay (car overlays))
- (overlay-invisible
- (ps-e-overlay-get overlay 'invisible))
- (overlay-priority
- (or (ps-e-overlay-get overlay 'priority) 0)))
- (and (> overlay-priority face-priority)
- (setq before-string
- (or (ps-e-overlay-get overlay 'before-string)
- before-string)
- after-string
- (or (and (<= (ps-e-overlay-end overlay) position)
- (ps-e-overlay-get overlay 'after-string))
- after-string)
- face-priority overlay-priority
- face
- (cond
- ((if (eq save-buffer-invisibility-spec t)
- (not (null overlay-invisible))
- (or (memq overlay-invisible
- save-buffer-invisibility-spec)
- (assq overlay-invisible
- save-buffer-invisibility-spec)))
- 'emacs--invisible--face)
- ((ps-e-overlay-get overlay 'face))
- (t face)
- ))))
- (setq overlays (cdr overlays))))
-
- (and before-string
- (ps-plot-string before-string))
- (ps-plot-with-face from position face)
- (and after-string
- (ps-plot-string after-string))
- (setq from position)))))
- (ps-plot-with-face from to face))))
- (defun ps-print-find-invisible-xmas (from to)
- (let ((list nil))
- (map-extents '(lambda (ex ignored)
- (let ((prop (extent-property ex 'invisible)))
- (if (or (and (eq buffer-invisibility-spec t)
- (not (null prop)))
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))
- (setq list (cons (list
- (extent-start-position ex)
- (extent-end-position ex))
- list))))
- nil)
- (current-buffer)
- from to nil 'start-and-end-in-region 'invisible)
- (reverse list)))
- (defun ps-mapper (extent list)
-
- (let ((beg (ps-x-extent-start-position extent))
- (end (ps-x-extent-end-position extent))
- (inv-lst list-invisible)
- (found nil))
- (while (and inv-lst
- (not found))
- (let ((inv-beg (caar inv-lst))
- (inv-end (cadar inv-lst)))
- (if (and (>= beg inv-beg)
- (<= end inv-end)
- (not (extent-property extent 'invisible)))
- (setq found t))
- (setq inv-lst (cdr inv-lst))))
- (if (not found)
- (nconc list
- (list (list beg 'push extent)
- (list end 'pull extent)))))
- nil)
- (provide 'ps-print-invisible)
|