Timestamp package replacement. Some enhancements. Some

XEmacs compatibility.  Doc Fix.
(ps-print-version): New version number (6.4).
(ps-printer-name): Initialization fix.
(ps-zebra-stripe-follow): Funcionality enhancement.
(ps-prologue-file): Code enhancement.
(ps-right-header): Timestamp package replacement.
(ps-setup, ps-face-bold-p, ps-face-italic-p, ps-get-page-dimensions)
(ps-generate-header, ps-begin-file, ps-begin-job)
(ps-generate-postscript-with-faces, ps-do-despool): Code fix.
(ps-time-stamp-mon-dd-yyyy, ps-time-stamp-hh:mm:ss): New funs.
(ps-zebra-stripe-full-p, ps-zebra-stripe-alist): New vars.
(coding-system-for-write): Var declaration (XEmacs compatibility).

1 files changed, 167 insertions, 103 deletions

diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 502ded397fd..4238f258dc8 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1,6 +1,6 @@
 ;;; ps-print.el --- Print text from the buffer as PostScript
 
-;; Copyright (C) 1993,94,95,96,97,98,99,2000
+;; Copyright (C) 1993,94,95,96,97,98,99,00,2001
 ;; Free Software Foundation, Inc.
 
 ;; Author:      Jim Thompson (was <thompson@wg2.waii.com>)
@@ -10,12 +10,12 @@
 ;; Maintainer:  Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
 ;; Maintainer:  Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Keywords:    wp, print, PostScript
-;; Time-stamp:  <2000/12/26 23:19:24 Vinicius>
-;; Version:     6.3.3
+;; Time-stamp:  <2001/02/19 14:54:52 Vinicius>
+;; Version:     6.4
 ;; X-URL:       http://www.cpqd.com.br/~vinicius/emacs/
 
-(defconst ps-print-version "6.3.3"
-  "ps-print.el, v 6.3.3 <2000/12/26 vinicius>
+(defconst ps-print-version "6.4"
+  "ps-print.el, v 6.4 <2001/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
@@ -757,33 +757,39 @@ Please send all bug fixes and enhancements to
 ;; corresponds to the Red Green Blue color scale.
 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
 ;;
-;; The variable `ps-zebra-stripe-follow' specifies if zebra stripe should
-;; continue on next page or restart on each page.  If `ps-zebra-stripe-follow'
-;; is nil, zebra stripe is restarted on each page.  If `ps-zebra-stripe-follow'
-;; is non-nil, zebra stripe continues on next page.  Visually, we have:
-;;
-;;              `ps-zebra-stripe-follow'        `ps-zebra-stripe-follow'
-;;                 is nil                          is non-nil
-;; Current Page ------------------------        ------------------------
-;;              1  XXXXXXXXXXXXXXXXXXXXX        1  XXXXXXXXXXXXXXXXXXXXX
-;;              2  XXXXXXXXXXXXXXXXXXXXX        2  XXXXXXXXXXXXXXXXXXXXX
-;;              3  XXXXXXXXXXXXXXXXXXXXX        3  XXXXXXXXXXXXXXXXXXXXX
-;;              4                               4
-;;              5                               5
-;;              6                               6
-;;              7  XXXXXXXXXXXXXXXXXXXXX        7  XXXXXXXXXXXXXXXXXXXXX
-;;              8  XXXXXXXXXXXXXXXXXXXXX        8  XXXXXXXXXXXXXXXXXXXXX
-;;              ------------------------        ------------------------
-;;    Next Page ------------------------        ------------------------
-;;              9  XXXXXXXXXXXXXXXXXXXXX        9  XXXXXXXXXXXXXXXXXXXXX
-;;              10 XXXXXXXXXXXXXXXXXXXXX        10
-;;              11 XXXXXXXXXXXXXXXXXXXXX        11
-;;              12                              12
-;;              13                              13 XXXXXXXXXXXXXXXXXXXXX
-;;              14                              14 XXXXXXXXXXXXXXXXXXXXX
-;;              15 XXXXXXXXXXXXXXXXXXXXX        15 XXXXXXXXXXXXXXXXXXXXX
-;;              16 XXXXXXXXXXXXXXXXXXXXX        16
-;;              ------------------------        ------------------------
+;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
+;; on next page.  Visually, valid values are (the character `+' at right of
+;; each column indicates that a line is printed):
+;;
+;;                 `nil'        `follow'        `full'        `full-follow'
+;; Current Page --------     -----------     ---------     ----------------
+;;              1  XXXXX +   1  XXXXXXXX +   1  XXXXXX +   1  XXXXXXXXXXXXX +
+;;              2  XXXXX +   2  XXXXXXXX +   2  XXXXXX +   2  XXXXXXXXXXXXX +
+;;              3  XXXXX +   3  XXXXXXXX +   3  XXXXXX +   3  XXXXXXXXXXXXX +
+;;              4        +   4           +   4         +   4                +
+;;              5        +   5           +   5         +   5                +
+;;              6        +   6           +   6         +   6                +
+;;              7  XXXXX +   7  XXXXXXXX +   7  XXXXXX +   7  XXXXXXXXXXXXX +
+;;              8  XXXXX +   8  XXXXXXXX +   8  XXXXXX +   8  XXXXXXXXXXXXX +
+;;              9  XXXXX +   9  XXXXXXXX +   9  XXXXXX +   9  XXXXXXXXXXXXX +
+;;              10       +   10          +
+;;              11       +   11          +
+;;              --------     -----------     ---------     ----------------
+;;    Next Page --------     -----------     ---------     ----------------
+;;              12 XXXXX +   12          +   10 XXXXXX +   10               +
+;;              13 XXXXX +   13 XXXXXXXX +   11 XXXXXX +   11               +
+;;              14 XXXXX +   14 XXXXXXXX +   12 XXXXXX +   12               +
+;;              15       +   15 XXXXXXXX +   13        +   13 XXXXXXXXXXXXX +
+;;              16       +   16          +   14        +   14 XXXXXXXXXXXXX +
+;;              17       +   17          +   15        +   15 XXXXXXXXXXXXX +
+;;              18 XXXXX +   18          +   16 XXXXXX +   16               +
+;;              19 XXXXX +   19 XXXXXXXX +   17 XXXXXX +   17               +
+;;              20 XXXXX +   20 XXXXXXXX +   18 XXXXXX +   18               +
+;;              21       +   21 XXXXXXXX +
+;;              22       +   22          +
+;;              --------     -----------     ---------     ----------------
+;;
+;; Any other value is treated as `nil'.
 ;;
 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
 ;;
@@ -1263,7 +1269,8 @@ Please send all bug fixes and enhancements to
 ;; for XEmacs beta-tests.
 ;;
 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
-;; prologue code suggestion and for odd/even printing suggestion.
+;; prologue code suggestion, for odd/even printing suggestion and for
+;; `ps-prologue-file' enhancement.
 ;;
 ;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
 ;;
@@ -1379,8 +1386,13 @@ Please send all bug fixes and enhancements to
   (defalias 'ps-x-map-extents                   'map-extents)
 
   ;; GNU Emacs
-  (defalias 'ps-e-x-color-values 'x-color-values)
-  (defalias 'ps-e-color-values   'color-values)
+  (defalias 'ps-e-face-bold-p         'face-bold-p)
+  (defalias 'ps-e-face-italic-p       'face-italic-p)
+  (defalias 'ps-e-next-overlay-change 'next-overlay-change)
+  (defalias 'ps-e-overlays-at         'overlays-at)
+  (defalias 'ps-e-overlay-get         'overlay-get)
+  (defalias 'ps-e-x-color-values      'x-color-values)
+  (defalias 'ps-e-color-values        'color-values)
   (if (fboundp 'find-composition)
       (defalias 'ps-e-find-composition 'find-composition)
     (defalias 'ps-e-find-composition 'ignore))
@@ -1571,7 +1583,7 @@ For more information about PostScript document comments, see:
   :group 'ps-print-miscellany)
 
 (defcustom ps-printer-name (and (boundp 'printer-name)
-                                printer-name)
+                                (symbol-value 'printer-name))
   "*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
@@ -1943,36 +1955,46 @@ See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
   :group 'ps-print-zebra)
 
 (defcustom ps-zebra-stripe-follow nil
-  "*Non-nil means zebra stripe continues on next page.
-
-If `ps-zebra-stripe-follow' is nil, zebra stripe is restarted on each page.
-If `ps-zebra-stripe-follow' is non-nil, zebra stripe continues on next page.
-
-Visually, we have:
-
-                `ps-zebra-stripe-follow'        `ps-zebra-stripe-follow'
-                   is nil                          is non-nil
-   Current Page ------------------------        ------------------------
-                1  XXXXXXXXXXXXXXXXXXXXX        1  XXXXXXXXXXXXXXXXXXXXX
-                2  XXXXXXXXXXXXXXXXXXXXX        2  XXXXXXXXXXXXXXXXXXXXX
-                3  XXXXXXXXXXXXXXXXXXXXX        3  XXXXXXXXXXXXXXXXXXXXX
-                4                               4
-                5                               5
-                6                               6
-                7  XXXXXXXXXXXXXXXXXXXXX        7  XXXXXXXXXXXXXXXXXXXXX
-                8  XXXXXXXXXXXXXXXXXXXXX        8  XXXXXXXXXXXXXXXXXXXXX
-                ------------------------        ------------------------
-      Next Page ------------------------        ------------------------
-                9  XXXXXXXXXXXXXXXXXXXXX        9  XXXXXXXXXXXXXXXXXXXXX
-                10 XXXXXXXXXXXXXXXXXXXXX        10
-                11 XXXXXXXXXXXXXXXXXXXXX        11
-                12                              12
-                13                              13 XXXXXXXXXXXXXXXXXXXXX
-                14                              14 XXXXXXXXXXXXXXXXXXXXX
-                15 XXXXXXXXXXXXXXXXXXXXX        15 XXXXXXXXXXXXXXXXXXXXX
-                16 XXXXXXXXXXXXXXXXXXXXX        16
-                ------------------------        ------------------------"
-  :type 'boolean
+  "*Specify how zebra stripes continue on next page.
+
+Visually, valid values are (the character `+' at right of each column indicates
+that a line is printed):
+
+                   `nil'        `follow'        `full'        `full-follow'
+   Current Page --------     -----------     ---------     ----------------
+                1  XXXXX +   1  XXXXXXXX +   1  XXXXXX +   1  XXXXXXXXXXXXX +
+                2  XXXXX +   2  XXXXXXXX +   2  XXXXXX +   2  XXXXXXXXXXXXX +
+                3  XXXXX +   3  XXXXXXXX +   3  XXXXXX +   3  XXXXXXXXXXXXX +
+                4        +   4           +   4         +   4                +
+                5        +   5           +   5         +   5                +
+                6        +   6           +   6         +   6                +
+                7  XXXXX +   7  XXXXXXXX +   7  XXXXXX +   7  XXXXXXXXXXXXX +
+                8  XXXXX +   8  XXXXXXXX +   8  XXXXXX +   8  XXXXXXXXXXXXX +
+                9  XXXXX +   9  XXXXXXXX +   9  XXXXXX +   9  XXXXXXXXXXXXX +
+                10       +   10          +
+                11       +   11          +
+                --------     -----------     ---------     ----------------
+      Next Page --------     -----------     ---------     ----------------
+                12 XXXXX +   12          +   10 XXXXXX +   10               +
+                13 XXXXX +   13 XXXXXXXX +   11 XXXXXX +   11               +
+                14 XXXXX +   14 XXXXXXXX +   12 XXXXXX +   12               +
+                15       +   15 XXXXXXXX +   13        +   13 XXXXXXXXXXXXX +
+                16       +   16          +   14        +   14 XXXXXXXXXXXXX +
+                17       +   17          +   15        +   15 XXXXXXXXXXXXX +
+                18 XXXXX +   18          +   16 XXXXXX +   16               +
+                19 XXXXX +   19 XXXXXXXX +   17 XXXXXX +   17               +
+                20 XXXXX +   20 XXXXXXXX +   18 XXXXXX +   18               +
+                21       +   21 XXXXXXXX +
+                22       +   22          +
+                --------     -----------     ---------     ----------------
+
+Any other value is treated as `nil'."
+  :type '(choice :menu-tag "Zebra Stripe Follow"
+                 :tag "Zebra Stripe Follow"
+                 (const :tag "Always Restart" nil)
+                 (const :tag "Continue on Next Page" follow)
+                 (const :tag "Print Only Full Stripe" full)
+                 (const :tag "Continue on Full Stripe" full-follow))
   :group 'ps-print-zebra)
 
 (defcustom ps-line-number nil
@@ -2633,7 +2655,8 @@ string delimiters added to it."
   :group 'ps-print-headers)
 
 (defcustom ps-right-header
-  (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
+  (list "/pagenumberstring load"
+        'ps-time-stamp-mon-dd-yyyy 'ps-time-stamp-hh:mm:ss)
   "*The items to display (each on a line) on the right part of the page header.
 This applies to generating PostScript.
 
@@ -2964,7 +2987,7 @@ The table depends on the current ps-print setup."
    ps-number-of-columns
    ps-zebra-stripes
    ps-zebra-stripe-height
-   ps-zebra-stripe-follow
+   (ps-print-quote ps-zebra-stripe-follow)
    (ps-print-quote ps-zebra-color)
    ps-line-number
    (ps-print-quote ps-line-number-step)
@@ -3004,7 +3027,7 @@ The table depends on the current ps-print setup."
    ps-n-up-margin
    ps-n-up-border-p
    (ps-print-quote ps-n-up-filling)
-   (ps-print-quote ps-multibyte-buffer) ; see `ps-mule.el'
+   (ps-print-quote (symbol-value 'ps-multibyte-buffer)) ; see `ps-mule.el'
    (ps-print-quote ps-font-family)
    (ps-print-quote ps-font-size)
    (ps-print-quote ps-header-font-family)
@@ -3027,6 +3050,14 @@ The table depends on the current ps-print setup."
 ;; Utility functions and variables:
 
 
+(defun ps-time-stamp-mon-dd-yyyy ()
+  (format-time-string "%b %d %Y"))
+
+
+(defun ps-time-stamp-hh:mm:ss ()
+  (format-time-string "%T"))
+
+
 (defun ps-print-quote (sym)
   (cond ((null sym)
          nil)
@@ -3094,6 +3125,9 @@ The table depends on the current ps-print setup."
 
   (cond ((eq ps-print-emacs-type 'emacs) ; emacs
 
+         ;; to avoid XEmacs compilation gripes
+         (defvar coding-system-for-write nil)
+
          (defun ps-color-values (x-color)
            (cond
             ((fboundp 'color-values)
@@ -3107,11 +3141,11 @@ The table depends on the current ps-print setup."
          (defalias 'ps-face-background-name 'face-background)
 
          (defun ps-face-bold-p (face)
-           (or (face-bold-p face)
+           (or (ps-e-face-bold-p face)
                (memq face ps-bold-faces)))
 
          (defun ps-face-italic-p (face)
-           (or (face-italic-p face)
+           (or (ps-e-face-italic-p face)
                (memq face ps-italic-faces)))
          )
                                         ; xemacs
@@ -3166,22 +3200,22 @@ The table depends on the current ps-print setup."
       (memq face ps-underlined-faces)))
 
 
-(require 'time-stamp)
-
-
 (defun ps-prologue-file (filenumber)
-  (save-excursion
-    (let* ((filename (convert-standard-filename
-                      (expand-file-name (format "ps-prin%d.ps" filenumber)
-                                        ps-postscript-code-directory)))
-           (buffer
-            (or (find-file-noselect filename 'no-warn 'rawfile)
-                (error "ps-print PostScript prologue `%s' file was not found."
-                       filename))))
-      (set-buffer buffer)
-      (prog1
-          (buffer-string)
-        (kill-buffer buffer)))))
+  "If prologue FILENUMBER exists and is readable, returns contents as string.
+
+Note: No major/minor-mode is activated and no local variables are evaluated for
+      FILENUMBER, but proper EOL-conversion and character interpretation is
+      done!"
+  (let ((filename (convert-standard-filename
+                   (expand-file-name (format "ps-prin%d.ps" filenumber)
+                                     ps-postscript-code-directory))))
+    (if (and (file-exists-p filename)
+             (file-readable-p filename))
+        (with-temp-buffer
+          (insert-file-contents filename)
+          (buffer-string))
+      (error "ps-print PostScript prologue `%s' file was not found."
+             filename))))
 
 
 (defvar ps-mark-code-directory nil)
@@ -3230,6 +3264,7 @@ The table depends on the current ps-print setup."
 (defvar ps-current-color nil)
 (defvar ps-current-bg nil)
 
+(defvar ps-zebra-stripe-full-p nil)
 (defvar ps-razchunk 0)
 
 (defvar ps-color-p nil)
@@ -3758,7 +3793,24 @@ page-height == bm + print-height + tm - ho - hh
                   (* (ps-line-height 'ps-font-for-header)
                      (1- ps-header-lines))
                   ps-header-pad)
-               ps-print-height))))
+               ps-print-height))
+    ;; ps-zebra-stripe-follow is `full' or `full-follow'
+    (if ps-zebra-stripe-full-p
+        (let* ((line-height (ps-line-height 'ps-font-for-text))
+               (zebra (* line-height ps-zebra-stripe-height)))
+          (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
+                                   line-height))
+          (if (<= ps-print-height 0)
+              (error "Bad vertical layout:
+ps-zebra-stripe-follow == %s
+ps-zebra-stripe-height == %s
+font-text-height       == %s
+page-height == ((floor print-height (th * zh)) * (th * zh)) - th
+=> print-height == %d !"
+                     ps-zebra-stripe-follow
+                     ps-zebra-stripe-height
+                     (ps-line-height 'ps-font-for-text)
+                     ps-print-height))))))
 
 (defun ps-print-preprint (prefix-arg)
   (and prefix-arg
@@ -3953,8 +4005,8 @@ page-height == bm + print-height + tm - ho - hh
         (while (and (< count ps-header-lines)
                     (setq contents (cdr contents)))
           (ps-generate-header-line "/h1" (car contents))
-          (setq count (1+ count)))
-        (ps-output "] def\n"))))
+          (setq count (1+ count)))))
+  (ps-output "] def\n"))
 
 
 (defun ps-output-boolean (name bool)
@@ -4547,7 +4599,14 @@ XSTART YSTART are the relative position for the first page in a sheet.")
     (paper            . 1)
     (system           . 2)
     (paper-and-system . 3))
-  "Alist for error handler message")
+  "Alist for error handler message.")
+
+
+(defconst ps-zebra-stripe-alist
+  '((follow      . 1)
+    (full        . 2)
+    (full-follow . 3))
+  "Alist for zebra stripe continuation.")
 
 
 (defun ps-begin-file ()
@@ -4570,8 +4629,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
                                         ; first buffer printed
      "\n%%Creator: " (user-full-name)
      " (using ps-print v" ps-print-version
-     ")\n%%CreationDate: "
-     (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
+     ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
      "\n%%Orientation: "
      (if ps-landscape-mode "Landscape" "Portrait")
      "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
@@ -4638,18 +4696,21 @@ XSTART YSTART are the relative position for the first page in a sheet.")
     (ps-output-boolean "ShowNofN          " ps-show-n-of-n)
 
     (let ((line-height (ps-line-height 'ps-font-for-text)))
-      (ps-output (format "/LineHeight     %s def\n" line-height)
-                 (format "/LinesPerColumn %d def\n"
+      (ps-output (format "/LineHeight       %s def\n" line-height)
+                 (format "/LinesPerColumn   %d def\n"
                          (round (/ (+ ps-print-height
                                       (* line-height 0.45))
                                    line-height)))))
 
     (ps-output-boolean "WarnPaperSize   " ps-warn-paper-type)
     (ps-output-boolean "Zebra           " ps-zebra-stripes)
-    (ps-output-boolean "ZebraFollow     " ps-zebra-stripe-follow)
     (ps-output-boolean "PrintLineNumber " ps-line-number)
     (ps-output-boolean "SyncLineZebra   " (not (integerp ps-line-number-step)))
-    (ps-output (format "/PrintLineStep    %d def\n"
+    (ps-output (format "/ZebraFollow      %d def\n"
+                       (or (cdr (assq ps-zebra-stripe-follow
+                                      ps-zebra-stripe-alist))
+                           0))
+               (format "/PrintLineStep    %d def\n"
                        (if (integerp ps-line-number-step)
                            ps-line-number-step
                          ps-zebra-stripe-height))
@@ -4861,7 +4922,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
     (and (re-search-backward "^%%Trailer$" nil t)
          (delete-region (match-beginning 0) (point-max))))
   ;; miscellaneous
-  (setq ps-page-postscript 0
+  (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
+                                     '(full full-follow))
+        ps-page-postscript 0
         ps-page-sheet 0
         ps-page-n-up 0
         ps-page-column 0
@@ -5443,7 +5506,8 @@ If FACE is not a valid face name, it is used default face."
                  (setq property-change (next-property-change from nil to)))
             (and (< overlay-change to)  ; Don't search for overlay change
                                         ; unless previous search succeeded.
-                 (setq overlay-change (min (next-overlay-change from) to)))
+                 (setq overlay-change (min (ps-e-next-overlay-change from)
+                                           to)))
             (setq position (min property-change overlay-change))
             ;; The code below is not quite correct,
             ;; because a non-nil overlay invisible property
@@ -5461,13 +5525,13 @@ If FACE is not a valid face name, it is used default face."
                          'emacs--invisible--face)
                         ((get-text-property from 'face))
                         (t 'default)))
-            (let ((overlays (overlays-at from))
+            (let ((overlays (ps-e-overlays-at from))
                   (face-priority -1))   ; text-property
               (while (and overlays
                           (not (eq face 'emacs--invisible--face)))
                 (let* ((overlay (car overlays))
-                       (overlay-invisible (overlay-get overlay 'invisible))
-                       (overlay-priority (or (overlay-get overlay 'priority)
+                       (overlay-invisible (ps-e-overlay-get overlay 'invisible))
+                       (overlay-priority (or (ps-e-overlay-get overlay 'priority)
                                              0)))
                   (and (> overlay-priority face-priority)
                        (setq face
@@ -5478,7 +5542,7 @@ If FACE is not a valid face name, it is used default face."
                                           (assq overlay-invisible
                                                 save-buffer-invisibility-spec)))
                                     'emacs--invisible--face)
-                                   ((overlay-get overlay 'face))
+                                   ((ps-e-overlay-get overlay 'face))
                                    (t face))
                              face-priority overlay-priority)))
                 (setq overlays (cdr overlays))))
@@ -5616,7 +5680,7 @@ If FACE is not a valid face name, it is used default face."
         (let* ((coding-system-for-write 'raw-text-unix)
                (ps-printer-name (or ps-printer-name
                                     (and (boundp 'printer-name)
-                                         printer-name)))
+                                         (symbol-value 'printer-name))))
                (ps-lpr-switches
                 (append ps-lpr-switches
                         (and (stringp ps-printer-name)