|
@@ -1,225 +0,0 @@
|
|
|
-;;; ps-print-invisible.el - addon to ps-print package that deals
|
|
|
-;; with invisible text printing in xemacs
|
|
|
-
|
|
|
-;; Author: Greg Chernov
|
|
|
-;;
|
|
|
-;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
-;; it under the terms of the GNU General Public License as published by
|
|
|
-;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
-;; any later version.
|
|
|
-
|
|
|
-;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
-;; GNU General Public License for more details.
|
|
|
-
|
|
|
-;; You should have received a copy of the GNU General Public License
|
|
|
-;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
-;; Boston, MA 02110-1301, USA.
|
|
|
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
-;;
|
|
|
-;;; Commentary:
|
|
|
-;;
|
|
|
-;; Put ps-print-invisible.el on your load path.
|
|
|
-;; (require 'ps-print-invisible)
|
|
|
-;; ps-print-buffer-with-faces will not print invisible parts of the buffer.
|
|
|
-;; Work with invisible extents/text properties only
|
|
|
-;; (xemacs hideshow and noutline packages).
|
|
|
-
|
|
|
-(defun ps-generate-postscript-with-faces (from to)
|
|
|
- ;; Some initialization...
|
|
|
- (setq ps-current-effect 0)
|
|
|
-
|
|
|
- ;; Build the reference lists of faces if necessary.
|
|
|
- (when (or ps-always-build-face-reference
|
|
|
- ps-build-face-reference)
|
|
|
- (message "Collecting face information...")
|
|
|
- (ps-build-reference-face-lists))
|
|
|
-
|
|
|
- ;; Black/white printer.
|
|
|
- (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))
|
|
|
-
|
|
|
- ;; Generate some PostScript.
|
|
|
- (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))
|
|
|
- ;; Build the list of extents...
|
|
|
- ;;(debug)
|
|
|
- (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)
|
|
|
-
|
|
|
- ;; Loop through the extents...
|
|
|
- (while a
|
|
|
- (setq record (car a)
|
|
|
- position (car record)
|
|
|
-
|
|
|
- record (cdr record)
|
|
|
- type (car record)
|
|
|
-
|
|
|
- record (cdr record)
|
|
|
- extent (car record))
|
|
|
-
|
|
|
- ;; Plot up to this record.
|
|
|
- ;; XEmacs 19.12: for some reason, we're getting into a
|
|
|
- ;; situation in which some of the records have
|
|
|
- ;; positions less than 'from'. Since we've narrowed
|
|
|
- ;; the buffer, this'll generate errors. This is a hack,
|
|
|
- ;; but don't call ps-plot-with-face unless from > point-min.
|
|
|
- (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) ; Don't search for property change
|
|
|
- ; unless previous search succeeded.
|
|
|
- (setq property-change (next-property-change from nil to)))
|
|
|
- (and (< overlay-change to) ; Don't search for overlay change
|
|
|
- ; unless previous search succeeded.
|
|
|
- (setq overlay-change (min (ps-e-next-overlay-change from)
|
|
|
- to)))
|
|
|
- (setq position (min property-change overlay-change)
|
|
|
- before-string nil
|
|
|
- after-string nil)
|
|
|
- ;; The code below is not quite correct,
|
|
|
- ;; because a non-nil overlay invisible property
|
|
|
- ;; which is inactive according to the current value
|
|
|
- ;; of buffer-invisibility-spec nonetheless overrides
|
|
|
- ;; a face text property.
|
|
|
- (setq face
|
|
|
- (cond ((let ((prop (get-text-property from 'invisible)))
|
|
|
- ;; Decide whether this invisible property
|
|
|
- ;; really makes the text 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)) ; text-property
|
|
|
- (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))))
|
|
|
- ;; Plot up to this record.
|
|
|
- (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)
|
|
|
- ;;(debug)
|
|
|
- (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)
|
|
|
-
|
|
|
-
|
|
|
-;;; ps-print-invisible.el ends here
|