|
0
|
1 ;;; w3-print.el,v --- Printing support for emacs-w3
|
|
|
2 ;; Author: wmperry
|
|
|
3 ;; Created: 1996/06/06 15:03:15
|
|
|
4 ;; Version: 1.15
|
|
|
5 ;; Keywords: faces, help, printing, hypermedia
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
8 ;;; Copyright (c) 1993, 1994 by William M. Perry (wmperry@spry.com)
|
|
|
9 ;;;
|
|
|
10 ;;; This file is part of GNU Emacs.
|
|
|
11 ;;;
|
|
|
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;;; any later version.
|
|
|
16 ;;;
|
|
|
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;;; GNU General Public License for more details.
|
|
|
21 ;;;
|
|
|
22 ;;; You should have received a copy of the GNU General Public License
|
|
|
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
26 (defvar w3-use-ps-print nil
|
|
|
27 "*If non-nil, then printing will be done via the ps-print package by
|
|
|
28 James C. Thompson <thompson@wg2.waii.com>.")
|
|
|
29
|
|
|
30 (defun w3-face-type (face)
|
|
|
31 "Return a list specifying what a face looks like. ie: '(bold italic)"
|
|
|
32 (let ((font (or (face-font face) (face-font 'default)))
|
|
|
33 (retval nil))
|
|
|
34 (if (not (stringp font))
|
|
|
35 (setq font
|
|
|
36 (cond
|
|
|
37 ((and (fboundp 'fontp) (not (fontp font))) nil)
|
|
|
38 ((fboundp 'font-truename) (font-truename font))
|
|
|
39 ((fboundp 'font-name) (font-name font))
|
|
|
40 (t nil))))
|
|
|
41 (cond
|
|
|
42 ((not font) nil)
|
|
|
43 ((string-match "^-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-\\([^-]+\\)-" font)
|
|
|
44 (let ((wght (substring font (match-beginning 3) (match-end 3)))
|
|
|
45 (slnt (substring font (match-beginning 4) (match-end 4))))
|
|
|
46 (if (string-match "bold" wght)
|
|
|
47 (setq retval (cons 'bold retval)))
|
|
|
48 (if (or (string-match "i" slnt) (string-match "o" slnt))
|
|
|
49 (setq retval (cons 'italic retval)))
|
|
|
50 (if (and (fboundp 'face-underline-p)
|
|
|
51 (face-underline-p face))
|
|
|
52 (setq retval (cons 'underline retval)))))
|
|
|
53 ((and (symbolp face) (string-match "bold" (symbol-name face)))
|
|
|
54 (setq retval '(bold)))
|
|
|
55 ((and (symbolp face) (string-match "italic" (symbol-name face)))
|
|
|
56 (setq retval '(italic)))
|
|
|
57 (t nil))
|
|
|
58 retval))
|
|
|
59
|
|
|
60 (defun w3-print-with-ps-print (&optional buffer function)
|
|
|
61 "Print a buffer using `ps-print-buffer-with-faces'.
|
|
|
62 This function wraps `ps-print-buffer-with-faces' so that the w3 faces
|
|
|
63 will be correctly listed in ps-bold-faces and ps-italic-faces"
|
|
|
64 (interactive)
|
|
|
65 (require 'ps-print)
|
|
|
66 (setq buffer (or buffer (current-buffer))
|
|
|
67 function (or function 'ps-print-buffer-with-faces))
|
|
|
68 (let ((ps-bold-faces ps-bold-faces)
|
|
|
69 (ps-italic-faces ps-italic-faces)
|
|
|
70 (ps-underline-faces (cond
|
|
|
71 ((boundp 'ps-underline-faces)
|
|
|
72 (symbol-value 'ps-underline-faces))
|
|
|
73 ((boundp 'ps-underlined-faces)
|
|
|
74 (symbol-value 'ps-underlined-faces))
|
|
|
75 (t nil)))
|
|
|
76 (ps-underlined-faces nil)
|
|
|
77 (ps-left-header '(ps-get-buffer-name url-view-url))
|
|
|
78 (faces (face-list))
|
|
|
79 (data nil)
|
|
|
80 (face nil))
|
|
|
81 (if (string< ps-print-version "1.6")
|
|
|
82 (while faces
|
|
|
83 (setq face (car faces)
|
|
|
84 data (w3-face-type face)
|
|
|
85 faces (cdr faces))
|
|
|
86 (if (and (memq 'bold data) (not (memq face ps-bold-faces)))
|
|
|
87 (setq ps-bold-faces (cons face ps-bold-faces)))
|
|
|
88 (if (and (memq 'italic data) (not (memq face ps-italic-faces)))
|
|
|
89 (setq ps-italic-faces (cons face ps-italic-faces)))
|
|
|
90 (if (and (memq 'underline data) (not (memq face ps-underline-faces)))
|
|
|
91 (setq ps-underline-faces (cons face ps-underline-faces))))
|
|
|
92 (setq ps-underlined-faces ps-underline-faces))
|
|
|
93 (save-excursion
|
|
|
94 (set-buffer buffer)
|
|
|
95 (funcall function))))
|
|
|
96
|
|
|
97 (defun w3-print-this-url (&optional url format)
|
|
|
98 "Print out the current document (in LaTeX format)"
|
|
|
99 (interactive)
|
|
|
100 (if (not url) (setq url (url-view-url t)))
|
|
|
101 (let* ((completion-ignore-case t)
|
|
|
102 (format (or format
|
|
|
103 (completing-read
|
|
|
104 "Format: "
|
|
|
105 '(("HTML Source") ; The raw HTML code
|
|
|
106 ("Formatted Text") ; Plain ASCII rendition
|
|
|
107 ("PostScript") ; Pretty PostScript
|
|
|
108 ("LaTeX'd") ; LaTeX it, then print
|
|
|
109 )
|
|
|
110 nil t))))
|
|
|
111 (save-excursion
|
|
|
112 (cond
|
|
|
113 ((equal "HTML Source" format)
|
|
|
114 (if w3-current-source
|
|
|
115 (let ((x w3-current-source))
|
|
|
116 (set-buffer (get-buffer-create url-working-buffer))
|
|
|
117 (erase-buffer)
|
|
|
118 (insert x))
|
|
|
119 (url-retrieve url))
|
|
|
120 (lpr-buffer))
|
|
|
121 ((or (equal "Formatted Text" format)
|
|
|
122 (equal "" format))
|
|
|
123 (lpr-buffer))
|
|
|
124 ((equal "PostScript" format)
|
|
|
125 (w3-print-with-ps-print (current-buffer)))
|
|
|
126 ((equal "LaTeX'd" format)
|
|
|
127 (w3-parse-tree-to-latex w3-current-parse url)
|
|
|
128 (save-window-excursion
|
|
|
129 (write-region (point-min) (point-max)
|
|
|
130 (expand-file-name "w3-tmp.latex"
|
|
|
131 w3-temporary-directory) nil 5)
|
|
|
132 (shell-command
|
|
|
133 (format
|
|
|
134 "cd %s ; latex w3-tmp.latex ; %s w3-tmp.dvi ; rm -f w3-tmp*"
|
|
|
135 w3-temporary-directory
|
|
|
136 w3-print-command))
|
|
|
137 (kill-buffer "*Shell Command Output*")))))))
|
|
|
138
|
|
|
139 (defun w3-print-url-under-point ()
|
|
|
140 "Print out the url under point (in LaTeX format)"
|
|
|
141 (interactive)
|
|
|
142 (w3-print-this-url (w3-view-this-url t)))
|
|
|
143
|
|
|
144 (provide 'w3-print)
|
