;; 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/05/05 12:36:30 vinicius>
+;; Version: 3.06.1
-(defconst ps-print-version "3.06"
- "ps-print.el, v 3.06 <98/03/06 vinicius>
+(defconst ps-print-version "3.06.1"
+ "ps-print.el, v 3.06.1 <98/05/05 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>
;;; 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,
+it is sent the string \"^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))
: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
;; 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
"Font family name for text of `font-type', when generating PostScript."
(let* ((font-list (ps-font-list 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-list font-sym)))
(defun ps-font-number (font-sym font-type)
- (or (position font-type (ps-font-list font-sym) :key 'car)
+ (or (ps-position font-type (ps-font-list 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-position (item list)
+ (let ((tail list) (index 0) found)
+ (while tail
+ (if (setq found (eq (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)
(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-list '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"))
(defun ps-header-page ()
(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))
HCoop / bpt / emacs.git / blobdiff