From 090be653c38dbe456e536426f33568f8e4971ad9 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 16 Jan 1997 05:09:21 +0000 Subject: [PATCH] (ps-print-version): Fix value. (cl lisp-float-type): Require them. (ps-number-of-columns ps-*-font-size): Try to select defaults better suited when `ps-landscape-mode' is non-nil. (ps-*-faces): Change default for Font Lock mode faces when `ps-print-color-p' is nil. (ps-right-header): Replace `time-stamp-yy/mm/dd' by `time-stamp-mon-dd-yyyy'. (ps-end-file ps-begin-page): Fix bug in page count for Ghostview. (ps-generate-postscript-with-faces): Replace `ps-sorter' by `car-less-than-car'. (ps-plot ps-generate): Replace `%d' by `%3d'. --- lisp/ps-print.el | 168 +++++++++++++++++------------------------------ 1 file changed, 62 insertions(+), 106 deletions(-) diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 57e9b378fe3..cecdb75b571 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -2,9 +2,23 @@ ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. -;; Author: Jim Thompson -;; Maintainer: duthen@cegelec-red.fr (Jacques Duthen Prestataire) -;; Keywords: print, PostScript +;; Author: Jim Thompson (was ) +;; Maintainer: Jacques Duthen +;; Keywords: print, PostScript +;; Time-stamp: <97/01/09 13:52:08 duthen> +;; Version: 3.04 + +(defconst ps-print-version "3.04" + "ps-print.el, v 3.04 <97/01/09 duthen> + +Jack'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. + +Please send all bug fixes and enhancements to + Jacques Duthen . +") ;; This file is part of GNU Emacs. @@ -23,72 +37,6 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;; LCD Archive Entry: -;; ps-print|James C. Thompson|thompson@wg2.waii.com| -;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)| -;; 26-Feb-1994|2.8|~/packages/ps-print.el| - -;; 3.03 [jack] Sept 27, 1996 Jacques Duthen -;; Merge 31 diffs between 19.29 and 19.34 - -;; 3.02 [jack] June 26, 1996 Jacques Duthen -;; Add new page dimensions to `ps-page-dimensions-database' for `paper-type' -;; Improve landscape mode `ps-landscape-mode' and multiple columns -;; printing `ps-number-of-columns': -;; The text and the margins are no more scaled. -;; Simplify the semantics of `ps-inter-column' (space between columns). -;; Add error checking for negative `ps-print-width' and `ps-print-height'. -;; Change the semantics of `ps-top-margin' which is now the TOP MARGIN, -;; and add `ps-header-offset' instead of having `ps-top-margin' split in 2. -;; Add `ps-header-font-family', `ps-header-font-size' and -;; `ps-header-title-font-size' to control the header. -;; Add `ps-header-line-pad'. -;; Change the semantics of `ps-font-info-database' to have symbolic -;; font families. -;; Add new fonts to `ps-font-info-database': `Courier' `Helvetica' -;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk' -;; Make public `ps-font-family' and `ps-font-size' so that the user -;; can directly control the text font and size without loading ps-print. -;; Add error checking for unknown font families and a message giving -;; the exhaustive list of available font families. -;; Document how to install a new font family. -;; Add `/ReportAllFontInfo' to get all the font families of the printer. -;; Add the possibility to make `mixed' font families. -;; Add `ps-setup' to get the current setup. -;; Add tools `ps-line-lengths' `ps-nb-pages-buffer' `ps-nb-pages-region' -;; to help choose the font size. -;; Split `ps-print-prologue' in two to insert info from header fonts -;; Replace indexes by macro `ps-page-dimensions-get-width' -;; to get access to the dimensions list. -;; Add `ps-select-font' inside `ps-get-page-dimensions'. -;; Fix the "clumsy" `ps-page-height' management. -;; Move `ps-get-page-dimensions' to the beginning of `ps-begin-file' -;; to get early error checking. -;; Add sample setup `ps-jack-setup'. -;; -;; Rewrite a lot of postscript code and add comments inside it -;; (maybe they should not (or optionally) be included in the generated -;; Postscript). -;; Translate the origin to (lm, bm) to simplify the other moves. -;; Fix bug in `/HeaderOffset' with `/PrintStartY'. -;; Fix bug in `/SetHeaderLines'. -;; Change `/ReportFontInfo' for use by `/ReportAllFontInfo'. -;; - -;; 3.01 [jack] June 4, 1996 Jacques Duthen -;; Manage float value for every variable representing a size. -;; Add `ps-font-info-database' `ps-inter-column' - -;; 3.00 [jack] May 17, 1996 Jacques Duthen -;; based on 2.8 Jim's Pretty-Good version: -;; Add `ps-landscape-mode' and `ps-number-of-columns' -;; for dumb multi-column landscape mode. - -;; Baseline-version: 2.8. (Jim'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.) - ;;; Commentary: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -659,17 +607,11 @@ ;;; Code: -(defconst ps-print-version "3.01" - "ps-print.el,v 3.01 1996/06/13 18:12 jack - -Jack'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. +(eval-when-compile + (require 'cl)) -Please send all bug fixes and enhancements to - Jacques Duthen . -") +(unless (featurep 'lisp-float-type) + (error "`ps-print' requires floating point support")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: @@ -720,13 +662,13 @@ see `ps-paper-type'.") (defvar ps-paper-type 'letter "*Specifies the size of paper to format for. -Should be one of the paper types defined in `ps-page-dimensions-database': -`letter', `legal', `a4'...") +Should be one of the paper types defined in `ps-page-dimensions-database', for +example `letter', `legal' or `a4'.") (defvar ps-landscape-mode 'nil "*Non-nil means print in landscape mode.") -(defvar ps-number-of-columns 1 +(defvar ps-number-of-columns (if ps-landscape-mode 2 1) "*Specifies the number of columns") ;;; Horizontal layout @@ -871,16 +813,16 @@ You can get all the fonts of YOUR printer using `ReportAllFontInfo'.") (defvar ps-font-family 'Courier "Font family name for ordinary text, when generating Postscript.") -(defvar ps-font-size 8.5 +(defvar ps-font-size (if ps-landscape-mode 7 8.5) "Font size, in points, for ordinary text, when generating Postscript.") (defvar ps-header-font-family 'Helvetica "Font family name for text in the header, when generating Postscript.") -(defvar ps-header-font-size 12 +(defvar ps-header-font-size (if ps-landscape-mode 10 12) "Font size, in points, for text in the header, when generating Postscript.") -(defvar ps-header-title-font-size 14 +(defvar 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.") @@ -902,15 +844,31 @@ when generating Postscript.") nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', and `ps-underlined-faces'.") -(defvar ps-bold-faces '() +(defvar ps-bold-faces + (unless ps-print-color-p + '(font-lock-function-name-face + font-lock-builtin-face + font-lock-variable-name-face + font-lock-keyword-face + font-lock-warning-face)) "*A list of the \(non-bold\) faces that should be printed in bold font. This applies to generating Postscript.") -(defvar ps-italic-faces '() +(defvar ps-italic-faces + (unless ps-print-color-p + '(font-lock-variable-name-face + font-lock-string-face + font-lock-comment-face + font-lock-warning-face)) "*A list of the \(non-italic\) faces that should be printed in italic font. This applies to generating Postscript.") -(defvar ps-underlined-faces '() +(defvar ps-underlined-faces + (unless ps-print-color-p + '(font-lock-function-name-face + font-lock-type-face + font-lock-reference-face + font-lock-warning-face)) "*A list of the \(non-underlined\) faces that should be printed underlined. This applies to generating Postscript.") @@ -934,7 +892,7 @@ string delimiters added to it.") (make-variable-buffer-local 'ps-left-header) (defvar ps-right-header - (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss) + (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy '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. @@ -2165,7 +2123,8 @@ page-height == bm + print-height + tm - ho - hh (defun ps-end-file () (ps-output "\nEndDoc\n\n") (ps-output "%%Trailer\n") - (ps-output "%%Pages: " (format "%d\n" ps-showpage-count))) + (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count) + ps-number-of-columns))))) (defun ps-next-page () (ps-end-page) @@ -2177,19 +2136,20 @@ page-height == bm + print-height + tm - ho - hh (setq ps-width-remaining ps-print-width) (setq ps-height-remaining ps-print-height) - (setq ps-page-count (+ ps-page-count 1)) + ;; Print only when a new real page begins. + (when (zerop (mod ps-page-count ps-number-of-columns)) + (ps-output (format "\n%%%%Page: %d %d\n" + (1+ (/ ps-page-count ps-number-of-columns)) + (1+ (/ ps-page-count ps-number-of-columns))))) - (ps-output "\n%%Page: " - (format "%d %d\n" ps-page-count (+ 1 ps-showpage-count))) (ps-output "BeginDSCPage\n") - (ps-output (format "/PageNumber %d def\n" ps-page-count)) + (ps-output (format "/PageNumber %d def\n" (incf ps-page-count))) (ps-output "/PageCount 0 def\n") - (if ps-print-header - (progn - (ps-generate-header "HeaderLinesLeft" ps-left-header) - (ps-generate-header "HeaderLinesRight" ps-right-header) - (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))) + (when ps-print-header + (ps-generate-header "HeaderLinesLeft" ps-left-header) + (ps-generate-header "HeaderLinesRight" ps-right-header) + (ps-output (format "%d SetHeaderLines\n" ps-header-lines))) (ps-output "BeginPage\n") (ps-set-font ps-current-font) @@ -2276,7 +2236,7 @@ EndDSCPage\n")) (if (< q-todo 100) (/ (* 100 q-done) q-todo) (/ q-done (/ q-todo 100)))) - (message "Formatting...%d%%" foo)))))) + (message "Formatting...%3d%%" foo)))))) (defun ps-set-font (font) (setq ps-current-font font) @@ -2490,9 +2450,6 @@ EndDSCPage\n")) (list (extent-end-position extent) 'pull extent))) nil) -(defun ps-sorter (a b) - (< (car a) (car b))) - (defun ps-extent-sorter (a b) (< (extent-priority a) (extent-priority b))) @@ -2528,8 +2485,7 @@ EndDSCPage\n")) (let ((a (cons 'dummy nil)) record type extent extent-list) (map-extents 'ps-mapper nil from to a) - (setq a (cdr a)) - (setq a (sort a 'ps-sorter)) + (setq a (sort (cdr a) 'car-less-than-car)) (setq extent-list nil) @@ -2640,7 +2596,7 @@ EndDSCPage\n")) (save-restriction (narrow-to-region from to) (if ps-razzle-dazzle - (message "Formatting...%d%%" (setq ps-razchunk 0))) + (message "Formatting...%3d%%" (setq ps-razchunk 0))) (set-buffer buffer) (setq ps-source-buffer buffer) (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) -- 2.39.2