Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hrmail.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Brown U. 9 ;; ORG: Brown U.
10 ;; 10 ;;
11 ;; ORIG-DATE: 9-May-91 at 04:22:02 11 ;; ORIG-DATE: 9-May-91 at 04:22:02
12 ;; LAST-MOD: 14-Feb-97 at 11:38:57 by Bob Weiner 12 ;; LAST-MOD: 19-May-95 at 15:09:04 by Bob Weiner
13 ;; 13 ;;
14 ;; This file is part of Hyperbole. 14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs. 15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;; 16 ;;
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc. 17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
20 ;; DESCRIPTION: 20 ;; DESCRIPTION:
21 ;; 21 ;;
22 ;; Automatically configured for use in "hyperbole.el". 22 ;; Automatically configured for use in "hyperbole.el".
23 ;; If hsite loading fails prior to initializing Hyperbole Rmail support, 23 ;; If hsite loading fails prior to initializing Hyperbole Rmail support,
24 ;; 24 ;;
25 ;; {M-x Rmail-init RET} 25 ;; {M-x Rmail-init RTN}
26 ;; 26 ;;
27 ;; will do it. 27 ;; will do it.
28 ;; 28 ;;
29 ;; DESCRIP-END. 29 ;; DESCRIP-END.
30 30
214 (setq buffer-read-only t)) 214 (setq buffer-read-only t))
215 215
216 216
217 ;;; Overlay version of this function from "rmail.el" to include any 217 ;;; Overlay version of this function from "rmail.el" to include any
218 ;;; Hyperbole button data. 218 ;;; Hyperbole button data.
219 (defun rmail-forward (resend) 219 (defun rmail-forward (&optional resend)
220 "Forward the current message to another user. 220 "Forward the current message to another user."
221 With prefix argument, \"resend\" the message instead of forwarding it; 221 (interactive)
222 see the documentation of `rmail-resend'." 222 ;; Resend argument is ignored but for now but is there for Emacs V19 call
223 (interactive "P") 223 ;; compatibility.
224 (if resend 224 ;;>> this gets set even if we abort. Can't do anything about it, though.
225 (call-interactively 'rmail-resend) 225 (rmail-set-attribute "forwarded" t)
226 (let ((forward-buffer (current-buffer)) 226 (let ((forward-buffer (current-buffer))
227 (subject (concat "[" 227 (subject (concat "["
228 (let ((from (or (mail-fetch-field "From") 228 (mail-strip-quoted-names (mail-fetch-field "From"))
229 (mail-fetch-field ">From")))) 229 ": " (or (mail-fetch-field "Subject") "") "]")))
230 (if from 230 (save-restriction
231 (concat (mail-strip-quoted-names from) ": ") 231 (Rmail-msg-widen)
232 "")) 232 ;; If only one window, use it for the mail buffer.
233 (or (mail-fetch-field "Subject") "") 233 ;; Otherwise, use another window for the mail buffer
234 "]"))) 234 ;; so that the Rmail buffer remains visible
235 (save-restriction 235 ;; and sending the mail will get back to it.
236 (Rmail-msg-widen) 236 (if (if (one-window-p t)
237 ;; Turn off the usual actions for initializing the message body 237 (mail nil nil subject)
238 ;; because we want to get only the text from the failure message. 238 (mail-other-window nil nil subject))
239 (let (mail-signature mail-setup-hook) 239 (save-excursion
240 ;; If only one window, use it for the mail buffer. 240 (goto-char (point-max))
241 ;; Otherwise, use another window for the mail buffer 241 (forward-line 1)
242 ;; so that the Rmail buffer remains visible 242 (insert-buffer forward-buffer)
243 ;; and sending the mail will get back to it. 243 (hmail:msg-narrow)
244 (if (funcall (if (one-window-p t) 244 )))))
245 (function mail)
246 (function mail-other-window))
247 nil nil subject nil nil nil
248 (list (list (function (lambda (buf msgnum)
249 (save-excursion
250 (set-buffer buf)
251 (rmail-set-attribute
252 "forwarded" t msgnum))))
253 (current-buffer)
254 rmail-current-message)))
255 (save-excursion
256 (goto-char (point-max))
257 (forward-line 1)
258 (insert-buffer forward-buffer)
259 (hmail:msg-narrow))))))))
260 245
261 ;;; Overlay version of 'rmail-get-new-mail' from "rmail.el" to highlight 246 ;;; Overlay version of 'rmail-get-new-mail' from "rmail.el" to highlight
262 ;;; Hyperbole buttons when possible. 247 ;;; Hyperbole buttons when possible.
263 ;;; 248 ;;;
264 (hypb:function-overload 'rmail-get-new-mail nil 249 (hypb:function-overload 'rmail-get-new-mail nil