Mercurial > emacs
comparison lisp/ps-samp.el @ 90736:ef1369583937
Split XEmacs/Emacs definitions and sample setup code into separate files
author | Vinicius Jose Latorre <viniciusjl@ig.com.br> |
---|---|
date | Fri, 26 Jan 2007 02:30:28 +0000 |
parents | |
children | a77c806ee80a |
comparison
equal
deleted
inserted
replaced
90735:be5c45687c00 | 90736:ef1369583937 |
---|---|
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 | |
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 | |
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 (defmacro ps-prsc () | |
53 `(if (featurep 'xemacs) 'f22 [f22])) | |
54 (defmacro ps-c-prsc () | |
55 `(if (featurep 'xemacs) '(control f22) [C-f22])) | |
56 (defmacro ps-s-prsc () | |
57 `(if (featurep 'xemacs) '(shift f22) [S-f22])) | |
58 | |
59 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the | |
60 ;; `ps-left-headers' specially for mail messages. | |
61 (defun ps-rmail-mode-hook () | |
62 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary) | |
63 (setq ps-header-lines 3 | |
64 ps-left-header | |
65 ;; The left headers will display the message's subject, its | |
66 ;; author, and the name of the folder it was in. | |
67 '(ps-article-subject ps-article-author buffer-name))) | |
68 | |
69 ;; See `ps-gnus-print-article-from-summary'. This function does the | |
70 ;; same thing for rmail. | |
71 (defun ps-rmail-print-message-from-summary () | |
72 (interactive) | |
73 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) | |
74 | |
75 ;; Used in `ps-rmail-print-article-from-summary', | |
76 ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'. | |
77 (defun ps-print-message-from-summary (summary-buffer summary-default) | |
78 (let ((ps-buf (or (and (boundp summary-buffer) | |
79 (symbol-value summary-buffer)) | |
80 summary-default))) | |
81 (and (get-buffer ps-buf) | |
82 (save-excursion | |
83 (set-buffer ps-buf) | |
84 (ps-spool-buffer-with-faces))))) | |
85 | |
86 ;; Look in an article or mail message for the Subject: line. To be | |
87 ;; placed in `ps-left-headers'. | |
88 (defun ps-article-subject () | |
89 (save-excursion | |
90 (goto-char (point-min)) | |
91 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) | |
92 (buffer-substring (match-beginning 1) (match-end 1)) | |
93 "Subject ???"))) | |
94 | |
95 ;; Look in an article or mail message for the From: line. Sorta-kinda | |
96 ;; understands RFC-822 addresses and can pull the real name out where | |
97 ;; it's provided. To be placed in `ps-left-headers'. | |
98 (defun ps-article-author () | |
99 (save-excursion | |
100 (goto-char (point-min)) | |
101 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) | |
102 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) | |
103 (cond | |
104 | |
105 ;; Try first to match addresses that look like | |
106 ;; thompson@wg2.waii.com (Jim Thompson) | |
107 ((string-match ".*[ \t]+(\\(.*\\))" fromstring) | |
108 (substring fromstring (match-beginning 1) (match-end 1))) | |
109 | |
110 ;; Next try to match addresses that look like | |
111 ;; Jim Thompson <thompson@wg2.waii.com> or | |
112 ;; "Jim Thompson" <thompson@wg2.waii.com> | |
113 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) | |
114 (substring fromstring (match-beginning 2) (match-end 2))) | |
115 | |
116 ;; Couldn't find a real name -- show the address instead. | |
117 (t fromstring))) | |
118 "From ???"))) | |
119 | |
120 ;; A hook to bind to `gnus-article-prepare-hook'. This will set the | |
121 ;; `ps-left-headers' specially for gnus articles. Unfortunately, | |
122 ;; `gnus-article-mode-hook' is called only once, the first time the *Article* | |
123 ;; buffer enters that mode, so it would only work for the first time | |
124 ;; we ran gnus. The second time, this hook wouldn't get set up. The | |
125 ;; only alternative is `gnus-article-prepare-hook'. | |
126 (defun ps-gnus-article-prepare-hook () | |
127 (setq ps-header-lines 3 | |
128 ps-left-header | |
129 ;; The left headers will display the article's subject, its | |
130 ;; author, and the newsgroup it was in. | |
131 '(ps-article-subject ps-article-author gnus-newsgroup-name))) | |
132 | |
133 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the | |
134 ;; `ps-left-headers' specially for mail messages. | |
135 (defun ps-vm-mode-hook () | |
136 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary) | |
137 (setq ps-header-lines 3 | |
138 ps-left-header | |
139 ;; The left headers will display the message's subject, its | |
140 ;; author, and the name of the folder it was in. | |
141 '(ps-article-subject ps-article-author buffer-name))) | |
142 | |
143 ;; Every now and then I forget to switch from the *Summary* buffer to | |
144 ;; the *Article* before hitting prsc, and a nicely formatted list of | |
145 ;; article subjects shows up at the printer. This function, bound to | |
146 ;; prsc for the gnus *Summary* buffer means I don't have to switch | |
147 ;; buffers first. | |
148 ;; sb: Updated for Gnus 5. | |
149 (defun ps-gnus-print-article-from-summary () | |
150 (interactive) | |
151 (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) | |
152 | |
153 ;; See `ps-gnus-print-article-from-summary'. This function does the | |
154 ;; same thing for vm. | |
155 (defun ps-vm-print-message-from-summary () | |
156 (interactive) | |
157 (ps-print-message-from-summary 'vm-mail-buffer "")) | |
158 | |
159 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind | |
160 ;; prsc. | |
161 (defun ps-gnus-summary-setup () | |
162 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary)) | |
163 | |
164 ;; Look in an article or mail message for the Subject: line. To be | |
165 ;; placed in `ps-left-headers'. | |
166 (defun ps-info-file () | |
167 (save-excursion | |
168 (goto-char (point-min)) | |
169 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) | |
170 (buffer-substring (match-beginning 1) (match-end 1)) | |
171 "File ???"))) | |
172 | |
173 ;; Look in an article or mail message for the Subject: line. To be | |
174 ;; placed in `ps-left-headers'. | |
175 (defun ps-info-node () | |
176 (save-excursion | |
177 (goto-char (point-min)) | |
178 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) | |
179 (buffer-substring (match-beginning 1) (match-end 1)) | |
180 "Node ???"))) | |
181 | |
182 (defun ps-info-mode-hook () | |
183 (setq ps-left-header | |
184 ;; The left headers will display the node name and file name. | |
185 '(ps-info-node ps-info-file))) | |
186 | |
187 ;; WARNING! The following function is a *sample* only, and is *not* | |
188 ;; meant to be used as a whole unless you understand what the effects | |
189 ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- | |
190 ;; I'd be very surprised if it was useful to *anybody*, without | |
191 ;; modification.) | |
192 | |
193 (defun ps-jts-ps-setup () | |
194 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc | |
195 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces) | |
196 (global-set-key (ps-c-prsc) 'ps-despool) | |
197 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) | |
198 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) | |
199 (add-hook 'vm-mode-hook 'ps-vm-mode-hook) | |
200 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) | |
201 (add-hook 'Info-mode-hook 'ps-info-mode-hook) | |
202 (setq ps-spool-duplex t | |
203 ps-print-color-p nil | |
204 ps-lpr-command "lpr" | |
205 ps-lpr-switches '("-Jjct,duplex_long")) | |
206 'ps-jts-ps-setup) | |
207 | |
208 ;; WARNING! The following function is a *sample* only, and is *not* | |
209 ;; meant to be used as a whole unless it corresponds to your needs. | |
210 ;; (In fact, this is a copy of Jack's setup for ps-print -- | |
211 ;; I would not be that surprised if it was useful to *anybody*, | |
212 ;; without modification.) | |
213 | |
214 (defun ps-jack-setup () | |
215 (setq ps-print-color-p nil | |
216 ps-lpr-command "lpr" | |
217 ps-lpr-switches nil | |
218 | |
219 ps-paper-type 'a4 | |
220 ps-landscape-mode t | |
221 ps-number-of-columns 2 | |
222 | |
223 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm | |
224 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm | |
225 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm | |
226 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm | |
227 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm | |
228 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm | |
229 ps-header-line-pad .15 | |
230 ps-print-header t | |
231 ps-print-header-frame t | |
232 ps-header-lines 2 | |
233 ps-show-n-of-n t | |
234 ps-spool-duplex nil | |
235 | |
236 ps-font-family 'Courier | |
237 ps-font-size 5.5 | |
238 ps-header-font-family 'Helvetica | |
239 ps-header-font-size 6 | |
240 ps-header-title-font-size 8) | |
241 'ps-jack-setup) | |
242 | |
243 | |
244 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
245 | |
246 (provide 'ps-samp) | |
247 | |
248 ;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579 | |
249 ;;; ps-samp.el ends here |