comparison lisp/ps-print.el @ 85711:b6f5dc84b2e1

Detect if text foreground and background are equals

85710:beb909dfc54d

;;	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
;; Version: 6.7.6
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre

(defconst ps-print-version "6.7.6"
  "ps-print.el, v 6.7.6 <2007/10/10 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.

;; On black/white printers, colors are displayed in gray scale.
;; To turn off color output, set `ps-print-color-p' to nil.
;; You can also set `ps-print-color-p' to 'black-white to have a better looking
;; on black/white printers.  See also `ps-black-white-faces' for documentation.
;;
;;
;; How Ps-Print Maps Faces
;; -----------------------
;;
;; As ps-print uses PostScript to print buffers, it is possible to have other

;; New since version 2.8
;; ---------------------
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    20040229
;;	 `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
;;
;;    20010619
;;	 `ps-time-stamp-locale-default'
;;
;;    20010530
;;	 Handle before-string and after-string overlay properties.
;;
;;    20010407
;;	 `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
;;	 `ps-print-footer-frame', `ps-footer-font-family',
;;	 `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
;;	 `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
;;	 `ps-header-frame-alist'.
;;
;;    20010328
;;	 `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
;;	 `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
;;
;;    20001122
;;	 `ps-line-number-font', `ps-line-number-font-size' and
;;	 `ps-end-with-control-d'.
;;
;;    20000821
;;	 `ps-even-or-odd-pages'
;;
;;    20000617
;;	 `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
;;	 `ps-selected-pages', `ps-last-selected-pages',
;;	 `ps-restore-selected-pages', `ps-switch-header',
;;	 `ps-line-number-step', `ps-line-number-start',
;;	 `ps-zebra-stripe-follow' and `ps-use-face-background'.
;;
;;    20000310
;;	 PostScript error handler.
;;	 `ps-user-defined-prologue' and `ps-error-handler-message'.
;;
;;    19991211
;;	 `ps-print-customize'.
;;
;;    19990703
;;	 Better customization.
;;	 `ps-banner-page-when-duplexing' and `ps-zebra-color'.
;;
;;    19990513
;;	 N-up printing.
;;	 Hook: `ps-print-begin-sheet-hook'.
;;
;; [kenichi] 19990509 Ken'ichi Handa <[e-mail]>
;;
;;    `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19990301
;;	 PostScript tumble and setpagedevice.
;;
;;    19980922
;;	 PostScript prologue header comment insertion.
;;	 Skip invisible text better.
;;
;; [kenichi] 19980819 Ken'ichi Handa <[e-mail]>
;;
;;    Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19980306
;;	 Skip invisible text.
;;
;;    19971130
;;	 Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
;;	 `ps-print-begin-column-hook'.
;;	 Put one header per page over the columns.
;;	 Better database font management.
;;	 Better control characters handling.
;;
;;    19971121
;;	 Dynamic evaluation at print time of `ps-lpr-switches'.
;;	 Handle control characters.
;;	 Face remapping.
;;	 New face attributes.
;;	 Line number.
;;	 Zebra stripes.
;;	 Text and/or image on background.
;;
;; [jack] 19960517 Jacques Duthen <[e-mail]>
;;
;; Font family and float size for text and header.
;; Landscape mode.
;; Multiple columns.
;; Tools for page setup.
;;
;;
;; Known bugs and limitations of ps-print
;; --------------------------------------
;;

;;
;; Things to change
;; ----------------
;;
;; Avoid page break inside a paragraph.
;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
;; Improve the memory management for big files (hard?).
;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
;; lines.
;;
;;
;; Acknowledgments

		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED, GREEN, BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and black color will be used.

		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED, GREEN, BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and white color will be used.

		 (list :tag "RGB Color" :value (1.0 1.0 1.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :version "20"
  :group 'ps-print-color)

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

  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory
  (or (if (featurep 'xemacs)
	  (cond ((fboundp 'locate-data-directory) ; XEmacs
		 (locate-data-directory "ps-print"))
		((boundp 'data-directory) ; XEmacs
		 data-directory)
		(t			; don't know what to do
		 nil))
	data-directory)			; Emacs
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.

      '(23 . ps-zebra-color)
      '(23 . ps-line-number)
      '(23 . ps-line-number-step)
      '(23 . ps-line-number-start)
      nil
      '(17 . ps-default-fg)
      '(17 . ps-default-bg)
      '(17 . ps-razzle-dazzle)
      nil
      '(23 . ps-use-face-background)
      nil
      '(28 . ps-print-control-characters)
      nil

      '(20 . ps-bold-faces)
      '(20 . ps-italic-faces)
      '(20 . ps-underlined-faces)
      '(20 . ps-black-white-faces)
      "      )\n
;; The following customized variables have long lists and are seldom modified:
;;    ps-page-dimensions-database
;;    ps-font-info-database

\;;; ps-print - end of settings\n")
     "\n")))

(defvar ps-default-foreground nil)
(defvar ps-default-background nil)
(defvar ps-default-color nil)
(defvar ps-current-color nil)
(defvar ps-current-bg nil)

(defvar ps-zebra-stripe-full-p nil)
(defvar ps-razchunk 0)

(defvar ps-color-p nil)

				 (ps-face-foreground-name 'default))
				(t
				 ps-default-fg))
			       "unspecified-fg"
			       0.0)
	ps-default-color      (and (not (member ps-print-color-p
						'(nil back-white)))
				   ps-default-foreground)
	ps-current-color      ps-default-color)
  ;; initialize page dimensions

(defun ps-plot-region (from to font &optional fg-color bg-color effects)
  (or (equal font ps-current-font)
      (ps-set-font font))

  ;; Specify a foreground color only if one's specified and it's
  ;; different than the current.
  (let ((fg (or fg-color ps-default-foreground)))
    (or (equal fg ps-current-color)
	(ps-set-color fg)))

  (or (equal bg-color ps-current-bg)
      (ps-set-bg bg-color))

  ;; Specify effects (underline, overline, box, etc)
  (cond
   ((not (integerp effects))
    (ps-output "0 EF\n")
    (setq ps-current-effect 0))
   ((/= effects ps-current-effect)

   (t
    (vector 0 nil nil))))


(defun ps-face-background (face background)
  (and (cond ((eq ps-use-face-background t))	; always
	     ((null ps-use-face-background) nil) ; never
	     ;; ps-user-face-background is a symbol face list
	     ((symbolp face)
	      (memq face ps-use-face-background))
	     ((listp face)

			  the same buffer.  See `ps-font-family',
			  `ps-header-font-family' and `ps-font-info-database'.

Any other value is treated as nil.")

(custom-autoload (quote ps-multibyte-buffer) "ps-mule" t)

(autoload (quote ps-mule-prepare-ascii-font) "ps-mule" "\
Setup special ASCII font for STRING.
STRING should contain only ASCII characters.

\(fn STRING)" nil nil)

(autoload (quote ps-mule-set-ascii-font) "ps-mule" "\
Not documented

\(fn)" nil nil)

(autoload (quote ps-mule-plot-string) "ps-mule" "\
Generate PostScript code for plotting characters in the region FROM and TO.

It is assumed that all characters in this region belong to the same charset.

Optional argument BG-COLOR specifies background color.

Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence.

\(fn FROM TO &optional BG-COLOR)" nil nil)

(autoload (quote ps-mule-plot-composition) "ps-mule" "\
Generate PostScript code for plotting composition in the region FROM and TO.

It is assumed that all characters in this region belong to the same
composition.

Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence.

\(fn FROM TO &optional BG-COLOR)" nil nil)

(autoload (quote ps-mule-initialize) "ps-mule" "\
Initialize global data for printing multi-byte characters.

\(fn)" nil nil)

(autoload (quote ps-mule-encode-header-string) "ps-mule" "\
Generate PostScript code for ploting STRING by font FONTTAG.
FONTTAG should be a string \"/h0\" or \"/h1\".

\(fn STRING FONTTAG)" nil nil)

(autoload (quote ps-mule-begin-job) "ps-mule" "\
Start printing job for multi-byte chars between FROM and TO.
It checks if all multi-byte characters in the region are printable or not.

\(fn FROM TO)" nil nil)

(autoload (quote ps-mule-begin-page) "ps-mule" "\
Not documented

\(fn)" nil nil)

;;;***

85711:b6f5dc84b2e1

;;	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
;; Version: 6.8
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre

(defconst ps-print-version "6.8"
  "ps-print.el, v 6.8 <2007/10/26 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.

;; On black/white printers, colors are displayed in gray scale.
;; To turn off color output, set `ps-print-color-p' to nil.
;; You can also set `ps-print-color-p' to 'black-white to have a better looking
;; on black/white printers.  See also `ps-black-white-faces' for documentation.
;;
;; ps-print also detects if the text foreground and background colors are
;; equals when `ps-fg-validate-p' is non-nil.  In this case, if these colors
;; are used, no text will appear.  You can use `ps-fg-list' to give a list of
;; foreground colors to be used when text foreground and background colors are
;; equals.  It'll be used the first foreground color in `ps-fg-list' which is
;; different from the background color.  If `ps-fg-list' is nil, the default
;; foreground color is used. 
;;
;;
;; How Ps-Print Maps Faces
;; -----------------------
;;
;; As ps-print uses PostScript to print buffers, it is possible to have other

;; New since version 2.8
;; ---------------------
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    2007-10-27
;;	 `ps-fg-validate-p', `ps-fg-list'
;;
;;    2004-02-29
;;	 `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
;;
;;    2001-06-19
;;	 `ps-time-stamp-locale-default'
;;
;;    2001-05-30
;;	 Handle before-string and after-string overlay properties.
;;
;;    2001-04-07
;;	 `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
;;	 `ps-print-footer-frame', `ps-footer-font-family',
;;	 `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
;;	 `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
;;	 `ps-header-frame-alist'.
;;
;;    2001-03-28
;;	 `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
;;	 `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
;;
;;    2000-11-22
;;	 `ps-line-number-font', `ps-line-number-font-size' and
;;	 `ps-end-with-control-d'.
;;
;;    2000-08-21
;;	 `ps-even-or-odd-pages'
;;
;;    2000-06-17
;;	 `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
;;	 `ps-selected-pages', `ps-last-selected-pages',
;;	 `ps-restore-selected-pages', `ps-switch-header',
;;	 `ps-line-number-step', `ps-line-number-start',
;;	 `ps-zebra-stripe-follow' and `ps-use-face-background'.
;;
;;    2000-03-10
;;	 PostScript error handler.
;;	 `ps-user-defined-prologue' and `ps-error-handler-message'.
;;
;;    1999-12-11
;;	 `ps-print-customize'.
;;
;;    1999-07-03
;;	 Better customization.
;;	 `ps-banner-page-when-duplexing' and `ps-zebra-color'.
;;
;;    1999-05-13
;;	 N-up printing.
;;	 Hook: `ps-print-begin-sheet-hook'.
;;
;; [kenichi] 1999-05-09 Ken'ichi Handa <[e-mail]>
;;
;;    `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    1999-03-01
;;	 PostScript tumble and setpagedevice.
;;
;;    1998-09-22
;;	 PostScript prologue header comment insertion.
;;	 Skip invisible text better.
;;
;; [kenichi] 1998-08-19 Ken'ichi Handa <[e-mail]>
;;
;;    Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    1998-03-06
;;	 Skip invisible text.
;;
;;    1997-11-30
;;	 Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
;;	 `ps-print-begin-column-hook'.
;;	 Put one header per page over the columns.
;;	 Better database font management.
;;	 Better control characters handling.
;;
;;    1997-11-21
;;	 Dynamic evaluation at print time of `ps-lpr-switches'.
;;	 Handle control characters.
;;	 Face remapping.
;;	 New face attributes.
;;	 Line number.
;;	 Zebra stripes.
;;	 Text and/or image on background.
;;
;; [jack] 1996-05-17 Jacques Duthen <[e-mail]>
;;
;;    Font family and float size for text and header.
;;    Landscape mode.
;;    Multiple columns.
;;    Tools for page setup.
;;
;;
;; Known bugs and limitations of ps-print
;; --------------------------------------
;;

;;
;; Things to change
;; ----------------
;;
;; Avoid page break inside a paragraph.
;;
;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
;;
;; Improve the memory management for big files (hard?).
;;
;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
;; lines.
;;
;;
;; Acknowledgments

		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED GREEN BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and black color will be used.

		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED GREEN BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and white color will be used.

		 (list :tag "RGB Color" :value (1.0 1.0 1.0)
		       (number :tag "Red")
		       (number :tag "Green")
		       (number :tag "Blue")))
  :version "20"
  :group 'ps-print-color)

(defcustom ps-fg-list nil
  "*Specify foreground color list.

This list is used to chose a text foreground color which is different than the
background color.  It'll be used the first foreground color in `ps-fg-list'
which is different from the background color.

If this list is nil, the default foreground color is used.  See
`ps-default-fg'.

The list element valid values are:

   NUMBER	It's a real value between 0.0 (black) and 1.0 (white) that
		indicate the gray color.

   COLOR-NAME	It's a string which contains the color name.  For example:
		\"yellow\".

   LIST		It's a list of RGB values, that is a list of three real values
		of the form:

		  (RED GREEN BLUE)

		Where RED, GREEN and BLUE are reals between 0.0 (no color) and
		1.0 (full color).

Any other value is ignored and black color will be used.

This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
when `ps-print-color-p' (which see) is neither nil nor black-white."
  :type '(repeat
	  (choice :menu-tag "Foreground Gray/Color"
		  :tag "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"))))
  :version "22"
  :group 'ps-print-color)

(defcustom ps-fg-validate-p t
  "*Non-nil means validate if foreground color is different than background.

If text foreground and background colors are equals, no text will appear.

See also `ps-fg-list'."
  :type 'boolean
  :version "22"
  :group 'ps-print-color)

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

  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory
  (or (if (featurep 'xemacs)
	  (cond ((fboundp 'locate-data-directory) ; XEmacs
		 (funcall 'locate-data-directory "ps-print"))
		((boundp 'data-directory) ; XEmacs
		 (symbol-value 'data-directory))
		(t			; don't know what to do
		 nil))
	data-directory)			; Emacs
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.

      '(23 . ps-zebra-color)
      '(23 . ps-line-number)
      '(23 . ps-line-number-step)
      '(23 . ps-line-number-start)
      nil
      '(17 . ps-razzle-dazzle)
      '(17 . ps-default-bg)
      '(17 . ps-default-fg)
      '(17 . ps-fg-validate-p)
      '(17 . ps-fg-list)
      nil
      '(23 . ps-use-face-background)
      nil
      '(28 . ps-print-control-characters)
      nil

      '(20 . ps-bold-faces)
      '(20 . ps-italic-faces)
      '(20 . ps-underlined-faces)
      '(20 . ps-black-white-faces)
      "      )\n
\;; The following customized variables have long lists and are seldom modified:
\;;    ps-page-dimensions-database
\;;    ps-font-info-database

\;;; ps-print - end of settings\n")
     "\n")))

(defvar ps-default-foreground nil)
(defvar ps-default-background nil)
(defvar ps-default-color nil)
(defvar ps-current-color nil)
(defvar ps-current-bg nil)
(defvar ps-foreground-list nil)

(defvar ps-zebra-stripe-full-p nil)
(defvar ps-razchunk 0)

(defvar ps-color-p nil)

				 (ps-face-foreground-name 'default))
				(t
				 ps-default-fg))
			       "unspecified-fg"
			       0.0)
	ps-foreground-list    (mapcar
			       #'(lambda (arg)
				   (ps-rgb-color arg "unspecified-fg" 0.0))
			       (append (and (not (member ps-print-color-p
							 '(nil back-white)))
					    ps-fg-list)
				       (list ps-default-foreground
					     "black")))
	ps-default-color      (and (not (member ps-print-color-p
						'(nil back-white)))
				   ps-default-foreground)
	ps-current-color      ps-default-color)
  ;; initialize page dimensions

(defun ps-plot-region (from to font &optional fg-color bg-color effects)
  (or (equal font ps-current-font)
      (ps-set-font font))

  ;; Specify a foreground color only if:
  ;;    one's specified,
  ;;    it's different than the background (if `ps-fg-validate-p' is non-nil)
  ;;    and it's different than the current.
  (let ((fg (or fg-color ps-default-foreground)))
    (if ps-fg-validate-p
	(let ((bg (or bg-color ps-default-background))
	      (el ps-foreground-list))
	  (while (and el (equal fg bg))
	    (setq fg (car el)
		  el (cdr el)))))
    (or (equal fg ps-current-color)
	(ps-set-color fg)))

  (or (equal bg-color ps-current-bg)
      (ps-set-bg bg-color))

  ;; Specify effects (underline, overline, box, etc.)
  (cond
   ((not (integerp effects))
    (ps-output "0 EF\n")
    (setq ps-current-effect 0))
   ((/= effects ps-current-effect)

   (t
    (vector 0 nil nil))))


(defun ps-face-background (face background)
  (and (cond ((eq ps-use-face-background t))	 ; always
	     ((null ps-use-face-background) nil) ; never
	     ;; ps-user-face-background is a symbol face list
	     ((symbolp face)
	      (memq face ps-use-face-background))
	     ((listp face)

			  the same buffer.  See `ps-font-family',
			  `ps-header-font-family' and `ps-font-info-database'.

Any other value is treated as nil.")

(custom-autoload 'ps-multibyte-buffer "ps-mule" t)

(autoload 'ps-mule-prepare-ascii-font "ps-mule" "\
Setup special ASCII font for STRING.
STRING should contain only ASCII characters.

\(fn STRING)" nil nil)

(autoload 'ps-mule-set-ascii-font "ps-mule" "\
Not documented

\(fn)" nil nil)

(autoload 'ps-mule-plot-string "ps-mule" "\
Generate PostScript code for plotting characters in the region FROM and TO.

It is assumed that all characters in this region belong to the same charset.

Optional argument BG-COLOR specifies background color.

Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence.

\(fn FROM TO &optional BG-COLOR)" nil nil)

(autoload 'ps-mule-plot-composition "ps-mule" "\
Generate PostScript code for plotting composition in the region FROM and TO.

It is assumed that all characters in this region belong to the same
composition.

Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence.

\(fn FROM TO &optional BG-COLOR)" nil nil)

(autoload 'ps-mule-initialize "ps-mule" "\
Initialize global data for printing multi-byte characters.

\(fn)" nil nil)

(autoload 'ps-mule-encode-header-string "ps-mule" "\
Generate PostScript code for ploting STRING by font FONTTAG.
FONTTAG should be a string \"/h0\" or \"/h1\".

\(fn STRING FONTTAG)" nil nil)

(autoload 'ps-mule-begin-job "ps-mule" "\
Start printing job for multi-byte chars between FROM and TO.
It checks if all multi-byte characters in the region are printable or not.

\(fn FROM TO)" nil nil)

(autoload 'ps-mule-begin-page "ps-mule" "\
Not documented

\(fn)" nil nil)

;;;***