comparison lisp/ps-print.el @ 47674:330113e9df2b

(ps-print-emacs-type): Error if ps-print is activated in Epoch, inLucid or in Emacs v19 or lesser. Value can no longer be `lucid'. (ps-print-version): New version number (6.5.8). (faces): Never do (require 'faces).

47673:a3f7ece066e5

;;	Vinicius Jose Latorre <[e-mail]>
;;	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer: Kenichi Handa <[e-mail]> (multi-byte characters)
;;	Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, print, PostScript
;; Time-stamp: <2002/09/11 15:52:39 vinicius>
;; Version: 6.5.7
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

(defconst ps-print-version "6.5.7"
  "ps-print.el, v 6.5.7 <2002/09/11 vinicius>

Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number.  When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.

;; About ps-print
;; --------------
;;
;; This package provides printing of Emacs buffers on PostScript printers; the
;; buffer's bold and italic text attributes are preserved in the printer
;; output.  ps-print is intended for use with Emacs or Lucid Emacs, together
;; with a fontifying package such as font-lock or hilit.
;;
;; ps-print uses the same face attributes defined through font-lock or hilit to
;; print a PostScript file, but some faces are better seeing on the screen than
;; on paper, specially when you have a black/white PostScript printer.
;;

;;
;; Default background color isn't working.
;;
;; Faces are always treated as opaque.
;;
;; Epoch and Emacs 19 not supported.  At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
;; lines.

(eval-and-compile
  (require 'lpr)

  (or (featurep 'lisp-float-type)
      (error "`ps-print' requires floating point support"))


  ;; For Emacs 20.2 and the earlier version.

  (or (fboundp 'set-buffer-multibyte)

    (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
  (defconst ps-lp-system
    (memq system-type '(usg-unix-v dgux hpux irix)))


  (defvar ps-print-emacs-type
    (cond ((string-match "XEmacs" emacs-version) 'xemacs)
	  ((string-match "Lucid" emacs-version) 'lucid)
	  ((string-match "Epoch" emacs-version) 'epoch)
	  (t 'emacs)))

  (or (memq ps-print-emacs-type '(lucid xemacs))
      (require 'faces))			; face-font, face-underline-p,
					; x-font-regexp

  (defun ps-xemacs-color-name (color)
    (if (ps-x-color-specifier-p color)
	(ps-x-color-name color)
      color))

	 (defun ps-mark-active-p ()
	   mark-active)
	 (defalias 'ps-face-foreground-name 'face-foreground)
	 (defalias 'ps-face-background-name 'face-background)
	 )
	(t				; xemacs, lucid, epoch
	 (defalias 'ps-mark-active-p 'region-active-p)
	 (defun ps-face-foreground-name (face)
	   (ps-xemacs-color-name (face-foreground face)))
	 (defun ps-face-background-name (face)
	   (ps-xemacs-color-name (face-background face)))

(defcustom ps-postscript-code-directory
  (or (cond
       ((eq ps-print-emacs-type 'emacs)	; emacs
	data-directory)
       ((fboundp 'locate-data-directory) ; emacsens (xemacs, etc.)
	(locate-data-directory "ps-print"))
       ((boundp 'data-directory)	; emacsens (xemacs, etc.)
	data-directory)
       (t				; don't know what to do
	nil))
      (error "ps-postscript-code-directory isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
  :type 'directory
  :group 'ps-print-miscellany)

  "Return time as \"17:28:31\"."
  (format-time-string "%T"))


(eval-and-compile
  (and (memq ps-print-emacs-type '(lucid xemacs))
       ;; XEmacs change: Need to check for emacs-major-version too.
       (or (< emacs-major-version 19)
	   (and (= emacs-major-version 19) (< emacs-minor-version 12)))
       (setq ps-print-color-p nil))

	 (defun ps-face-italic-p (face)
	   (or (ps-e-face-italic-p face)
	       (memq face ps-italic-faces)))
	 )

	(t				; xemacs, lucid, epoch

	 ;; to avoid XEmacs compilation gripes
	 (defvar coding-system-for-write   nil)
	 (defvar coding-system-for-read    nil)
	 (defvar buffer-file-coding-system nil)

      ;; Emacs understands the %f format; we'll use it to limit color RGB
      ;; values to three decimals to cut down some on the size of the
      ;; PostScript output.
      "%0.3f %0.3f %0.3f"

    ;; Lucid emacsen will have to make do with %s (princ) for floats.
    "%s %s %s"))

;; These values determine how much print-height to deduct when headers/footers
;; are turned on.  This is a pretty clumsy way of handling it, but it'll do for
;; now.

	(vector 0 0 0 0)))))


;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
;; Lucid emacsen will have to make do with %s (princ) for floats.

(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
			    "%0.3f "	; emacs
			  "%s "))	; Lucid emacsen


(defun ps-float-format (value &optional default)
  (let ((literal (or value default)))
    (cond ((null literal)

    (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...
	(let ((a (cons 'dummy nil))
	      record type extent extent-list)
	  (ps-x-map-extents 'ps-mapper nil from to a)
	  (setq a (sort (cdr a) 'car-less-than-car)

47674:330113e9df2b

;;	Vinicius Jose Latorre <[e-mail]>
;;	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer: Kenichi Handa <[e-mail]> (multi-byte characters)
;;	Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, print, PostScript
;; Time-stamp: <2002/09/13 10:10:20 vinicius>
;; Version: 6.5.8
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

(defconst ps-print-version "6.5.8"
  "ps-print.el, v 6.5.8 <2002/09/13 vinicius>

Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number.  When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.

;; About ps-print
;; --------------
;;
;; This package provides printing of Emacs buffers on PostScript printers; the
;; buffer's bold and italic text attributes are preserved in the printer
;; output.  ps-print is intended for use with Emacs or XEmacs, together with a
;; fontifying package such as font-lock or hilit.
;;
;; ps-print uses the same face attributes defined through font-lock or hilit to
;; print a PostScript file, but some faces are better seeing on the screen than
;; on paper, specially when you have a black/white PostScript printer.
;;

;;
;; Default background color isn't working.
;;
;; Faces are always treated as opaque.
;;
;; Epoch, Lucid and Emacs 19 not supported.  At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
;; lines.

(eval-and-compile
  (require 'lpr)

  (or (featurep 'lisp-float-type)
      (error "`ps-print' requires floating point support"))


  (defvar ps-print-emacs-type
    (let ((case-fold-search t))
      (cond ((string-match "XEmacs" emacs-version) 'xemacs)
	    ((string-match "Lucid" emacs-version)
	     (error "`ps-print' doesn't support Lucid"))
	    ((string-match "Epoch" emacs-version)
	     (error "`ps-print' doesn't support Epoch"))
	    (t
	     (unless (and (boundp 'emacs-major-version)
			  (> emacs-major-version 19))
	       (error "`ps-print' only supports Emacs 20 and higher"))
	     'emacs))))


  ;; For Emacs 20.2 and the earlier version.

  (or (fboundp 'set-buffer-multibyte)

    (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
  (defconst ps-lp-system
    (memq system-type '(usg-unix-v dgux hpux irix)))


  (defun ps-xemacs-color-name (color)
    (if (ps-x-color-specifier-p color)
	(ps-x-color-name color)
      color))

	 (defun ps-mark-active-p ()
	   mark-active)
	 (defalias 'ps-face-foreground-name 'face-foreground)
	 (defalias 'ps-face-background-name 'face-background)
	 )
	(t				; xemacs
	 (defalias 'ps-mark-active-p 'region-active-p)
	 (defun ps-face-foreground-name (face)
	   (ps-xemacs-color-name (face-foreground face)))
	 (defun ps-face-background-name (face)
	   (ps-xemacs-color-name (face-background face)))

(defcustom ps-postscript-code-directory
  (or (cond
       ((eq ps-print-emacs-type 'emacs)	; emacs
	data-directory)
       ((fboundp 'locate-data-directory) ; xemacs
	(locate-data-directory "ps-print"))
       ((boundp 'data-directory)	; xemacs
	data-directory)
       (t				; don't know what to do
	nil))
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
  :type 'directory
  :group 'ps-print-miscellany)

  "Return time as \"17:28:31\"."
  (format-time-string "%T"))


(eval-and-compile
  (and (eq ps-print-emacs-type 'xemacs)
       ;; XEmacs change: Need to check for emacs-major-version too.
       (or (< emacs-major-version 19)
	   (and (= emacs-major-version 19) (< emacs-minor-version 12)))
       (setq ps-print-color-p nil))

	 (defun ps-face-italic-p (face)
	   (or (ps-e-face-italic-p face)
	       (memq face ps-italic-faces)))
	 )

	(t				; xemacs

	 ;; to avoid XEmacs compilation gripes
	 (defvar coding-system-for-write   nil)
	 (defvar coding-system-for-read    nil)
	 (defvar buffer-file-coding-system nil)

      ;; Emacs understands the %f format; we'll use it to limit color RGB
      ;; values to three decimals to cut down some on the size of the
      ;; PostScript output.
      "%0.3f %0.3f %0.3f"

    ;; XEmacs will have to make do with %s (princ) for floats.
    "%s %s %s"))

;; These values determine how much print-height to deduct when headers/footers
;; are turned on.  This is a pretty clumsy way of handling it, but it'll do for
;; now.

	(vector 0 0 0 0)))))


;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
;; XEmacs will have to make do with %s (princ) for floats.

(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
			    "%0.3f "	; emacs
			  "%s "))	; xemacs


(defun ps-float-format (value &optional default)
  (let ((literal (or value default)))
    (cond ((null literal)

    (narrow-to-region from to)
    (ps-print-ensure-fontified from to)
    (let ((face 'default)
	  (position to))
      (cond
       ((eq ps-print-emacs-type 'xemacs)
	;; Build the list of extents...
	(let ((a (cons 'dummy nil))
	      record type extent extent-list)
	  (ps-x-map-extents 'ps-mapper nil from to a)
	  (setq a (sort (cdr a) 'car-less-than-car)