comparison lisp/ps-print.el @ 90779:6ea6d3d1508d

Some code fix.

90778:c5ab22abb1ec

(or (featurep 'lisp-float-type)
    (error "`ps-print' requires floating point support"))


(defvar ps-print-emacs-type
  (let ((case-fold-search t))
    (cond ((string-match "XEmacs" emacs-version) 'xemacs)
	  ((string-match "Lucid" emacs-version)
	   (error "`ps-print' doesn't support Lucid"))
	  ((string-match "Epoch" emacs-version)
	   (error "`ps-print' doesn't support Epoch"))
	  (t
	   (unless (and (boundp 'emacs-major-version)
			(> emacs-major-version 22))
	     (error "`ps-print' only supports Emacs 23 and higher"))
	   'emacs))))


(defconst ps-windows-system
  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system

  :version "20"
  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory
  (or (if (featurep 'xemacs)
	  (cond ((fboundp 'locate-data-directory) ; xemacs
		 (funcall 'locate-data-directory "ps-print"))
		((boundp 'data-directory) ; xemacs
		 (symbol-value 'data-directory))
		(t			; don't know what to do
		 nil))
	data-directory)			; emacs
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
  :type 'directory
  :version "20"

  "Return the current PostScript-generation setup."
  (let (ps-prefix-quote)
    (mapconcat
     #'ps-print-quote
     (list
      (concat "\n;;; ps-print version " ps-print-version "\n")
      ";; internal vars"
      (ps-comment-string "emacs-version      " emacs-version)
      (ps-comment-string "ps-windows-system  " ps-windows-system)
      (ps-comment-string "ps-lp-system       " ps-lp-system)
      nil
      '(25 . ps-print-color-p)
      '(25 . ps-lpr-command)
      '(25 . ps-lpr-switches)
      '(25 . ps-printer-name)

	  (buffer-string))
      (error "ps-print PostScript prologue `%s' file was not found"
	     filename))))


(defvar ps-mark-code-directory nil)

(defvar ps-print-prologue-0 ""
  "ps-print PostScript error handler.")

(defvar ps-print-prologue-1 ""
  "ps-print PostScript prologue.")

;; Start Editing Here:

(defvar ps-source-buffer nil)
(defvar ps-spool-buffer-name "*PostScript*")
(defvar ps-spool-buffer nil)

(defvar ps-output-head nil)
(defvar ps-output-tail nil)

(defvar ps-page-postscript 0)		; page number
(defvar ps-page-order 0)		; PostScript page counter
(defvar ps-page-sheet 0)		; sheet counter
(defvar ps-page-column 0)		; column counter
(defvar ps-page-printed 0)		; total pages printed
(defvar ps-page-n-up 0)			; n-up counter
(defvar ps-lines-printed 0)		; total lines printed
(defvar ps-showline-count 1)		; line number counter
(defvar ps-first-page nil)
(defvar ps-last-page nil)
(defvar ps-print-page-p t)

(defvar ps-control-or-escape-regexp nil)
(defvar ps-n-up-on nil)

(defvar ps-background-pages nil)
(defvar ps-background-all-pages nil)
(defvar ps-background-text-count 0)
(defvar ps-background-image-count 0)

(defvar ps-current-font 0)
(defvar ps-default-foreground nil)
(defvar ps-default-background nil)
(defvar ps-default-color nil)
(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)

;; These values determine how much print-height to deduct when headers/footers
;; are turned on.  This is a pretty clumsy way of handling it, but it'll do for
;; now.

(defmacro ps-page-dimensions-get-width  (dims) `(nth 0 ,dims))
(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
(defmacro ps-page-dimensions-get-media  (dims) `(nth 2 ,dims))

(defvar ps-landscape-page-height nil)

(defvar ps-print-width nil)
(defvar ps-print-height nil)

(defvar ps-height-remaining nil)
(defvar ps-width-remaining nil)

(defvar ps-font-size-internal nil)
(defvar ps-header-font-size-internal nil)
(defvar ps-header-title-font-size-internal nil)
(defvar ps-footer-font-size-internal nil)
(defvar ps-line-spacing-internal nil)
(defvar ps-paragraph-spacing-internal nil)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal Variables

  (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)
(defvar ps-print-begin-page-hook nil)
(defvar ps-print-begin-column-hook nil)


(defun ps-print-without-faces (from to &optional filename region-p)
  (ps-spool-without-faces from to region-p)
  (ps-do-despool filename))

    (goto-char (point-max))
    (insert-file-contents fname)))

;; These functions insert the arrays that define the contents of the headers.

(defvar ps-encode-header-string-function nil)

(defun ps-generate-header-line (fonttag &optional content)
  (ps-output " [" fonttag " ")
  (cond
   ;; Literal strings should be output as is -- the string must contain its own

		       (if (< q-todo 100)
			   (/ (* 100 q-done) q-todo)
			 (/ q-done (/ q-todo 100)))
		       ))))))

(defvar ps-last-font nil)

(defun ps-set-font (font)
  (setq ps-last-font (format "f%d" (setq ps-current-font font)))
  (ps-output (format "/%s F\n" ps-last-font)))

90779:6ea6d3d1508d

(or (featurep 'lisp-float-type)
    (error "`ps-print' requires floating point support"))


(let ((case-fold-search t))
  (cond ((string-match "XEmacs" emacs-version))
	((string-match "Lucid" emacs-version)
	 (error "`ps-print' doesn't support Lucid"))
	((string-match "Epoch" emacs-version)
	 (error "`ps-print' doesn't support Epoch"))
	(t
	 (unless (and (boundp 'emacs-major-version)
		      (>= emacs-major-version 22))
	   (error "`ps-print' only supports Emacs 22 and higher")))))


(defconst ps-windows-system
  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system

  :version "20"
  :group 'ps-print-headers)

(defcustom ps-postscript-code-directory
  (or (if (featurep 'xemacs)
	  (cond ((fboundp 'locate-data-directory) ; XEmacs
		 (funcall 'locate-data-directory "ps-print"))
		((boundp 'data-directory) ; XEmacs
		 (symbol-value 'data-directory))
		(t			; don't know what to do
		 nil))
	data-directory)			; Emacs
      (error "`ps-postscript-code-directory' isn't set properly"))
  "*Directory where it's located the PostScript prologue file used by ps-print.
By default, this directory is the same as in the variable `data-directory'."
  :type 'directory
  :version "20"

  "Return the current PostScript-generation setup."
  (let (ps-prefix-quote)
    (mapconcat
     #'ps-print-quote
     (list
      (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs")
	      ") ps-print version " ps-print-version "\n")
      ";; internal vars"
      (ps-comment-string "emacs-version     " emacs-version)
      (ps-comment-string "ps-windows-system " ps-windows-system)
      (ps-comment-string "ps-lp-system      " ps-lp-system)
      nil
      '(25 . ps-print-color-p)
      '(25 . ps-lpr-command)
      '(25 . ps-lpr-switches)
      '(25 . ps-printer-name)

	  (buffer-string))
      (error "ps-print PostScript prologue `%s' file was not found"
	     filename))))


(defvar ps-mark-code-directory)

(defvar ps-print-prologue-0 ""
  "ps-print PostScript error handler.")

(defvar ps-print-prologue-1 ""
  "ps-print PostScript prologue.")

;; Start Editing Here:

(defvar ps-source-buffer)
(defvar ps-spool-buffer-name "*PostScript*")
(defvar ps-spool-buffer)

(defvar ps-output-head)
(defvar ps-output-tail)

(defvar ps-page-postscript 0)		; page number
(defvar ps-page-order 0)		; PostScript page counter
(defvar ps-page-sheet 0)		; sheet counter
(defvar ps-page-column 0)		; column counter
(defvar ps-page-printed 0)		; total pages printed
(defvar ps-page-n-up 0)			; n-up counter
(defvar ps-lines-printed 0)		; total lines printed
(defvar ps-showline-count 1)		; line number counter
(defvar ps-first-page)
(defvar ps-last-page)
(defvar ps-print-page-p t)

(defvar ps-control-or-escape-regexp)
(defvar ps-n-up-on)

(defvar ps-background-pages)
(defvar ps-background-all-pages)
(defvar ps-background-text-count 0)
(defvar ps-background-image-count 0)

(defvar ps-current-font 0)
(defvar ps-default-foreground)
(defvar ps-default-background)
(defvar ps-default-color)
(defvar ps-current-color)
(defvar ps-current-bg)

(defvar ps-zebra-stripe-full-p)
(defvar ps-razchunk 0)

(defvar ps-color-p)

;; These values determine how much print-height to deduct when headers/footers
;; are turned on.  This is a pretty clumsy way of handling it, but it'll do for
;; now.

(defmacro ps-page-dimensions-get-width  (dims) `(nth 0 ,dims))
(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
(defmacro ps-page-dimensions-get-media  (dims) `(nth 2 ,dims))

(defvar ps-landscape-page-height)

(defvar ps-print-width)
(defvar ps-print-height)

(defvar ps-height-remaining)
(defvar ps-width-remaining)

(defvar ps-font-size-internal)
(defvar ps-header-font-size-internal)
(defvar ps-header-title-font-size-internal)
(defvar ps-footer-font-size-internal)
(defvar ps-line-spacing-internal)
(defvar ps-paragraph-spacing-internal)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal Variables

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


(defvar ps-print-hook)
(defvar ps-print-begin-sheet-hook)
(defvar ps-print-begin-page-hook)
(defvar ps-print-begin-column-hook)


(defun ps-print-without-faces (from to &optional filename region-p)
  (ps-spool-without-faces from to region-p)
  (ps-do-despool filename))

    (goto-char (point-max))
    (insert-file-contents fname)))

;; These functions insert the arrays that define the contents of the headers.

(defvar ps-encode-header-string-function)

(defun ps-generate-header-line (fonttag &optional content)
  (ps-output " [" fonttag " ")
  (cond
   ;; Literal strings should be output as is -- the string must contain its own

		       (if (< q-todo 100)
			   (/ (* 100 q-done) q-todo)
			 (/ q-done (/ q-todo 100)))
		       ))))))

(defvar ps-last-font)

(defun ps-set-font (font)
  (setq ps-last-font (format "f%d" (setq ps-current-font font)))
  (ps-output (format "/%s F\n" ps-last-font)))