;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: print, PostScript
-;; Time-stamp: <98/03/06 11:14:08 vinicius>
-;; Version: 3.06
+;; Time-stamp: <98/06/04 15:23:12 vinicius>
+;; Version: 3.06.3
-(defconst ps-print-version "3.06"
- "ps-print.el, v 3.06 <98/03/06 vinicius>
+(defconst ps-print-version "3.06.3"
+ "ps-print.el, v 3.06.3 <98/06/04 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,
;;
;; The variable `ps-print-control-characters' specifies whether you want to see
;; a printable form for control and 8-bit characters, that is, instead of
-;; sending, for example, a ^D (\005) to printer, it is sent the string "^D".
+;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
;;
;; Valid values for `ps-print-control-characters' are:
;;
-;; '8-bit printable form for control and 8-bit characters
-;; (characters from \000 to \037 and \177 to \377).
-;; 'control-8-bit printable form for control and *control* 8-bit characters
-;; (characters from \000 to \037 and \177 to \237).
-;; 'control printable form for control character
-;; (characters from \000 to \037 and \177).
-;; nil raw character (no printable form).
+;; 8-bit This is the value to use when you want an ascii encoding of
+;; any control or non-ascii character. Control characters are
+;; encoded as "^D", and non-ascii characters have an
+;; octal encoding.
+;;
+;; control-8-bit This is the value to use when you want an ascii encoding of
+;; any control character, whether it is 7 or 8-bit.
+;; European 8-bits accented characters are printed according
+;; the current font.
+;;
+;; control Only ascii control characters have an ascii encoding.
+;; European 8-bits accented characters are printed according
+;; the current font.
+;;
+;; nil No ascii encoding. Any character is printed according the
+;; current font.
;;
;; Any other value is treated as nil.
;;
-;; The default is 'control-8-bit.
+;; The default is `control-8-bit'.
;;
;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
;;
;; Acknowledgements
;; ----------------
;;
+;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
+;; `ps-print-control-characters' variable documentation.
+;;
;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
;; database font management.
;;
;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
-;; header per page over the columns.
+;; header per page over the columns and correct line numbers when printing a
+;; region.
;;
;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
;; print time of `ps-lpr-switches'.
;;
+;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
+;; (his code was severely modified, but the main idea was kept).
+;;
;; Thanks to some suggestions on:
;; * Face color map: Marco Melgazzi <marco@techie.com>
;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
-;; * Check ps-paper-type: Sudhakar Frederick <sfrederi@asc.corp.mot.com>
+;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
;;
;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
;; I started from. [vinicius]
;;; Code:
-(eval-when-compile
- (require 'cl))
-
(unless (featurep 'lisp-float-type)
(error "`ps-print' requires floating point support"))
(defcustom ps-print-control-characters 'control-8-bit
"*Specifies the printable form for control and 8-bit characters.
+That is, instead of sending, for example, a ^D (\004) to printer,
+you can send ^ and D.
+
Valid values are:
- '8-bit printable form for control and 8-bit characters
- (characters from \000 to \037 and \177 to \377).
- 'control-8-bit printable form for control and *control* 8-bit characters
- (characters from \000 to \037 and \177 to \237).
- 'control printable form for control character
- (characters from \000 to \037 and \177).
- nil raw character (no printable form).
+
+ `8-bit' This is the value to use when you want an ASCII encoding of
+ any control or non-ASCII character. Control characters are
+ encoded as \"^D\", and non-ascii characters have an
+ octal encoding.
+
+ `control-8-bit' This is the value to use when you want an ASCII encoding of
+ any control character, whether it is 7 or 8-bit.
+ European 8-bits accented characters are printed according
+ the current font.
+
+ `control' Only ascii control characters have an ASCII encoding.
+ European 8-bits accented characters are printed according
+ the current font.
+
+ nil No ASCII encoding. Any character is printed according the
+ current font.
+
Any other value is treated as nil."
:type '(choice (const 8-bit) (const control-8-bit)
- (const control) (const nil))
+ (const control) (other :tag "nil" nil))
:group 'ps-print)
(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
:group 'ps-print-font)
(defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)
- "Font size, in points, for the top line of text in the header,
-when generating PostScript."
+ "Font size, in points, for the top line of text in header, in PostScript."
:type 'number
:group 'ps-print-font)
If this variable is non-nil, ps-print will rebuild its internal
reference lists of bold and italic faces *every* time one of the
--with-faces commands is called. Most users shouldn't need to set this
+...-with-faces commands is called. Most users shouldn't need to set this
variable."
:type 'boolean
:group 'ps-print-face)
;;;###autoload
(defun ps-setup ()
- "Return the current setup."
+ "Return the current PostScript-generation setup."
(format
"
\(setq ps-print-color-p %s
% stack: --
/doLineNumber {
- currentfont
- gsave
- 0.0 0.0 0.0 setrgbcolor
- /L0 findfont setfont
- LineNumber Lines ge
- {(end )}
- {LineNumber 6 string cvs ( ) strcat}
- ifelse
- dup stringwidth pop neg 0 rmoveto
- show
- grestore
- setfont
- /LineNumber LineNumber 1 add def
+ /LineNumber where
+ {
+ pop
+ currentfont
+ gsave
+ 0.0 0.0 0.0 setrgbcolor
+ /L0 findfont setfont
+ LineNumber Lines ge
+ {(end )}
+ {LineNumber 6 string cvs ( ) strcat}
+ ifelse
+ dup stringwidth pop neg 0 rmoveto
+ show
+ grestore
+ setfont
+ /LineNumber LineNumber 1 add def
+ } if
} def
% stack: --
(defvar ps-output-head nil)
(defvar ps-output-tail nil)
+(defvar ps-page-postscript 0)
(defvar ps-page-count 0)
(defvar ps-showline-count 1)
;; it'll do for now.
(defvar ps-header-pad 0
- "Vertical and horizontal space in points (1/72 inch) between the header frame
-and the text it contains.")
+ "Vertical and horizontal space between the header frame and the text.
+This is in units of points (1/72 inch).")
;; Define accessors to the dimensions list.
(defun ps-extend-face (face-extension &optional merge-p)
"Extend face in `ps-print-face-extension-alist'.
-If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
+If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
The elements of FACE-EXTENSION list have the form:
(boundp 'font-lock-face-attributes)
(let ((face-attributes font-lock-face-attributes))
(while face-attributes
- (let* ((face-attribute (pop face-attributes))
+ (let* ((face-attribute
+ (car (prog1 face-attributes
+ (setq face-attributes (cdr face-attributes)))))
(face (car face-attribute)))
;; Rustle up a `defface' SPEC from a
;; `font-lock-face-attributes' entry.
(defvar ps-printing-region nil
- "Variable used to indicate if it is printing a region.
+ "Variable used to indicate if ps-print is printing a region.
If non-nil, 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions
-(defsubst ps-font-list (font-sym)
+(defsubst ps-font-alist (font-sym)
(get font-sym 'fonts))
(defun ps-font (font-sym font-type)
"Font family name for text of `font-type', when generating PostScript."
- (let* ((font-list (ps-font-list font-sym))
+ (let* ((font-list (ps-font-alist font-sym))
(normal-font (cdr (assq 'normal font-list))))
- (loop for font in font-list do
- (when (eq font-type (car font))
- (return (or (cdr font) normal-font))))))
+ (while (and font-list (not (eq font-type (car (car font-list)))))
+ (setq font-list (cdr font-list)))
+ (or (cdr (car font-list)) normal-font)))
(defun ps-fonts (font-sym)
- (loop for font in (ps-font-list font-sym) collect (cdr font)))
+ (mapcar 'cdr (ps-font-alist font-sym)))
(defun ps-font-number (font-sym font-type)
- (or (position font-type (ps-font-list font-sym) :key 'car)
+ (or (ps-alist-position font-type (ps-font-alist font-sym))
0))
(defsubst ps-line-height (font-sym)
(display-buffer buf 'not-this-window)))
(defun ps-nb-pages (nb-lines)
- "Display an approximate correspondence between a font size and the number
-of pages the number of lines would require to print
-using the current ps-print setup."
+ "Display correspondence between font size and the number of pages.
+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
(ilh (ps-line-height 'ps-font-for-text)) ; initial line height
(insert "\n")
(display-buffer buf 'not-this-window)))
+;; macros used in `ps-select-font'
+(defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
+(defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
+
(defun ps-select-font (font-family sym font-size title-font-size)
(let ((font-entry (cdr (assq font-family ps-font-info-database))))
(or font-entry
(error "Don't have data to scale font %s. Known fonts families are %s"
font-family
(mapcar 'car ps-font-info-database)))
- (flet ((lookup (key) (cdr (assq key font-entry))))
- (let ((size (lookup 'size)))
- (put sym 'fonts (lookup 'fonts))
- (flet ((size-scale (key) (/ (* (lookup key) font-size) size)))
- (put sym 'space-width (size-scale 'space-width))
- (put sym 'avg-char-width (size-scale 'avg-char-width))
- (put sym 'line-height (size-scale 'line-height))
- (put sym 'title-line-height
- (/ (* (lookup 'line-height) title-font-size) size)))))))
+ (let ((size (ps-lookup 'size)))
+ (put sym 'fonts (ps-lookup 'fonts))
+ (put sym 'space-width (ps-size-scale 'space-width))
+ (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
+ (put sym 'line-height (ps-size-scale 'line-height))
+ (put sym 'title-line-height
+ (/ (* (ps-lookup 'line-height) title-font-size) size)))))
(defun ps-get-page-dimensions ()
(let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
;; (, ) and \.
(while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
(let ((special (following-char)))
- (delete-char 1)
- (insert (aref ps-string-escape-codes special))))
+ (if (> (char-bytes special) 1)
+ (forward-char)
+ (delete-char 1)
+ (insert (aref ps-string-escape-codes special)))))
(goto-char (point-max))
(insert ")")) ;insert end-string delimiter
(setq tail (cdr tail)))
(nreverse new)))
+;; Find the first occurrence of ITEM in LIST.
+;; Return the index of the matching item, or nil if not found.
+;; Elements are compared with `eq'.
+(defun ps-alist-position (item list)
+ (let ((tail list) (index 0) found)
+ (while tail
+ (if (setq found (eq (car (car tail)) item))
+ (setq tail nil)
+ (setq index (1+ index)
+ tail (cdr tail))))
+ (and found index)))
+
+
(defun ps-begin-file ()
(ps-get-page-dimensions)
- (setq ps-showline-count (if ps-printing-region (car ps-printing-region) 1)
+ (setq ps-page-postscript 0
ps-background-text-count 0
ps-background-image-count 0
ps-background-pages nil
(ps-output-boolean "Zebra" ps-zebra-stripes)
(ps-output-boolean "PrintLineNumber" ps-line-number)
- (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height)
- (format "/Lines %d def\n"
- (if ps-printing-region
- (cdr ps-printing-region)
- (ps-count-lines (point-min) (point-max))))
- "/PageCount 0 def\n") ; set total page number
- ; when printing has finished
- ; (see `ps-generate')
+ (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height))
(ps-background-text)
(ps-background-image)
(ps-output ps-print-prologue-2)
;; Text fonts
- (loop for font in (ps-font-list 'ps-font-for-text)
- for i from 0
- do
- (ps-output (format "/f%d %s /%s DefFont\n"
- i
- ps-font-size
- (ps-font 'ps-font-for-text (car font)))))
+ (let ((font (ps-font-alist 'ps-font-for-text))
+ (i 0))
+ (while font
+ (ps-output (format "/f%d %s /%s DefFont\n"
+ i
+ ps-font-size
+ (ps-font 'ps-font-for-text (car (car font)))))
+ (setq font (cdr font)
+ i (1+ i))))
(ps-output "\nBeginDoc\n\n"
"%%EndPrologue\n"))
(and (buffer-modified-p) " (unsaved)")))))
(defun ps-begin-job ()
- (setq ps-page-count 0
+ (save-excursion
+ (set-buffer ps-spool-buffer)
+ (goto-char (point-max))
+ (and (re-search-backward "^%%Trailer$" nil t)
+ (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-control-or-escape-regexp
(cond ((eq ps-print-control-characters '8-bit)
"[\000-\037\177-\377]")
`(1+ (/ (1- ps-page-count) ps-number-of-columns)))
(defun ps-end-file ()
- (ps-output "\nEndDoc\n\n%%Trailer\n%%Pages: "
- (format "%d" (ps-page-number))
- "\n%%EOF\n"))
+ (ps-output "\n%%Trailer\n%%Pages: "
+ (format "%d" ps-page-postscript)
+ "\n\nEndDoc\n\n%%EOF\n"))
(defun ps-next-page ()
(ps-begin-page))
(defun ps-header-page ()
+ ;; set total line and page number when printing has finished
+ ;; (see `ps-generate')
(if (prog1
(zerop (mod ps-page-count ps-number-of-columns))
- (incf ps-page-count))
+ (setq ps-page-count (1+ ps-page-count)))
;; Print only when a new real page begins.
- (let ((page-number (ps-page-number)))
- (ps-output (format "\n%%%%Page: %d %d\n" page-number page-number))
- (ps-output "BeginDSCPage\n")
- (ps-background page-number)
+ (progn
+ (setq ps-page-postscript (1+ ps-page-postscript))
+ (ps-output (format "\n%%%%Page: %d %d\n"
+ ps-page-postscript ps-page-postscript))
+ (ps-output "/Lines 0 def\n/PageCount 0 def\nBeginDSCPage\n")
+ (ps-background ps-page-postscript)
(run-hooks 'ps-print-begin-page-hook))
;; Print when any other page begins.
- (ps-output "BeginDSCPage\n")
+ (ps-output "/Lines 0 def\n/PageCount 0 def\nBeginDSCPage\n")
(run-hooks 'ps-print-begin-column-hook)))
(defun ps-begin-page ()
(unwind-protect
(progn
(set-buffer ps-spool-buffer)
-
+ (set-buffer-multibyte nil)
;; Get a marker and make it point to the current end of the
;; buffer, If an error occurs, we'll delete everything from
;; the end of this marker onwards.
(and ps-spool-duplex (= (mod ps-page-count 2) 1)
(ps-dummy-page))
+ (ps-end-file)
(ps-flush-output)
;; Back to the PS output buffer to set the page count
- (set-buffer ps-spool-buffer)
- (goto-char (point-min))
- (and (re-search-forward "^/PageCount 0 def$" nil t)
- (replace-match (format "/PageCount %d def"
- (if ps-print-only-one-header
- (ps-page-number)
- ps-page-count))
- t))
+ (let ((total-lines (if ps-printing-region
+ (cdr ps-printing-region)
+ (ps-count-lines (point-min) (point-max))))
+ (total-pages (if ps-print-only-one-header
+ (ps-page-number)
+ ps-page-count)))
+ (set-buffer ps-spool-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$"
+ nil t)
+ (replace-match (format "/Lines %d def\n/PageCount %d def"
+ total-lines total-pages) t)))
;; Setting this variable tells the unwind form that the
;; the PostScript was generated without error.
(if (or (not (boundp 'ps-spool-buffer))
(not (symbol-value 'ps-spool-buffer)))
(message "No spooled PostScript to print")
- (ps-end-file)
- (ps-flush-output)
(if filename
(save-excursion
(and ps-razzle-dazzle (message "Saving..."))
HCoop / bpt / emacs.git / blobdiff