1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
;;; gnus-mh.el --- mh-e interface for Gnus
;; Copyright (C) 1994,95 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
;; 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 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Send mail using mh-e.
;; The following mh-e interface is all cooperative works of
;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
;; SHINGU).
;;; Code:
(require 'mh-e)
(require 'mh-comp)
(require 'gnus)
(require 'gnus-msg)
(defun gnus-summary-save-article-folder (&optional arg)
"Append the current article to an mh folder.
If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
(let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
(gnus-summary-save-article arg)))
(defun gnus-summary-save-in-folder (&optional folder)
"Save this article to MH folder (using `rcvstore' in MH library).
Optional argument FOLDER specifies folder name."
;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
(mh-find-path)
(let ((folder
(or folder
(mh-prompt-for-folder
"Save article in"
(funcall gnus-folder-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-folder)
t)))
(errbuf (get-buffer-create " *Gnus rcvstore*")))
(gnus-eval-in-buffer-window
gnus-article-buffer
(save-restriction
(widen)
(unwind-protect
(call-process-region (point-min) (point-max)
(expand-file-name "rcvstore" mh-lib)
nil errbuf nil folder)
(set-buffer errbuf)
(if (zerop (buffer-size))
(message "Article saved in folder: %s" folder)
(message "%s" (buffer-string)))
(kill-buffer errbuf))))
(setq gnus-newsgroup-last-folder folder)))
(defun gnus-mail-reply-using-mhe (&optional yank)
"Compose reply mail using mh-e.
Optional argument YANK means yank original article.
The command \\[mh-yank-cur-msg] yank the original message into current buffer."
(let (from cc subject date to reply-to to-userid orig-to
references message-id
(config (current-window-configuration))
buffer)
(pop-to-buffer gnus-article-buffer)
(setq buffer (current-buffer))
(save-excursion
(save-restriction
(or gnus-user-login-name ; we need this
(setq gnus-user-login-name (or (getenv "USER")
(getenv "LOGNAME"))))
(gnus-article-show-all-headers);; so colors are happy
;; lots of junk to avoid mh-send deleting other windows
(setq from (or (gnus-fetch-field "from") "")
subject (let ((subject (or (gnus-fetch-field "subject")
"(None)")))
(if (and subject
(not (string-match "^[Rr][Ee]:.+$" subject)))
(concat "Re: " subject) subject))
reply-to (gnus-fetch-field "reply-to")
cc (gnus-fetch-field "cc")
orig-to (or (gnus-fetch-field "to") "")
date (gnus-fetch-field "date")
references (gnus-fetch-field "references")
message-id (gnus-fetch-field "message-id"))
(setq to (or reply-to from))
(setq to-userid (mail-strip-quoted-names orig-to))
(if (or (string-match "," orig-to)
(not (string-match (substring to-userid 0
(string-match "@" to-userid))
gnus-user-login-name)))
(setq cc (concat (if cc (concat cc ", ") "") orig-to)))
;; mh-yank-cur-msg needs to have mh-show-buffer set in the
;; *Article* buffer
(setq mh-show-buffer buffer)))
(mh-find-path)
(mh-send-sub (or to "") (or cc "")
(or subject "(None)") config);; Erik Selberg 1/23/94
(let ((draft (current-buffer))
(gnus-mail-buffer (current-buffer))
mail-buf)
(if (not yank)
(gnus-configure-windows 'reply 'force)
(gnus-configure-windows 'reply-yank 'force))
(setq mail-buf gnus-mail-buffer)
(pop-to-buffer mail-buf);; always in the display, so won't have window probs
(switch-to-buffer draft))
;; (mh-send to (or cc "") subject);; shouldn't use according to mhe
;; note - current buffer is now draft!
(save-excursion
(mh-insert-fields
"In-reply-to:"
(concat
(substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from))
"'s message of " date))
(nnheader-insert-references references message-id))
;; need this for mh-yank-cur-msg
(setq mh-sent-from-folder buffer)
(setq mh-sent-from-msg 1)
(setq mh-show-buffer buffer)
(setq mh-previous-window-config config))
;; Then, yank original article if requested.
(if yank
(let ((last (point)))
(mh-yank-cur-msg)
(goto-char last)))
(run-hooks 'gnus-mail-hook))
;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh
;; <itojun@ingram.mt.cs.keio.ac.jp>
(defun gnus-mail-forward-using-mhe (&optional buffer)
"Forward the current message to another user using mh-e."
;; First of all, prepare mhe mail buffer.
(let* ((to (read-string "To: "))
(cc (read-string "Cc: "))
(buffer (or buffer gnus-article-buffer))
(config (current-window-configuration));; need to add this - erik
(subject (gnus-forward-make-subject buffer)))
(setq mh-show-buffer buffer)
(mh-find-path)
(mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94
(let ((draft (current-buffer))
(gnus-mail-buffer (current-buffer))
mail-buf)
(gnus-configure-windows 'reply-yank 'force)
(setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer))))
(pop-to-buffer mail-buf);; always in the display, so won't have window probs
(switch-to-buffer draft)
)
(save-excursion
(goto-char (point-max))
(insert "\n------- Forwarded Message\n\n")
(insert-buffer buffer)
(goto-char (point-max))
(insert "\n------- End of Forwarded Message\n")
(setq mh-sent-from-folder buffer)
(setq mh-sent-from-msg 1)
(setq mh-previous-window-config config)
(run-hooks 'gnus-mail-hook)
)))
(defun gnus-mail-other-window-using-mhe ()
"Compose mail other window using mh-e."
(let ((to (read-string "To: "))
(cc (read-string "Cc: "))
(subject (read-string "Subject: ")))
(gnus-article-show-all-headers) ;I don't think this is really needed.
(setq mh-show-buffer (current-buffer))
(mh-find-path)
(mh-send-other-window to cc subject)
(setq mh-sent-from-folder (current-buffer))
(setq mh-sent-from-msg 1)
(run-hooks 'gnus-mail-hook)))
(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +News.group.
Otherwise, it is like +news/group."
(or last-folder
(concat "+"
(if gnus-use-long-file-name
(gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup)))))
(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +news.group.
Otherwise, it is like +news/group."
(or last-folder
(concat "+"
(if gnus-use-long-file-name
newsgroup
(gnus-newsgroup-directory-form newsgroup)))))
;;; gnus-mh.el ends here
|
