;;; ps-print.el --- Print text from the buffer as PostScript
-;; Copyright (C) 1993, 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 94, 95, 96, 97, 98, 1999 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Author: Jacques Duthen (was <duthen@cegelec-red.fr>)
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: print, PostScript
-;; Time-stamp: <98/11/13 9:32:27 vinicius>
-;; Version: 4.1.2
+;; Time-stamp: <99/02/19 11:47:32 vinicius>
+;; Version: 4.1.4
-(defconst ps-print-version "4.1.2"
- "ps-print.el, v 4.1.2 <98/11/13 vinicius>
+(defconst ps-print-version "4.1.4"
+ "ps-print.el, v 4.1.4 <99/02/19 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,
;; Using ps-print
;; --------------
;;
-;; The Commands
-;;
;; ps-print provides eight commands for generating PostScript images
;; of Emacs buffers:
;;
;; Font Managing
;; -------------
;;
-;; ps-print now knows rather precisely some fonts:
-;; the variable `ps-font-info-database' contains information
-;; for a list of font families (currently mainly `Courier' `Helvetica'
-;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
-;; Each font family contains the font names for standard, bold, italic
-;; and bold-italic characters, a reference size (usually 10) and the
-;; corresponding line height, width of a space and average character width.
+;; ps-print now knows rather precisely some fonts: the variable
+;; `ps-font-info-database' contains information for a list of font families
+;; (currently mainly `Courier' `Helvetica' `Times' `Palatino' `Helvetica-Narrow'
+;; `NewCenturySchlbk'). Each font family contains the font names for standard,
+;; bold, italic and bold-italic characters, a reference size (usually 10) and
+;; the corresponding line height, width of a space and average character width.
+;;
+;; The variable `ps-font-family' determines which font family is to be used for
+;; ordinary text. If its value does not correspond to a known font family, an
+;; error message is printed into the `*Messages*' buffer, which lists the
+;; currently available font families.
+;;
+;; The variable `ps-font-size' determines the size (in points) of the font for
+;; ordinary text, when generating PostScript. Its value is a float or a cons of
+;; floats which has the following form:
;;
-;; The variable `ps-font-family' determines which font family
-;; is to be used for ordinary text.
-;; If its value does not correspond to a known font family,
-;; an error message is printed into the `*Messages*' buffer,
-;; which lists the currently available font families.
+;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
;;
-;; The variable `ps-font-size' determines the size (in points)
-;; of the font for ordinary text, when generating PostScript.
-;; Its value is a float.
+;; Similarly, the variable `ps-header-font-family' determines which font family
+;; is to be used for text in the header.
;;
-;; Similarly, the variable `ps-header-font-family' determines
-;; which font family is to be used for text in the header.
-;; The variable `ps-header-font-size' determines the font size,
-;; in points, for text in the header.
-;; The variable `ps-header-title-font-size' determines the font size,
-;; in points, for the top line of text in the header.
+;; The variable `ps-header-font-size' determines the font size, in points, for
+;; text in the header (similar to `ps-font-size').
+;;
+;; The variable `ps-header-title-font-size' determines the font size, in points,
+;; for the top line of text in the header (similar to `ps-font-size').
;;
;;
;; Adding a New Font Family
"*The name of a local printer for printing PostScript files.
On Unix-like systems, a string value should be a name understood by
-lpr's -P option; otherwise the value should be nil.
-
-On MS-DOS and MS-Windows systems, if the value is a string, then it is
-taken as the name of the device to which PostScript files are written.
-By default it is the same as `printer-name'; typical non-default
-settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
-\"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
-\"//hostname/printer\" for a shared network printer. You can also set
-it to a name of a file, in which case the output gets appended to that
-file. \(Note that `ps-print' package already has facilities for
-printing to a file, so you might as well use them instead of changing
-the setting of this variable.\) If you want to silently discard the
-printed output, set this to \"NUL\".
-
-On DOS/Windows, if the value is anything but a string, PostScript files
-will be piped to the program given by `ps-lpr-command', with switches
-given by `ps-lpr-switches', which see."
- :type '(choice file (other :tag "Pipe to ps-lpr-command" pipe))
+lpr's -P option; a value of nil means use the value of `printer-name'
+instead. Any other value will be ignored.
+
+On MS-DOS and MS-Windows systems, a string value is taken as the name of
+the printer device or port to which PostScript files are written,
+provided `ps-lpr-command' is \"\". By default it is the same as
+`printer-name'; typical non-default settings would be \"LPT1\" to
+\"LPT3\" for parallel printers, or \"COM1\" to \"COM4\" or \"AUX\" for
+serial printers, or \"//hostname/printer\" for a shared network printer.
+You can also set it to a name of a file, in which case the output gets
+appended to that file. \(Note that `ps-print' package already has
+facilities for printing to a file, so you might as well use them instead
+of changing the setting of this variable.\) If you want to silently
+discard the printed output, set this to \"NUL\"."
+ :type '(choice file)
:group 'ps-print)
(defcustom ps-lpr-command lpr-command
- "*The shell command for printing a PostScript file."
+ "*Name of program for printing a PostScript file.
+
+On MS-DOS and MS-Windows systems, if the value is an empty string then
+Emacs will write directly to the printer port named by `ps-printer-name'.
+The programs `print' and `nprint' (the standard print programs on Windows
+NT and Novell Netware respectively) are handled specially, using
+`ps-printer-name' as the destination for output; any other program is
+treated like `lpr' except that an explicit filename is given as the last
+argument."
:type 'string
:group 'ps-print)
:type '(repeat string)
:group 'ps-print)
+(defcustom ps-print-region-function nil
+ "Function to call to print the region on a PostScript printer.
+See definition of `ps-do-despool' for calling conventions."
+ :type 'function
+ :group 'ps-print)
+
;;; Page layout
;; All page dimensions are in PostScript points.
:type 'symbol
:group 'ps-print-font)
-(defcustom ps-font-size (if ps-landscape-mode 7 8.5)
+(defcustom ps-font-size '(7 . 8.5)
"*Font size, in points, for ordinary text, when generating PostScript."
- :type 'number
+ :type '(choice (number :tag "Text Size")
+ (cons :tag "Landscape/Portrait"
+ (number :tag "Landscape Text Size")
+ (number :tag "Portrait Text Size")))
:group 'ps-print-font)
(defcustom ps-header-font-family 'Helvetica
:type 'symbol
:group 'ps-print-font)
-(defcustom ps-header-font-size (if ps-landscape-mode 10 12)
+(defcustom ps-header-font-size '(10 . 12)
"*Font size, in points, for text in the header, when generating PostScript."
- :type 'number
+ :type '(choice (number :tag "Header Size")
+ (cons :tag "Landscape/Portrait"
+ (number :tag "Landscape Header Size")
+ (number :tag "Portrait Header Size")))
:group 'ps-print-font)
-(defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)
+(defcustom ps-header-title-font-size '(12 . 14)
"*Font size, in points, for the top line of text in header, in PostScript."
- :type 'number
+ :type '(choice (number :tag "Header Title Size")
+ (cons :tag "Landscape/Portrait"
+ (number :tag "Landscape Header Title Size")
+ (number :tag "Portrait Header Title Size")))
:group 'ps-print-font)
;;; Colors
"
\(setq ps-print-color-p %s
ps-lpr-command %S
- ps-lpr-switches %S
+ ps-lpr-switches %s
ps-printer-name %S
- ps-paper-type %S
+ ps-paper-type %s
ps-landscape-mode %s
ps-number-of-columns %s
ps-zebra-stripe-height %s
ps-line-number %s
- ps-print-control-characters %S
+ ps-print-control-characters %s
- ps-print-background-image %S
+ ps-print-background-image %s
- ps-print-background-text %S
+ ps-print-background-text %s
- ps-print-prologue-header %S
+ ps-print-prologue-header %s
ps-left-margin %s
ps-right-margin %s
ps-show-n-of-n %s
ps-spool-duplex %s
- ps-multibyte-buffer %S
- ps-font-family %S
+ ps-multibyte-buffer %s
+ ps-font-family %s
ps-font-size %s
- ps-header-font-family %S
+ ps-header-font-family %s
ps-header-font-size %s
ps-header-title-font-size %s)
"
ps-spool-duplex
(ps-print-quote ps-multibyte-buffer) ; see `ps-mule.el'
(ps-print-quote ps-font-family)
- ps-font-size
+ (ps-print-quote ps-font-size)
(ps-print-quote ps-header-font-family)
- ps-header-font-size
- ps-header-title-font-size))
+ (ps-print-quote ps-header-font-size)
+ (ps-print-quote ps-header-title-font-size)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions and variables:
(defun ps-print-quote (sym)
- (and sym
- (if (or (symbolp sym) (listp sym))
- (format "'%S" sym)
+ (cond ((null sym)
+ nil)
+ ((or (symbolp sym) (listp sym))
+ (format "'%S" sym))
+ ((stringp sym)
+ (format "%S" sym))
+ (t
sym)))
(defvar ps-print-emacs-type
% ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
/JackGhostscript where {pop 1 27.7 29.7 div scale}if
% ---- [andrewi] set PageSize based on chosen dimensions
- /setpagedevice where {
- pop
- 1 dict dup
- /PageSize [ PrintPageWidth LeftMargin add RightMargin add
- LandscapePageHeight ] put
- setpagedevice
- }{
+% /setpagedevice where {
+% pop
+% 1 dict dup
+% /PageSize [ PrintPageWidth LeftMargin add RightMargin add
+% LandscapePageHeight ] put
+% setpagedevice
+% }{
LandscapeMode {
% ---- translate to bottom-right corner of Portrait page
LandscapePageHeight 0 translate
90 rotate
}if
- }ifelse
+% }ifelse
/ColumnWidth PrintWidth InterColumn add def
% ---- translate to lower left corner of TEXT
LeftMargin BottomMargin translate
(defvar ps-print-color-scale nil)
+(defvar ps-font-size-internal nil)
+(defvar ps-header-font-size-internal nil)
+(defvar ps-header-title-font-size-internal nil)
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal Variables
using the current ps-print setup.
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
(let ((buf (get-buffer-create "*Line-lengths*"))
- (ifs ps-font-size) ; initial font size
+ (ifs ps-font-size-internal) ; initial font size
(icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
(print-width (progn (ps-get-page-dimensions)
ps-print-width))
The correspondence is based on having NB-LINES lines of text,
and on the current ps-print setup."
(let ((buf (get-buffer-create "*Nb-Pages*"))
- (ifs ps-font-size) ; initial font size
+ (ifs ps-font-size-internal) ; initial font size
(ilh (ps-line-height 'ps-font-for-text)) ; initial line height
(page-height (progn (ps-get-page-dimensions)
ps-print-height))
ps-number-of-columns)))
(ps-select-font ps-font-family 'ps-font-for-text
- ps-font-size ps-font-size)
+ ps-font-size-internal ps-font-size-internal)
(ps-select-font ps-header-font-family 'ps-font-for-header
- ps-header-font-size ps-header-title-font-size)
+ ps-header-font-size-internal
+ ps-header-title-font-size-internal)
(setq page-width (ps-page-dimensions-get-width page-dimensions)
page-height (ps-page-dimensions-get-height page-dimensions))
;; Header fonts
(ps-output (format "/h0 %s (%s) cvn DefFont\n" ; /h0 14 /Helvetica-Bold DefFont
- ps-header-title-font-size (ps-font 'ps-font-for-header
- 'bold))
+ 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 (ps-font 'ps-font-for-header
- 'normal)))
+ ps-header-font-size-internal
+ (ps-font 'ps-font-for-header 'normal)))
(ps-output ps-print-prologue-2)
(while font
(ps-output (format "/f%d %s (%s) cvn DefFont\n"
i
- ps-font-size
+ ps-font-size-internal
(ps-font 'ps-font-for-text (car (car font)))))
(setq font (cdr font)
i (1+ i))))
(buffer-name)
(and (buffer-modified-p) " (unsaved)")))))
+
+(defun ps-get-font-size (font-sym)
+ (let ((font-size (symbol-value font-sym)))
+ (cond ((numberp font-size)
+ font-size)
+ ((and (consp font-size)
+ (numberp (car font-size))
+ (numberp (cdr font-size)))
+ (if ps-landscape-mode
+ (car font-size)
+ (cdr font-size)))
+ (t
+ (error "Invalid font size `%S' for `%S'" font-size font-sym)))))
+
+
(defun ps-begin-job ()
(save-excursion
(set-buffer ps-spool-buffer)
(delete-region (match-beginning 0) (point-max))))
(setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1)
ps-page-count 0
+ ps-font-size-internal (ps-get-font-size 'ps-font-size)
+ ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
+ ps-header-title-font-size-internal
+ (ps-get-font-size 'ps-header-title-font-size)
ps-control-or-escape-regexp
(cond ((eq ps-print-control-characters '8-bit)
(string-as-unibyte "[\000-\037\177-\377]"))
(setq needs-begin-file t))
(save-excursion
(set-buffer ps-source-buffer)
+ (ps-begin-job)
(when needs-begin-file
(ps-begin-file)
(ps-mule-initialize))
- (ps-begin-job)
(ps-mule-begin-job from to)
(ps-begin-page))
(set-buffer ps-source-buffer)
(and ps-razzle-dazzle (message "Formatting...done"))))))
+;; to avoid compilation gripes.
+(defvar dos-ps-printer nil)
+
+
;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
(defun ps-do-despool (filename)
(if (or (not (boundp 'ps-spool-buffer))
(and (stringp ps-printer-name)
(list (concat "-P" ps-printer-name)))
ps-lpr-switches)))
- (if (and (memq system-type '(ms-dos windows-nt))
- (or (and (boundp 'dos-ps-printer)
- (stringp (symbol-value 'dos-ps-printer)))
- (stringp ps-printer-name)))
- (let ((printer (or (and (boundp 'dos-ps-printer)
- (stringp (symbol-value 'dos-ps-printer))
- (symbol-value 'dos-ps-printer))
- ps-printer-name))
- ;; It seems that we must be careful about the
- ;; directory name that gets added by write-region
- ;; when using the standard "PRN" or "LPTx" ports.
- ;; The call can fail if the directory is on a
- ;; network drive.
- (safe-dir (or (getenv "windir") (getenv "TMPDIR") "c:/")))
- (write-region (point-min) (point-max)
- (expand-file-name printer safe-dir) t 0))
- (apply 'call-process-region
- (point-min) (point-max) ps-lpr-command nil
- (and (fboundp 'start-process) 0)
- nil
- (ps-flatten-list ; dynamic evaluation
- (mapcar 'ps-eval-switch ps-lpr-switches))))))
+ (apply (or ps-print-region-function 'call-process-region)
+ (point-min) (point-max) ps-lpr-command nil
+ (and (fboundp 'start-process) 0)
+ nil
+ (ps-flatten-list ; dynamic evaluation
+ (mapcar 'ps-eval-switch ps-lpr-switches)))))
(and ps-razzle-dazzle (message "Printing...done")))
(kill-buffer ps-spool-buffer)))