comparison lisp/ps-print.el @ 89909:68c22ea6027c

Sync to HEAD

89908:ee1402f7b568

;;; ps-print.el --- print text from the buffer as PostScript

;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
;; 2003 Free Software Foundation, Inc.

;; Author: Jim Thompson (was <[e-mail]>)
;;	Jacques Duthen (was <[e-mail]>)
;;	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: <2003/07/10 19:19:12 vinicius>
;; Version: 6.6.2
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/

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

;; New since version 2.8
;; ---------------------
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    20010619
;;	 `ps-time-stamp-locale-default'
;;
;;    20010530
;;	 Handle before-string and after-string overlay properties.

;;	 N-up printing.
;;	 Hook: `ps-print-begin-sheet-hook'.
;;
;; [keinichi] 19990509 Kein'ichi Handa <[e-mail]>
;;
;; `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19990301
;;	 PostScript tumble and setpagedevice.

;;	 PostScript prologue header comment insertion.
;;	 Skip invisible text better.
;;
;; [keinichi] 19980819 Kein'ichi Handa <[e-mail]>
;;
;; Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19980306
;;	 Skip invisible text.

;; suggestion for `ps-postscript-code-directory' variable.
;;
;; Thanks to David X Callaway <[e-mail]> for helping debugging PostScript
;; level 1 compatibility.
;;
;; Thanks to Colin Marquardt <[e-mail]> for upside-down,
;; line number step, line number start and zebra stripe follow suggestions, and
;; for XEmacs beta-tests.
;;
;; Thanks to Klaus Berndl <[e-mail]> for user defined PostScript
;; prologue code suggestion, for odd/even printing suggestion and for
;; `ps-prologue-file' enhancement.
;;

delimiters '(' and ')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it."
  :type '(repeat (choice :menu-tag "Left Header"
			 :tag "Left Header"
			 string symbol))
  :group 'ps-print-headers)

					as, for example, \"06/18/01\".

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :type '(repeat (choice :menu-tag "Right Header"
			 :tag "Right Header"

')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it."
  :version "21.1"
  :type '(repeat (choice :menu-tag "Left Footer"
			 :tag "Left Footer"
			 string symbol))
  :group 'ps-print-headers)

					as, for example, \"06/18/01\".

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :version "21.1"
  :type '(repeat (choice :menu-tag "Right Footer"

(defun ps-time-stamp-mon-dd-yyyy ()
  "Return date as \"Jun 18 2001\"."
  (format-time-string "%b %d %Y"))


(defun ps-time-stamp-hh:mm:ss ()
  "Return time as \"17:28:31\"."
  (format-time-string "%T"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions and variables


(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)

  (ps-spool-without-faces from to region-p)
  (ps-do-despool filename))


(defun ps-spool-without-faces (from to &optional region-p)
  (run-hooks 'ps-print-hook)
  (ps-printing-region region-p from to)
  (ps-generate (current-buffer) from to 'ps-generate-postscript))


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


(defun ps-spool-with-faces (from to &optional region-p)
  (run-hooks 'ps-print-hook)
  (ps-printing-region region-p from to)
  (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))


(defun ps-count-lines-preprint (from to)
   (or (and from to)
       (error "The mark is not set now"))
   (list (count-lines from to)))


(defun ps-count-lines (from to)
  (+ (count-lines from to)
     (save-excursion

	(t (list list))))

(defun ps-kill-emacs-check ()
  (let (ps-buffer)
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-modified-p ps-buffer)
	 (y-or-n-p "Unprinted PostScript waiting; print now? ")
	 (ps-despool))
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-modified-p ps-buffer)
	 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
	 (error "Unprinted PostScript"))))

(cond ((fboundp 'add-hook)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'ps-print)

;;; ps-print.el ends here

89909:68c22ea6027c

;;; ps-print.el --- print text from the buffer as PostScript

;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
;; 2003, 2004 Free Software Foundation, Inc.

;; Author: Jim Thompson (was <[e-mail]>)
;;	Jacques Duthen (was <[e-mail]>)
;;	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.

;; New since version 2.8
;; ---------------------
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    20040229
;;	 `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
;;
;;    20010619
;;	 `ps-time-stamp-locale-default'
;;
;;    20010530
;;	 Handle before-string and after-string overlay properties.

;;	 N-up printing.
;;	 Hook: `ps-print-begin-sheet-hook'.
;;
;; [keinichi] 19990509 Kein'ichi Handa <[e-mail]>
;;
;;    `ps-print-region-function'
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19990301
;;	 PostScript tumble and setpagedevice.

;;	 PostScript prologue header comment insertion.
;;	 Skip invisible text better.
;;
;; [keinichi] 19980819 Kein'ichi Handa <[e-mail]>
;;
;;    Multi-byte buffer handling.
;;
;; [vinicius] Vinicius Jose Latorre <[e-mail]>
;;
;;    19980306
;;	 Skip invisible text.

;; suggestion for `ps-postscript-code-directory' variable.
;;
;; Thanks to David X Callaway <[e-mail]> for helping debugging PostScript
;; level 1 compatibility.
;;
;; Thanks to Colin Marquardt <[e-mail]> for:
;;    - upside-down, line number step, line number start and zebra stripe
;;	follow suggestions.
;;    - `ps-time-stamp-yyyy-mm-dd' and `ps-time-stamp-iso8601' suggestion.
;;    - and for XEmacs beta-tests.
;;
;; Thanks to Klaus Berndl <[e-mail]> for user defined PostScript
;; prologue code suggestion, for odd/even printing suggestion and for
;; `ps-prologue-file' enhancement.
;;

delimiters '(' and ')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it.

If symbols are unbounded, they are silently ignored."
  :type '(repeat (choice :menu-tag "Left Header"
			 :tag "Left Header"
			 string symbol))
  :group 'ps-print-headers)

					as, for example, \"06/18/01\".

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

   `ps-time-stamp-yyyy-mm-dd'		Return date as \"2001-06-18\" (ISO
					date).

   `ps-time-stamp-iso8601'		Alias for `ps-time-stamp-yyyy-mm-dd'.

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :type '(repeat (choice :menu-tag "Right Header"
			 :tag "Right Header"

')'.

For symbols with bound functions, the function is called and should return a
string to be inserted into the array.  For symbols with bound values, the value
should be a string to be inserted into the array.  In either case, function or
variable, the string value has PostScript string delimiters added to it.

If symbols are unbounded, they are silently ignored."
  :version "21.1"
  :type '(repeat (choice :menu-tag "Left Footer"
			 :tag "Left Footer"
			 string symbol))
  :group 'ps-print-headers)

					as, for example, \"06/18/01\".

   `ps-time-stamp-hh:mm:ss'		Return time as \"17:28:31\".

   `ps-time-stamp-mon-dd-yyyy'		Return date as \"Jun 18 2001\".

   `ps-time-stamp-yyyy-mm-dd'		Return date as \"2001-06-18\" (ISO
					date).

   `ps-time-stamp-iso8601'		Alias for `ps-time-stamp-yyyy-mm-dd'.

You can also create your own time stamp function by using `format-time-string'
\(which see)."
  :version "21.1"
  :type '(repeat (choice :menu-tag "Right Footer"

(defun ps-time-stamp-mon-dd-yyyy ()
  "Return date as \"Jun 18 2001\"."
  (format-time-string "%b %d %Y"))


(defun ps-time-stamp-yyyy-mm-dd ()
  "Return date as \"2001-06-18\" (ISO date)."
  (format-time-string "%Y-%m-%d"))


(defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd
  "Alias for `ps-time-stamp-yyyy-mm-dd' (which see).")


(defun ps-time-stamp-hh:mm:ss ()
  "Return time as \"17:28:31\"."
  (format-time-string "%T"))

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

  (ps-spool-without-faces from to region-p)
  (ps-do-despool filename))


(defun ps-spool-without-faces (from to &optional region-p)
  (let ((message-log-max (ps-message-log-max)))	; to print *Messages* buffer
    (run-hooks 'ps-print-hook)
    (ps-printing-region region-p from to)
    (ps-generate (current-buffer) from to 'ps-generate-postscript)))


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


(defun ps-spool-with-faces (from to &optional region-p)
  (let ((message-log-max (ps-message-log-max)))	; to print *Messages* buffer
    (run-hooks 'ps-print-hook)
    (ps-printing-region region-p from to)
    (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)))


(defun ps-count-lines-preprint (from to)
  (or (and from to)
      (error "The mark is not set now"))
  (let ((message-log-max (ps-message-log-max)))	; to count lines of *Messages*
    (list (count-lines from to))))


(defun ps-count-lines (from to)
  (+ (count-lines from to)
     (save-excursion

	(t (list list))))

(defun ps-kill-emacs-check ()
  (let (ps-buffer)
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-name ps-buffer)	; check if it's not killed
	 (buffer-modified-p ps-buffer)
	 (y-or-n-p "Unprinted PostScript waiting; print now? ")
	 (ps-despool))
    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
	 (buffer-name ps-buffer)	; check if it's not killed
	 (buffer-modified-p ps-buffer)
	 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
	 (error "Unprinted PostScript"))))

(cond ((fboundp 'add-hook)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'ps-print)

;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579
;;; ps-print.el ends here