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