|
2
|
1 ;;; w3-print.el --- Printing support for emacs-w3
|
|
0
|
2 ;; Author: wmperry
|
|
14
|
3 ;; Created: 1996/10/09 19:00:59
|
|
|
4 ;; Version: 1.5
|
|
0
|
5 ;; Keywords: faces, help, printing, hypermedia
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
14
|
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
|
|
0
|
10 ;;;
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12 ;;;
|
|
|
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
14 ;;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;;; any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
14
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;;; Boston, MA 02111-1307, USA.
|
|
0
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28 (defvar w3-use-ps-print nil
|
|
|
29 "*If non-nil, then printing will be done via the ps-print package by
|
|
|
30 James C. Thompson <thompson@wg2.waii.com>.")
|
|
|
31
|
|
|
32 (defun w3-face-type (face)
|
|
|
33 "Return a list specifying what a face looks like. ie: '(bold italic)"
|
|
|
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)
|
|
2
|
72 (inhibit-read-only t)
|
|
0
|
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
|
|
|
100 (defun w3-print-this-url (&optional url format)
|
|
|
101 "Print out the current document (in LaTeX format)"
|
|
|
102 (interactive)
|
|
|
103 (if (not url) (setq url (url-view-url t)))
|
|
|
104 (let* ((completion-ignore-case t)
|
|
|
105 (format (or format
|
|
|
106 (completing-read
|
|
|
107 "Format: "
|
|
|
108 '(("HTML Source") ; The raw HTML code
|
|
|
109 ("Formatted Text") ; Plain ASCII rendition
|
|
|
110 ("PostScript") ; Pretty PostScript
|
|
|
111 ("LaTeX'd") ; LaTeX it, then print
|
|
|
112 )
|
|
|
113 nil t))))
|
|
|
114 (save-excursion
|
|
|
115 (cond
|
|
|
116 ((equal "HTML Source" format)
|
|
|
117 (if w3-current-source
|
|
|
118 (let ((x w3-current-source))
|
|
|
119 (set-buffer (get-buffer-create url-working-buffer))
|
|
|
120 (erase-buffer)
|
|
|
121 (insert x))
|
|
|
122 (url-retrieve url))
|
|
|
123 (lpr-buffer))
|
|
|
124 ((or (equal "Formatted Text" format)
|
|
|
125 (equal "" format))
|
|
|
126 (lpr-buffer))
|
|
|
127 ((equal "PostScript" format)
|
|
|
128 (w3-print-with-ps-print (current-buffer)))
|
|
|
129 ((equal "LaTeX'd" format)
|
|
|
130 (w3-parse-tree-to-latex w3-current-parse url)
|
|
|
131 (save-window-excursion
|
|
|
132 (write-region (point-min) (point-max)
|
|
|
133 (expand-file-name "w3-tmp.latex"
|
|
|
134 w3-temporary-directory) nil 5)
|
|
|
135 (shell-command
|
|
|
136 (format
|
|
|
137 "cd %s ; latex w3-tmp.latex ; %s w3-tmp.dvi ; rm -f w3-tmp*"
|
|
|
138 w3-temporary-directory
|
|
|
139 w3-print-command))
|
|
|
140 (kill-buffer "*Shell Command Output*")))))))
|
|
|
141
|
|
|
142 (defun w3-print-url-under-point ()
|
|
|
143 "Print out the url under point (in LaTeX format)"
|
|
|
144 (interactive)
|
|
|
145 (w3-print-this-url (w3-view-this-url t)))
|
|
|
146
|
|
|
147 (provide 'w3-print)
|
