;;; ps-print.el --- print text from the buffer as PostScript
-;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-;; 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
+;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2004/03/10 18:57:00 vinicius>
-;; Version: 6.6.4
-;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
+;; Version: 6.7.6
+;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(defconst ps-print-version "6.6.4"
- "ps-print.el, v 6.6.4 <2004/03/10 vinicius>
+(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
;; GNU Emacs is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2, or (at your option) any later
+;; Software Foundation; either version 3, or (at your option) any later
;; version.
;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
;; You should have received a copy of the GNU General Public License along with
;; GNU Emacs; see the file COPYING. If not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;; (my-mixed-family
;; (fonts (normal . "Courier-Bold")
;; (bold . "Helvetica")
-;; (italic . "Zapf-Chancery-MediumItalic")
+;; (italic . "ZapfChancery-MediumItalic")
;; (bold-italic . "NewCenturySchlbk-BoldItalic")
;; (w3-table-hack-x-face . "LineDrawNormal"))
;; (size . 10.0)
;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
;; (bold . "Helvetica")
;; (bold-italic . "NewCenturySchlbk-BoldItalic")
-;; (italic . "Zapf-Chancery-MediumItalic")
+;; (italic . "ZapfChancery-MediumItalic")
;; (normal . "Courier-Bold"))
;; (avg-char-width . 6.0)
;; (space-width . 6.0)
;; N-up printing.
;; Hook: `ps-print-begin-sheet-hook'.
;;
-;; [keinichi] 19990509 Kein'ichi Handa <handa@etl.go.jp>
+;; [kenichi] 19990509 Ken'ichi Handa <handa@m17n.org>
;;
;; `ps-print-region-function'
;;
;; PostScript prologue header comment insertion.
;; Skip invisible text better.
;;
-;; [keinichi] 19980819 Kein'ichi Handa <handa@etl.go.jp>
+;; [kenichi] 19980819 Ken'ichi Handa <handa@m17n.org>
;;
;; Multi-byte buffer handling.
;;
;;
;; Faces are always treated as opaque.
;;
-;; Epoch, Lucid and Emacs 19 not supported. At all.
+;; Epoch, Lucid and Emacs 21 not supported. At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; Acknowledgments
;; ---------------
;;
+;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
+;; compliance of the generated PostScript.
+;;
;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
;; for black/white PostScript printers.
;;
;; prologue code suggestion, for odd/even printing suggestion and for
;; `ps-prologue-file' enhancement.
;;
-;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
+;; Thanks to Ken'ichi Handa <handa@m17n.org> for multi-byte buffer handling.
;;
;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
;; empty columns.
;; initial port to Emacs 19. His code is no longer part of ps-print, but his
;; work is still appreciated.
;;
-;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for
+;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
;; adding underline support. Their code also is no longer part of ps-print,
;; but their efforts are not forgotten.
;;
;;; Code:
-(eval-and-compile
- (require 'lpr)
-
- (or (featurep 'lisp-float-type)
- (error "`ps-print' requires floating point support"))
-
-
- (defvar ps-print-emacs-type
- (let ((case-fold-search t))
- (cond ((string-match "XEmacs" emacs-version) 'xemacs)
- ((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 19))
- (error "`ps-print' only supports Emacs 20 and higher"))
- 'emacs))))
-
- ;; For Emacs 20.2 and the earlier version.
+(require 'lpr)
- (or (fboundp 'set-buffer-multibyte)
- (defun set-buffer-multibyte (arg)
- (setq enable-multibyte-characters arg)))
+(or (featurep 'lisp-float-type)
+ (error "`ps-print' requires floating point support"))
- (or (fboundp 'string-as-unibyte)
- (defun string-as-unibyte (arg) arg))
+(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")))))
- (or (fboundp 'string-as-multibyte)
- (defun string-as-multibyte (arg) arg))
- (or (fboundp 'char-charset)
- (defun char-charset (arg) 'ascii))
+;; 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))))
- (or (fboundp 'charset-after)
- (defun charset-after (&optional arg)
- (char-charset (char-after arg))))
+;; to avoid compilation gripes
- ;; 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)
- (if (fboundp 'find-composition)
- (defalias 'ps-e-find-composition 'find-composition)
- (defalias 'ps-e-find-composition 'ignore))
-
-
- (defconst ps-windows-system
- (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
- (defconst ps-lp-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))
-
-
- (cond ((eq ps-print-emacs-type 'emacs) ; emacs
- (defvar mark-active nil)
- (defun ps-mark-active-p ()
- mark-active)
- (defalias 'ps-face-foreground-name 'face-foreground)
- (defalias 'ps-face-background-name 'face-background)
- )
- (t ; xemacs
- (defalias 'ps-mark-active-p 'region-active-p)
- (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)))
- )))
+;; 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))
+
+
+(defconst ps-windows-system
+ (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
+(defconst ps-lp-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))
+ ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interface to the command system
(defgroup postscript nil
- "PostScript Group"
+ "PostScript Group."
:tag "PostScript"
+ :version "20"
:group 'emacs)
(defgroup ps-print nil
- "PostScript generator for Emacs"
+ "PostScript generator for Emacs."
:link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
:prefix "ps-"
+ :version "20"
:group 'wp
:group 'postscript)
(defgroup ps-print-horizontal nil
- "Horizontal page layout"
+ "Horizontal page layout."
:prefix "ps-"
:tag "Horizontal"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-vertical nil
- "Vertical page layout"
+ "Vertical page layout."
:prefix "ps-"
:tag "Vertical"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-headers nil
- "Headers & footers layout"
+ "Headers & footers layout."
:prefix "ps-"
:tag "Header & Footer"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-font nil
- "Fonts customization"
+ "Fonts customization."
:prefix "ps-"
:tag "Font"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-color nil
- "Color customization"
+ "Color customization."
:prefix "ps-"
:tag "Color"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-face nil
- "Faces customization"
+ "Faces customization."
:prefix "ps-"
:tag "PS Faces"
+ :version "20"
:group 'ps-print
:group 'faces)
(defgroup ps-print-n-up nil
- "N-up customization"
+ "N-up customization."
:prefix "ps-"
:tag "N-Up"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-zebra nil
- "Zebra customization"
+ "Zebra customization."
:prefix "ps-"
:tag "Zebra"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-background nil
- "Background customization"
+ "Background customization."
:prefix "ps-"
:tag "Background"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-printer '((lpr custom-group))
- "Printer customization"
+ "Printer customization."
:prefix "ps-"
:tag "Printer"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-page nil
- "Page customization"
+ "Page customization."
:prefix "ps-"
:tag "Page"
+ :version "20"
:group 'ps-print)
(defgroup ps-print-miscellany nil
- "Miscellany customization"
+ "Miscellany customization."
:prefix "ps-"
:tag "Miscellany"
+ :version "20"
:group 'ps-print)
:tag "Error Handler Message"
(const none) (const paper)
(const system) (const paper-and-system))
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-user-defined-prologue nil
:type '(choice :menu-tag "User Defined Prologue"
:tag "User Defined Prologue"
(const :tag "none" nil) string symbol)
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-print-prologue-header nil
:type '(choice :menu-tag "Prologue Header"
:tag "Prologue Header"
(const :tag "none" nil) string symbol)
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-printer-name (and (boundp 'printer-name)
(const :tag "No Printer Name" t)
(file :tag "Print to file")
(string :tag "Pipe to ps-lpr-command"))
+ :version "20"
:group 'ps-print-printer)
(defcustom ps-printer-name-option
the destination for output; any other program is treated like `lpr' except that
an explicit filename is given as the last argument."
:type 'string
+ :version "20"
:group 'ps-print-printer)
(defcustom ps-lpr-switches lpr-switches
(choice :menu-tag "PostScript lpr Switch"
:tag "PostScript lpr Switch"
string symbol (repeat sexp)))
+ :version "20"
:group 'ps-print-printer)
(defcustom ps-print-region-function nil
See definition of `call-process-region' for calling conventions. The fourth
and the sixth arguments are both nil."
:type '(choice (const nil) function)
+ :version "20"
:group 'ps-print-printer)
(defcustom ps-manual-feed nil
If it's nil, automatic feeding takes place."
:type 'boolean
+ :version "20"
:group 'ps-print-printer)
(defcustom ps-end-with-control-d (and ps-windows-system t)
"*Non-nil means insert C-d at end of PostScript file generated."
:version "21.1"
:type 'boolean
+ :version "20"
:group 'ps-print-printer)
;;; Page layout
(number :tag "Width")
(number :tag "Height")
(string :tag "Media")))
+ :version "20"
:group 'ps-print-page)
;;;###autoload
nil
(widget-put wid :error "Unknown paper size")
wid)))
+ :version "20"
:group 'ps-print-page)
(defcustom ps-warn-paper-type t
It's used when `ps-spool-config' is set to `setpagedevice'."
:type 'boolean
+ :version "20"
:group 'ps-print-page)
(defcustom ps-landscape-mode nil
"*Non-nil means print in landscape mode."
:type 'boolean
+ :version "20"
:group 'ps-print-page)
(defcustom ps-print-upside-down nil
(cons :tag "Range"
(integer :tag "From")
(integer :tag "To"))))
+ :version "20"
:group 'ps-print-page)
(defcustom ps-even-or-odd-pages nil
(const :tag "Only Odd Pages" odd-page)
(const :tag "Only Even Sheets" even-sheet)
(const :tag "Only Odd Sheets" odd-sheet))
+ :version "20"
:group 'ps-print-page)
(defcustom ps-print-control-characters 'control-8-bit
:tag "Control Char"
(const 8-bit) (const control-8-bit)
(const control) (const :tag "nil" nil))
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-n-up-printing 1
wid :error
"Number of pages per sheet paper must be between 1 and 100.")
wid)))
+ :version "20"
:group 'ps-print-n-up)
(defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
"*Specify the margin in points between the sheet border and n-up printing."
:type 'number
+ :version "20"
:group 'ps-print-n-up)
(defcustom ps-n-up-border-p t
"*Non-nil means a border is drawn around each page."
:type 'boolean
+ :version "20"
:group 'ps-print-n-up)
(defcustom ps-n-up-filling 'left-top
(const right-top) (const right-bottom)
(const top-left) (const bottom-left)
(const top-right) (const bottom-right))
+ :version "20"
:group 'ps-print-n-up)
(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
"*Specify the number of columns."
:type 'number
+ :version "20"
: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
+ :version "20"
: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
+ :version "20"
:group 'ps-print-zebra)
(defcustom ps-zebra-color 0.95
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue")))
+ :version "20"
:group 'ps-print-zebra)
(defcustom ps-zebra-stripe-follow nil
(const :tag "Continue on Next Page" follow)
(const :tag "Print Only Full Stripe" full)
(const :tag "Continue on Full Stripe" full-follow))
+ :version "20"
:group 'ps-print-zebra)
(defcustom ps-line-number nil
"*Non-nil means print line number."
:type 'boolean
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-line-number-step 1
:tag "Line Number Step"
(integer :tag "Step Interval")
(const :tag "Synchronize Zebra" zebra))
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-line-number-start 1
value of `ps-zebra-strip-height' inclusive. Use this combination if you
wish that line number be relative to zebra stripes."
:type '(integer :tag "Start Step Interval")
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-print-background-image nil
FILENAME is ignored, if it doesn't exist or is read protected.
X and Y are relative positions on paper to put the image.
-If X and Y are nil, the image is centralized on paper.
+If X and Y are nil, the image is centered on paper.
XSCALE and YSCALE are scale factor to be applied to image before printing.
If XSCALE and YSCALE are nil, the original size is used.
(cons :tag "Range"
(integer :tag "From")
(integer :tag "To"))))))
+ :version "20"
:group 'ps-print-background)
(defcustom ps-print-background-text nil
(cons :tag "Range"
(integer :tag "From")
(integer :tag "To"))))))
+ :version "20"
:group 'ps-print-background)
;;; Horizontal layout
(defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
"*Left margin in points (1/72 inch)."
:type 'number
+ :version "20"
:group 'ps-print-horizontal)
(defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
"*Right margin in points (1/72 inch)."
:type 'number
+ :version "20"
:group 'ps-print-horizontal)
(defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
"*Horizontal space between columns in points (1/72 inch)."
:type 'number
+ :version "20"
:group 'ps-print-horizontal)
;;; Vertical layout
(defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
"*Bottom margin in points (1/72 inch)."
:type 'number
+ :version "20"
:group 'ps-print-vertical)
(defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
"*Top margin in points (1/72 inch)."
:type 'number
+ :version "20"
:group 'ps-print-vertical)
(defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
"*Vertical space in points (1/72 inch) between the main text and the header."
:type 'number
+ :version "20"
:group 'ps-print-vertical)
(defcustom ps-header-line-pad 0.15
The insertion is done between the header frame and the text it contains,
both in the vertical and horizontal directions."
:type 'number
+ :version "20"
:group 'ps-print-vertical)
(defcustom ps-footer-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
"*Vertical space in points (1/72 inch) between the main text and the footer."
:type 'number
+ :version "20"
:group 'ps-print-vertical)
(defcustom ps-footer-line-pad 0.15
The insertion is done between the footer frame and the text it contains,
both in the vertical and horizontal directions."
:type 'number
+ :version "20"
:group 'ps-print-vertical)
;;; Header/Footer setup
buffer is visiting a file, the file's directory. Headers are customizable by
changing variables `ps-left-header' and `ps-right-header'."
:type 'boolean
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-print-header-frame t
"*Non-nil means draw a gaudy frame around the header."
:type 'boolean
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-header-frame-alist
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))))
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-header-lines 2
"*Number of lines to display in page header, when generating PostScript."
:type 'integer
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-print-footer nil
By default, the footer displays page number.
Footers are customizable by changing variables `ps-left-footer' and
`ps-right-footer'."
- :version "21.1"
:type 'boolean
+ :version "21.1"
:group 'ps-print-headers)
(defcustom ps-print-footer-frame t
"*Non-nil means draw a gaudy frame around the footer."
- :version "21.1"
:type 'boolean
+ :version "21.1"
:group 'ps-print-headers)
(defcustom ps-footer-frame-alist
`ps-get', `ps-put' and `ps-del' functions (see them for documentation).
See also `ps-header-frame-alist' for documentation."
- :version "21.1"
:type '(repeat
(choice :menu-tag "Header Frame Element"
:tag ""
(number :tag "Red")
(number :tag "Green")
(number :tag "Blue"))))))
+ :version "21.1"
:group 'ps-print-headers)
(defcustom ps-footer-lines 2
"*Number of lines to display in page footer, when generating PostScript."
- :version "21.1"
:type 'integer
+ :version "21.1"
:group 'ps-print-headers)
(defcustom ps-print-only-one-header nil
only one header/footer over all columns or one header/footer per column.
See also `ps-print-header' and `ps-print-footer'."
:type 'boolean
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-switch-header 'duplex
(const :tag "Never Switch" nil)
(const :tag "Always Switch" t)
(const :tag "Switch When Duplexing" duplex))
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-show-n-of-n t
NOTE: page numbers are displayed as part of headers,
see variable `ps-print-header'."
:type 'boolean
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-spool-config
:tag "Spool Config"
(const lpr-switches) (const setpagedevice)
(const :tag "nil" nil))
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-spool-duplex nil ; Not many people have duplex printers,
See also `ps-spool-tumble'."
:type 'boolean
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-spool-tumble nil
It has effect only when `ps-spool-duplex' is non-nil."
:type 'boolean
+ :version "20"
:group 'ps-print-headers)
;;; Fonts
(line-height . 9.63)
(space-width . 2.78)
(avg-char-width . 2.78))
+ (ZapfChancery-MediumItalic
+ (fonts (normal . "ZapfChancery-MediumItalic"))
+ (size . 10.0)
+ (line-height . 11.45)
+ (space-width . 2.2)
+ (avg-char-width . 4.10811))
+ ;; We keep this wrong entry name (but with correct font name) for
+ ;; backward compatibility.
(Zapf-Chancery-MediumItalic
- (fonts (normal . "Zapf-Chancery-MediumItalic"))
+ (fonts (normal . "ZapfChancery-MediumItalic"))
(size . 10.0)
(line-height . 11.45)
(space-width . 2.2)
(cons :format "%v"
(const :format "" avg-char-width)
(number :tag "Average Character Width"))))
+ :version "20"
:group 'ps-print-font)
(defcustom ps-font-family 'Courier
"*Font family name for ordinary text, when generating PostScript."
:type 'symbol
+ :version "20"
: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")
(cons :tag "Landscape/Portrait"
(number :tag "Landscape Text Size")
(number :tag "Portrait Text Size")))
+ :version "20"
:group 'ps-print-font)
(defcustom ps-header-font-family 'Helvetica
"*Font family name for text in the header, when generating PostScript."
:type 'symbol
+ :version "20"
: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")
(cons :tag "Landscape/Portrait"
(number :tag "Landscape Header Size")
(number :tag "Portrait Header Size")))
+ :version "20"
: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")
(cons :tag "Landscape/Portrait"
(number :tag "Landscape Header Title Size")
(number :tag "Portrait Header Title Size")))
+ :version "20"
:group 'ps-print-font)
(defcustom ps-footer-font-family 'Helvetica
"*Font family name for text in the footer, when generating PostScript."
- :version "21.1"
:type 'symbol
+ :version "21.1"
:group 'ps-print-font)
(defcustom ps-footer-font-size '(10 . 12)
- "*Font size, in points, for text in the footer, when generating PostScript."
- :version "21.1"
+ "*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")
(cons :tag "Landscape/Portrait"
(number :tag "Landscape Footer Size")
(number :tag "Portrait Footer Size")))
+ :version "21.1"
:group 'ps-print-font)
(defcustom ps-line-number-color "black"
(defcustom ps-line-number-font "Times-Italic"
"*Font for line-number, when generating PostScript."
:type 'string
+ :version "20"
:group 'ps-print-font
: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")
(cons :tag "Landscape/Portrait"
(number :tag "Landscape Font Size")
(number :tag "Portrait Font Size")))
+ :version "20"
:group 'ps-print-font
:group 'ps-print-miscellany)
(const :tag "Do NOT Print Color" nil)
(const :tag "Print Always Color" t)
(const :tag "Print Black/White Color" black-white))
+ :version "20"
:group 'ps-print-color)
-(defcustom ps-default-fg '(0.0 0.0 0.0) ; black
- "*RGB values of the default foreground color. Defaults to black.
+(defcustom ps-default-fg nil
+ "*RGB values of the default foreground color.
The `ps-default-fg' variable contains the default foreground color used by
ps-print, that is, if there is a face in a text that doesn't have a foreground
t The foreground color of Emacs session will be used.
+ frame-parameter The foreground-color frame parameter will be used.
+
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 wich contains the color name. For example:
+ 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
Where RED, GREEN and BLUE are reals between 0.0 (no color) and
1.0 (full color).
-Any other value is ignored and it's used the black 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)
+ (const :tag "Frame Foreground" frame-parameter)
(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 "20"
:group 'ps-print-color)
-(defcustom ps-default-bg '(1.0 1.0 1.0) ; white
- "*RGB values of the default background color. Defaults to white.
+(defcustom ps-default-bg nil
+ "*RGB values of the default background color.
The `ps-default-bg' variable contains the default background color used by
ps-print, that is, if there is a face in a text that doesn't have a background
t The background color of Emacs session will be used.
+ frame-parameter The background-color frame parameter will be used.
+
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 wich contains the color name. For example:
+ 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
Where RED, GREEN and BLUE are reals between 0.0 (no color) and
1.0 (full color).
-Any other value is ignored and it's used the white 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"
:tag "Default Background Gray/Color"
(const :tag "Session Background" t)
+ (const :tag "Frame Background" frame-parameter)
(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")))
+ :version "20"
:group 'ps-print-color)
(defcustom ps-auto-font-detect t
If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
`ps-underlined-faces'."
:type 'boolean
+ :version "20"
:group 'ps-print-font)
(defcustom ps-black-white-faces
(const shadow)
(const box)
(const outline)))))
+ :version "20"
:group 'ps-print-face)
(defcustom ps-bold-faces
"*A list of the \(non-bold\) faces that should be printed in bold font.
This applies to generating PostScript."
:type '(repeat face)
+ :version "20"
:group 'ps-print-face)
(defcustom ps-italic-faces
"*A list of the \(non-italic\) faces that should be printed in italic font.
This applies to generating PostScript."
:type '(repeat face)
+ :version "20"
:group 'ps-print-face)
(defcustom ps-underlined-faces
"*A list of the \(non-underlined\) faces that should be printed underlined.
This applies to generating PostScript."
:type '(repeat face)
+ :version "20"
:group 'ps-print-face)
(defcustom ps-use-face-background nil
(repeat :menu-tag "Face Background List"
:tag "Face Background List"
face))
+ :version "20"
:group 'ps-print-face)
(defcustom ps-left-header
:type '(repeat (choice :menu-tag "Left Header"
:tag "Left Header"
string symbol))
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-right-header
:type '(repeat (choice :menu-tag "Right Header"
:tag "Right Header"
string symbol))
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-left-footer
variable, the string value has PostScript string delimiters added to it.
If symbols are unbounded, they are silently ignored."
- :version "21.1"
:type '(repeat (choice :menu-tag "Left Footer"
:tag "Left Footer"
string symbol))
+ :version "21.1"
:group 'ps-print-headers)
(defcustom ps-right-footer
You can also create your own time stamp function by using `format-time-string'
\(which see)."
- :version "21.1"
:type '(repeat (choice :menu-tag "Right Footer"
:tag "Right Footer"
string symbol))
+ :version "21.1"
:group 'ps-print-headers)
(defcustom ps-razzle-dazzle t
"*Non-nil means report progress while formatting buffer."
:type 'boolean
+ :version "20"
:group 'ps-print-miscellany)
(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
By default, `ps-adobe-tag' contains the standard identifier. Some printers
require slightly different versions of this line."
:type 'string
+ :version "20"
: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 lists of
-bold and italic faces. By settings its value back to t, you can force ps-print
+bold and italic faces. By setting its value back to t, you can force ps-print
to rebuild the lists the next time you invoke one of the ...-with-faces
commands.
face, or create new faces. Most users shouldn't have to worry about its
setting, though."
:type 'boolean
+ :version "20"
:group 'ps-print-face)
(defcustom ps-always-build-face-reference nil
of bold and italic faces *every* time one of the ...-with-faces commands is
called. Most users shouldn't need to set this variable."
:type 'boolean
+ :version "20"
:group 'ps-print-face)
(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
+ :version "20"
:group 'ps-print-headers)
(defcustom ps-postscript-code-directory
- (or (cond
- ((eq ps-print-emacs-type 'emacs) ; emacs
- data-directory)
- ((fboundp 'locate-data-directory) ; xemacs
- (locate-data-directory "ps-print"))
- ((boundp 'data-directory) ; xemacs
- data-directory)
- (t ; don't know what to do
- nil))
+ (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.
By default, this directory is the same as in the variable `data-directory'."
:type 'directory
+ :version "20"
:group 'ps-print-miscellany)
(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
(mapconcat
#'ps-print-quote
(list
- (concat "\n;;; ps-print version " ps-print-version "\n")
+ (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs")
+ ") ps-print version " ps-print-version "\n")
+ ";; internal vars"
+ (ps-comment-string "emacs-version " emacs-version)
+ (ps-comment-string "ps-windows-system " ps-windows-system)
+ (ps-comment-string "ps-lp-system " ps-lp-system)
+ nil
'(25 . ps-print-color-p)
'(25 . ps-lpr-command)
'(25 . ps-lpr-switches)
;; ps-page-dimensions-database
;; ps-font-info-database
-;;; ps-print - end of settings\n")
+\;;; ps-print - end of settings\n")
"\n")))
"(setq ")
key
(if (> col len)
- (make-string (- col len) ?\ )
+ (make-string (- col len) ?\s)
" ")
(ps-value-string val))))
(t "")
(format "%S" val))))
+(defun ps-comment-string (str value)
+ "Return a comment string like \";; STR = VALUE\"."
+ (format ";; %s = %s" str (ps-value-string value)))
+
+
(defun ps-value (alist-sym key)
"Return value from association list ALIST-SYM which car is `eq' to KEY."
(cdr (assq key (symbol-value alist-sym))))
(format-time-string "%Y-%m-%d"))
-(defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd
- "Alias for `ps-time-stamp-yyyy-mm-dd' (which see).")
+;; Alias for `ps-time-stamp-yyyy-mm-dd' (which see).
+(defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd)
(defun ps-time-stamp-hh:mm:ss ()
(format-time-string "%T"))
-(eval-and-compile
- (and (eq ps-print-emacs-type '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))
+(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.
- (cond ((and (eq ps-print-emacs-type 'xemacs)
+;; 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
- (defun ps-color-device ()
+ (>= emacs-minor-version 12)))) ; XEmacs >= 19.12
+ (lambda ()
(eq (ps-x-device-class) 'color)))
- (t ; emacs
- (defun ps-color-device ()
+ (t ; Emacs
+ (lambda ()
(if (fboundp 'color-values)
(ps-e-color-values "Green")
- t))))
+ 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-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-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
- (defun ps-extent-sorter (a b)
- (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
+ (defalias 'ps-face-strikeout-p 'ignore)
- (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))))
+ (defalias 'ps-face-overline-p 'ignore)
- (cond ((eq ps-print-emacs-type 'emacs) ; emacs
+ (defalias 'ps-face-box-p 'ignore)
+ )
- (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"))))
+ (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-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)))
- )
+ (defun ps-face-italic-p (face)
+ (or (ps-e-face-italic-p face)
+ (memq face ps-italic-faces)))
+
+ (defun ps-face-strikeout-p (face)
+ (eq (face-attribute face :strike-through) t))
- (t ; xemacs
-
- ;; to avoid XEmacs compilation gripes
- (defvar coding-system-for-write nil)
- (defvar coding-system-for-read nil)
- (defvar buffer-file-coding-system nil)
-
- (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
- )))
+ (defun ps-face-overline-p (face)
+ (eq (face-attribute face :overline) t))
+
+ (defun ps-face-box-p (face)
+ (not (memq (face-attribute face :box) '(nil unspecified))))
+ ))
(defvar ps-print-color-scale 1.0)
(defvar ps-color-p nil)
(defvar ps-color-format
- (if (eq ps-print-emacs-type 'emacs)
-
- ;; 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"
+ (if (featurep 'xemacs)
+ ;; XEmacs will have to make do with %s (princ) for floats.
+ "%s %s %s"
- ;; 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
If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
with face extension in ALIST-SYM; otherwise, overrides.
-If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
+If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
otherwise, it should be an alist symbol.
-The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
+The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.
See `ps-extend-face' for documentation."
(while face-extension-list
If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
with face extensions in ALIST-SYM; otherwise, overrides.
-If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
+If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
otherwise, it should be an alist symbol.
The elements of FACE-EXTENSION list have the form:
(defun ps-message-log-max ()
(and (not (string= (buffer-name) "*Messages*"))
+ (boundp 'message-log-max)
message-log-max))
(defvar ps-printing-region nil
- "Variable used to indicate if the region that ps-print is printing.
+ "Variable used to indicate the region that ps-print is printing.
It is a cons, the car of which is the line number where the region begins, and
its cdr is the total number of lines in the buffer. Formatting functions can
use this information to print the original line number (and not the number of
(let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
(buffer-name)))
".ps"))
- (prompt (format "Save PostScript to file: (default %s) " name))
+ (prompt (format "Save PostScript to file (default %s): " name))
(res (read-file-name prompt default-directory name nil)))
(while (cond ((file-directory-p res)
(ding)
(save-excursion
(set-buffer ps-spool-buffer)
(goto-char (point-max))
- (insert-file fname)))
+ (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',
(let (str)
(while content
(setq str (cons (cond
+ ;; string
((stringp (car content))
(car content))
- ((and (symbolp (car content)) (fboundp (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)
(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)))
- (mapconcat 'identity
- (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache)
- ""))
+ (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.
;; Functions are called -- they should return strings; they will be inserted
;; as strings and the PS string delimiters added.
- ((and (symbolp content) (fboundp content))
+ ((functionp content)
(ps-output-string (ps-mule-encode-header-string (funcall content)
fonttag)))
;; 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 (eq ps-print-emacs-type 'emacs)
- "%0.3f " ; emacs
- "%s ")) ; xemacs
+(defvar ps-float-format (if (featurep 'xemacs)
+ "%s " ; XEmacs
+ "%0.3f ")) ; Emacs
(defun ps-float-format (value &optional default)
"PrintHeight 2 div BottomMargin add")
"\nBeginBackImage\n")
(ps-insert-file image-file)
- ;; coordinate adjustment to centralize image
+ ;; coordinate adjustment to center image
;; around x and y position
(let ((box (ps-get-boundingbox)))
(save-excursion
ps-adobe-tag
"%%Title: " (buffer-name) ; Take job name from name of
; first buffer printed
- "\n%%Creator: " (user-full-name)
- " (using ps-print v" ps-print-version
- ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
+ "\n%%Creator: ps-print v" ps-print-version
+ "\n%%For: " (user-full-name)
+ "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
"\n%%Orientation: "
(if ps-landscape-mode "Landscape" "Portrait")
"\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
(ps-remove-duplicates
(append (ps-fonts 'ps-font-for-text)
(list (ps-font 'ps-font-for-header 'normal)
- (ps-font 'ps-font-for-header 'bold))))
+ (ps-font 'ps-font-for-header 'bold)
+ (ps-font 'ps-font-for-footer 'normal)
+ (ps-font 'ps-font-for-footer 'bold))))
"\n%%+ font ")
+ "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
"\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
(format " %d" (round (ps-page-dimensions-get-width dimensions)))
(format " %d" (round (ps-page-dimensions-get-height dimensions)))
ps-error-handler-alist))
1)) ; send to paper
ps-print-prologue-0
- "\n%%BeginProcSet: UserDefinedPrologue\n\n")
+ "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
(ps-insert-string ps-user-defined-prologue)
- (ps-output "\n%%EndProcSet\n\n")
+ (ps-output "\n%%EndResource\n\n")
(ps-output-boolean "LandscapeMode "
(or ps-landscape-mode
ps-zebra-stripe-height)
"/ZebraColor "
(ps-format-color ps-zebra-color 0.95)
- "def\n/BackgroundColor "
+ "def\n")
+ (ps-output "/BackgroundColor "
(ps-format-color ps-default-background 1.0)
- "def\n/UseSetpagedevice "
+ "def\n")
+ (ps-output "/UseSetpagedevice "
(if (eq ps-spool-config 'setpagedevice)
"/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
"false")
(setq ps-background-all-pages (nreverse ps-background-all-pages)
ps-background-pages (nreverse ps-background-pages))
- (ps-output "\n" ps-print-prologue-1)
-
- (ps-output "\n/printGlobalBackground{\n")
+ (ps-output "\n" ps-print-prologue-1
+ "\n/printGlobalBackground{\n")
(mapcar 'ps-output ps-background-all-pages)
- (ps-output "}def\n/printLocalBackground{\n}def\n")
-
- ;; Header/line number fonts
- (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
- ps-header-title-font-size-internal
- (ps-font 'ps-font-for-header 'bold))
- (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
- ps-header-font-size-internal
- (ps-font 'ps-font-for-header 'normal))
- (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
- (ps-get-font-size 'ps-line-number-font-size)
- ps-line-number-font)
- (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
- ps-footer-font-size-internal
- (ps-font 'ps-font-for-footer 'normal))
- "\n\n% ---- These lines must be kept together because...
+ (ps-output
+ "}def\n/printLocalBackground{\n}def\n"
+ "\n%%EndProlog\n\n%%BeginSetup\n"
+ "\n%%IncludeResource: font Times-Roman"
+ "\n%%IncludeResource: font Times-Italic"
+ "\n%%IncludeResource: font "
+ (mapconcat 'identity
+ (ps-remove-duplicates
+ (append (ps-fonts 'ps-font-for-text)
+ (list (ps-font 'ps-font-for-header 'normal)
+ (ps-font 'ps-font-for-header 'bold)
+ (ps-font 'ps-font-for-footer 'normal)
+ (ps-font 'ps-font-for-footer 'bold))))
+ "\n%%IncludeResource: font ")
+ ;; Header/line number fonts
+ (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
+ ps-header-title-font-size-internal
+ (ps-font 'ps-font-for-header 'bold))
+ (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
+ ps-header-font-size-internal
+ (ps-font 'ps-font-for-header 'normal))
+ (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
+ (ps-get-font-size 'ps-line-number-font-size)
+ ps-line-number-font)
+ (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
+ ps-footer-font-size-internal
+ (ps-font 'ps-font-for-footer 'normal))
+ "\n\n% ---- These lines must be kept together because...
/h0 F
/HeaderTitleLineHeight FontHeight def
(ps-output (format "/SpaceWidthRatio %f def\n"
(/ (ps-lookup 'space-width) (ps-lookup 'size)))))
- (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
(unless (eq ps-spool-config 'lpr-switches)
(ps-output "\n%%BeginFeature: *Duplex "
(ps-boolean-capitalized ps-spool-duplex)
(ps-get-size (symbol-value font-sym) "font size" font-sym))
-(defun ps-rgb-color (color default)
- (cond ((and color (listp color) (= (length color) 3)
- (let ((cl color)
- (ok t) e)
- (while (and ok cl)
- (setq e (car cl)
- cl (cdr cl)
- ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
- ok))
- color)
- ((and (floatp color) (<= 0.0 color) (<= color 1.0))
- (list color color color))
- ((stringp color) (ps-color-scale color))
- (t (list default default default))
- ))
-
-
-(defun ps-begin-job ()
+(defun ps-rgb-color (color unspecified default)
+ (cond
+ ;; (float float float) ==> (R G B)
+ ((and color (listp color) (= (length color) 3)
+ (let ((cl color)
+ (ok t) e)
+ (while (and ok cl)
+ (setq e (car cl)
+ cl (cdr cl)
+ ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
+ ok))
+ color)
+ ;; float ==> 0.0 = black .. 1.0 = white
+ ((and (floatp color) (<= 0.0 color) (<= color 1.0))
+ (list color color color))
+ ;; "colorName" but different from "unspecified-[bf]g"
+ ((and (stringp color) (not (string= color unspecified)))
+ (ps-color-scale color))
+ ;; ok, use the default
+ (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)
((eq ps-print-control-characters 'control)
"[\000-\037\177]")
(t "[\t\n\f]"))
+ ;; 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)
ps-default-background (ps-rgb-color
- (if (eq ps-default-bg t)
- (ps-face-background-name 'default)
- ps-default-bg)
+ (cond
+ ((or (member ps-print-color-p
+ '(nil back-white))
+ (eq genfunc 'ps-generate-postscript))
+ nil)
+ ((eq ps-default-bg 'frame-parameter)
+ (ps-frame-parameter nil 'background-color))
+ ((eq ps-default-bg t)
+ (ps-face-background-name 'default))
+ (t
+ ps-default-bg))
+ "unspecified-bg"
1.0)
ps-default-foreground (ps-rgb-color
- (if (eq ps-default-fg t)
- (ps-face-foreground-name 'default)
- ps-default-fg)
+ (cond
+ ((or (member ps-print-color-p
+ '(nil back-white))
+ (eq genfunc 'ps-generate-postscript))
+ nil)
+ ((eq ps-default-fg 'frame-parameter)
+ (ps-frame-parameter nil 'foreground-color))
+ ((eq ps-default-fg t)
+ (ps-face-foreground-name 'default))
+ (t
+ ps-default-fg))
+ "unspecified-fg"
0.0)
- ps-default-color (and (eq ps-print-color-p t) 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))
+ 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
(ps-get-page-dimensions)
;; final check
(ps-begin-page))
+(defun ps-end-sheet ()
+ (and ps-print-page-p (> ps-page-sheet 0)
+ (ps-output "EndSheet\n")))
+
+
(defun ps-header-sheet ()
;; Print only when a new sheet begins.
- (and ps-print-page-p (> ps-page-sheet 0)
- (ps-output "EndSheet\n"))
+ (ps-end-sheet)
(setq ps-page-sheet (1+ ps-page-sheet))
(when (ps-print-sheet-p)
(setq ps-page-order (1+ ps-page-order))
(defvar ps-current-effect 0)
+(defvar ps-print-translation-table
+ (let ((tbl (make-char-table 'translation-table nil)))
+ (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
+ (char-table-p ucs-mule-8859-to-mule-unicode))
+ (map-char-table
+ #'(lambda (k v)
+ (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
+ (aset tbl k v)))
+ ucs-mule-8859-to-mule-unicode))
+ tbl)
+ "Translation table for PostScript printing.
+The default value is a table that translates non-Latin-1 Latin characters
+to the equivalent Latin-1 characters.")
(defun ps-plot-region (from to font &optional fg-color bg-color effects)
(or (equal font ps-current-font)
(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) (eq (charset-after) charset))
+ (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
(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.
`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."
+If FACE is not a valid face name, use default face."
(cond
(ps-black-white-faces-alist
(or (and (symbolp face)
(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))))
(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)
- ))
+ (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 (ps-face-color-p (car face))
+ (let (ok)
+ (while face
+ (if (or (memq (car face) ps-use-face-background)
+ (ps-face-color-p (car face)))
+ (setq face nil
+ ok t)
+ (setq face (cdr face))))
+ ok)))
+ (t
+ nil)
+ )
background))
((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
(defun ps-screen-to-bit-face (face)
(cons face
- (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
- (if (ps-face-italic-p face) 2 0) ; italic
- (if (ps-face-underlined-p face) 4 0)) ; underline
+ (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
+ (if (ps-face-italic-p face) 2 0) ; italic
+ (if (ps-face-underlined-p face) 4 0) ; underline
+ (if (ps-face-strikeout-p face) 8 0) ; strikeout
+ (if (ps-face-overline-p face) 16 0) ; overline
+ (if (ps-face-box-p face) 64 0)) ; box
(ps-face-foreground-name face)
(ps-face-background-name face))))
+;; to avoid compilation gripes
+(defalias 'ps-jitify 'jit-lock-fontify-now)
+(defalias 'ps-lazify 'lazy-lock-fontify-region)
+
+
;; to avoid compilation gripes
(defun ps-print-ensure-fontified (start end)
- (cond
- ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
- (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
- (ps-jitify start end))
- ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
- (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
- (ps-lazify start end))))
+ (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
+ (ps-jitify start end))
+ ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
+ (ps-lazify start end))))
(defun ps-generate-postscript-with-faces (from to)
(let ((face 'default)
(position to))
(cond
- ((eq ps-print-emacs-type 'xemacs)
+ ((featurep 'xemacs) ; XEmacs
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)
from position
a (cdr a)))))
- ((eq ps-print-emacs-type 'emacs)
+ (t ; Emacs
(let ((property-change from)
(overlay-change from)
(save-buffer-invisibility-spec buffer-invisibility-spec)
(ps-plot-with-face from to face))))
(defun ps-generate-postscript (from to)
- (ps-plot-region from to 0 nil))
+ (ps-plot-region from to 0))
(defun ps-generate (buffer from to genfunc)
(save-excursion
(save-excursion
(let ((ps-print-page-p t)
ps-even-or-odd-pages)
- (ps-begin-job)
+ (ps-begin-job genfunc)
(when needs-begin-file
(ps-begin-file)
(ps-mule-initialize))
(defun ps-end-job (needs-begin-file)
- (let ((previous-print ps-print-page-p)
- (ps-print-page-p t))
+ (let ((ps-print-page-p t))
(ps-flush-output)
(save-excursion
(let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
(number-to-string ps-lines-printed) " BeginPage\n")
(ps-end-page)))
;; Set end of PostScript file
- (and previous-print
- (ps-output "EndSheet\n"))
+ (ps-end-sheet)
(ps-output "\n%%Trailer\n%%Pages: "
(number-to-string
(if (and needs-begin-file
(and (stringp ps-printer-name-option)
ps-printer-name-option)
ps-printer-name))))))
+ (or (stringp ps-printer-name)
+ (setq ps-printer-name nil))
(apply (or ps-print-region-function 'call-process-region)
(point-min) (point-max) ps-lpr-command nil
(and (fboundp 'start-process) 0)
;; WARNING!!! The following code is *sample* code only.
;; Don't use it unless you understand what it does!
-(defmacro ps-prsc ()
- `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
-(defmacro ps-c-prsc ()
- `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
-(defmacro ps-s-prsc ()
- `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
+;; 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 (ps-prsc) 'ps-rmail-print-message-from-summary)
+ (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
;; 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 (ps-prsc) 'ps-vm-print-message-from-summary)
+ (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
;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
;; prsc.
(defun ps-gnus-summary-setup ()
- (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
+ (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'.
;; modification.)
(defun ps-jts-ps-setup ()
- (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
- (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
- (global-set-key (ps-c-prsc) 'ps-despool)
+ (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)
(provide 'ps-print)
-;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579
+;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579
;;; ps-print.el ends here