;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Version: 7.2.4
+;; Version: 7.3.1
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(defconst ps-print-version "7.2.4"
- "ps-print.el, v 7.2.4 <2007/07/20 vinicius>
+(defconst ps-print-version "7.3.1"
+ "ps-print.el, v 7.3.1 <2007/11/21 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
;; 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
;; -----------------------
;;
;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
;;
-;; 20040229
+;; 2007-10-27
+;; `ps-fg-validate-p', `ps-fg-list'
+;;
+;; 2004-02-29
;; `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
;;
-;; 20010619
+;; 2001-06-19
;; `ps-time-stamp-locale-default'
;;
-;; 20010530
+;; 2001-05-30
;; Handle before-string and after-string overlay properties.
;;
-;; 20010407
+;; 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'.
;;
-;; 20010328
+;; 2001-03-28
;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
;;
-;; 20001122
+;; 2000-11-22
;; `ps-line-number-font', `ps-line-number-font-size' and
;; `ps-end-with-control-d'.
;;
-;; 20000821
+;; 2000-08-21
;; `ps-even-or-odd-pages'
;;
-;; 20000617
+;; 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'.
;;
-;; 20000310
+;; 2000-03-10
;; PostScript error handler.
;; `ps-user-defined-prologue' and `ps-error-handler-message'.
;;
-;; 19991211
+;; 1999-12-11
;; `ps-print-customize'.
;;
-;; 19990703
+;; 1999-07-03
;; Better customization.
;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
;;
-;; 19990513
+;; 1999-05-13
;; N-up printing.
;; Hook: `ps-print-begin-sheet-hook'.
;;
-;; [kenichi] 19990509 Ken'ichi Handa <handa@m17n.org>
+;; [kenichi] 1999-05-09 Ken'ichi Handa <handa@m17n.org>
;;
;; `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
;;
-;; 19990301
+;; 1999-03-01
;; PostScript tumble and setpagedevice.
;;
-;; 19980922
+;; 1998-09-22
;; PostScript prologue header comment insertion.
;; Skip invisible text better.
;;
-;; [kenichi] 19980819 Ken'ichi Handa <handa@m17n.org>
+;; [kenichi] 1998-08-19 Ken'ichi Handa <handa@m17n.org>
;;
;; Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
;;
-;; 19980306
+;; 1998-03-06
;; Skip invisible text.
;;
-;; 19971130
+;; 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.
;;
-;; 19971121
+;; 1997-11-21
;; Dynamic evaluation at print time of `ps-lpr-switches'.
;; Handle control characters.
;; Face remapping.
;; Zebra stripes.
;; Text and/or image on background.
;;
-;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
+;; [jack] 1996-05-17 Jacques Duthen <duthen@cegelec-red.fr>
;;
-;; Font family and float size for text and header.
-;; Landscape mode.
-;; Multiple columns.
-;; Tools for page setup.
+;; Font family and float size for text and header.
+;; Landscape mode.
+;; Multiple columns.
+;; Tools for page setup.
;;
;;
;; Known bugs and limitations of ps-print
;; ----------------
;;
;; 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.
;;
(error "`ps-print' requires floating point support"))
-(let ((case-fold-search t))
- (cond ((string-match "XEmacs" emacs-version))
- ((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 22))
- (error "`ps-print' only supports Emacs 22 and higher")))))
+(if (featurep 'xemacs)
+ ()
+ (unless (and (boundp 'emacs-major-version)
+ (>= emacs-major-version 23))
+ (error "`ps-print' only supports Emacs 23 and higher")))
(defconst ps-windows-system
:group 'ps-print-printer)
(defcustom ps-lpr-switches lpr-switches
- "*A list of extra switches to pass to `ps-lpr-command'."
+ "*List of extra switches to pass to `ps-lpr-command'.
+
+The list element can be:
+
+ string it should be an option for `ps-lpr-command' (which see).
+ For example: \"-o Duplex=DuplexNoTumble\"
+
+ symbol it can be a function or variable symbol. If it's a function
+ symbol, it should be a function with no argument. The result
+ of the function or the variable value should be a string or a
+ list of strings.
+
+ list the header should be a symbol function and the tail is the
+ arguments for this function. This function should return a
+ string or a list of strings.
+
+Any other value is silently ignored.
+
+It is recommended to set `ps-printer-name' (which see) instead of including an
+explicit switch on this list.
+
+See `ps-lpr-command'."
:type '(repeat :tag "PostScript lpr Switches"
(choice :menu-tag "PostScript lpr Switch"
:tag "PostScript lpr Switch"
:group 'ps-print-font)
(defcustom ps-font-size '(7 . 8.5)
- "*Font size, in points, for ordinary text, when generating PostScript."
+ "*Font size, in points, for ordinary text, when generating PostScript.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
:type '(choice :menu-tag "Ordinary Text Font Size"
:tag "Ordinary Text Font Size"
(number :tag "Text Size")
:group 'ps-print-font)
(defcustom ps-header-font-size '(10 . 12)
- "*Font size, in points, for text in the header, when generating PostScript."
+ "*Font size, in points, for text in the header, when generating PostScript.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
:type '(choice :menu-tag "Header Font Size"
:tag "Header Font Size"
(number :tag "Header Size")
:group 'ps-print-font)
(defcustom ps-header-title-font-size '(12 . 14)
- "*Font size, in points, for the top line of text in header, in PostScript."
+ "*Font size, in points, for the top line of text in header, in PostScript.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
:type '(choice :menu-tag "Header Title Font Size"
:tag "Header Title Font Size"
(number :tag "Header Title Size")
:group 'ps-print-font)
(defcustom ps-footer-font-size '(10 . 12)
- "*Font size, in points, for text in the footer, when generating PostScript."
+ "*Font size, in points, for text in the footer, when generating PostScript.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
:type '(choice :menu-tag "Footer Font Size"
:tag "Footer Font Size"
(number :tag "Footer Size")
:group 'ps-print-miscellany)
(defcustom ps-line-number-font-size 6
- "*Font size, in points, for line number, when generating PostScript."
+ "*Font size, in points, for line number, when generating PostScript.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
:type '(choice :menu-tag "Line Number Font Size"
:tag "Line Number Font Size"
(number :tag "Font Size")
LIST It's a list of RGB values, that is a list of three real values
of the form:
- (RED, GREEN, BLUE)
+ (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.
-It's used only when `ps-print-color-p' is non-nil."
+This variable is used only when `ps-print-color-p' (which see) is neither nil
+nor black-white."
:type '(choice :menu-tag "Default Foreground Gray/Color"
:tag "Default Foreground Gray/Color"
(const :tag "Session Foreground" t)
LIST It's a list of RGB values, that is a list of three real values
of the form:
- (RED, GREEN, BLUE)
+ (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.
-It's used only when `ps-print-color-p' is non-nil.
+This variable is used only when `ps-print-color-p' (which see) is neither nil
+nor black-white.
See also `ps-use-face-background'."
:type '(choice :menu-tag "Default Background Gray/Color"
: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
(defcustom ps-line-spacing 0
"*Specify line spacing, in points, for ordinary text.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
+
See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
To get all lines with some spacing set both `ps-line-spacing' and
(defcustom ps-paragraph-spacing 0
"*Specify paragraph spacing, in points, for ordinary text.
+Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
+
See also `ps-line-spacing' and `ps-paragraph-regexp'.
To get all lines with some spacing set both `ps-line-spacing' and
'(23 . ps-line-number-step)
'(23 . ps-line-number-start)
nil
- '(17 . ps-default-fg)
- '(17 . ps-default-bg)
'(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
'(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
+\;; 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-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)
;; Functions are called -- they should return strings; they will be inserted
;; as strings and the PS string delimiters added.
- ((fboundp content)
- (if (fboundp ps-encode-header-string-function)
+ ((functionp content)
+ (if (functionp ps-encode-header-string-function)
(dolist (l (funcall ps-encode-header-string-function
(funcall content) fonttag))
(ps-output-string l))
(defun ps-background (page-number)
(let (has-local-background)
- (mapcar #'(lambda (range)
- (and (<= (aref range 0) page-number)
- (<= page-number (aref range 1))
- (if has-local-background
- (ps-output (aref range 2))
- (setq has-local-background t)
- (ps-output "/printLocalBackground{\n"
- (aref range 2)))))
- ps-background-pages)
+ (mapc #'(lambda (range)
+ (and (<= (aref range 0) page-number)
+ (<= page-number (aref range 1))
+ (if has-local-background
+ (ps-output (aref range 2))
+ (setq has-local-background t)
+ (ps-output "/printLocalBackground{\n"
+ (aref range 2)))))
+ ps-background-pages)
(and has-local-background (ps-output "}def\n"))))
(ps-output "\n" ps-print-prologue-1
"\n/printGlobalBackground{\n")
- (mapcar 'ps-output ps-background-all-pages)
+ (mapc 'ps-output ps-background-all-pages)
(ps-output
"}def\n/printLocalBackground{\n}def\n"
"\n%%EndProlog\n\n%%BeginSetup\n"
1.0)
ps-default-background (ps-rgb-color
(cond
- ((or (not (eq ps-print-color-p t))
+ ((or (member ps-print-color-p
+ '(nil back-white))
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-bg 'frame-parameter)
1.0)
ps-default-foreground (ps-rgb-color
(cond
- ((or (not (eq ps-print-color-p t))
+ ((or (member ps-print-color-p
+ '(nil back-white))
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-fg 'frame-parameter)
ps-default-fg))
"unspecified-fg"
0.0)
- ps-default-color (and (eq ps-print-color-p t)
+ 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
- ;; Set up default functions. They may be overridden by
- ;; ps-mule-begin-job.
- ps-basic-plot-string-function 'ps-basic-plot-string
+ ;; Set up default functions.
+ ;; They may be overridden by ps-mule-begin-job.
+ ps-basic-plot-string-function 'ps-basic-plot-string
ps-encode-header-string-function nil)
;; initialize page dimensions
(ps-get-page-dimensions)
;; final check
+ (unless (listp ps-lpr-switches)
+ (error "`ps-lpr-switches' value should be a list."))
(and ps-color-p
(equal ps-default-background ps-default-foreground)
(error
(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.
+ ;; 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)
+ ;; Specify effects (underline, overline, box, etc.)
(cond
((not (integerp effects))
(ps-output "0 EF\n")
(ps-output " S\n")))
+(defsubst ps-face-foreground-color-p (attr)
+ (memq attr '(foreground-color :foreground)))
+
+
+(defsubst ps-face-background-color-p (attr)
+ (memq attr '(background-color :background)))
+
+
+(defsubst ps-face-color-p (attr)
+ (memq attr '(foreground-color :foreground background-color :background)))
+
+
(defun ps-face-attributes (face)
"Return face attribute vector.
(setq ps-print-face-alist
(cons new-face ps-print-face-alist)))
new-face))))
- ((eq (car face) 'foreground-color)
+ ((ps-face-foreground-color-p (car face))
(vector 0 (cdr face) nil))
- ((eq (car face) 'background-color)
+ ((ps-face-background-color-p (car face))
(vector 0 nil (cdr face)))
(t
(vector 0 nil nil))))
((symbolp face)
(memq face ps-use-face-background))
((listp face)
- (or (memq (car face) '(foreground-color background-color))
+ (or (ps-face-color-p (car face))
(let (ok)
(while face
(if (or (memq (car face) ps-use-face-background)
- (memq (car face)
- '(foreground-color background-color)))
+ (ps-face-color-p (car face)))
(setq face nil
ok t)
(setq face (cdr face))))
((not (listp face-or-list))
(ps-face-attributes face-or-list))
;; only foreground color, not a `real' face
- ((eq (car face-or-list) 'foreground-color)
+ ((ps-face-foreground-color-p (car face-or-list))
(vector 0 (cdr face-or-list) nil))
;; only background color, not a `real' face
- ((eq (car face-or-list) 'background-color)
+ ((ps-face-background-color-p (car face-or-list))
(vector 0 nil (cdr face-or-list)))
;; list of faces
(t
;; Now, rebuild reference face lists
(setq ps-print-face-alist nil)
(if ps-auto-font-detect
- (mapcar 'ps-map-face (face-list))
- (mapcar 'ps-set-face-bold ps-bold-faces)
- (mapcar 'ps-set-face-italic ps-italic-faces)
- (mapcar 'ps-set-face-underline ps-underlined-faces))
+ (mapc 'ps-map-face (face-list))
+ (mapc 'ps-set-face-bold ps-bold-faces)
+ (mapc 'ps-set-face-italic ps-italic-faces)
+ (mapc 'ps-set-face-underline ps-underlined-faces))
(setq ps-build-face-reference nil))
(and (fboundp 'start-process) 0)
nil
(ps-flatten-list ; dynamic evaluation
- (mapcar 'ps-eval-switch ps-lpr-switches)))))
+ (ps-string-list
+ (mapcar 'ps-eval-switch ps-lpr-switches))))))
(and ps-razzle-dazzle (message "Printing...done")))
(kill-buffer ps-spool-buffer)))
+(defun ps-string-list (arg)
+ (let (lstr)
+ (dolist (elm arg)
+ (cond ((stringp elm)
+ (setq lstr (cons elm lstr)))
+ ((listp elm)
+ (let ((s (ps-string-list elm)))
+ (when s
+ (setq lstr (cons s lstr)))))
+ (t ))) ; ignore any other value
+ (nreverse lstr)))
+
;; Dynamic evaluation
(defun ps-eval-switch (arg)
(cond ((stringp arg) arg)
;; But autoload them here to make the separation invisible.
\f
;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
-;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "bb18668f99d691db470ec2a32753ba28")
+;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "ba0ba38bf1f9831ca12701290fd4b211")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
Any other value is treated as nil.")
-(custom-autoload (quote ps-multibyte-buffer) "ps-mule" t)
+(custom-autoload 'ps-multibyte-buffer "ps-mule" t)
-(autoload (quote ps-mule-initialize) "ps-mule" "\
+(autoload 'ps-mule-initialize "ps-mule" "\
Initialize global data for printing multi-byte characters.
\(fn)" nil nil)
-(autoload (quote ps-mule-begin-job) "ps-mule" "\
+(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 (quote ps-mule-end-job) "ps-mule" "\
+(autoload 'ps-mule-end-job "ps-mule" "\
Finish printing job for multi-byte chars.
\(fn)" nil nil)