]> code.delx.au - gnu-emacs/blobdiff - lisp/ps-samp.el
(mailclient-send-it): Fix message.
[gnu-emacs] / lisp / ps-samp.el
index 67907e0a663f13f4b506e570a5bd4d74f1d26666..ce2429fe57c374dc848280d9574ece02b5ccd47c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ps-samp.el --- ps-print sample setup code
 
-;; Copyright (C) 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
 ;;     Jacques Duthen (was <duthen@cegelec-red.fr>)
@@ -9,24 +9,22 @@
 ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
 ;;     Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Keywords: wp, print, PostScript
-;; Version: 7.2
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify it under
-;; the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2, or (at your option) any later
-;; version.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
-;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-;; details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
 
-;; You should have received a copy of the GNU General Public License along with
-;; GNU Emacs; see the file COPYING.  If not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;; WARNING!!! The following code is *sample* code only.
 ;; Don't use it unless you understand what it does!
 
-(defmacro ps-prsc ()
-  `(if (featurep 'xemacs) 'f22           [f22]))
-(defmacro ps-c-prsc ()
-  `(if (featurep 'xemacs) '(control f22) [C-f22]))
-(defmacro ps-s-prsc ()
-  `(if (featurep 'xemacs) '(shift f22)   [S-f22]))
+;; The key `f22' should probably be replaced by `print'.  --Stef
 
 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
 ;; `ps-left-headers' specially for mail messages.
 (defun ps-rmail-mode-hook ()
-  (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
+  (local-set-key [(f22)] 'ps-rmail-print-message-from-summary)
   (setq ps-header-lines 3
        ps-left-header
        ;; The left headers will display the message's subject, its
 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
 ;; `ps-left-headers' specially for mail messages.
 (defun ps-vm-mode-hook ()
-  (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
+  (local-set-key [(f22)] 'ps-vm-print-message-from-summary)
   (setq ps-header-lines 3
        ps-left-header
        ;; The left headers will display the message's subject, its
 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
 ;; prsc.
 (defun ps-gnus-summary-setup ()
-  (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
+  (local-set-key [(f22)] 'ps-gnus-print-article-from-summary))
 
 ;; Look in an article or mail message for the Subject: line.  To be
 ;; placed in `ps-left-headers'.
 ;; modification.)
 
 (defun ps-jts-ps-setup ()
-  (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
-  (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
-  (global-set-key (ps-c-prsc) 'ps-despool)
+  (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc
+  (global-set-key [(shift f22)] 'ps-spool-region-with-faces)
+  (global-set-key [(control f22)] 'ps-despool)
   (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
   (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
   (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;; If zeroconf is enabled, all CUPS printers can be detected.  The
+;; "Postscript printer" menu will be modified dynamically, as printers
+;; are added or removed.
+
+;; Preconditions:
+;;
+;; * Emacs has D-Bus support enabled.  That is, D-Bus is installed on
+;;   the system, and Emacs has been configured and built with the
+;;   --with-dbus option.
+;;
+;; * The zeroconf daemon avahi-daemon is running.
+;;
+;; * CUPS has enabled the option "Share published printers connected
+;;   to this system" (see <http://localhost:631/admin>).
+
+(eval-when-compile
+  (require 'cl))
+
+(eval-and-compile
+  (require 'printing)
+  (require 'zeroconf))
+
+;; Add a Postscript printer to the "Postscript printer" menu.
+(defun ps-add-printer (service)
+  (let ((name (zeroconf-service-name service))
+       (text (zeroconf-service-txt service))
+       (addr (zeroconf-service-address service))
+       (port (zeroconf-service-port service))
+       is-ps cups-queue)
+    ;; `text' is an array of key=value strings like ("Duplex=T" "Copies=T").
+    (dolist (string text)
+      (let ((split (split-string string "=" t)))
+       ;; If it is a Postscript printer, there must be a string like
+       ;; "pdl=application/postscript,application/vnd.hp-PCL,...".
+       (when (and (string-equal "pdl" (car split))
+                  (string-match "application/postscript" (cadr split)))
+         (setq is-ps t))
+       ;; A CUPS printer queue is coded as "rp=printers/<name>".
+       (when (and (string-equal "rp" (car split))
+                  (string-match "printers/\\(.+\\)" (cadr split)))
+         (setq cups-queue (match-string 1 (cadr split))))))
+    ;; Add the printer.
+    (when is-ps
+      (if cups-queue
+         (add-to-list
+          'pr-ps-printer-alist (list (intern name) "lpr" nil "-P" cups-queue))
+       ;; No CUPS printer, but a network printer.
+       (add-to-list
+        'pr-ps-printer-alist (list (intern name) "cupsdoprint"
+                                   '("-P" "default")
+                                   "-H" (format "%s:%s" addr port))))
+      (pr-update-menus t))))
+
+;; Remove a printer from the "Postscript printer" menu.
+(defun ps-remove-printer (service)
+  (setq pr-ps-printer-alist
+       (delete (assoc (intern (zeroconf-service-name service))
+                      pr-ps-printer-alist)
+               pr-ps-printer-alist))
+  (pr-update-menus t))
+
+;; Activate the functions in zeroconf.
+(defun ps-make-dynamic-printer-menu ()
+  (when (featurep 'dbusbind)
+    (zeroconf-init)
+    (zeroconf-service-add-hook "_ipp._tcp" :new 'ps-add-printer)
+    (zeroconf-service-add-hook "_ipp._tcp" :removed 'ps-remove-printer)))
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (provide 'ps-samp)
 
 ;; arch-tag: 99c415d3-be39-43c6-aa32-7ee33ba19600