;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Version: 6.7.6
+;; Version: 7.3.1
;; 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>
+(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
;;
;; Faces are always treated as opaque.
;;
-;; Epoch, Lucid and Emacs 21 not supported. At all.
+;; Epoch, Lucid and Emacs 22 not supported. At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; ----------------
;;
;; 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.
;;
(require 'lpr)
+
(or (featurep 'lisp-float-type)
(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")))))
-
-
-;; GNU Emacs
-(or (fboundp 'line-beginning-position)
- (defun line-beginning-position (&optional n)
- (save-excursion
- (and n (/= n 1) (forward-line (1- n)))
- (beginning-of-line)
- (point))))
-
-;; to avoid compilation gripes
-
-;; XEmacs
-(defalias 'ps-x-color-instance-p 'color-instance-p)
-(defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
-(defalias 'ps-x-color-name 'color-name)
-(defalias 'ps-x-color-specifier-p 'color-specifier-p)
-(defalias 'ps-x-copy-coding-system 'copy-coding-system)
-(defalias 'ps-x-device-class 'device-class)
-(defalias 'ps-x-extent-end-position 'extent-end-position)
-(defalias 'ps-x-extent-face 'extent-face)
-(defalias 'ps-x-extent-priority 'extent-priority)
-(defalias 'ps-x-extent-start-position 'extent-start-position)
-(defalias 'ps-x-face-font-instance 'face-font-instance)
-(defalias 'ps-x-find-coding-system 'find-coding-system)
-(defalias 'ps-x-font-instance-properties 'font-instance-properties)
-(defalias 'ps-x-make-color-instance 'make-color-instance)
-(defalias 'ps-x-map-extents 'map-extents)
-
-;; GNU Emacs
-(defalias 'ps-e-face-bold-p 'face-bold-p)
-(defalias 'ps-e-face-italic-p 'face-italic-p)
-(defalias 'ps-e-next-overlay-change 'next-overlay-change)
-(defalias 'ps-e-overlays-at 'overlays-at)
-(defalias 'ps-e-overlay-get 'overlay-get)
-(defalias 'ps-e-overlay-end 'overlay-end)
-(defalias 'ps-e-x-color-values 'x-color-values)
-(defalias 'ps-e-color-values 'color-values)
-(defalias 'ps-e-find-composition (if (fboundp 'find-composition)
- 'find-composition
- 'ignore))
+(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
(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))
-
-(defalias 'ps-frame-parameter
- (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property))
-
-(defalias 'ps-mark-active-p
- (if (fboundp 'region-active-p)
- 'region-active-p ; XEmacs
- (defvar mark-active) ; To shup up XEmacs's byte compiler.
- (lambda () mark-active))) ; Emacs
-
-(cond ((featurep 'xemacs) ; XEmacs
- (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)))
- )
- (t ; Emacs 22 or higher
- (defun ps-face-foreground-name (face)
- (face-foreground face nil t))
- (defun ps-face-background-name (face)
- (face-background face nil t))
- ))
+;; Load XEmacs/Emacs definitions
+(eval-and-compile (require 'ps-def))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
: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"
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).
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).
: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-postscript-code-directory
(or (if (featurep 'xemacs)
(cond ((fboundp 'locate-data-directory) ; XEmacs
- (locate-data-directory "ps-print"))
+ (funcall 'locate-data-directory "ps-print"))
((boundp 'data-directory) ; XEmacs
- data-directory)
+ (symbol-value 'data-directory))
(t ; don't know what to do
nil))
data-directory) ; Emacs
'(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")))
(format-time-string "%T"))
-(and (featurep '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))
-
-
-;; Return t if the device (which can be changed during an emacs session)
-;; can handle colors.
-;; This function is not yet implemented for GNU emacs.
-(defalias 'ps-color-device
- (cond ((and (featurep '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)))) ; XEmacs >= 19.12
- (lambda ()
- (eq (ps-x-device-class) 'color)))
-
- (t ; Emacs
- (lambda ()
- (if (fboundp 'color-values)
- (ps-e-color-values "Green")
- t)))))
-
-
-(defun ps-mapper (extent list)
- (nconc list
- (list (list (ps-x-extent-start-position extent) 'push extent)
- (list (ps-x-extent-end-position extent) 'pull extent)))
- nil)
-
-(defun ps-extent-sorter (a b)
- (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
-
-(defun ps-xemacs-face-kind-p (face kind kind-regex)
- (let* ((frame-font (or (ps-x-face-font-instance face)
- (ps-x-face-font-instance 'default)))
- (kind-cons
- (and frame-font
- (assq kind
- (ps-x-font-instance-properties frame-font))))
- (kind-spec (cdr-safe kind-cons))
- (case-fold-search t))
- (and kind-spec (string-match kind-regex kind-spec))))
-
-(cond ((featurep 'xemacs) ; XEmacs
-
- ;; to avoid XEmacs compilation gripes
- (defvar coding-system-for-write)
- (defvar coding-system-for-read)
- (defvar buffer-file-coding-system)
-
- (and (fboundp 'find-coding-system)
- (or (ps-x-find-coding-system 'raw-text-unix)
- (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))
-
- (defun ps-color-values (x-color)
- (let ((color (ps-xemacs-color-name x-color)))
- (cond
- ((fboundp 'x-color-values)
- (ps-e-x-color-values color))
- ((and (fboundp 'color-instance-rgb-components)
- (ps-color-device))
- (ps-x-color-instance-rgb-components
- (if (ps-x-color-instance-p x-color)
- x-color
- (ps-x-make-color-instance color))))
- (t
- (error "No available function to determine X color values")))))
-
- (defun ps-face-bold-p (face)
- (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
- (memq face ps-bold-faces))) ; Kludge-compatible
-
- (defun ps-face-italic-p (face)
- (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
- (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
- (memq face ps-italic-faces))) ; Kludge-compatible
- )
-
- (t ; Emacs
-
- (defun ps-color-values (x-color)
- (cond
- ((fboundp 'color-values)
- (ps-e-color-values x-color))
- ((fboundp 'x-color-values)
- (ps-e-x-color-values x-color))
- (t
- (error "No available function to determine X color values"))))
-
- (defun ps-face-bold-p (face)
- (or (ps-e-face-bold-p face)
- (memq face ps-bold-faces)))
-
- (defun ps-face-italic-p (face)
- (or (ps-e-face-italic-p face)
- (memq face ps-italic-faces)))
- ))
-
-
(defvar ps-print-color-scale 1.0)
(defun ps-color-scale (color)
(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)
-(defvar ps-color-format
- (if (featurep 'xemacs)
- ;; XEmacs will have to make do with %s (princ) for floats.
- "%s %s %s"
-
- ;; 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"))
;; 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
(goto-char (point-max))
(insert-file-contents fname)))
-;; These functions are used in `ps-mule' to get charset of header and footer.
-;; To avoid unnecessary calls to functions in `ps-left-header',
-;; `ps-right-header', `ps-left-footer' and `ps-right-footer'.
-
-(defun ps-generate-string-list (content)
- (let (str)
- (while content
- (setq str (cons (cond
- ;; string
- ((stringp (car content))
- (car content))
- ;; function symbol
- ((functionp (car content))
- (concat "(" (funcall (car content)) ")"))
- ;; variable symbol
- ((and (symbolp (car content)) (boundp (car content)))
- (concat "(" (symbol-value (car content)) ")"))
- ;; otherwise, empty string
- (t
- ""))
- str)
- content (cdr content)))
- (nreverse str)))
-
-(defvar ps-lh-cache nil)
-(defvar ps-rh-cache nil)
-(defvar ps-lf-cache nil)
-(defvar ps-rf-cache nil)
-
-(defun ps-header-footer-string ()
- (and ps-print-header
- (setq ps-lh-cache (ps-generate-string-list ps-left-header)
- ps-rh-cache (ps-generate-string-list ps-right-header)))
- (and ps-print-footer
- (setq ps-lf-cache (ps-generate-string-list ps-left-footer)
- ps-rf-cache (ps-generate-string-list ps-right-footer)))
- (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache))
-
;; These functions insert the arrays that define the contents of the headers.
+(defvar ps-encode-header-string-function nil)
+
(defun ps-generate-header-line (fonttag &optional content)
(ps-output " [" fonttag " ")
(cond
;; Literal strings should be output as is -- the string must contain its own
;; PS string delimiters, '(' and ')', if necessary.
((stringp content)
- (ps-output (ps-mule-encode-header-string content fonttag)))
+ (ps-output content))
;; Functions are called -- they should return strings; they will be inserted
;; as strings and the PS string delimiters added.
((functionp content)
- (ps-output-string (ps-mule-encode-header-string (funcall content)
- fonttag)))
+ (if (functionp ps-encode-header-string-function)
+ (dolist (l (funcall ps-encode-header-string-function
+ (funcall content) fonttag))
+ (ps-output-string l))
+ (ps-output-string (funcall content))))
;; Variables will have their contents inserted. They should contain
;; strings, and will be inserted as strings.
((and (symbolp content) (boundp content))
- (ps-output-string (ps-mule-encode-header-string (symbol-value content)
- fonttag)))
+ (if (fboundp ps-encode-header-string-function)
+ (dolist (l (funcall ps-encode-header-string-function
+ (symbol-value content) fonttag))
+ (ps-output-string l))
+ (ps-output-string (symbol-value content))))
;; Anything else will get turned into an empty string.
(t
(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 (featurep 'xemacs)
- "%s " ; XEmacs
- "%0.3f ")) ; Emacs
-
-
(defun ps-float-format (value &optional default)
(let ((literal (or value default)))
(cond ((null literal)
(t
(list default default default))))
+(defvar ps-basic-plot-string-function 'ps-basic-plot-string)
(defun ps-begin-job (genfunc)
;; prologue files
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)
+ 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
+ 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
(format "/PageNumber %d def\n" (ps-page-number)))
(when ps-print-header
- (ps-generate-header "HeaderLinesLeft" "/h0" "/h1"
- (or ps-lh-cache ps-left-header))
- (ps-generate-header "HeaderLinesRight" "/h0" "/h1"
- (or ps-rh-cache ps-right-header))
- (ps-output (format "%d SetHeaderLines\n" ps-header-lines))
- (setq ps-lh-cache nil
- ps-rh-cache nil))
+ (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
+ (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
+ (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
(when ps-print-footer
- (ps-generate-header "FooterLinesLeft" "/H0" "/H0"
- (or ps-lf-cache ps-left-footer))
- (ps-generate-header "FooterLinesRight" "/H0" "/H0"
- (or ps-rf-cache ps-right-footer))
- (ps-output (format "%d SetFooterLines\n" ps-footer-lines))
- (setq ps-lf-cache nil
- ps-rf-cache nil))
+ (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
+ (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
+ (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
(ps-output (number-to-string ps-lines-printed) " BeginPage\n")
(ps-set-font ps-current-font)
(ps-set-bg ps-current-bg)
- (ps-set-color ps-current-color)
- (ps-mule-begin-page))
+ (ps-set-color ps-current-color))
(defsubst ps-skip-newline (limit)
(setq ps-showline-count (1+ ps-showline-count)
(ps-avg-char-width 'ps-font-for-text)))
(to (car wrappoint))
(str (substring string from to)))
- (ps-mule-prepare-ascii-font str)
(ps-output-string str)
(ps-output " S\n")
wrappoint))
(ps-avg-char-width 'ps-font-for-text)))
(to (car wrappoint))
(string (buffer-substring-no-properties from to)))
- (ps-mule-prepare-ascii-font string)
(ps-output-string string)
(ps-output " S\n")
wrappoint))
(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")
(if (re-search-forward ps-control-or-escape-regexp to t)
;; region with some control characters or some multi-byte characters
(let* ((match-point (match-beginning 0))
- (match (char-after match-point))
- (composition (ps-e-find-composition from (1+ match-point))))
- (if composition
- (if (and (nth 2 composition)
- (<= (car composition) match-point))
- (progn
- (setq match-point (car composition)
- match 0)
- (goto-char (nth 1 composition)))
- (setq composition nil)))
+ (match (char-after match-point)))
(when (< from match-point)
- (ps-mule-set-ascii-font)
- (ps-plot 'ps-basic-plot-string from match-point bg-color))
+ (ps-plot ps-basic-plot-string-function
+ from match-point bg-color))
(cond
((= match ?\t) ; tab
(let ((linestart (line-beginning-position)))
(forward-char -1)
(setq from (+ linestart (current-column)))
(when (re-search-forward "[ \t]+" to t)
- (ps-mule-set-ascii-font)
(ps-plot 'ps-basic-plot-whitespace
from (+ linestart (current-column))
bg-color))))
(ps-skip-newline to))
(ps-next-page)))
- (composition ; a composite sequence
- (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
-
- ((> match 255) ; a multi-byte character
- (setq match (or (aref ps-print-translation-table match) match))
- (let* ((charset (char-charset match))
- (composition (ps-e-find-composition match-point to))
- (stop (if (nth 2 composition) (car composition) to)))
- (or (eq charset 'composition)
- (while (and (< (point) stop)
- (let ((ch (following-char)))
- (setq ch
- (or (aref ps-print-translation-table ch)
- ch))
- (eq (char-charset ch) charset)))
- (forward-char 1)))
- (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
- ; characters from ^@ to ^_ and
(t ; characters from 127 to 255
(ps-control-character match)))
(setq from (point)))
- ;; region without control characters nor multi-byte characters
- (ps-mule-set-ascii-font)
- (ps-plot 'ps-basic-plot-string from to bg-color)
+ ;; region without control characters
+ (ps-plot ps-basic-plot-string-function from to bg-color)
(setq from to)))))
(defvar ps-string-control-codes
(if (< (car wrappoint) to)
(ps-continue-line))
(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-face-background (face background)
- (and (cond ((eq ps-use-face-background t)) ; always
+ (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)
(save-restriction
(narrow-to-region from to)
(ps-print-ensure-fontified from to)
- (let ((face 'default)
- (position to))
- (cond
- ((featurep 'xemacs) ; 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)
- extent-list nil)
-
- ;; Loop through the extents...
- (while a
- (setq record (car a)
- position (car record)
-
- record (cdr record)
- type (car record)
-
- record (cdr record)
- extent (car record))
-
- ;; Plot up to this record.
- ;; XEmacs 19.12: for some reason, we're getting into a
- ;; situation in which some of the records have
- ;; positions less than 'from'. Since we've narrowed
- ;; the buffer, this'll generate errors. This is a hack,
- ;; but don't call ps-plot-with-face unless from > point-min.
- (and (>= from (point-min))
- (ps-plot-with-face from (min position (point-max)) face))
-
- (cond
- ((eq type 'push)
- (and (ps-x-extent-face extent)
- (setq extent-list (sort (cons extent extent-list)
- 'ps-extent-sorter))))
-
- ((eq type 'pull)
- (setq extent-list (sort (delq extent extent-list)
- 'ps-extent-sorter))))
-
- (setq face (if extent-list
- (ps-x-extent-face (car extent-list))
- 'default)
- from position
- a (cdr a)))))
-
- (t ; Emacs
- (let ((property-change from)
- (overlay-change from)
- (save-buffer-invisibility-spec buffer-invisibility-spec)
- (buffer-invisibility-spec nil)
- before-string after-string)
- (while (< from to)
- (and (< property-change to) ; Don't search for property change
- ; unless previous search succeeded.
- (setq property-change (next-property-change from nil to)))
- (and (< overlay-change to) ; Don't search for overlay change
- ; unless previous search succeeded.
- (setq overlay-change (min (ps-e-next-overlay-change from)
- to)))
- (setq position (min property-change overlay-change)
- before-string nil
- after-string nil)
- ;; The code below is not quite correct,
- ;; because a non-nil overlay invisible property
- ;; which is inactive according to the current value
- ;; of buffer-invisibility-spec nonetheless overrides
- ;; a face text property.
- (setq face
- (cond ((let ((prop (get-text-property from 'invisible)))
- ;; Decide whether this invisible property
- ;; really makes the text invisible.
- (if (eq save-buffer-invisibility-spec t)
- (not (null prop))
- (or (memq prop save-buffer-invisibility-spec)
- (assq prop save-buffer-invisibility-spec))))
- 'emacs--invisible--face)
- ((get-text-property from 'face))
- (t 'default)))
- (let ((overlays (ps-e-overlays-at from))
- (face-priority -1)) ; text-property
- (while (and overlays
- (not (eq face 'emacs--invisible--face)))
- (let* ((overlay (car overlays))
- (overlay-invisible
- (ps-e-overlay-get overlay 'invisible))
- (overlay-priority
- (or (ps-e-overlay-get overlay 'priority) 0)))
- (and (> overlay-priority face-priority)
- (setq before-string
- (or (ps-e-overlay-get overlay 'before-string)
- before-string)
- after-string
- (or (and (<= (ps-e-overlay-end overlay) position)
- (ps-e-overlay-get overlay 'after-string))
- after-string)
- face-priority overlay-priority
- face
- (cond
- ((if (eq save-buffer-invisibility-spec t)
- (not (null overlay-invisible))
- (or (memq overlay-invisible
- save-buffer-invisibility-spec)
- (assq overlay-invisible
- save-buffer-invisibility-spec)))
- 'emacs--invisible--face)
- ((ps-e-overlay-get overlay 'face))
- (t face)
- ))))
- (setq overlays (cdr overlays))))
- ;; Plot up to this record.
- (and before-string
- (ps-plot-string before-string))
- (ps-plot-with-face from position face)
- (and after-string
- (ps-plot-string after-string))
- (setq from position)))))
- (ps-plot-with-face from to face))))
+ (ps-generate-postscript-with-faces1 from to)))
(defun ps-generate-postscript (from to)
(ps-plot-region from to 0))
(ps-begin-page)
(funcall genfunc from to)
(ps-end-page)
+ (ps-mule-end-job)
(ps-end-job needs-begin-file)
;; Setting this variable tells the unwind form that the
(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)
(t
(setq kill-emacs-hook 'ps-kill-emacs-check)))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Sample Setup Code:
-
-
-;; This stuff is for anybody that's brave enough to look this far,
-;; and able to figure out how to use it. It isn't really part of
-;; ps-print, but I'll leave it here in hopes it might be useful:
-
-;; WARNING!!! The following code is *sample* code only.
-;; Don't use it unless you understand what it does!
-
-;; The key `f22' should probably be replaced by `print'. --Stef
-
-;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
-(defun ps-rmail-mode-hook ()
- (local-set-key [(f22)] 'ps-rmail-print-message-from-summary)
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the message's subject, its
- ;; author, and the name of the folder it was in.
- '(ps-article-subject ps-article-author buffer-name)))
-
-;; See `ps-gnus-print-article-from-summary'. This function does the
-;; same thing for rmail.
-(defun ps-rmail-print-message-from-summary ()
- (interactive)
- (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
-
-;; Used in `ps-rmail-print-article-from-summary',
-;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
-(defun ps-print-message-from-summary (summary-buffer summary-default)
- (let ((ps-buf (or (and (boundp summary-buffer)
- (symbol-value summary-buffer))
- summary-default)))
- (and (get-buffer ps-buf)
- (save-excursion
- (set-buffer ps-buf)
- (ps-spool-buffer-with-faces)))))
-
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
-(defun ps-article-subject ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "Subject ???")))
-
-;; Look in an article or mail message for the From: line. Sorta-kinda
-;; understands RFC-822 addresses and can pull the real name out where
-;; it's provided. To be placed in `ps-left-headers'.
-(defun ps-article-author ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
- (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
- (cond
-
- ;; Try first to match addresses that look like
- ;; thompson@wg2.waii.com (Jim Thompson)
- ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
- (substring fromstring (match-beginning 1) (match-end 1)))
-
- ;; Next try to match addresses that look like
- ;; Jim Thompson <thompson@wg2.waii.com> or
- ;; "Jim Thompson" <thompson@wg2.waii.com>
- ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
- (substring fromstring (match-beginning 2) (match-end 2)))
-
- ;; Couldn't find a real name -- show the address instead.
- (t fromstring)))
- "From ???")))
-
-;; A hook to bind to `gnus-article-prepare-hook'. This will set the
-;; `ps-left-headers' specially for gnus articles. Unfortunately,
-;; `gnus-article-mode-hook' is called only once, the first time the *Article*
-;; buffer enters that mode, so it would only work for the first time
-;; we ran gnus. The second time, this hook wouldn't get set up. The
-;; only alternative is `gnus-article-prepare-hook'.
-(defun ps-gnus-article-prepare-hook ()
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the article's subject, its
- ;; author, and the newsgroup it was in.
- '(ps-article-subject ps-article-author gnus-newsgroup-name)))
-
-;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
-(defun ps-vm-mode-hook ()
- (local-set-key [(f22)] 'ps-vm-print-message-from-summary)
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the message's subject, its
- ;; author, and the name of the folder it was in.
- '(ps-article-subject ps-article-author buffer-name)))
-
-;; Every now and then I forget to switch from the *Summary* buffer to
-;; the *Article* before hitting prsc, and a nicely formatted list of
-;; article subjects shows up at the printer. This function, bound to
-;; prsc for the gnus *Summary* buffer means I don't have to switch
-;; buffers first.
-;; sb: Updated for Gnus 5.
-(defun ps-gnus-print-article-from-summary ()
- (interactive)
- (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
-
-;; See `ps-gnus-print-article-from-summary'. This function does the
-;; same thing for vm.
-(defun ps-vm-print-message-from-summary ()
- (interactive)
- (ps-print-message-from-summary 'vm-mail-buffer ""))
-
-;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
-;; prsc.
-(defun ps-gnus-summary-setup ()
- (local-set-key [(f22)] 'ps-gnus-print-article-from-summary))
-
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
-(defun ps-info-file ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "File ???")))
-
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
-(defun ps-info-node ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "Node ???")))
-
-(defun ps-info-mode-hook ()
- (setq ps-left-header
- ;; The left headers will display the node name and file name.
- '(ps-info-node ps-info-file)))
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless you understand what the effects
-;; will be! (In fact, this is a copy of Jim's setup for ps-print --
-;; I'd be very surprised if it was useful to *anybody*, without
-;; modification.)
-
-(defun ps-jts-ps-setup ()
- (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc
- (global-set-key [(shift f22)] 'ps-spool-region-with-faces)
- (global-set-key [(control f22)] 'ps-despool)
- (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
- (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
- (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
- (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
- (add-hook 'Info-mode-hook 'ps-info-mode-hook)
- (setq ps-spool-duplex t
- ps-print-color-p nil
- ps-lpr-command "lpr"
- ps-lpr-switches '("-Jjct,duplex_long"))
- 'ps-jts-ps-setup)
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless it corresponds to your needs.
-;; (In fact, this is a copy of Jack's setup for ps-print --
-;; I would not be that surprised if it was useful to *anybody*,
-;; without modification.)
-
-(defun ps-jack-setup ()
- (setq ps-print-color-p nil
- ps-lpr-command "lpr"
- ps-lpr-switches nil
-
- ps-paper-type 'a4
- ps-landscape-mode t
- ps-number-of-columns 2
-
- ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
- ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
- ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-header-line-pad .15
- ps-print-header t
- ps-print-header-frame t
- ps-header-lines 2
- ps-show-n-of-n t
- ps-spool-duplex nil
-
- ps-font-family 'Courier
- ps-font-size 5.5
- ps-header-font-family 'Helvetica
- ps-header-font-size 6
- ps-header-title-font-size 8)
- 'ps-jack-setup)
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; To make this file smaller, some commands go in a separate file.
;; But autoload them here to make the separation invisible.
\f
-;;;### (autoloads (ps-mule-begin-page ps-mule-begin-job ps-mule-encode-header-string
-;;;;;; ps-mule-initialize ps-mule-plot-composition ps-mule-plot-string
-;;;;;; ps-mule-set-ascii-font ps-mule-prepare-ascii-font ps-multibyte-buffer)
-;;;;;; "ps-mule" "ps-mule.el" "586d0a4deeb89be9b80cc01def34481c")
+;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
+;;;;;; 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)
-
-(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.
+(custom-autoload 'ps-multibyte-buffer "ps-mule" t)
-Returns the value:
-
- (ENDPOS . RUN-WIDTH)
-
-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.
-
-Optional argument BG-COLOR specifies background color.
-
-Returns the value:
-
- (ENDPOS . RUN-WIDTH)
-
-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" "\
+(autoload '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" "\
+(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-begin-page) "ps-mule" "\
-Not documented
+(autoload 'ps-mule-end-job "ps-mule" "\
+Finish printing job for multi-byte chars.
\(fn)" nil nil)