comparison lisp/ps-print.el @ 75702:78d94b04f6aa

Fix background color printing

75701:744efaecbd36

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

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

	((stringp color) (ps-color-scale color))
	(t (list default default default))
	))


(defun ps-begin-job ()
  ;; prologue files
  (or (equal ps-mark-code-directory ps-postscript-code-directory)
      (setq ps-print-prologue-0    (ps-prologue-file 0)
	    ps-print-prologue-1    (ps-prologue-file 1)
	    ps-mark-code-directory ps-postscript-code-directory))

	      ((eq ps-print-control-characters 'control)
	       "[\000-\037\177]")
	      (t "[\t\n\f]"))
	ps-default-background (ps-rgb-color
			       (cond
				((eq ps-default-bg 'frame-parameter)
				 (ps-frame-parameter 'background-color))
				((eq ps-default-bg t)
				 (ps-face-background-name 'default))
				(t
				 ps-default-bg))
			       1.0)
	ps-default-foreground (ps-rgb-color
			       (cond
				((eq ps-default-fg 'frame-parameter)
				 (ps-frame-parameter 'foreground-color))
				((eq ps-default-fg t)
				 (ps-face-foreground-name 'default))
				(t

If FACE is not in `ps-print-face-extension-alist' or in
`ps-print-face-alist', insert it on `ps-print-face-alist' and
return the attribute vector.

If FACE is not a valid face name, it is used default face."
  (cond
   (ps-black-white-faces-alist
    (or (and (symbolp face)
	     (cdr (assq face ps-black-white-faces-alist)))
	(vector 0 nil nil)))

   (t
    (vector 0 nil nil))))


(defun ps-face-background (face background)
  (and (or (eq ps-use-face-background t)
	   (cond ((symbolp face)
		  (memq face ps-use-face-background))
		 ((listp face)
		  (or (memq (car face) '(foreground-color background-color))
		      (let (ok)
			(while face
			  (if (or (memq (car face) ps-use-face-background)
				  (memq (car face)
					'(foreground-color background-color)))
			      (setq face nil
				    ok   t)
			    (setq face (cdr face))))
			ok)))
		 (t
		  nil)
		 ))
       background))


(defun ps-face-attribute-list (face-or-list)
  (cond

		 (ps-plot-string after-string))
	    (setq from position)))))
      (ps-plot-with-face from to face))))

(defun ps-generate-postscript (from to)
  (ps-plot-region from to 0 nil))

(defun ps-generate (buffer from to genfunc)
  (save-excursion
    (let ((from (min to from))
	  (to (max to from))

		(set-buffer ps-source-buffer)
		(save-excursion
		  (let ((ps-print-page-p t)
			ps-even-or-odd-pages)
		    (ps-begin-job)
		    (when needs-begin-file
		      (ps-begin-file)
		      (ps-mule-initialize))
		    (ps-mule-begin-job from to)
		    (ps-selected-pages)))

75702:78d94b04f6aa

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

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

	((stringp color) (ps-color-scale color))
	(t (list default default default))
	))


(defun ps-begin-job (genfunc)
  ;; prologue files
  (or (equal ps-mark-code-directory ps-postscript-code-directory)
      (setq ps-print-prologue-0    (ps-prologue-file 0)
	    ps-print-prologue-1    (ps-prologue-file 1)
	    ps-mark-code-directory ps-postscript-code-directory))

	      ((eq ps-print-control-characters 'control)
	       "[\000-\037\177]")
	      (t "[\t\n\f]"))
	ps-default-background (ps-rgb-color
			       (cond
				((eq genfunc 'ps-generate-postscript)
				 nil)
				((eq ps-default-bg 'frame-parameter)
				 (ps-frame-parameter 'background-color))
				((eq ps-default-bg t)
				 (ps-face-background-name 'default))
				(t
				 ps-default-bg))
			       1.0)
	ps-default-foreground (ps-rgb-color
			       (cond
				((eq genfunc 'ps-generate-postscript)
				 nil)
				((eq ps-default-fg 'frame-parameter)
				 (ps-frame-parameter 'foreground-color))
				((eq ps-default-fg t)
				 (ps-face-foreground-name 'default))
				(t

If FACE is not in `ps-print-face-extension-alist' or in
`ps-print-face-alist', insert it on `ps-print-face-alist' and
return the attribute vector.

If FACE is not a valid face name, use default face."
  (cond
   (ps-black-white-faces-alist
    (or (and (symbolp face)
	     (cdr (assq face ps-black-white-faces-alist)))
	(vector 0 nil nil)))

   (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)
	      (or (memq (car face) '(foreground-color background-color))
		  (let (ok)
		    (while face
		      (if (or (memq (car face) ps-use-face-background)
			      (memq (car face)
				    '(foreground-color background-color)))
			  (setq face nil
				ok   t)
			(setq face (cdr face))))
		    ok)))
	     (t
	      nil)
	     )
       background))


(defun ps-face-attribute-list (face-or-list)
  (cond

		 (ps-plot-string after-string))
	    (setq from position)))))
      (ps-plot-with-face from to face))))

(defun ps-generate-postscript (from to)
  (ps-plot-region from to 0))

(defun ps-generate (buffer from to genfunc)
  (save-excursion
    (let ((from (min to from))
	  (to (max to from))

		(set-buffer ps-source-buffer)
		(save-excursion
		  (let ((ps-print-page-p t)
			ps-even-or-odd-pages)
		    (ps-begin-job genfunc)
		    (when needs-begin-file
		      (ps-begin-file)
		      (ps-mule-initialize))
		    (ps-mule-begin-job from to)
		    (ps-selected-pages)))