lisp/ps-samp.el

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