;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19.
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Jim Thompson <thompson@wg2.waii.com>
+;; Maintainer: FSF
;; Keywords: print, PostScript
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; 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|
;; printout than to find 50 single-page printouts).
;;
;; Ps-print has a hook in the kill-emacs-hooks so that you won't
-;; accidently quit from Emacs while you have unprinted PostScript
+;; accidentally quit from Emacs while you have unprinted PostScript
;; waiting in the spool buffer. If you do attempt to exit with
;; spooled PostScript, you'll be asked if you want to print it, and if
;; you decline, you'll be asked to confirm the exit; this is modeled
;; Ps-print keeps internal lists of which fonts are bold and which are
;; italic; these lists are built the first time you invoke ps-print.
;; For the sake of efficiency, the lists are built only once; the same
-;; lists are referred in later invokations of ps-print.
+;; lists are referred in later invocations of ps-print.
;;
;; Because these lists are built only once, it's possible for them to
;; get out of sync, if a face changes, or if new faces are added. To
;; or variables. Functions are called, and should return a string to
;; show in the header. Variables should contain strings to display in
;; the header. In either case, function or variable, the PostScript
-;; strings delimeters are added by ps-print, and should not be part of
+;; string delimiters are added by ps-print, and should not be part of
;; the returned value.
;;
;; Here's an example: say we want the left header to display the text
;; formats for; it should contain one of the symbols ps-letter,
;; ps-legal, or ps-a4. The default is ps-letter.
;;
-;;
-;; Installing ps-print
-;; -------------------
-;;
-;; 1. Place ps-print.el somewhere in your load-path and byte-compile
-;; it. You can ignore all byte-compiler warnings; they are the
-;; result of multi-Emacs support. This step is necessary only if
-;; you're installing your own ps-print; if ps-print came with your
-;; copy of Emacs, this been done already.
-;;
-;; 2. Place in your .emacs file the line
;;
-;; (require 'ps-print)
+;; Make sure that the variables ps-lpr-command and ps-lpr-switches
+;; contain appropriate values for your system; see the usage notes
+;; below and the documentation of these variables.
;;
-;; to load ps-print. Or you may cause any of the ps-print commands
-;; to be autoloaded with an autoload command such as:
-;;
-;; (autoload 'ps-print-buffer "ps-print"
-;; "Generate and print a PostScript image of the buffer..." t)
-;;
-;; 3. Make sure that the variables ps-lpr-command and ps-lpr-switches
-;; contain appropriate values for your system; see the usage notes
-;; below and the documentation of these variables.
;;
;; New since version 1.5
;; ---------------------
Note: page numbers are displayed as part of headers, see variable
`ps-print-headers'.")
-(defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; fsf
- (fboundp 'pixel-components)) ; xemacs
+(defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; Emacs
+ (fboundp 'pixel-components)) ; XEmacs
(fboundp 'float))
; Printing color requires both floating point and x-color-values.
"*If non-nil, print the buffer's text in color.")
;;;###autoload
(defun ps-print-buffer-with-faces (&optional filename)
"Generate and print a PostScript image of the buffer.
-
Like `ps-print-buffer', but includes font, color, and underline
-information in the generated image."
+information in the generated image. This command works only if you
+are using a window system, so it has a way to determine color values."
(interactive (list (ps-print-preprint current-prefix-arg)))
(ps-generate (current-buffer) (point-min) (point-max)
'ps-generate-postscript-with-faces)
;;;###autoload
(defun ps-print-region (from to &optional filename)
"Generate and print a PostScript image of the region.
-
Like `ps-print-buffer', but prints just the current region."
(interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
;;;###autoload
(defun ps-print-region-with-faces (from to &optional filename)
"Generate and print a PostScript image of the region.
-
Like `ps-print-region', but includes font, color, and underline
-information in the generated image."
+information in the generated image. This command works only if you
+are using a window system, so it has a way to determine color values."
(interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
(ps-generate (current-buffer) from to
;;;###autoload
(defun ps-spool-buffer ()
"Generate and spool a PostScript image of the buffer.
-
Like `ps-print-buffer' except that the PostScript image is saved in a
local buffer to be sent to the printer later.
;;;###autoload
(defun ps-spool-buffer-with-faces ()
"Generate and spool a PostScript image of the buffer.
-
Like `ps-spool-buffer', but includes font, color, and underline
-information in the generated image.
+information in the generated image. This command works only if you
+are using a window system, so it has a way to determine color values.
Use the command `ps-despool' to send the spooled images to the printer."
;;;###autoload
(defun ps-spool-region (from to)
"Generate a PostScript image of the region and spool locally.
-
Like `ps-spool-buffer', but spools just the current region.
Use the command `ps-despool' to send the spooled images to the printer."
;;;###autoload
(defun ps-spool-region-with-faces (from to)
"Generate a PostScript image of the region and spool locally.
-
Like `ps-spool-region', but includes font, color, and underline
-information in the generated image.
+information in the generated image. This command works only if you
+are using a window system, so it has a way to determine color values.
Use the command `ps-despool' to send the spooled images to the printer."
(interactive "r")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions and variables:
-(if (featurep 'emacs-vers)
- nil
- (defvar emacs-type (cond ((string-match "XEmacs" emacs-version) 'xemacs)
- ((string-match "Lucid" emacs-version) 'lucid)
- ((string-match "Epoch" emacs-version) 'epoch)
- (t 'fsf))))
+(defvar ps-print-emacs-type
+ (cond ((string-match "XEmacs" emacs-version) 'xemacs)
+ ((string-match "Lucid" emacs-version) 'lucid)
+ ((string-match "Epoch" emacs-version) 'epoch)
+ (t 'emacs)))
-(if (or (eq emacs-type 'lucid)
- (eq emacs-type 'xemacs))
+(if (or (eq ps-print-emacs-type 'lucid)
+ (eq ps-print-emacs-type 'xemacs))
(if (< emacs-minor-version 12)
(setq ps-print-color-p nil))
(require 'faces)) ; face-font, face-underline-p,
(defvar ps-razchunk 0)
-(defvar ps-color-format (if (eq emacs-type 'fsf)
+(defvar ps-color-format (if (eq ps-print-emacs-type 'emacs)
;;Emacs understands the %f format; we'll
;;use it to limit color RGB values to
(listp filename)))
(let* ((name (concat (buffer-name) ".ps"))
(prompt (format "Save PostScript to file: (default %s) "
- name)))
- (read-file-name prompt default-directory
- name nil))))
+ name))
+ (res (read-file-name prompt default-directory name nil)))
+ (if (file-directory-p res)
+ (expand-file-name name (file-name-as-directory res))
+ res))))
;; The following functions implement a simple list-buffering scheme so
;; that ps-print doesn't have to repeatedly switch between buffers
(goto-char to)))
-(defun ps-fsf-face-kind-p (face kind kind-regex kind-list)
+(defun ps-emacs-face-kind-p (face kind kind-regex kind-list)
(let ((frame-font (face-font face))
(face-defaults (face-font face t)))
(or
(memq face kind-list))))
(defun ps-face-bold-p (face)
- (if (eq emacs-type 'fsf)
- (ps-fsf-face-kind-p face 'bold "-\\(bold\\|demibold\\)-"
+ (if (eq ps-print-emacs-type 'emacs)
+ (ps-emacs-face-kind-p face 'bold "-\\(bold\\|demibold\\)-"
ps-bold-faces)
(ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
ps-bold-faces)))
(defun ps-face-italic-p (face)
- (if (eq emacs-type 'fsf)
- (ps-fsf-face-kind-p face 'italic "-[io]-" ps-italic-faces)
+ (if (eq ps-print-emacs-type 'emacs)
+ (ps-emacs-face-kind-p face 'italic "-[io]-" ps-italic-faces)
(or
(ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces)
(ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces))))
(let ((face 'default)
(position to))
(ps-print-ensure-fontified from to)
- (cond ((or (eq emacs-type 'lucid) (eq emacs-type 'xemacs))
+ (cond ((or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs))
;; Build the list of extents...
(let ((a (cons 'dummy nil))
record type extent extent-list)
(setq from position)
(setq a (cdr a)))))
- ((eq emacs-type 'fsf)
+ ((eq ps-print-emacs-type 'emacs)
(let ((property-change from)
(overlay-change from))
(while (< from to)
(min (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
+ ;; which is inactive according to the current value
+ ;; of buffer-invisibility-spec nonetheless overrides
+ ;; a face text property.
(setq face
- (cond ((get-text-property from 'invisible) nil)
+ (cond ((let ((prop (get-text-property from 'invisible)))
+ ;; Decide whether this invisible property
+ ;; really makes the text invisible.
+ (if (eq buffer-invisibility-spec t)
+ (not (null prop))
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec))))
+ nil)
((get-text-property from 'face))
(t 'default)))
(let ((overlays (overlays-at from))
0)))
(if (and (or overlay-invisible overlay-face)
(> overlay-priority face-priority))
- (setq face (cond (overlay-invisible nil)
+ (setq face (cond ((if (eq buffer-invisibility-spec t)
+ (not (null overlay-invisible))
+ (or (memq overlay-invisible buffer-invisibility-spec)
+ (assq overlay-invisible buffer-invisibility-spec)))
+ nil)
((and face overlay-face)))
face-priority overlay-priority)))
(setq overlays (cdr overlays))))
(defun ps-generate (buffer from to genfunc)
(let ((from (min to from))
- (to (max to from)))
+ (to (max to from))
+ ;; This avoids trouble if chars with read-only properties
+ ;; are copied into ps-spool-buffer.
+ (inhibit-read-only t))
(save-restriction
(narrow-to-region from to)
(if ps-razzle-dazzle
;; the postscript was generated without error.
(setq completed-safely t))
- ;; Unwind form: If some bad mojo ocurred while generating
+ ;; Unwind form: If some bad mojo occurred while generating
;; postscript, delete all the postscript that was generated.
;; This protects the previously spooled files from getting
;; corrupted.
(message "Printing..."))
(save-excursion
(set-buffer ps-spool-buffer)
- (apply 'call-process-region
- (point-min) (point-max) ps-lpr-command nil 0 nil
- ps-lpr-switches))
+ (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer))
+ (write-region (point-min) (point-max) dos-ps-printer t 0)
+ (let ((binary-process-input t)) ; for MS-DOS
+ (apply 'call-process-region
+ (point-min) (point-max) ps-lpr-command nil
+ (if (fboundp 'start-process) 0 nil)
+ nil
+ ps-lpr-switches))))
(if ps-razzle-dazzle
(message "Printing...done")))
(kill-buffer ps-spool-buffer)))
;; WARNING!!! The following code is *sample* code only. Don't use it
;; unless you understand what it does!
-(defmacro ps-prsc () (list 'if (list 'eq 'emacs-type ''fsf) [f22] ''f22))
-(defmacro ps-c-prsc () (list 'if (list 'eq 'emacs-type ''fsf) [C-f22]
+(defmacro ps-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
+ [f22] ''f22))
+(defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
+ [C-f22]
''(control f22)))
-(defmacro ps-s-prsc () (list 'if (list 'eq 'emacs-type ''fsf) [S-f22]
+(defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
+ [S-f22]
''(shift f22)))
;; Look in an article or mail message for the Subject: line. To be