diff lisp/w3/w3-print.el @ 20:859a2309aef8 r19-15b93

Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/w3/w3-print.el	Mon Aug 13 08:49:44 2007 +0200
+++ b/lisp/w3/w3-print.el	Mon Aug 13 08:50:05 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3-print.el --- Printing support for emacs-w3
 ;; Author: wmperry
-;; Created: 1997/01/10 00:13:05
-;; Version: 1.6
+;; Created: 1997/02/07 01:05:01
+;; Version: 1.7
 ;; Keywords: faces, help, printing, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -25,77 +25,12 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;;; Boston, MA 02111-1307, USA.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar w3-use-ps-print nil
-  "*If non-nil, then printing will be done via the ps-print package by
-James C. Thompson <thompson@wg2.waii.com>.")
-
-(defun w3-face-type (face)
-  "Return a list specifying what a face looks like.  ie: '(bold italic)"
-  (let ((font (or (face-font face) (face-font 'default)))
-	(retval nil))
-    (if (not (stringp font))
-	(setq font
-	      (cond
-	       ((and (fboundp 'fontp) (not (fontp font))) nil)
-	       ((fboundp 'font-truename) (font-truename font))
-	       ((fboundp 'font-name) (font-name font))
-	       (t nil))))
-    (cond
-     ((not font) nil)
-     ((string-match "^-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-" font)
-      (let ((wght (substring font (match-beginning 3) (match-end 3)))
-	    (slnt (substring font (match-beginning 4) (match-end 4))))
-	(if (string-match "bold" wght)
-	    (setq retval (cons 'bold retval)))
-	(if (or (string-match "i" slnt) (string-match "o" slnt))
-	    (setq retval (cons 'italic retval)))
-	(if (and (fboundp 'face-underline-p)
-		 (face-underline-p face))
-	    (setq retval (cons 'underline retval)))))
-     ((and (symbolp face) (string-match "bold" (symbol-name face)))
-      (setq retval '(bold)))
-     ((and (symbolp face) (string-match "italic" (symbol-name face)))
-      (setq retval '(italic)))
-     (t nil))
-    retval))
-
-(defun w3-print-with-ps-print (&optional buffer function)
-  "Print a buffer using `ps-print-buffer-with-faces'.
-This function wraps `ps-print-buffer-with-faces' so that the w3 faces
-will be correctly listed in ps-bold-faces and ps-italic-faces"
-  (interactive)
-  (require 'ps-print)
-  (setq buffer (or buffer (current-buffer))
-	function (or function 'ps-print-buffer-with-faces))
-  (let ((ps-bold-faces ps-bold-faces)
-	(ps-italic-faces ps-italic-faces)
-	(inhibit-read-only t)
-	(ps-underline-faces (cond
-			     ((boundp 'ps-underline-faces)
-			      (symbol-value 'ps-underline-faces))
-			     ((boundp 'ps-underlined-faces)
-			      (symbol-value 'ps-underlined-faces))
-			     (t nil)))
-	(ps-underlined-faces nil)
-	(ps-left-header '(ps-get-buffer-name url-view-url))
-	(faces (face-list))
-	(data nil)
-	(face nil))
-    (if (string< ps-print-version "1.6")
-	(while faces
-	  (setq face (car faces)
-		data (w3-face-type face)
-		faces (cdr faces))
-	  (if (and (memq 'bold data) (not (memq face ps-bold-faces)))
-	      (setq ps-bold-faces (cons face ps-bold-faces)))
-	  (if (and (memq 'italic data) (not (memq face ps-italic-faces)))
-	      (setq ps-italic-faces (cons face ps-italic-faces)))
-	  (if (and (memq 'underline data) (not (memq face ps-underline-faces)))
-	      (setq ps-underline-faces (cons face ps-underline-faces))))
-      (setq ps-underlined-faces ps-underline-faces))
-    (save-excursion
-      (set-buffer buffer)
-      (funcall function))))
+(defvar w3-postscript-print-function 'ps-print-buffer-with-faces
+  "*Name of the function to use to print a buffer as PostScript.
+This should take no arguments, and act on the current buffer.
+Possible values include:
+ps-print-buffer-with-faces   - print immediately
+ps-spool-buffer-with-faces   - spool for later")
 
 (defun w3-print-this-url (&optional url format)
   "Print out the current document (in LaTeX format)"
@@ -125,7 +60,7 @@
 	    (equal "" format))
 	(lpr-buffer))
        ((equal "PostScript" format)
-	(w3-print-with-ps-print (current-buffer)))
+	(funcall w3-postscript-print-function))
        ((equal "LaTeX'd" format)
  	(w3-parse-tree-to-latex w3-current-parse url)
 	(save-window-excursion