comparison lisp/ps-print.el @ 56504:8d030ffc0866

Improve DSC compliance.

56503:8bbd2323fbf2

;;	Vinicius Jose Latorre <[e-mail]>
;;	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer: Kenichi Handa <[e-mail]> (multi-byte characters)
;;	Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, print, PostScript
;; Time-stamp: <2004/03/10 18:57:00 vinicius>
;; Version: 6.6.4
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

(defconst ps-print-version "6.6.4"
  "ps-print.el, v 6.6.4 <2004/03/10 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.

;;
;;
;; Acknowledgments
;; ---------------
;;
;; Thanks to Adam Doppelt <[e-mail]> for face mapping suggestion
;; for black/white PostScript printers.
;;
;; Thanks to Toni Ronkko <[e-mail]> for line and paragraph spacing,
;; region to cut out when printing and footer suggestions.

;;
;; Thanks to Avishai Yacobi, [e-mail], for writing the
;; initial port to Emacs 19.  His code is no longer part of ps-print, but his
;; work is still appreciated.
;;
;; Thanks to Remi Houdaille and Michel Train, [e-mail], for
;; adding underline support.  Their code also is no longer part of ps-print,
;; but their efforts are not forgotten.
;;
;; Thanks also to all of you who mailed code to add features to ps-print;
;; although I didn't use your code, I still appreciate your sharing it with me.

;; Internal functions and variables


(defun ps-message-log-max ()
  (and (not (string= (buffer-name) "*Messages*"))
       message-log-max))


(defvar ps-print-hook nil)
(defvar ps-print-begin-sheet-hook nil)

       (goto-char to)
       (if (= (current-column) 0) 1 0))))


(defvar ps-printing-region nil
  "Variable used to indicate if the region that ps-print is printing.
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 to print the original line number (and not the number of
lines printed), and to indicate in the header that the printout is of a partial
file.")

(defun ps-generate-string-list (content)
  (let (str)
    (while content
      (setq str (cons (cond
		       ((stringp (car content))
			(car content))
		       ((and (symbolp (car content)) (fboundp (car content)))
			(concat "(" (funcall (car content)) ")"))
		       ((and (symbolp (car content)) (boundp (car content)))
			(concat "(" (symbol-value (car content)) ")"))
		       (t
			""))
		      str)
	    content (cdr content)))
    (nreverse str)))

    (and ps-n-up-on (setq tumble (not tumble)))
    (ps-output
     ps-adobe-tag
     "%%Title: " (buffer-name)		; Take job name from name of
					; first buffer printed
     "\n%%Creator: " (user-full-name)
     " (using ps-print v" ps-print-version
     ")\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 "
     (mapconcat 'identity
		(ps-remove-duplicates
		 (append (ps-fonts 'ps-font-for-text)
			 (list (ps-font 'ps-font-for-header 'normal)
			       (ps-font 'ps-font-for-header 'bold))))
		"\n%%+ font ")
     "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
     (format " %d" (round (ps-page-dimensions-get-width dimensions)))
     (format " %d" (round (ps-page-dimensions-get-height dimensions)))
     " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
     (if ps-spool-duplex

	       (format "/ErrorMessage  %s def\n\n"
		       (or (cdr (assoc ps-error-handler-message
				       ps-error-handler-alist))
			   1))		; send to paper
	       ps-print-prologue-0
	       "\n%%BeginProcSet: UserDefinedPrologue\n\n")

    (ps-insert-string ps-user-defined-prologue)

    (ps-output "\n%%EndProcSet\n\n")

    (ps-output-boolean "LandscapeMode      "
		       (or ps-landscape-mode
			   (eq (ps-n-up-landscape n-up) 'pag)))
    (ps-output-boolean "UpsideDown         " ps-print-upside-down)

    (ps-output "\n/printGlobalBackground{\n")
    (mapcar 'ps-output ps-background-all-pages)
    (ps-output "}def\n/printLocalBackground{\n}def\n")

    ;; Header/line number fonts
    (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
		       ps-header-title-font-size-internal
		       (ps-font 'ps-font-for-header 'bold))
	       (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont

    (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
      (ps-output (format "/SpaceWidthRatio %f def\n"
			 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))

    (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
    (unless (eq ps-spool-config 'lpr-switches)
      (ps-output "\n%%BeginFeature: *Duplex "
		 (ps-boolean-capitalized ps-spool-duplex)
		 " *Tumble "
		 (ps-boolean-capitalized tumble)

56504:8d030ffc0866

;;	Vinicius Jose Latorre <[e-mail]>
;;	Kenichi Handa <[e-mail]> (multi-byte characters)
;; Maintainer: Kenichi Handa <[e-mail]> (multi-byte characters)
;;	Vinicius Jose Latorre <[e-mail]>
;; Keywords: wp, print, PostScript
;; Time-stamp: <2004/07/21 23:12:05 vinicius>
;; Version: 6.6.5
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

(defconst ps-print-version "6.6.5"
  "ps-print.el, v 6.6.5 <2004/07/21 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.

;;
;;
;; Acknowledgments
;; ---------------
;;
;; Thanks to Michael Piotrowski <[e-mail]> for improving the DSC
;; compliance of the generated PostScript.
;;
;; Thanks to Adam Doppelt <[e-mail]> for face mapping suggestion
;; for black/white PostScript printers.
;;
;; Thanks to Toni Ronkko <[e-mail]> for line and paragraph spacing,
;; region to cut out when printing and footer suggestions.

;;
;; Thanks to Avishai Yacobi, [e-mail], for writing the
;; initial port to Emacs 19.  His code is no longer part of ps-print, but his
;; work is still appreciated.
;;
;; Thanks to Remi Houdaille and Michel Train <[e-mail]> for
;; adding underline support.  Their code also is no longer part of ps-print,
;; but their efforts are not forgotten.
;;
;; Thanks also to all of you who mailed code to add features to ps-print;
;; although I didn't use your code, I still appreciate your sharing it with me.

;; Internal functions and variables


(defun ps-message-log-max ()
  (and (not (string= (buffer-name) "*Messages*"))
       (boundp 'message-log-max)
       message-log-max))


(defvar ps-print-hook nil)
(defvar ps-print-begin-sheet-hook nil)

       (goto-char to)
       (if (= (current-column) 0) 1 0))))


(defvar ps-printing-region nil
  "Variable used to indicate the region that ps-print is printing.
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 to print the original line number (and not the number of
lines printed), and to indicate in the header that the printout is of a partial
file.")

(defun ps-generate-string-list (content)
  (let (str)
    (while content
      (setq str (cons (cond
		       ;; string
		       ((stringp (car content))
			(car content))
		       ;; function symbol
		       ((and (symbolp (car content)) (fboundp (car content)))
			(concat "(" (funcall (car content)) ")"))
		       ;; variable symbol
		       ((and (symbolp (car content)) (boundp (car content)))
			(concat "(" (symbol-value (car content)) ")"))
		       ;; otherwise, empty string
		       (t
			""))
		      str)
	    content (cdr content)))
    (nreverse str)))

    (and ps-n-up-on (setq tumble (not tumble)))
    (ps-output
     ps-adobe-tag
     "%%Title: " (buffer-name)		; Take job name from name of
					; first buffer printed
     "\n%%Creator: ps-print v" ps-print-version
     "\n%%For: " (user-full-name)
     "\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 "
     (mapconcat 'identity
		(ps-remove-duplicates
		 (append (ps-fonts 'ps-font-for-text)
			 (list (ps-font 'ps-font-for-header 'normal)
			       (ps-font 'ps-font-for-header 'bold)
			       (ps-font 'ps-font-for-footer 'normal)
			       (ps-font 'ps-font-for-footer 'bold))))
		"\n%%+ font ")
     "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
     "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
     (format " %d" (round (ps-page-dimensions-get-width dimensions)))
     (format " %d" (round (ps-page-dimensions-get-height dimensions)))
     " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
     (if ps-spool-duplex

	       (format "/ErrorMessage  %s def\n\n"
		       (or (cdr (assoc ps-error-handler-message
				       ps-error-handler-alist))
			   1))		; send to paper
	       ps-print-prologue-0
	       "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")

    (ps-insert-string ps-user-defined-prologue)

    (ps-output "\n%%EndResource\n\n")

    (ps-output-boolean "LandscapeMode      "
		       (or ps-landscape-mode
			   (eq (ps-n-up-landscape n-up) 'pag)))
    (ps-output-boolean "UpsideDown         " ps-print-upside-down)

    (ps-output "\n/printGlobalBackground{\n")
    (mapcar 'ps-output ps-background-all-pages)
    (ps-output "}def\n/printLocalBackground{\n}def\n")

    (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")

    (ps-output
     "\n%%IncludeResource: font Times-Roman"
     "\n%%IncludeResource: font Times-Italic\n%%IncludeResource: font "
     (mapconcat 'identity
		(ps-remove-duplicates
		 (append (ps-fonts 'ps-font-for-text)
			 (list (ps-font 'ps-font-for-header 'normal)
			       (ps-font 'ps-font-for-header 'bold)
			       (ps-font 'ps-font-for-footer 'normal)
			       (ps-font 'ps-font-for-footer 'bold))))
		"\n%%IncludeResource: font ")
     "\n")

    ;; Header/line number fonts
    (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
		       ps-header-title-font-size-internal
		       (ps-font 'ps-font-for-header 'bold))
	       (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont

    (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
      (ps-output (format "/SpaceWidthRatio %f def\n"
			 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))

    (unless (eq ps-spool-config 'lpr-switches)
      (ps-output "\n%%BeginFeature: *Duplex "
		 (ps-boolean-capitalized ps-spool-duplex)
		 " *Tumble "
		 (ps-boolean-capitalized tumble)