Moved to scheme/
Showing
1 changed file
with
0 additions
and
80 deletions
examples/reply.scm
deleted
100644 → 0
1 | ;;;; GNU Mailutils -- a suite of utilities for electronic mail | ||
2 | ;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. | ||
3 | ;;;; | ||
4 | ;;;; GNU Mailutils is free software; you can redistribute it and/or modify | ||
5 | ;;;; it under the terms of the GNU General Public License as published by | ||
6 | ;;;; the Free Software Foundation; either version 2, or (at your option) | ||
7 | ;;;; any later version. | ||
8 | ;;;; | ||
9 | ;;;; GNU Mailutils is distributed in the hope that it will be useful, | ||
10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
12 | ;;;; GNU General Public License for more details. | ||
13 | ;;;; | ||
14 | ;;;; You should have received a copy of the GNU General Public License | ||
15 | ;;;; along with GNU Mailutils; if not, write to the Free Software | ||
16 | ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
17 | |||
18 | ;;; This is a simple Guile program that generates automatic reply to | ||
19 | ;;; incoming mail messages. | ||
20 | ;;; | ||
21 | ;;; usage: to your /etc/aliases add: | ||
22 | ;;; | ||
23 | ;;; username: "|/usr/local/bin/guimb -f <path>/reply.scm" | ||
24 | ;;; | ||
25 | ;;; and adjust variables below to your liking. | ||
26 | ;;; Any message to the address username@your.host will be responded | ||
27 | ;;; and (optionally) saved in a mailbox. | ||
28 | |||
29 | (define indent-prefix "> ") | ||
30 | (define save-mailbox #f) | ||
31 | (define reply-text | ||
32 | "Sorry, I am not here to attend your message. I will do\n\ | ||
33 | it as soon as I come back.\n\n\ | ||
34 | Kind regards\n") | ||
35 | |||
36 | ;; Reply to the incoming message | ||
37 | (define (reply in-msg) | ||
38 | (let* ((out-msg (mu-message-create)) | ||
39 | (in-port (mu-message-get-port in-msg "r")) | ||
40 | (out-port (mu-message-get-port out-msg "w"))) | ||
41 | (mu-message-set-header out-msg "To" | ||
42 | (mu-message-get-header in-msg "From")) | ||
43 | (mu-message-set-header out-msg "Cc" | ||
44 | (mu-message-get-header in-msg "Cc")) | ||
45 | (mu-message-set-header out-msg "Subject" | ||
46 | (string-append | ||
47 | "Re: " | ||
48 | (mu-message-get-header in-msg "Subject"))) | ||
49 | |||
50 | (display reply-text out-port) | ||
51 | |||
52 | (display "\n\nOriginal message:\n" out-port) | ||
53 | (do ((hdr (mu-message-get-header-fields in-msg) (cdr hdr))) | ||
54 | ((null? hdr) #f) | ||
55 | (let ((s (car hdr))) | ||
56 | (display (string-append | ||
57 | indent-prefix | ||
58 | (car s) ": " (cdr s) "\n") out-port))) | ||
59 | (display (string-append indent-prefix "\n") out-port) | ||
60 | (do ((line (read-line in-port) (read-line in-port))) | ||
61 | ((eof-object? line) #f) | ||
62 | (display (string-append indent-prefix line "\n") out-port)) | ||
63 | |||
64 | (close-input-port in-port) | ||
65 | (close-output-port out-port) | ||
66 | |||
67 | (mu-message-send out-msg))) | ||
68 | |||
69 | ;;; Upon receiving a message, store it away in the save mailbox and | ||
70 | ;;; reply to the sender. | ||
71 | (let ((mbox (and save-mailbox (mu-mailbox-open save-mailbox "cw"))) | ||
72 | (msg (mu-mailbox-get-message current-mailbox 1))) | ||
73 | (cond | ||
74 | (mbox | ||
75 | (mu-mailbox-append-message mbox msg) | ||
76 | (mu-mailbox-close mbox))) | ||
77 | (reply msg)) | ||
78 | |||
79 | |||
80 | |||
... | \ No newline at end of file | ... | \ No newline at end of file |
-
Please register or sign in to post a comment