emacs: lisp/ps-print.el comparison

comparison lisp/ps-print.el @ 24414:971efbc0ac2c

Doc fix, font size specifies landscape and portrait sizes. (ps-print-version): New version number (4.1.4). (ps-font-size, ps-header-font-size, ps-header-title-font-size): Specifies landscape and portrait sizes. (ps-setup, ps-print-quote, ps-line-lengths-internal, ps-nb-pages) (ps-get-page-dimensions, ps-begin-file, ps-begin-job, ps-generate): Fun fix. (ps-get-font-size): New fun. (ps-font-size-internal, ps-header-font-size-internal) (ps-header-title-font-size-internal): New vars. PostScript programming fix. (ps-print-prologue-1): Fix BeginDoc PostScript procedure (do'nt use setpagedevice operator).

author	Kenichi Handa <handa@m17n.org>
date	Sat, 27 Feb 1999 01:37:15 +0000
parents	3a9da940e5f2
children	77ab1bf09106

comparison

equal deleted inserted replaced

-:e2c5b1571392
+:971efbc0ac2c
 ;;; 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>)
 ;; Author:	Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Author:	Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
 ;; 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/23 15:02:20 vinicius>
+;; Time-stamp:	<99/02/19 11:47:32 vinicius>
-;; Version:	4.1.3
+;; Version:	4.1.4
-(defconst ps-print-version "4.1.3"
+(defconst ps-print-version "4.1.4"
-"ps-print.el, v 4.1.3 <98/11/23 vinicius>
+"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,
 please also report the version of Emacs, if any, that ps-print was
 distributed with.
 ;;
 ;;
 ;; Font Managing
 ;; -------------
 ;;
-;; ps-print now knows rather precisely some fonts:
+;; ps-print now knows rather precisely some fonts: the variable
-;; the variable `ps-font-info-database' contains information
+;; `ps-font-info-database' contains information for a list of font families
-;; for a list of font families (currently mainly `Courier' `Helvetica'
+;; (currently mainly `Courier' `Helvetica' `Times' `Palatino' `Helvetica-Narrow'
-;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
+;; `NewCenturySchlbk').  Each font family contains the font names for standard,
-;; Each font family contains the font names for standard, bold, italic
+;; bold, italic and bold-italic characters, a reference size (usually 10) and
-;; and bold-italic characters, a reference size (usually 10) and the
+;; the corresponding line height, width of a space and average character width.
-;; 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
-;; The variable `ps-font-family' determines which font family
+;; ordinary text.  If its value does not correspond to a known font family, an
-;; is to be used for ordinary text.
+;; error message is printed into the `*Messages*' buffer, which lists the
-;; If its value does not correspond to a known font family,
+;; currently available font families.
-;; 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
-;; The variable `ps-font-size' determines the size (in points)
+;; floats which has the following form:
-;; of the font for ordinary text, when generating PostScript.
+;;
-;; Its value is a float.
+;;    (LANDSCAPE-SIZE . PORTRAIT-SIZE)
 ;;
-;; Similarly, the variable `ps-header-font-family' determines
+;; Similarly, the variable `ps-header-font-family' determines which font family
-;; which font family is to be used for text in the header.
+;; 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-font-size' determines the font size, in points, for
-;; The variable `ps-header-title-font-size' determines the font size,
+;; text in the header (similar to `ps-font-size').
-;; in points, for the top line of 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 (similar to `ps-font-size').
 ;;
 ;;
 ;; Adding a New Font Family
 ;; ------------------------
 ;;
 (defcustom ps-font-family 'Courier
 "*Font family name for ordinary text, when generating PostScript."
 :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
 "*Font family name for text in the header, when generating PostScript."
 :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
 ;; Printing color requires x-color-values.
 "Return the current PostScript-generation setup."
 (format
 "
 \(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-stripes       %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-inter-column          %s
 ps-bottom-margin         %s
 ps-print-header-frame    %s
 ps-header-lines          %s
 ps-show-n-of-n           %s
 ps-spool-duplex          %s
-ps-multibyte-buffer       %S
+ps-multibyte-buffer       %s
-ps-font-family            %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-print-color-p
 ps-lpr-command
 ps-header-lines
 ps-show-n-of-n
 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-print-quote ps-header-font-size)
-ps-header-title-font-size))
+(ps-print-quote ps-header-title-font-size)))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Utility functions and variables:
 (defun ps-print-quote (sym)
-(and sym
+(cond ((null sym)
-(if (or (symbolp sym) (listp sym))
+	 nil)
-	   (format "'%S" sym)
+	((or (symbolp sym) (listp sym))
+	 (format "'%S" sym))
+	((stringp sym)
+	 (format "%S" sym))
+	(t
 	 sym)))
 (defvar ps-print-emacs-type
 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
 	((string-match "Lucid" emacs-version) 'lucid)
 % ---- save the state of the document (useful for ghostscript!)
 /docState save def
 % ---- [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 {
+%  /setpagedevice where {
-pop
+%    pop
-1 dict dup
+%    1 dict dup
-/PageSize [ PrintPageWidth LeftMargin add RightMargin add
+%    /PageSize [ PrintPageWidth LeftMargin add RightMargin add
-LandscapePageHeight ] put
+%		 LandscapePageHeight ] put
-setpagedevice
+%    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
 % ---- define where  printing will start
 /f0 F					% this installs Ascent
 (defvar ps-height-remaining nil)
 (defvar ps-width-remaining nil)
 (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)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal Variables
 (defun ps-line-lengths-internal ()
 "Display the correspondence between a line length and a font size,
 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))
 	(ps-setup (ps-setup))		; setup for the current buffer
 	(fs-min 5)			; minimum font size
 (defun ps-nb-pages (nb-lines)
 "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
+	(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-setup (ps-setup))		; setup for the current buffer
 	(fs-min 4)			; minimum font size
 ((< ps-number-of-columns 1)
 (error "The number of columns %d should be positive"
 	     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))
 ;; Landscape mode
 (ps-output-list ps-background-all-pages)
 (ps-output "} def\n/printLocalBackground {\n} def\n")
 ;; 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
+		     ps-header-title-font-size-internal
-							'bold))
+		     (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
+		     ps-header-font-size-internal
-						  'normal)))
+		     (ps-font 'ps-font-for-header 'normal)))
 (ps-output ps-print-prologue-2)
 ;; Text fonts
 (let ((font (ps-font-alist 'ps-font-for-text))
 	(i 0))
 (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))))
 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
 (t (concat
 (and ps-printing-region "Subset of: ")
 (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)
 (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-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]"))
 	      ((eq ps-print-control-characters 'control-8-bit)
 	       (string-as-unibyte "[\000-\037\177-\237]"))
 		(goto-char (point-min))
 		(or (looking-at (regexp-quote ps-adobe-tag))
 		    (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)
 		(funcall genfunc from to)
 		(ps-end-page)
 		 (progn
 		   (set-buffer ps-spool-buffer)
 		   (delete-region (marker-position safe-marker) (point-max))))))
 	(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))

Mercurial > emacs

comparison lisp/ps-print.el @ 24414:971efbc0ac2c