Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 131b0175ea99
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
1 ;;; w3-print.el --- Printing support for emacs-w3 1 ;;; w3-print.el --- Printing support for emacs-w3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/10 00:13:05 3 ;; Created: 1997/02/07 01:05:01
4 ;; Version: 1.6 4 ;; Version: 1.7
5 ;; Keywords: faces, help, printing, hypermedia 5 ;; Keywords: faces, help, printing, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
23 ;;; You should have received a copy of the GNU General Public License 23 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA. 26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 (defvar w3-use-ps-print nil 28 (defvar w3-postscript-print-function 'ps-print-buffer-with-faces
29 "*If non-nil, then printing will be done via the ps-print package by 29 "*Name of the function to use to print a buffer as PostScript.
30 James C. Thompson <thompson@wg2.waii.com>.") 30 This should take no arguments, and act on the current buffer.
31 31 Possible values include:
32 (defun w3-face-type (face) 32 ps-print-buffer-with-faces - print immediately
33 "Return a list specifying what a face looks like. ie: '(bold italic)" 33 ps-spool-buffer-with-faces - spool for later")
34 (let ((font (or (face-font face) (face-font 'default)))
35 (retval nil))
36 (if (not (stringp font))
37 (setq font
38 (cond
39 ((and (fboundp 'fontp) (not (fontp font))) nil)
40 ((fboundp 'font-truename) (font-truename font))
41 ((fboundp 'font-name) (font-name font))
42 (t nil))))
43 (cond
44 ((not font) nil)
45 ((string-match "^-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-" font)
46 (let ((wght (substring font (match-beginning 3) (match-end 3)))
47 (slnt (substring font (match-beginning 4) (match-end 4))))
48 (if (string-match "bold" wght)
49 (setq retval (cons 'bold retval)))
50 (if (or (string-match "i" slnt) (string-match "o" slnt))
51 (setq retval (cons 'italic retval)))
52 (if (and (fboundp 'face-underline-p)
53 (face-underline-p face))
54 (setq retval (cons 'underline retval)))))
55 ((and (symbolp face) (string-match "bold" (symbol-name face)))
56 (setq retval '(bold)))
57 ((and (symbolp face) (string-match "italic" (symbol-name face)))
58 (setq retval '(italic)))
59 (t nil))
60 retval))
61
62 (defun w3-print-with-ps-print (&optional buffer function)
63 "Print a buffer using `ps-print-buffer-with-faces'.
64 This function wraps `ps-print-buffer-with-faces' so that the w3 faces
65 will be correctly listed in ps-bold-faces and ps-italic-faces"
66 (interactive)
67 (require 'ps-print)
68 (setq buffer (or buffer (current-buffer))
69 function (or function 'ps-print-buffer-with-faces))
70 (let ((ps-bold-faces ps-bold-faces)
71 (ps-italic-faces ps-italic-faces)
72 (inhibit-read-only t)
73 (ps-underline-faces (cond
74 ((boundp 'ps-underline-faces)
75 (symbol-value 'ps-underline-faces))
76 ((boundp 'ps-underlined-faces)
77 (symbol-value 'ps-underlined-faces))
78 (t nil)))
79 (ps-underlined-faces nil)
80 (ps-left-header '(ps-get-buffer-name url-view-url))
81 (faces (face-list))
82 (data nil)
83 (face nil))
84 (if (string< ps-print-version "1.6")
85 (while faces
86 (setq face (car faces)
87 data (w3-face-type face)
88 faces (cdr faces))
89 (if (and (memq 'bold data) (not (memq face ps-bold-faces)))
90 (setq ps-bold-faces (cons face ps-bold-faces)))
91 (if (and (memq 'italic data) (not (memq face ps-italic-faces)))
92 (setq ps-italic-faces (cons face ps-italic-faces)))
93 (if (and (memq 'underline data) (not (memq face ps-underline-faces)))
94 (setq ps-underline-faces (cons face ps-underline-faces))))
95 (setq ps-underlined-faces ps-underline-faces))
96 (save-excursion
97 (set-buffer buffer)
98 (funcall function))))
99 34
100 (defun w3-print-this-url (&optional url format) 35 (defun w3-print-this-url (&optional url format)
101 "Print out the current document (in LaTeX format)" 36 "Print out the current document (in LaTeX format)"
102 (interactive) 37 (interactive)
103 (if (not url) (setq url (url-view-url t))) 38 (if (not url) (setq url (url-view-url t)))
123 (lpr-buffer)) 58 (lpr-buffer))
124 ((or (equal "Formatted Text" format) 59 ((or (equal "Formatted Text" format)
125 (equal "" format)) 60 (equal "" format))
126 (lpr-buffer)) 61 (lpr-buffer))
127 ((equal "PostScript" format) 62 ((equal "PostScript" format)
128 (w3-print-with-ps-print (current-buffer))) 63 (funcall w3-postscript-print-function))
129 ((equal "LaTeX'd" format) 64 ((equal "LaTeX'd" format)
130 (w3-parse-tree-to-latex w3-current-parse url) 65 (w3-parse-tree-to-latex w3-current-parse url)
131 (save-window-excursion 66 (save-window-excursion
132 (write-region (point-min) (point-max) 67 (write-region (point-min) (point-max)
133 (expand-file-name "w3-tmp.latex" 68 (expand-file-name "w3-tmp.latex"