comparison lisp/ps-print.el @ 28426:5236c7327cd6

PostScript programming fix for ghostview, doc fix. (ps-print-version): New version number (5.1.3). (ps-begin-file, ps-begin-job, ps-set-color, ps-do-despool, ps-setup) (ps-insert-file, ps-output-boolean, ps-plot-with-face) (ps-generate-postscript-with-faces): Code fix. (ps-color-values): XEmacs compatibility. (ps-print-background-image, ps-print-background-text, ps-printer-name) (ps-default-fg, ps-default-bg): Adjust customization. (ps-zebra-color): Adjust customization, renaming old ps-zebra-gray var. (ps-color-scale): Renaming old ps-color-value fun. (ps-print-headers): Replace ps-print-header group to avoid conflict with ps-print-header variable. (ps-print-miscellany): New group. (ps-format-color, ps-rgb-color): New funs. (ps-default-foreground): New var. (ps-printer-name-option): New const.

28425:6cc408ca6aef

;; Author:	Vinicius Jose Latorre <[e-mail]>
;; Author:	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer:	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer:	Vinicius Jose Latorre <[e-mail]>
;; Keywords:	wp, print, PostScript
;; Time-stamp:	<2000/03/22 09:12:07 vinicius>
;; Version:	5.1.2

(defconst ps-print-version "5.1.2"
  "ps-print.el, v 5.1.2 <2000/03/22 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.

;;
;; paper		catch the error and print on paper the error message.
;;			This is the default value.
;;
;; system		catch the error and send back the error message to
;;			printing system.
;;
;; paper-and-system	catch the error, print on paper the error message and
;;			send back the error message to printing system.
;;
;; Any other value is treated as `paper'.

;; The distance between stripes equals the height of a stripe.
;;
;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
;; Non-nil means yes, nil means no.  The default is nil.
;;
;; The variable `ps-zebra-gray' controls the zebra stripes gray scale.
;; It should be a float number between 0.0 (black color) and 1.0 (white color).
;; The default is 0.95.
;;
;; See also section How Ps-Print Has A Text And/Or Image On Background.
;;
;;
;; Hooks

;;
;; ps-print detects faces with foreground and background colors
;; defined and embeds color information in the PostScript image.
;; The default foreground and background colors are defined by the
;; variables `ps-default-fg' and `ps-default-bg'.
;; On black-and-white printers, colors are displayed in grayscale.
;; To turn off color output, set `ps-print-color-p' to nil.
;;
;;
;; How Ps-Print Maps Faces
;; -----------------------

;; If it is not possible to read (or does not exist) an image file, that file
;; is ignored.
;;
;; The printing order is:
;;
;;    1. Print zebra stripes
;;    2. Print background texts that it should be on all pages
;;    3. Print background images that it should be on all pages
;;    4. Print background texts only for current page (if any)
;;    5. Print background images only for current page (if any)
;;    6. Print header
;;    7. Print buffer text (with faces, if specified) and line number
;;
;;
;; Utilities
;; ---------
;;

;; `ps-print-customize'.
;;
;; [vinicius] 990703 Vinicius Jose Latorre <[e-mail]>
;;
;; Better customization.
;; `ps-banner-page-when-duplexing' and `ps-zebra-gray'.
;;
;; [vinicius] 990513 Vinicius Jose Latorre <[e-mail]>
;;
;; N-up printing.
;; Hook: `ps-print-begin-sheet-hook'.

  "Vertical page layout"
  :prefix "ps-"
  :tag "Vertical"
  :group 'ps-print)

(defgroup ps-print-header nil
  "Headers layout"
  :prefix "ps-"
  :tag "Header"
  :group 'ps-print)

  "Page customization"
  :prefix "ps-"
  :tag "Page"
  :group 'ps-print)


(defcustom ps-error-handler-message 'paper
  "*Specify where the error handler message should be sent.

Valid values are:

   `none'		catch the error and *DON'T* send any message.

   `paper'		catch the error and print on paper the error message.

   `system'		catch the error and send back the error message to
			printing system.

   `paper-and-system'	catch the error, print on paper the error message and
			send back the error message to printing system.

Any other value is treated as `paper'."
  :type '(choice :tag "Error Handler Message"
		 (const none)   (const paper)
		 (const system) (const paper-and-system))
  :group 'ps-print)

(defcustom ps-user-defined-prologue nil
  "*User defined PostScript prologue code inserted before all prologue code.

`ps-user-defined-prologue' may be a string or a symbol function which returns a

For more information about PostScript, see:
   PostScript Language Reference Manual (2nd edition)
   Adobe Systems Incorporated"
  :type '(choice :tag "User Defined Prologue"
		 string symbol (other :tag "nil" nil))
  :group 'ps-print)

(defcustom ps-print-prologue-header nil
  "*PostScript prologue header comments besides that ps-print generates.

`ps-print-prologue-header' may be a string or a symbol function which

   PostScript Language Reference Manual (2nd edition)
   Adobe Systems Incorporated
   Appendix G: Document Structuring Conventions -- Version 3.0"
  :type '(choice :tag "Prologue Header"
		 string symbol (other :tag "nil" nil))
  :group 'ps-print)

(defcustom ps-printer-name (and (boundp 'printer-name)
				printer-name)
  "*The name of a local printer for printing PostScript files.

appended to that file.  \(Note that `ps-print' package already has
facilities for printing to a file, so you might as well use them instead
of changing the setting of this variable.\)  If you want to silently
discard the printed output, set this to \"NUL\"."
  :type '(choice :tag "Printer Name"
		 file (other :tag "Pipe to ps-lpr-command" pipe))
  :group 'ps-print-printer)

(defcustom ps-lpr-command lpr-command
  "*Name of program for printing a PostScript file.

Any other value is treated as nil."
  :type '(choice :tag "Control Char"
		 (const 8-bit)   (const control-8-bit)
		 (const control) (other :tag "nil" nil))
  :group 'ps-print)

(defcustom ps-n-up-printing 1
  "*Specify the number of pages per sheet paper."
  :type '(integer
	  :tag "N Up Printing"

  :group 'ps-print-n-up)

(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
  "*Specify the number of columns"
  :type 'number
  :group 'ps-print)

(defcustom ps-zebra-stripes nil
  "*Non-nil means print zebra stripes.
See also documentation for `ps-zebra-stripe-height' and `ps-zebra-gray'."
  :type 'boolean
  :group 'ps-print-zebra)

(defcustom ps-zebra-stripe-height 3
  "*Number of zebra stripe lines.
See also documentation for `ps-zebra-stripes' and `ps-zebra-gray'."
  :type 'number
  :group 'ps-print-zebra)

(defcustom ps-zebra-gray 0.95
  "*Zebra stripe gray scale.
See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
  :type 'number
  :group 'ps-print-zebra)

(defcustom ps-line-number nil
  "*Non-nil means print line number."
  :type 'boolean
  :group 'ps-print)

(defcustom ps-print-background-image nil
  "*EPS image list to be printed on background.

The elements are:

For example, if you wish to print an EPS image on all pages do:

   '((\"~/images/EPS-image.ps\"))"
  :type '(repeat (list (file   :tag "EPS File")
		       (choice :tag "X" number string (const nil))
		       (choice :tag "Y" number string (const nil))
		       (choice :tag "X Scale" number string (const nil))
		       (choice :tag "Y Scale" number string (const nil))
		       (choice :tag "Rotation" number string (const nil))
		       (repeat :tag "Pages" :inline t
			       (radio (integer :tag "Page")
				      (cons :tag "Range"
					    (integer :tag "From")
					    (integer :tag "To"))))))

For example, if you wish to print text \"Preliminary\" on all pages do:

   '((\"Preliminary\"))"
  :type '(repeat (list (string :tag "Text")
		       (choice :tag "X" number string (const nil))
		       (choice :tag "Y" number string (const nil))
		       (choice :tag "Font" string (const nil))
		       (choice :tag "Fontsize" number string (const nil))
		       (choice :tag "Gray" number string (const nil))
		       (choice :tag "Rotation" number string (const nil))
		       (repeat :tag "Pages" :inline t
			       (radio (integer :tag "Page")
				      (cons :tag "Range"
					    (integer :tag "From")
					    (integer :tag "To"))))))

By default, the header displays the buffer name, page number, and, if
the buffer is visiting a file, the file's directory.  Headers are
customizable by changing variables `ps-left-header' and
`ps-right-header'."
  :type 'boolean
  :group 'ps-print-header)

(defcustom ps-print-only-one-header nil
  "*Non-nil means print only one header at the top of each page.
This is useful when printing more than one column, so it is possible
to have only one header over all columns or one header per column.
See also `ps-print-header'."
  :type 'boolean
  :group 'ps-print-header)

(defcustom ps-print-header-frame t
  "*Non-nil means draw a gaudy frame around the header."
  :type 'boolean
  :group 'ps-print-header)

(defcustom ps-header-lines 2
  "*Number of lines to display in page header, when generating PostScript."
  :type 'integer
  :group 'ps-print-header)

(defcustom ps-show-n-of-n t
  "*Non-nil means show page numbers as N/M, meaning page N of M.
NOTE: page numbers are displayed as part of headers,
      see variable `ps-print-headers'."
  :type 'boolean
  :group 'ps-print-header)

(defcustom ps-spool-config (if (memq system-type
				     '(win32 w32 mswindows ms-dos windows-nt))
			       nil
			     'lpr-switches)

	 `setpagedevice', generate a test file and send it to your printer; if
	 the printed file isn't ok, set `ps-spool-config' to nil."
  :type '(choice :tag "Spool Config"
		 (const lpr-switches) (const setpagedevice)
		 (other :tag "nil" nil))
  :group 'ps-print-header)

(defcustom ps-spool-duplex nil		; Not many people have duplex printers,
					; so default to nil.
  "*Non-nil generates PostScript for a two-sided printer.
For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert

reversed on duplex printers so that the page numbers fall to the left on
even-numbered pages.

See also `ps-spool-tumble'."
  :type 'boolean
  :group 'ps-print-header)

(defcustom ps-spool-tumble nil
  "*Specify how the page images on opposite sides of a sheet are oriented.
If `ps-spool-tumble' is nil, produces output suitable for binding on the left or
right.  If `ps-spool-tumble' is non-nil, produces output suitable for binding at
the top or bottom.

It has effect only when `ps-spool-duplex' is non-nil."
  :type 'boolean
  :group 'ps-print-header)

;;; Fonts

(defcustom ps-font-info-database
  '((Courier				; the family key

  :type 'boolean
  :group 'ps-print-color)

(defcustom ps-default-fg '(0.0 0.0 0.0)
  "*RGB values of the default foreground color.  Defaults to black."
  :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
  :group 'ps-print-color)

(defcustom ps-default-bg '(1.0 1.0 1.0)
  "*RGB values of the default background color.  Defaults to white."
  :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
  :group 'ps-print-color)

(defcustom ps-auto-font-detect t
  "*Non-nil means automatically detect bold/italic face attributes.
If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces',

return a string to be inserted into the array.  For symbols with bound
values, the value should be a string to be inserted into the array.
In either case, function or variable, the string value has PostScript
string delimiters added to it."
  :type '(repeat (choice string symbol))
  :group 'ps-print-header)

(defcustom ps-right-header
  (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
  "*The items to display (each on a line) on the right part of the page header.
This applies to generating PostScript.

See the variable `ps-left-header' for a description of the format of
this variable."
  :type '(repeat (choice string symbol))
  :group 'ps-print-header)

(defcustom ps-razzle-dazzle t
  "*Non-nil means report progress while formatting buffer."
  :type 'boolean
  :group 'ps-print)

(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
  "*Contains the header line identifying the output as PostScript.
By default, `ps-adobe-tag' contains the standard identifier.  Some
printers require slightly different versions of this line."
  :type 'string
  :group 'ps-print)

(defcustom ps-build-face-reference t
  "*Non-nil means build the reference face lists.

ps-print sets this value to nil after it builds its internal reference

(defcustom ps-banner-page-when-duplexing nil
  "*Non-nil means the very first page is skipped.
It's like the very first character of buffer (or region) is ^L (\\014)."
  :type 'boolean
  :group 'ps-print-header)

(defcustom ps-postscript-code-directory data-directory
  "*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)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization

      ps-landscape-mode      %s
      ps-number-of-columns   %s

      ps-zebra-stripes       %s
      ps-zebra-stripe-height %s
      ps-zebra-gray          %s
      ps-line-number         %s

      ps-print-control-characters %s

      ps-print-background-image %s

   (ps-print-quote ps-paper-type)
   ps-landscape-mode
   ps-number-of-columns
   ps-zebra-stripes
   ps-zebra-stripe-height
   ps-zebra-gray
   ps-line-number
   (ps-print-quote ps-print-control-characters)
   (ps-print-quote ps-print-background-image)
   (ps-print-quote ps-print-background-text)
   (ps-print-quote ps-error-handler-message)
   (ps-print-quote ps-user-defined-prologue)

(defvar ps-background-all-pages nil)
(defvar ps-background-text-count 0)
(defvar ps-background-image-count 0)

(defvar ps-current-font 0)
(defvar ps-default-color (and ps-print-color-p ps-default-fg)) ; black
(defvar ps-current-color ps-default-color)
(defvar ps-current-bg nil)

(defvar ps-razchunk 0)

(defvar ps-color-p nil)

      (setq ps-output-head (cdr ps-output-head))))
  (ps-init-output-queue))

(defun ps-insert-file (fname)
  (ps-flush-output)
  ;; Check to see that the file exists and is readable; if not, throw
  ;; an error.
  (or (file-readable-p fname)
      (error "Could not read file `%s'" fname))
  (save-excursion
    (set-buffer ps-spool-buffer)
    (goto-char (point-max))
    (insert-file fname)))

	  (ps-generate-header-line "/h1" (car contents))
	  (setq count (1+ count)))
	(ps-output "] def\n"))))


(defun ps-output-boolean (name bool &optional no-def)
  (ps-output (format "/%s %s%s"
		     name (if bool "true" "false") (if no-def "\n" " def\n"))))


(defun ps-background-pages (page-list func)
  (if page-list
      (mapcar

       "\n"))

    (ps-insert-string ps-print-prologue-header)

    (ps-output "%%EndComments\n\n%%BeginPrologue\n\n"
	       "/gs_languagelevel /languagelevel where"
	       "{pop languagelevel}{1}ifelse def\n"
	       (format "/ErrorMessage     %s def\n\n"
		       (or (cdr (assoc ps-error-handler-message
				       ps-error-handler-alist))
			   1))		; send to paper
	       ps-print-prologue-0
	       "\n%%BeginProcSet: UserDefinedPrologue\n\n")

				   line-height)))))

    (ps-output-boolean "Zebra           " ps-zebra-stripes)
    (ps-output-boolean "PrintLineNumber " ps-line-number)
    (ps-output (format "/ZebraHeight      %d def\n" ps-zebra-stripe-height)
	       (format "/ZebraGray        %s def\n" ps-zebra-gray)
	       "/UseSetpagedevice "
	       (if (eq ps-spool-config 'setpagedevice)
		   "/setpagedevice where {pop true}{false}ifelse def\n"
		 "false def\n")
	       "\n/PageWidth "
	       "PrintPageWidth LeftMargin add RightMargin add def\n\n"
	       (format "/N-Up           %d def\n" ps-n-up-printing))
    (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
    (ps-output-boolean "N-Up-Border   " ps-n-up-border-p)
    (ps-output (format "/N-Up-Lines     %d def\n" (ps-n-up-lines n-up))
	       (format "/N-Up-Columns   %d def\n" (ps-n-up-columns n-up))
	       (format "/N-Up-Missing   %d def\n" (ps-n-up-missing n-up))
	       (format "/N-Up-Margin    %s" ps-n-up-margin)
	       " def\n/N-Up-Repeat    "
	       (if ps-landscape-mode
		   (ps-n-up-end     n-up-filling)
		 (ps-n-up-repeat  n-up-filling))
	       " def\n/N-Up-End       "
	       (if ps-landscape-mode

		 ps-print-duplex-feature
		 "\n%%EndFeature\n")))
  (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n")
  (and ps-banner-page-when-duplexing
       (ps-output "\n%%Page: 0 0\nsave showpage restore\n")))


(defun ps-insert-string (prologue)
  (let ((str (if (functionp prologue)
		 (funcall prologue)

	       (string-as-unibyte "[\000-\037\177-\377]"))
	      ((eq ps-print-control-characters 'control-8-bit)
	       (string-as-unibyte "[\000-\037\177-\237]"))
	      ((eq ps-print-control-characters 'control)
	       "[\000-\037\177]")
	      (t "[\t\n\f]"))))

(defmacro ps-page-number ()
  `(1+ (/ (1- ps-page-count) ps-number-of-columns)))

(defun ps-end-file (needs-begin-file)

			 (nth 0 color) (nth 1 color) (nth 2 color))
		 " true BG\n")
    (ps-output "false BG\n")))

(defun ps-set-color (color)
  (setq ps-current-color (or color ps-default-fg))
  (ps-output (format ps-color-format
		     (nth 0 ps-current-color)
		     (nth 1 ps-current-color) (nth 2 ps-current-color))
	     " FG\n"))

    (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
    (ps-mule-prepare-ascii-font str)
    (ps-output-string str)
    (ps-output " S\n")))

(defun ps-color-value (x-color-value)
  ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
  (/ x-color-value ps-print-color-scale))


(cond ((eq ps-print-emacs-type 'emacs)  ; emacs

       (defun ps-color-values (x-color)

       )
					; xemacs
					; lucid
      (t				; epoch
       (defun ps-color-values (x-color)
	 (cond ((fboundp 'x-color-values)
		(x-color-values x-color))
	       ((and (fboundp 'color-instance-rgb-components)
		     (ps-color-device))
		(color-instance-rgb-components
		 (if (color-instance-p x-color)
		     x-color
		   (make-color-instance
		    (if (color-specifier-p x-color)
			(color-name x-color)
		      x-color)))))
	       (t
		(error "No available function to determine X color values."))))
       ))


(defun ps-face-attributes (face)
  "Return face attribute vector.

    (let* ((face-bit   (ps-face-attribute-list face))
	   (effect     (aref face-bit 0))
	   (foreground (aref face-bit 1))
	   (background (aref face-bit 2))
	   (fg-color (if (and ps-color-p foreground)
			 (mapcar 'ps-color-value
				 (ps-color-values foreground))
		       ps-default-color))
	   (bg-color (and ps-color-p background
			  (mapcar 'ps-color-value
				  (ps-color-values background)))))
      (ps-plot-region
       from to
       (ps-font-number 'ps-font-for-text
		       (or (aref ps-font-type (logand effect 3))
			   face))

  (if (or ps-always-build-face-reference
	  ps-build-face-reference)
      (progn
	(message "Collecting face information...")
	(ps-build-reference-face-lists)))
  ;; Set the color scale.  We do it here instead of in the defvar so
  ;; that ps-print can be dumped into emacs.  This expression can't be
  ;; evaluated at dump-time because X isn't initialized.
  (setq ps-color-p           (and ps-print-color-p (ps-color-device))
	ps-print-color-scale (if ps-color-p
				 (float (car (ps-color-values "white")))
			       1.0))
  ;; Generate some PostScript.
  (save-restriction
    (narrow-to-region from to)
    (ps-print-ensure-fontified from to)
    (let ((face 'default)

    (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
	 (replace-match (format "/Lines %d def\n/PageCount %d def"
				total-lines total-pages) t))))


;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
(defun ps-do-despool (filename)
  (if (or (not (boundp 'ps-spool-buffer))
	  (not (symbol-value 'ps-spool-buffer)))
      (message "No spooled PostScript to print")

	       (ps-printer-name (or ps-printer-name
				    (and (boundp 'printer-name)
					 printer-name)))
	       (ps-lpr-switches
		(append (and (stringp ps-printer-name)
			     (list (concat "-P" ps-printer-name)))
			ps-lpr-switches)))
	  (apply (or ps-print-region-function 'call-process-region)
		 (point-min) (point-max) ps-lpr-command nil
		 (and (fboundp 'start-process) 0)
		 nil

28426:5236c7327cd6

;; Author:	Vinicius Jose Latorre <[e-mail]>
;; Author:	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer:	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer:	Vinicius Jose Latorre <[e-mail]>
;; Keywords:	wp, print, PostScript
;; Time-stamp:	<2000/03/29 15:45:24 vinicius>
;; Version:	5.1.3

(defconst ps-print-version "5.1.3"
  "ps-print.el, v 5.1.3 <2000/03/29 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.

;;
;; paper		catch the error and print on paper the error message.
;;			This is the default value.
;;
;; system		catch the error and send back the error message to
;;			printing system.  This is useful only if printing system
;;			send back an email reporting the error, or if there is
;;			some other alternative way to report back the error from
;;			the system to you.
;;
;; paper-and-system	catch the error, print on paper the error message and
;;			send back the error message to printing system.
;;
;; Any other value is treated as `paper'.

;; The distance between stripes equals the height of a stripe.
;;
;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
;; Non-nil means yes, nil means no.  The default is nil.
;;
;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
;; color.  It should be a float number between 0.0 (black color) and 1.0 (white
;; color), a string which is a color name, or a list of 3 numbers which
;; corresponds to the Red Green Blue color scale.
;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
;;
;; See also section How Ps-Print Has A Text And/Or Image On Background.
;;
;;
;; Hooks

;;
;; ps-print detects faces with foreground and background colors
;; defined and embeds color information in the PostScript image.
;; The default foreground and background colors are defined by the
;; variables `ps-default-fg' and `ps-default-bg'.
;; On black-and-white printers, colors are displayed in gray scale.
;; To turn off color output, set `ps-print-color-p' to nil.
;;
;;
;; How Ps-Print Maps Faces
;; -----------------------

;; If it is not possible to read (or does not exist) an image file, that file
;; is ignored.
;;
;; The printing order is:
;;
;;    1. Print background color
;;    2. Print zebra stripes
;;    3. Print background texts that it should be on all pages
;;    4. Print background images that it should be on all pages
;;    5. Print background texts only for current page (if any)
;;    6. Print background images only for current page (if any)
;;    7. Print header
;;    8. Print buffer text (with faces, if specified) and line number
;;
;;
;; Utilities
;; ---------
;;

;; `ps-print-customize'.
;;
;; [vinicius] 990703 Vinicius Jose Latorre <[e-mail]>
;;
;; Better customization.
;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
;;
;; [vinicius] 990513 Vinicius Jose Latorre <[e-mail]>
;;
;; N-up printing.
;; Hook: `ps-print-begin-sheet-hook'.

  "Vertical page layout"
  :prefix "ps-"
  :tag "Vertical"
  :group 'ps-print)

(defgroup ps-print-headers nil
  "Headers layout"
  :prefix "ps-"
  :tag "Header"
  :group 'ps-print)

  "Page customization"
  :prefix "ps-"
  :tag "Page"
  :group 'ps-print)

(defgroup ps-print-miscellany nil
  "Miscellany customization"
  :prefix "ps-"
  :tag "Miscellany"
  :group 'ps-print)


(defcustom ps-error-handler-message 'paper
  "*Specify where the error handler message should be sent.

Valid values are:

   `none'		catch the error and *DON'T* send any message.

   `paper'		catch the error and print on paper the error message.

   `system'		catch the error and send back the error message to
			printing system.  This is useful only if printing system
			send back an email reporting the error, or if there is
			some other alternative way to report back the error from
			the system to you.

   `paper-and-system'	catch the error, print on paper the error message and
			send back the error message to printing system.

Any other value is treated as `paper'."
  :type '(choice :tag "Error Handler Message"
		 (const none)   (const paper)
		 (const system) (const paper-and-system))
  :group 'ps-print-miscellany)

(defcustom ps-user-defined-prologue nil
  "*User defined PostScript prologue code inserted before all prologue code.

`ps-user-defined-prologue' may be a string or a symbol function which returns a

For more information about PostScript, see:
   PostScript Language Reference Manual (2nd edition)
   Adobe Systems Incorporated"
  :type '(choice :tag "User Defined Prologue"
		 string symbol (other :tag "nil" nil))
  :group 'ps-print-miscellany)

(defcustom ps-print-prologue-header nil
  "*PostScript prologue header comments besides that ps-print generates.

`ps-print-prologue-header' may be a string or a symbol function which

   PostScript Language Reference Manual (2nd edition)
   Adobe Systems Incorporated
   Appendix G: Document Structuring Conventions -- Version 3.0"
  :type '(choice :tag "Prologue Header"
		 string symbol (other :tag "nil" nil))
  :group 'ps-print-miscellany)

(defcustom ps-printer-name (and (boundp 'printer-name)
				printer-name)
  "*The name of a local printer for printing PostScript files.

appended to that file.  \(Note that `ps-print' package already has
facilities for printing to a file, so you might as well use them instead
of changing the setting of this variable.\)  If you want to silently
discard the printed output, set this to \"NUL\"."
  :type '(choice :tag "Printer Name"
		 (file :tag "Print to file")
		 (string :tag "Pipe to ps-lpr-command")
		 (other :tag "Same as printer-name" nil))
  :group 'ps-print-printer)

(defcustom ps-lpr-command lpr-command
  "*Name of program for printing a PostScript file.

Any other value is treated as nil."
  :type '(choice :tag "Control Char"
		 (const 8-bit)   (const control-8-bit)
		 (const control) (other :tag "nil" nil))
  :group 'ps-print-miscellany)

(defcustom ps-n-up-printing 1
  "*Specify the number of pages per sheet paper."
  :type '(integer
	  :tag "N Up Printing"

  :group 'ps-print-n-up)

(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
  "*Specify the number of columns"
  :type 'number
  :group 'ps-print-miscellany)

(defcustom ps-zebra-stripes nil
  "*Non-nil means print zebra stripes.
See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
  :type 'boolean
  :group 'ps-print-zebra)

(defcustom ps-zebra-stripe-height 3
  "*Number of zebra stripe lines.
See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
  :type 'number
  :group 'ps-print-zebra)

(defcustom ps-zebra-color 0.95
  "*Zebra stripe gray scale or RGB color.
See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
  :type '(choice :tag "Zebra Gray/Color"
		 (number :tag "Gray Scale" :value 0.95)
		 (string :tag "Color Name" :value "gray95")
		 (list :tag "RGB Color" :value (0.95 0.95 0.95)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :group 'ps-print-zebra)

(defcustom ps-line-number nil
  "*Non-nil means print line number."
  :type 'boolean
  :group 'ps-print-miscellany)

(defcustom ps-print-background-image nil
  "*EPS image list to be printed on background.

The elements are:

For example, if you wish to print an EPS image on all pages do:

   '((\"~/images/EPS-image.ps\"))"
  :type '(repeat (list (file   :tag "EPS File")
		       (choice :tag "X" (const :tag "default" nil) number string)
		       (choice :tag "Y" (const :tag "default" nil) number string)
		       (choice :tag "X Scale" (const :tag "default" nil) number string)
		       (choice :tag "Y Scale" (const :tag "default" nil) number string)
		       (choice :tag "Rotation" (const :tag "default" nil) number string)
		       (repeat :tag "Pages" :inline t
			       (radio (integer :tag "Page")
				      (cons :tag "Range"
					    (integer :tag "From")
					    (integer :tag "To"))))))

For example, if you wish to print text \"Preliminary\" on all pages do:

   '((\"Preliminary\"))"
  :type '(repeat (list (string :tag "Text")
		       (choice :tag "X" (const :tag "default" nil) number string)
		       (choice :tag "Y" (const :tag "default" nil) number string)
		       (choice :tag "Font" (const :tag "default" nil) string)
		       (choice :tag "Fontsize" (const :tag "default" nil) number string)
		       (choice :tag "Gray" (const :tag "default" nil) number string)
		       (choice :tag "Rotation" (const :tag "default" nil) number string)
		       (repeat :tag "Pages" :inline t
			       (radio (integer :tag "Page")
				      (cons :tag "Range"
					    (integer :tag "From")
					    (integer :tag "To"))))))

By default, the header displays the buffer name, page number, and, if
the buffer is visiting a file, the file's directory.  Headers are
customizable by changing variables `ps-left-header' and
`ps-right-header'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-print-only-one-header nil
  "*Non-nil means print only one header at the top of each page.
This is useful when printing more than one column, so it is possible
to have only one header over all columns or one header per column.
See also `ps-print-header'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-print-header-frame t
  "*Non-nil means draw a gaudy frame around the header."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-header-lines 2
  "*Number of lines to display in page header, when generating PostScript."
  :type 'integer
  :group 'ps-print-headers)

(defcustom ps-show-n-of-n t
  "*Non-nil means show page numbers as N/M, meaning page N of M.
NOTE: page numbers are displayed as part of headers,
      see variable `ps-print-header'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-spool-config (if (memq system-type
				     '(win32 w32 mswindows ms-dos windows-nt))
			       nil
			     'lpr-switches)

	 `setpagedevice', generate a test file and send it to your printer; if
	 the printed file isn't ok, set `ps-spool-config' to nil."
  :type '(choice :tag "Spool Config"
		 (const lpr-switches) (const setpagedevice)
		 (other :tag "nil" nil))
  :group 'ps-print-headers)

(defcustom ps-spool-duplex nil		; Not many people have duplex printers,
					; so default to nil.
  "*Non-nil generates PostScript for a two-sided printer.
For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert

reversed on duplex printers so that the page numbers fall to the left on
even-numbered pages.

See also `ps-spool-tumble'."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-spool-tumble nil
  "*Specify how the page images on opposite sides of a sheet are oriented.
If `ps-spool-tumble' is nil, produces output suitable for binding on the left or
right.  If `ps-spool-tumble' is non-nil, produces output suitable for binding at
the top or bottom.

It has effect only when `ps-spool-duplex' is non-nil."
  :type 'boolean
  :group 'ps-print-headers)

;;; Fonts

(defcustom ps-font-info-database
  '((Courier				; the family key

  :type 'boolean
  :group 'ps-print-color)

(defcustom ps-default-fg '(0.0 0.0 0.0)
  "*RGB values of the default foreground color.  Defaults to black."
  :type '(choice :tag "Default Foreground Gray/Color"
		 (number :tag "Gray Scale" :value 0.0)
		 (string :tag "Color Name" :value "black")
		 (list :tag "RGB Color" :value (0.0 0.0 0.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :group 'ps-print-color)

(defcustom ps-default-bg '(1.0 1.0 1.0)
  "*RGB values of the default background color.  Defaults to white."
  :type '(choice :tag "Default Background Gray/Color"
		 (number :tag "Gray Scale" :value 1.0)
		 (string :tag "Color Name" :value "white")
		 (list :tag "RGB Color" :value (1.0 1.0 1.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :group 'ps-print-color)

(defcustom ps-auto-font-detect t
  "*Non-nil means automatically detect bold/italic face attributes.
If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces',

return a string to be inserted into the array.  For symbols with bound
values, the value should be a string to be inserted into the array.
In either case, function or variable, the string value has PostScript
string delimiters added to it."
  :type '(repeat (choice string symbol))
  :group 'ps-print-headers)

(defcustom ps-right-header
  (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
  "*The items to display (each on a line) on the right part of the page header.
This applies to generating PostScript.

See the variable `ps-left-header' for a description of the format of
this variable."
  :type '(repeat (choice string symbol))
  :group 'ps-print-headers)

(defcustom ps-razzle-dazzle t
  "*Non-nil means report progress while formatting buffer."
  :type 'boolean
  :group 'ps-print-miscellany)

(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
  "*Contains the header line identifying the output as PostScript.
By default, `ps-adobe-tag' contains the standard identifier.  Some
printers require slightly different versions of this line."
  :type 'string
  :group 'ps-print-miscellany)

(defcustom ps-build-face-reference t
  "*Non-nil means build the reference face lists.

ps-print sets this value to nil after it builds its internal reference

(defcustom ps-banner-page-when-duplexing nil
  "*Non-nil means the very first page is skipped.
It's like the very first character of buffer (or region) is ^L (\\014)."
  :type 'boolean
  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory data-directory
  "*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)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization

      ps-landscape-mode      %s
      ps-number-of-columns   %s

      ps-zebra-stripes       %s
      ps-zebra-stripe-height %s
      ps-zebra-color         %s
      ps-line-number         %s

      ps-default-fg %s
      ps-default-bg %s

      ps-print-control-characters %s

      ps-print-background-image %s

   (ps-print-quote ps-paper-type)
   ps-landscape-mode
   ps-number-of-columns
   ps-zebra-stripes
   ps-zebra-stripe-height
   (ps-print-quote ps-zebra-color)
   ps-line-number
   (ps-print-quote ps-default-fg)
   (ps-print-quote ps-default-bg)
   (ps-print-quote ps-print-control-characters)
   (ps-print-quote ps-print-background-image)
   (ps-print-quote ps-print-background-text)
   (ps-print-quote ps-error-handler-message)
   (ps-print-quote ps-user-defined-prologue)

(defvar ps-background-all-pages nil)
(defvar ps-background-text-count 0)
(defvar ps-background-image-count 0)

(defvar ps-current-font 0)
(defvar ps-default-foreground nil)
(defvar ps-default-color nil)
(defvar ps-current-color nil)
(defvar ps-current-bg nil)

(defvar ps-razchunk 0)

(defvar ps-color-p nil)

      (setq ps-output-head (cdr ps-output-head))))
  (ps-init-output-queue))

(defun ps-insert-file (fname)
  (ps-flush-output)
  (save-excursion
    (set-buffer ps-spool-buffer)
    (goto-char (point-max))
    (insert-file fname)))

	  (ps-generate-header-line "/h1" (car contents))
	  (setq count (1+ count)))
	(ps-output "] def\n"))))


(defun ps-output-boolean (name bool)
  (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))


(defun ps-background-pages (page-list func)
  (if page-list
      (mapcar

       "\n"))

    (ps-insert-string ps-print-prologue-header)

    (ps-output "%%EndComments\n\n%%BeginPrologue\n\n"
	       "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
	       (format "/ErrorMessage  %s def\n\n"
		       (or (cdr (assoc ps-error-handler-message
				       ps-error-handler-alist))
			   1))		; send to paper
	       ps-print-prologue-0
	       "\n%%BeginProcSet: UserDefinedPrologue\n\n")

				   line-height)))))

    (ps-output-boolean "Zebra           " ps-zebra-stripes)
    (ps-output-boolean "PrintLineNumber " ps-line-number)
    (ps-output (format "/ZebraHeight      %d def\n" ps-zebra-stripe-height)
	       "/ZebraColor       "
	       (ps-format-color ps-zebra-color 0.95)
	       "def\n/BackgroundColor  "
	       (ps-format-color ps-default-bg 1.0)
	       "def\n/UseSetpagedevice "
	       (if (eq ps-spool-config 'setpagedevice)
		   "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
		 "false")
	       " def\n\n/PageWidth "
	       "PrintPageWidth LeftMargin add RightMargin add def\n\n"
	       (format "/N-Up           %d def\n" ps-n-up-printing))
    (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
    (ps-output-boolean "N-Up-Border   " ps-n-up-border-p)
    (ps-output (format "/N-Up-Lines     %d def\n" (ps-n-up-lines n-up))
	       (format "/N-Up-Columns   %d def\n" (ps-n-up-columns n-up))
	       (format "/N-Up-Missing   %d def\n" (ps-n-up-missing n-up))
	       (format "/N-Up-Margin    %s def\n" ps-n-up-margin)
	       "/N-Up-Repeat    "
	       (if ps-landscape-mode
		   (ps-n-up-end     n-up-filling)
		 (ps-n-up-repeat  n-up-filling))
	       " def\n/N-Up-End       "
	       (if ps-landscape-mode

		 ps-print-duplex-feature
		 "\n%%EndFeature\n")))
  (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n")
  (and ps-banner-page-when-duplexing
       (ps-output "\n%%Page: 0 0\nsave showpage restore\n")))


(defun ps-format-color (color &optional default)
  (let ((the-color (if (stringp color)
		       (ps-color-scale color)
		     color)))
    (if (and the-color (listp the-color))
	(concat "["
		(format ps-color-format
			(nth 0 the-color)
			(nth 1 the-color)
			(nth 2 the-color))
		"] ")
      (ps-float-format (if (numberp the-color) the-color default)))))


(defun ps-insert-string (prologue)
  (let ((str (if (functionp prologue)
		 (funcall prologue)

	       (string-as-unibyte "[\000-\037\177-\377]"))
	      ((eq ps-print-control-characters 'control-8-bit)
	       (string-as-unibyte "[\000-\037\177-\237]"))
	      ((eq ps-print-control-characters 'control)
	       "[\000-\037\177]")
	      (t "[\t\n\f]"))
	ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
	ps-default-color (and ps-print-color-p ps-default-foreground)
	ps-current-color ps-default-color
	;; Set the color scale.  We do it here instead of in the defvar so
	;; that ps-print can be dumped into emacs.  This expression can't be
	;; evaluated at dump-time because X isn't initialized.
	ps-color-p           (and ps-print-color-p (ps-color-device))
	ps-print-color-scale (if ps-color-p
				 (float (car (ps-color-values "white")))
			       1.0)))


(defun ps-rgb-color (color default)
  (cond ((and color (listp color)) color)
	((stringp color) (ps-color-scale color))
	((numberp color) (list color color color))
	(t (list default default default))
	))


(defmacro ps-page-number ()
  `(1+ (/ (1- ps-page-count) ps-number-of-columns)))

(defun ps-end-file (needs-begin-file)

			 (nth 0 color) (nth 1 color) (nth 2 color))
		 " true BG\n")
    (ps-output "false BG\n")))

(defun ps-set-color (color)
  (setq ps-current-color (or color ps-default-foreground))
  (ps-output (format ps-color-format
		     (nth 0 ps-current-color)
		     (nth 1 ps-current-color) (nth 2 ps-current-color))
	     " FG\n"))

    (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
    (ps-mule-prepare-ascii-font str)
    (ps-output-string str)
    (ps-output " S\n")))

(defun ps-color-scale (color)
  ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
  (mapcar #'(lambda (value) (/ value ps-print-color-scale))
	  (ps-color-values color)))


(cond ((eq ps-print-emacs-type 'emacs)  ; emacs

       (defun ps-color-values (x-color)

       )
					; xemacs
					; lucid
      (t				; epoch
       (defun ps-color-values (x-color)
	 (let ((the-color (if (color-specifier-p x-color)
			      (color-name x-color)
			    x-color)))
	   (cond
	    ((fboundp 'x-color-values)
	     (x-color-values the-color))
	    ((and (fboundp 'color-instance-rgb-components)
		  (ps-color-device))
	     (color-instance-rgb-components
	      (if (color-instance-p x-color)
		  x-color
		(make-color-instance the-color))))
	    (t
	     (error "No available function to determine X color values.")))))
       ))


(defun ps-face-attributes (face)
  "Return face attribute vector.

    (let* ((face-bit   (ps-face-attribute-list face))
	   (effect     (aref face-bit 0))
	   (foreground (aref face-bit 1))
	   (background (aref face-bit 2))
	   (fg-color (if (and ps-color-p foreground)
			 (ps-color-scale foreground)
		       ps-default-color))
	   (bg-color (and ps-color-p background
			  (ps-color-scale background))))
      (ps-plot-region
       from to
       (ps-font-number 'ps-font-for-text
		       (or (aref ps-font-type (logand effect 3))
			   face))

  (if (or ps-always-build-face-reference
	  ps-build-face-reference)
      (progn
	(message "Collecting face information...")
	(ps-build-reference-face-lists)))
  ;; Generate some PostScript.
  (save-restriction
    (narrow-to-region from to)
    (ps-print-ensure-fontified from to)
    (let ((face 'default)

    (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
	 (replace-match (format "/Lines %d def\n/PageCount %d def"
				total-lines total-pages) t))))


(defconst ps-printer-name-option
  (cond ((memq system-type '(win32 w32 mswindows ms-dos windows-nt))
	 "-P")
	((memq system-type '(usq-unix-v dgux hpux irix))
	 "-d")
	(t
	 "-P" )))


;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
(defun ps-do-despool (filename)
  (if (or (not (boundp 'ps-spool-buffer))
	  (not (symbol-value 'ps-spool-buffer)))
      (message "No spooled PostScript to print")

	       (ps-printer-name (or ps-printer-name
				    (and (boundp 'printer-name)
					 printer-name)))
	       (ps-lpr-switches
		(append (and (stringp ps-printer-name)
			     (list (concat ps-printer-name-option
					   ps-printer-name)))
			ps-lpr-switches)))
	  (apply (or ps-print-region-function 'call-process-region)
		 (point-min) (point-max) ps-lpr-command nil
		 (and (fboundp 'start-process) 0)
		 nil