| 1 | ;;; ps-samp.el --- ps-print sample setup code |
| 2 | |
| 3 | ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. |
| 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 |
| 12 | ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre |
| 13 | ;; Package: ps-print |
| 14 | |
| 15 | ;; This file is part of GNU Emacs. |
| 16 | |
| 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/>. |
| 29 | |
| 30 | ;;; Commentary: |
| 31 | |
| 32 | ;; See ps-print.el for documentation. |
| 33 | |
| 34 | ;;; Code: |
| 35 | |
| 36 | |
| 37 | (require 'ps-print) |
| 38 | |
| 39 | \f |
| 40 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 41 | ;;; Sample Setup Code: |
| 42 | |
| 43 | |
| 44 | ;; This stuff is for anybody that's brave enough to look this far, |
| 45 | ;; and able to figure out how to use it. It isn't really part of |
| 46 | ;; ps-print, but I'll leave it here in hopes it might be useful: |
| 47 | |
| 48 | ;; WARNING!!! The following code is *sample* code only. |
| 49 | ;; Don't use it unless you understand what it does! |
| 50 | |
| 51 | ;; The key `f22' should probably be replaced by `print'. --Stef |
| 52 | |
| 53 | ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the |
| 54 | ;; `ps-left-headers' specially for mail messages. |
| 55 | (defun ps-rmail-mode-hook () |
| 56 | (local-set-key [(f22)] 'ps-rmail-print-message-from-summary) |
| 57 | (setq ps-header-lines 3 |
| 58 | ps-left-header |
| 59 | ;; The left headers will display the message's subject, its |
| 60 | ;; author, and the name of the folder it was in. |
| 61 | '(ps-article-subject ps-article-author buffer-name))) |
| 62 | |
| 63 | ;; See `ps-gnus-print-article-from-summary'. This function does the |
| 64 | ;; same thing for rmail. |
| 65 | (defun ps-rmail-print-message-from-summary () |
| 66 | (interactive) |
| 67 | (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) |
| 68 | |
| 69 | ;; Used in `ps-rmail-print-article-from-summary', |
| 70 | ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'. |
| 71 | (defun ps-print-message-from-summary (summary-buffer summary-default) |
| 72 | (let ((ps-buf (or (and (boundp summary-buffer) |
| 73 | (symbol-value summary-buffer)) |
| 74 | summary-default))) |
| 75 | (and (get-buffer ps-buf) |
| 76 | (with-current-buffer ps-buf |
| 77 | (ps-spool-buffer-with-faces))))) |
| 78 | |
| 79 | ;; Look in an article or mail message for the Subject: line. To be |
| 80 | ;; placed in `ps-left-headers'. |
| 81 | (defun ps-article-subject () |
| 82 | (save-excursion |
| 83 | (goto-char (point-min)) |
| 84 | (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) |
| 85 | (buffer-substring (match-beginning 1) (match-end 1)) |
| 86 | "Subject ???"))) |
| 87 | |
| 88 | ;; Look in an article or mail message for the From: line. Sorta-kinda |
| 89 | ;; understands RFC-822 addresses and can pull the real name out where |
| 90 | ;; it's provided. To be placed in `ps-left-headers'. |
| 91 | (defun ps-article-author () |
| 92 | (save-excursion |
| 93 | (goto-char (point-min)) |
| 94 | (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) |
| 95 | (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) |
| 96 | (cond |
| 97 | |
| 98 | ;; Try first to match addresses that look like |
| 99 | ;; thompson@wg2.waii.com (Jim Thompson) |
| 100 | ((string-match ".*[ \t]+(\\(.*\\))" fromstring) |
| 101 | (substring fromstring (match-beginning 1) (match-end 1))) |
| 102 | |
| 103 | ;; Next try to match addresses that look like |
| 104 | ;; Jim Thompson <thompson@wg2.waii.com> or |
| 105 | ;; "Jim Thompson" <thompson@wg2.waii.com> |
| 106 | ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) |
| 107 | (substring fromstring (match-beginning 2) (match-end 2))) |
| 108 | |
| 109 | ;; Couldn't find a real name -- show the address instead. |
| 110 | (t fromstring))) |
| 111 | "From ???"))) |
| 112 | |
| 113 | ;; A hook to bind to `gnus-article-prepare-hook'. This will set the |
| 114 | ;; `ps-left-headers' specially for gnus articles. Unfortunately, |
| 115 | ;; `gnus-article-mode-hook' is called only once, the first time the *Article* |
| 116 | ;; buffer enters that mode, so it would only work for the first time |
| 117 | ;; we ran gnus. The second time, this hook wouldn't get set up. The |
| 118 | ;; only alternative is `gnus-article-prepare-hook'. |
| 119 | (defun ps-gnus-article-prepare-hook () |
| 120 | (setq ps-header-lines 3 |
| 121 | ps-left-header |
| 122 | ;; The left headers will display the article's subject, its |
| 123 | ;; author, and the newsgroup it was in. |
| 124 | '(ps-article-subject ps-article-author gnus-newsgroup-name))) |
| 125 | |
| 126 | ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the |
| 127 | ;; `ps-left-headers' specially for mail messages. |
| 128 | (defun ps-vm-mode-hook () |
| 129 | (local-set-key [(f22)] 'ps-vm-print-message-from-summary) |
| 130 | (setq ps-header-lines 3 |
| 131 | ps-left-header |
| 132 | ;; The left headers will display the message's subject, its |
| 133 | ;; author, and the name of the folder it was in. |
| 134 | '(ps-article-subject ps-article-author buffer-name))) |
| 135 | |
| 136 | ;; Every now and then I forget to switch from the *Summary* buffer to |
| 137 | ;; the *Article* before hitting prsc, and a nicely formatted list of |
| 138 | ;; article subjects shows up at the printer. This function, bound to |
| 139 | ;; prsc for the gnus *Summary* buffer means I don't have to switch |
| 140 | ;; buffers first. |
| 141 | ;; sb: Updated for Gnus 5. |
| 142 | (defun ps-gnus-print-article-from-summary () |
| 143 | (interactive) |
| 144 | (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) |
| 145 | |
| 146 | ;; See `ps-gnus-print-article-from-summary'. This function does the |
| 147 | ;; same thing for vm. |
| 148 | (defun ps-vm-print-message-from-summary () |
| 149 | (interactive) |
| 150 | (ps-print-message-from-summary 'vm-mail-buffer "")) |
| 151 | |
| 152 | ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind |
| 153 | ;; prsc. |
| 154 | (defun ps-gnus-summary-setup () |
| 155 | (local-set-key [(f22)] 'ps-gnus-print-article-from-summary)) |
| 156 | |
| 157 | ;; Look in an article or mail message for the Subject: line. To be |
| 158 | ;; placed in `ps-left-headers'. |
| 159 | (defun ps-info-file () |
| 160 | (save-excursion |
| 161 | (goto-char (point-min)) |
| 162 | (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) |
| 163 | (buffer-substring (match-beginning 1) (match-end 1)) |
| 164 | "File ???"))) |
| 165 | |
| 166 | ;; Look in an article or mail message for the Subject: line. To be |
| 167 | ;; placed in `ps-left-headers'. |
| 168 | (defun ps-info-node () |
| 169 | (save-excursion |
| 170 | (goto-char (point-min)) |
| 171 | (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) |
| 172 | (buffer-substring (match-beginning 1) (match-end 1)) |
| 173 | "Node ???"))) |
| 174 | |
| 175 | (defun ps-info-mode-hook () |
| 176 | (setq ps-left-header |
| 177 | ;; The left headers will display the node name and file name. |
| 178 | '(ps-info-node ps-info-file))) |
| 179 | |
| 180 | ;; WARNING! The following function is a *sample* only, and is *not* |
| 181 | ;; meant to be used as a whole unless you understand what the effects |
| 182 | ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- |
| 183 | ;; I'd be very surprised if it was useful to *anybody*, without |
| 184 | ;; modification.) |
| 185 | |
| 186 | (defun ps-jts-ps-setup () |
| 187 | (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc |
| 188 | (global-set-key [(shift f22)] 'ps-spool-region-with-faces) |
| 189 | (global-set-key [(control f22)] 'ps-despool) |
| 190 | (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) |
| 191 | (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) |
| 192 | (add-hook 'vm-mode-hook 'ps-vm-mode-hook) |
| 193 | (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) |
| 194 | (add-hook 'Info-mode-hook 'ps-info-mode-hook) |
| 195 | (setq ps-spool-duplex t |
| 196 | ps-print-color-p nil |
| 197 | ps-lpr-command "lpr" |
| 198 | ps-lpr-switches '("-Jjct,duplex_long")) |
| 199 | 'ps-jts-ps-setup) |
| 200 | |
| 201 | ;; WARNING! The following function is a *sample* only, and is *not* |
| 202 | ;; meant to be used as a whole unless it corresponds to your needs. |
| 203 | ;; (In fact, this is a copy of Jack's setup for ps-print -- |
| 204 | ;; I would not be that surprised if it was useful to *anybody*, |
| 205 | ;; without modification.) |
| 206 | |
| 207 | (defun ps-jack-setup () |
| 208 | (setq ps-print-color-p nil |
| 209 | ps-lpr-command "lpr" |
| 210 | ps-lpr-switches nil |
| 211 | |
| 212 | ps-paper-type 'a4 |
| 213 | ps-landscape-mode t |
| 214 | ps-number-of-columns 2 |
| 215 | |
| 216 | ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm |
| 217 | ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm |
| 218 | ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm |
| 219 | ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm |
| 220 | ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm |
| 221 | ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm |
| 222 | ps-header-line-pad .15 |
| 223 | ps-print-header t |
| 224 | ps-print-header-frame t |
| 225 | ps-header-lines 2 |
| 226 | ps-show-n-of-n t |
| 227 | ps-spool-duplex nil |
| 228 | |
| 229 | ps-font-family 'Courier |
| 230 | ps-font-size 5.5 |
| 231 | ps-header-font-family 'Helvetica |
| 232 | ps-header-font-size 6 |
| 233 | ps-header-title-font-size 8) |
| 234 | 'ps-jack-setup) |
| 235 | |
| 236 | \f |
| 237 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 238 | |
| 239 | ;; If zeroconf is enabled, all CUPS printers can be detected. The |
| 240 | ;; "Postscript printer" menu will be modified dynamically, as printers |
| 241 | ;; are added or removed. |
| 242 | |
| 243 | ;; Preconditions: |
| 244 | ;; |
| 245 | ;; * Emacs has D-Bus support enabled. That is, D-Bus is installed on |
| 246 | ;; the system, and Emacs has been configured and built with the |
| 247 | ;; --with-dbus option. |
| 248 | ;; |
| 249 | ;; * The zeroconf daemon avahi-daemon is running. |
| 250 | ;; |
| 251 | ;; * CUPS has enabled the option "Share published printers connected |
| 252 | ;; to this system" (see <http://localhost:631/admin>). |
| 253 | |
| 254 | (eval-when-compile |
| 255 | (require 'cl)) |
| 256 | |
| 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 |
| 307 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 308 | |
| 309 | (provide 'ps-samp) |
| 310 | |
| 311 | ;;; ps-samp.el ends here |