Mercurial > emacs

changeset 24414:971efbc0ac2c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 e2c5b1571392
children 48003e436759
files lisp/ps-print.el
diffstat 1 files changed, 115 insertions(+), 72 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ps-print.el	Fri Feb 26 16:40:13 1999 +0000
+++ b/lisp/ps-print.el	Sat Feb 27 01:37:15 1999 +0000
@@ -1,6 +1,6 @@
 ;;; 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>)
@@ -9,11 +9,11 @@
 ;; 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>
-;; Version:	4.1.3
-
-(defconst ps-print-version "4.1.3"
-  "ps-print.el, v 4.1.3 <98/11/23 vinicius>
+;; Time-stamp:	<99/02/19 11:47:32 vinicius>
+;; Version:	4.1.4
+
+(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,
@@ -501,30 +501,32 @@
 ;; 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.
-;;
-;; 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.
-;;
-;; 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.
+;; 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:
+;;
+;;    (LANDSCAPE-SIZE . PORTRAIT-SIZE)
+;;
+;; 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 (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
@@ -1525,9 +1527,12 @@
   :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
@@ -1535,14 +1540,20 @@
   :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
@@ -1807,10 +1818,10 @@
    "
 \(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
 
@@ -1818,13 +1829,13 @@
       ps-zebra-stripe-height %s
       ps-line-number         %s
 
-      ps-print-control-characters %S
-
-      ps-print-background-image %S
-
-      ps-print-background-text %S
-
-      ps-print-prologue-header %S
+      ps-print-control-characters %s
+
+      ps-print-background-image %s
+
+      ps-print-background-text %s
+
+      ps-print-prologue-header %s
 
       ps-left-margin           %s
       ps-right-margin          %s
@@ -1840,10 +1851,10 @@
       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)
 "
@@ -1876,18 +1887,22 @@
    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
@@ -2314,19 +2329,19 @@
   % ---- [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
@@ -2620,6 +2635,10 @@
 
 (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
@@ -2892,7 +2911,7 @@
 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))
@@ -2930,7 +2949,7 @@
 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))
@@ -3000,9 +3019,10 @@
 	     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))
@@ -3481,11 +3501,11 @@
 
   ;; 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)
 
@@ -3495,7 +3515,7 @@
     (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))))
@@ -3527,6 +3547,21 @@
        (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)
@@ -3535,6 +3570,10 @@
 	 (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]"))
@@ -4169,10 +4208,10 @@
 		    (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)
@@ -4214,6 +4253,10 @@
 	(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))