Commit | Line | Data |
---|---|---|
c97a3f22 VJL |
1 | ;;; ps-samp.el --- ps-print sample setup code |
2 | ||
49f70d46 | 3 | ;; Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
c97a3f22 VJL |
4 | |
5 | ;; Author: Jim Thompson (was <thompson@wg2.waii.com>) | |
6 | ;; Jacques Duthen (was <duthen@cegelec-red.fr>) | |
7 | ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> | |
8 | ;; Kenichi Handa <handa@m17n.org> (multi-byte characters) | |
9 | ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters) | |
10 | ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> | |
11 | ;; Keywords: wp, print, PostScript | |
c97a3f22 VJL |
12 | ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre |
13 | ||
14 | ;; This file is part of GNU Emacs. | |
15 | ||
eb3fa2cf GM |
16 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
17 | ;; it under the terms of the GNU General Public License as published by | |
18 | ;; the Free Software Foundation, either version 3 of the License, or | |
19 | ;; (at your option) any later version. | |
20 | ||
21 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
24 | ;; GNU General Public License for more details. | |
25 | ||
26 | ;; You should have received a copy of the GNU General Public License | |
27 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
c97a3f22 VJL |
28 | |
29 | ;;; Commentary: | |
30 | ||
31 | ;; See ps-print.el for documentation. | |
32 | ||
33 | ;;; Code: | |
34 | ||
35 | ||
36 | (eval-and-compile (require 'ps-print)) | |
37 | ||
38 | \f | |
39 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
40 | ;;; Sample Setup Code: | |
41 | ||
42 | ||
43 | ;; This stuff is for anybody that's brave enough to look this far, | |
44 | ;; and able to figure out how to use it. It isn't really part of | |
45 | ;; ps-print, but I'll leave it here in hopes it might be useful: | |
46 | ||
47 | ;; WARNING!!! The following code is *sample* code only. | |
48 | ;; Don't use it unless you understand what it does! | |
49 | ||
9e53076e | 50 | ;; The key `f22' should probably be replaced by `print'. --Stef |
c97a3f22 VJL |
51 | |
52 | ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the | |
53 | ;; `ps-left-headers' specially for mail messages. | |
54 | (defun ps-rmail-mode-hook () | |
9e53076e | 55 | (local-set-key [(f22)] 'ps-rmail-print-message-from-summary) |
c97a3f22 VJL |
56 | (setq ps-header-lines 3 |
57 | ps-left-header | |
58 | ;; The left headers will display the message's subject, its | |
59 | ;; author, and the name of the folder it was in. | |
60 | '(ps-article-subject ps-article-author buffer-name))) | |
61 | ||
62 | ;; See `ps-gnus-print-article-from-summary'. This function does the | |
63 | ;; same thing for rmail. | |
64 | (defun ps-rmail-print-message-from-summary () | |
65 | (interactive) | |
66 | (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) | |
67 | ||
68 | ;; Used in `ps-rmail-print-article-from-summary', | |
69 | ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'. | |
70 | (defun ps-print-message-from-summary (summary-buffer summary-default) | |
71 | (let ((ps-buf (or (and (boundp summary-buffer) | |
72 | (symbol-value summary-buffer)) | |
73 | summary-default))) | |
74 | (and (get-buffer ps-buf) | |
7fdbcd83 | 75 | (with-current-buffer ps-buf |
c97a3f22 VJL |
76 | (ps-spool-buffer-with-faces))))) |
77 | ||
78 | ;; Look in an article or mail message for the Subject: line. To be | |
79 | ;; placed in `ps-left-headers'. | |
80 | (defun ps-article-subject () | |
81 | (save-excursion | |
82 | (goto-char (point-min)) | |
83 | (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) | |
84 | (buffer-substring (match-beginning 1) (match-end 1)) | |
85 | "Subject ???"))) | |
86 | ||
87 | ;; Look in an article or mail message for the From: line. Sorta-kinda | |
88 | ;; understands RFC-822 addresses and can pull the real name out where | |
89 | ;; it's provided. To be placed in `ps-left-headers'. | |
90 | (defun ps-article-author () | |
91 | (save-excursion | |
92 | (goto-char (point-min)) | |
93 | (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) | |
94 | (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) | |
95 | (cond | |
96 | ||
97 | ;; Try first to match addresses that look like | |
98 | ;; thompson@wg2.waii.com (Jim Thompson) | |
99 | ((string-match ".*[ \t]+(\\(.*\\))" fromstring) | |
100 | (substring fromstring (match-beginning 1) (match-end 1))) | |
101 | ||
102 | ;; Next try to match addresses that look like | |
103 | ;; Jim Thompson <thompson@wg2.waii.com> or | |
104 | ;; "Jim Thompson" <thompson@wg2.waii.com> | |
105 | ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) | |
106 | (substring fromstring (match-beginning 2) (match-end 2))) | |
107 | ||
108 | ;; Couldn't find a real name -- show the address instead. | |
109 | (t fromstring))) | |
110 | "From ???"))) | |
111 | ||
112 | ;; A hook to bind to `gnus-article-prepare-hook'. This will set the | |
113 | ;; `ps-left-headers' specially for gnus articles. Unfortunately, | |
114 | ;; `gnus-article-mode-hook' is called only once, the first time the *Article* | |
115 | ;; buffer enters that mode, so it would only work for the first time | |
116 | ;; we ran gnus. The second time, this hook wouldn't get set up. The | |
117 | ;; only alternative is `gnus-article-prepare-hook'. | |
118 | (defun ps-gnus-article-prepare-hook () | |
119 | (setq ps-header-lines 3 | |
120 | ps-left-header | |
121 | ;; The left headers will display the article's subject, its | |
122 | ;; author, and the newsgroup it was in. | |
123 | '(ps-article-subject ps-article-author gnus-newsgroup-name))) | |
124 | ||
125 | ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the | |
126 | ;; `ps-left-headers' specially for mail messages. | |
127 | (defun ps-vm-mode-hook () | |
9e53076e | 128 | (local-set-key [(f22)] 'ps-vm-print-message-from-summary) |
c97a3f22 VJL |
129 | (setq ps-header-lines 3 |
130 | ps-left-header | |
131 | ;; The left headers will display the message's subject, its | |
132 | ;; author, and the name of the folder it was in. | |
133 | '(ps-article-subject ps-article-author buffer-name))) | |
134 | ||
135 | ;; Every now and then I forget to switch from the *Summary* buffer to | |
136 | ;; the *Article* before hitting prsc, and a nicely formatted list of | |
137 | ;; article subjects shows up at the printer. This function, bound to | |
138 | ;; prsc for the gnus *Summary* buffer means I don't have to switch | |
139 | ;; buffers first. | |
140 | ;; sb: Updated for Gnus 5. | |
141 | (defun ps-gnus-print-article-from-summary () | |
142 | (interactive) | |
143 | (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) | |
144 | ||
145 | ;; See `ps-gnus-print-article-from-summary'. This function does the | |
146 | ;; same thing for vm. | |
147 | (defun ps-vm-print-message-from-summary () | |
148 | (interactive) | |
149 | (ps-print-message-from-summary 'vm-mail-buffer "")) | |
150 | ||
151 | ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind | |
152 | ;; prsc. | |
153 | (defun ps-gnus-summary-setup () | |
9e53076e | 154 | (local-set-key [(f22)] 'ps-gnus-print-article-from-summary)) |
c97a3f22 VJL |
155 | |
156 | ;; Look in an article or mail message for the Subject: line. To be | |
157 | ;; placed in `ps-left-headers'. | |
158 | (defun ps-info-file () | |
159 | (save-excursion | |
160 | (goto-char (point-min)) | |
161 | (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) | |
162 | (buffer-substring (match-beginning 1) (match-end 1)) | |
163 | "File ???"))) | |
164 | ||
165 | ;; Look in an article or mail message for the Subject: line. To be | |
166 | ;; placed in `ps-left-headers'. | |
167 | (defun ps-info-node () | |
168 | (save-excursion | |
169 | (goto-char (point-min)) | |
170 | (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) | |
171 | (buffer-substring (match-beginning 1) (match-end 1)) | |
172 | "Node ???"))) | |
173 | ||
174 | (defun ps-info-mode-hook () | |
175 | (setq ps-left-header | |
176 | ;; The left headers will display the node name and file name. | |
177 | '(ps-info-node ps-info-file))) | |
178 | ||
179 | ;; WARNING! The following function is a *sample* only, and is *not* | |
180 | ;; meant to be used as a whole unless you understand what the effects | |
181 | ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- | |
182 | ;; I'd be very surprised if it was useful to *anybody*, without | |
183 | ;; modification.) | |
184 | ||
185 | (defun ps-jts-ps-setup () | |
9e53076e VJL |
186 | (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc |
187 | (global-set-key [(shift f22)] 'ps-spool-region-with-faces) | |
188 | (global-set-key [(control f22)] 'ps-despool) | |
c97a3f22 VJL |
189 | (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) |
190 | (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) | |
191 | (add-hook 'vm-mode-hook 'ps-vm-mode-hook) | |
192 | (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) | |
193 | (add-hook 'Info-mode-hook 'ps-info-mode-hook) | |
194 | (setq ps-spool-duplex t | |
195 | ps-print-color-p nil | |
196 | ps-lpr-command "lpr" | |
197 | ps-lpr-switches '("-Jjct,duplex_long")) | |
198 | 'ps-jts-ps-setup) | |
199 | ||
200 | ;; WARNING! The following function is a *sample* only, and is *not* | |
201 | ;; meant to be used as a whole unless it corresponds to your needs. | |
202 | ;; (In fact, this is a copy of Jack's setup for ps-print -- | |
203 | ;; I would not be that surprised if it was useful to *anybody*, | |
204 | ;; without modification.) | |
205 | ||
206 | (defun ps-jack-setup () | |
207 | (setq ps-print-color-p nil | |
208 | ps-lpr-command "lpr" | |
209 | ps-lpr-switches nil | |
210 | ||
211 | ps-paper-type 'a4 | |
212 | ps-landscape-mode t | |
213 | ps-number-of-columns 2 | |
214 | ||
215 | ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm | |
216 | ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm | |
217 | ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm | |
218 | ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm | |
219 | ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm | |
220 | ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm | |
221 | ps-header-line-pad .15 | |
222 | ps-print-header t | |
223 | ps-print-header-frame t | |
224 | ps-header-lines 2 | |
225 | ps-show-n-of-n t | |
226 | ps-spool-duplex nil | |
227 | ||
228 | ps-font-family 'Courier | |
229 | ps-font-size 5.5 | |
230 | ps-header-font-family 'Helvetica | |
231 | ps-header-font-size 6 | |
232 | ps-header-title-font-size 8) | |
233 | 'ps-jack-setup) | |
234 | ||
235 | \f | |
074a226b MA |
236 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
237 | ||
238 | ;; If zeroconf is enabled, all CUPS printers can be detected. The | |
239 | ;; "Postscript printer" menu will be modified dynamically, as printers | |
240 | ;; are added or removed. | |
241 | ||
242 | ;; Preconditions: | |
243 | ;; | |
244 | ;; * Emacs has D-Bus support enabled. That is, D-Bus is installed on | |
245 | ;; the system, and Emacs has been configured and built with the | |
246 | ;; --with-dbus option. | |
247 | ;; | |
248 | ;; * The zeroconf daemon avahi-daemon is running. | |
249 | ;; | |
250 | ;; * CUPS has enabled the option "Share published printers connected | |
251 | ;; to this system" (see <http://localhost:631/admin>). | |
252 | ||
253 | (eval-when-compile | |
254 | (require 'cl)) | |
255 | ||
256 | (eval-and-compile | |
257 | (require 'printing) | |
258 | (require 'zeroconf)) | |
259 | ||
260 | ;; Add a Postscript printer to the "Postscript printer" menu. | |
261 | (defun ps-add-printer (service) | |
262 | (let ((name (zeroconf-service-name service)) | |
263 | (text (zeroconf-service-txt service)) | |
264 | (addr (zeroconf-service-address service)) | |
265 | (port (zeroconf-service-port service)) | |
266 | is-ps cups-queue) | |
267 | ;; `text' is an array of key=value strings like ("Duplex=T" "Copies=T"). | |
268 | (dolist (string text) | |
269 | (let ((split (split-string string "=" t))) | |
270 | ;; If it is a Postscript printer, there must be a string like | |
271 | ;; "pdl=application/postscript,application/vnd.hp-PCL,...". | |
272 | (when (and (string-equal "pdl" (car split)) | |
273 | (string-match "application/postscript" (cadr split))) | |
274 | (setq is-ps t)) | |
275 | ;; A CUPS printer queue is coded as "rp=printers/<name>". | |
276 | (when (and (string-equal "rp" (car split)) | |
277 | (string-match "printers/\\(.+\\)" (cadr split))) | |
278 | (setq cups-queue (match-string 1 (cadr split)))))) | |
279 | ;; Add the printer. | |
280 | (when is-ps | |
281 | (if cups-queue | |
282 | (add-to-list | |
283 | 'pr-ps-printer-alist (list (intern name) "lpr" nil "-P" cups-queue)) | |
284 | ;; No CUPS printer, but a network printer. | |
285 | (add-to-list | |
286 | 'pr-ps-printer-alist (list (intern name) "cupsdoprint" | |
287 | '("-P" "default") | |
288 | "-H" (format "%s:%s" addr port)))) | |
289 | (pr-update-menus t)))) | |
290 | ||
291 | ;; Remove a printer from the "Postscript printer" menu. | |
292 | (defun ps-remove-printer (service) | |
293 | (setq pr-ps-printer-alist | |
294 | (delete (assoc (intern (zeroconf-service-name service)) | |
295 | pr-ps-printer-alist) | |
296 | pr-ps-printer-alist)) | |
297 | (pr-update-menus t)) | |
298 | ||
299 | ;; Activate the functions in zeroconf. | |
300 | (defun ps-make-dynamic-printer-menu () | |
301 | (when (featurep 'dbusbind) | |
302 | (zeroconf-init) | |
303 | (zeroconf-service-add-hook "_ipp._tcp" :new 'ps-add-printer) | |
304 | (zeroconf-service-add-hook "_ipp._tcp" :removed 'ps-remove-printer))) | |
305 | ||
306 | \f | |
c97a3f22 VJL |
307 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
308 | ||
309 | (provide 'ps-samp) | |
310 | ||
3fb6f73a | 311 | ;; arch-tag: 99c415d3-be39-43c6-aa32-7ee33ba19600 |
c97a3f22 | 312 | ;;; ps-samp.el ends here |