Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hrmail.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
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: 19-May-95 at 15:09:04 by Bob Weiner 12 ;; LAST-MOD: 14-Feb-97 at 11:38:57 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 RTN} 25 ;; {M-x Rmail-init RET}
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 (&optional resend) 219 (defun rmail-forward (resend)
220 "Forward the current message to another user." 220 "Forward the current message to another user.
221 (interactive) 221 With prefix argument, \"resend\" the message instead of forwarding it;
222 ;; Resend argument is ignored but for now but is there for Emacs V19 call 222 see the documentation of `rmail-resend'."
223 ;; compatibility. 223 (interactive "P")
224 ;;>> this gets set even if we abort. Can't do anything about it, though. 224 (if resend
225 (rmail-set-attribute "forwarded" t) 225 (call-interactively 'rmail-resend)
226 (let ((forward-buffer (current-buffer)) 226 (let ((forward-buffer (current-buffer))
227 (subject (concat "[" 227 (subject (concat "["
228 (mail-strip-quoted-names (mail-fetch-field "From")) 228 (let ((from (or (mail-fetch-field "From")
229 ": " (or (mail-fetch-field "Subject") "") "]"))) 229 (mail-fetch-field ">From"))))
230 (save-restriction 230 (if from
231 (Rmail-msg-widen) 231 (concat (mail-strip-quoted-names from) ": ")
232 ;; If only one window, use it for the mail buffer. 232 ""))
233 ;; Otherwise, use another window for the mail buffer 233 (or (mail-fetch-field "Subject") "")
234 ;; so that the Rmail buffer remains visible 234 "]")))
235 ;; and sending the mail will get back to it. 235 (save-restriction
236 (if (if (one-window-p t) 236 (Rmail-msg-widen)
237 (mail nil nil subject) 237 ;; Turn off the usual actions for initializing the message body
238 (mail-other-window nil nil subject)) 238 ;; because we want to get only the text from the failure message.
239 (save-excursion 239 (let (mail-signature mail-setup-hook)
240 (goto-char (point-max)) 240 ;; If only one window, use it for the mail buffer.
241 (forward-line 1) 241 ;; Otherwise, use another window for the mail buffer
242 (insert-buffer forward-buffer) 242 ;; so that the Rmail buffer remains visible
243 (hmail:msg-narrow) 243 ;; and sending the mail will get back to it.
244 ))))) 244 (if (funcall (if (one-window-p t)
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))))))))
245 260
246 ;;; Overlay version of 'rmail-get-new-mail' from "rmail.el" to highlight 261 ;;; Overlay version of 'rmail-get-new-mail' from "rmail.el" to highlight
247 ;;; Hyperbole buttons when possible. 262 ;;; Hyperbole buttons when possible.
248 ;;; 263 ;;;
249 (hypb:function-overload 'rmail-get-new-mail nil 264 (hypb:function-overload 'rmail-get-new-mail nil