Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hmail.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: hmail.el
4 ;; SUMMARY: Support for Hyperbole buttons embedded in e-mail messages.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia, mail
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Brown U.
10 ;;
11 ;; ORIG-DATE: 9-Oct-91 at 18:38:05
12 ;; LAST-MOD: 4-Nov-95 at 04:37:50 by Bob Weiner
13 ;;
14 ;; This file is part of Hyperbole.
15 ;; Available for use and distribution under the same terms as GNU Emacs.
16 ;;
17 ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
18 ;; Developed with support from Motorola Inc.
19 ;;
20 ;; DESCRIPTION:
21 ;;
22 ;; The 'hmail' class provides an abstract interface for connecting
23 ;; GNU Emacs-based mail readers and composers to Hyperbole. Its
24 ;; public variables together with supporting classes determine the
25 ;; mail tools that Hyperbole will support.
26 ;;
27 ;; The 'rmail' and 'lmail' classes provide a set of feature names
28 ;; that Hyperbole packages can call to interface to a user's selected
29 ;; mail reader. Eventually, a full abstract calling interface may be
30 ;; developed. The public features (the ones above the line of dashes)
31 ;; must be redefined for any mail reader. The private features are
32 ;; used only by a particular mail reader.
33 ;;
34 ;; The 'smail' class is similar; it connects a mail composer for use
35 ;; with Hyperbole.
36 ;;
37 ;; DESCRIP-END.
38
39 ;;; ************************************************************************
40 ;;; Public variables
41 ;;; ************************************************************************
42
43 (defvar hnews:composer 'news-reply-mode
44 "Major mode for composing USENET news to be sent with Hyperbole buttons.")
45 (defvar hnews:lister 'gnus-summary-mode
46 "Major mode for listing USENET news header summaries with Hyperbole buttons.")
47 (defvar hnews:reader 'gnus-article-mode
48 "Major mode for reading USENET news with Hyperbole buttons.")
49
50 (defvar hmail:init-function nil
51 "*Function (a symbol) to run to initialize Hyperbole support for a mail reader/composer.
52 Valid values are: nil, Rmail-init, Vm-init, Mh-init, or Pm-init.")
53
54 (defvar hmail:composer 'mail-mode
55 "Major mode for composing mail to be sent with Hyperbole buttons.")
56 (defvar hmail:lister nil
57 "Major mode for listing mail header summaries with Hyperbole buttons.")
58 (defvar hmail:modifier nil
59 "Major mode for editing received mail with Hyperbole buttons.")
60 (defvar hmail:reader nil
61 "Major mode for reading mail with Hyperbole buttons.")
62
63 ;;; ************************************************************************
64 ;;; Public functions
65 ;;; ************************************************************************
66
67 ;;; ========================================================================
68 ;;; hmail class - abstract
69 ;;; ========================================================================
70
71 (defun hmail:hbdata-start (&optional msg-start msg-end)
72 "Returns point immediately before any Hyperbole button data in current msg.
73 Returns message end point when no button data is found.
74 Has side-effect of widening buffer.
75 Message's displayable part begins at optional MSG-START and ends at or before
76 MSG-END."
77 (widen)
78 (or msg-end (setq msg-end (point-max)))
79 (save-excursion
80 (goto-char msg-end)
81 (if (search-backward hmail:hbdata-sep msg-start t) (1- (point)) msg-end)))
82
83 (defun hmail:hbdata-to-p ()
84 "Moves point to Hyperbole but data start in an e-mail msg.
85 Returns t if button data is found."
86 (and (cond ((memq major-mode (list hmail:reader hmail:modifier))
87 (rmail:msg-narrow) t)
88 ((or (hmail:lister-p) (hnews:lister-p)) t)
89 ((memq major-mode (list hmail:composer hnews:reader
90 hnews:composer))
91 (widen) t))
92 (progn
93 (goto-char (point-max))
94 (if (search-backward hmail:hbdata-sep nil t)
95 (progn (forward-line 1) t)))))
96
97 (defun hmail:browser-p ()
98 "Returns t iff current major mode helps browse received e-mail messages."
99 (memq major-mode (list hmail:reader hmail:lister)))
100
101 (defun hmail:buffer (&optional buf invisible-flag)
102 "Start composing mail with the contents of optional BUF as the message body.
103 Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is
104 non-nil. BUF defaults to the current buffer and may be a buffer or buffer
105 name."
106 (interactive (list (current-buffer) (y-or-n-p "Include invisible text? ")))
107 (or buf (setq buf (current-buffer)))
108 (if (stringp buf) (setq buf (get-buffer buf)))
109 (set-buffer buf)
110 (hmail:region (point-min) (point-max) buf invisible-flag))
111
112 ;;;###autoload
113 (defun hmail:compose (address expr &optional subject help)
114 "Compose mail with ADDRESS and evaluation of EXPR.
115 Optional SUBJECT and HELP message may also be given."
116 (interactive "sDeliver e-mail to: \nSubject: ")
117 (require 'hactypes) ;; Needed in case EXPR calls 'hact.
118 (if (or (stringp help) (stringp subject))
119 nil
120 (setq subject "Be explicit here. Make a statement or ask a question."))
121 (hmail:invoke address nil subject)
122 (eval expr)
123 (if (re-search-backward "^Subject: " nil t)
124 (goto-char (match-end 0)))
125 (message (if (stringp help)
126 help
127 "Replace subject, compose message, and then mail.")))
128
129 (defun hmail:composing-dir (key-src)
130 "If button KEY-SRC is a mail/news composure buffer, returns composure directory, else nil."
131 (save-excursion
132 (and (bufferp key-src)
133 (progn (set-buffer key-src)
134 (or (eq major-mode hmail:composer)
135 (eq major-mode hnews:composer)))
136 default-directory)))
137
138 (defun hmail:editor-p ()
139 "Returns t iff current major mode edits Hyperbole e-mail/news messages."
140 (memq major-mode (list hmail:composer hnews:composer hmail:modifier)))
141
142 (defun hmail:init (class-prefix func-suffix-list)
143 "Sets up CLASS-PREFIX functions with aliases for FUNC-SUFFIX-LIST.
144 'hmail:reader' should be set appropriately before this is called."
145 (if (null hmail:reader)
146 nil
147 (let* ((reader-name (symbol-name hmail:reader))
148 (reader-prefix (capitalize
149 (substring reader-name
150 0 (string-match "-" reader-name))))
151 hmail-func)
152 (mapcar (function
153 (lambda (func-suffix)
154 (setq hmail-func (hypb:replace-match-string
155 "Summ-" func-suffix "" t))
156 (fset (intern (concat class-prefix hmail-func))
157 (intern (concat reader-prefix "-" func-suffix)))))
158 func-suffix-list))))
159
160 (defun hmail:invoke (&optional address cc subject)
161 "Invoke user preferred mail composer: vm-mail, mh-send or mail.
162 Optional arguments are ADDRESS, CC list and SUBJECT of mail."
163 (or address (setq address ""))
164 (or cc (setq cc ""))
165 (or subject (setq subject ""))
166 (cond ((and (featurep 'vm) (fboundp 'vm-mail))
167 (vm-mail)
168 (insert address)
169 (cond ((re-search-forward "^CC: " nil t)
170 (end-of-line)
171 (insert cc))
172 ((not (equal cc ""))
173 (forward-line 1)
174 (insert "CC: " cc)))
175 (if (re-search-forward "^Subject: " nil t)
176 (progn (end-of-line)
177 (save-excursion
178 (insert subject)))))
179 ((and (featurep 'mh-e) (fboundp 'mh-send))
180 (mh-send address cc subject))
181 (t
182 ;; Next 3 lines prevent blank lines between fields due to
183 ;; fill-region-as-paragraph within mail-setup.
184 (if (equal address "") (setq address nil))
185 (if (equal cc "") (setq cc nil))
186 (if (equal subject "") (setq subject nil))
187 (mail nil address subject nil cc))))
188
189 (defun hmail:lister-p ()
190 "Returns t iff current major mode is a Hyperbole e-mail lister mode."
191 (eq major-mode hmail:lister))
192
193 (defun hnews:lister-p ()
194 "Returns t iff current major mode is a Hyperbole news summary lister mode."
195 (eq major-mode hnews:lister))
196
197 (defun hmail:mode-is-p ()
198 "Returns current major mode if a Hyperbole e-mail or news mode, else nil."
199 (car (memq major-mode
200 (list hmail:reader hmail:composer hmail:lister hmail:modifier
201 hnews:reader hnews:composer hnews:lister)
202 )))
203
204 (defun hmail:msg-narrow (&optional msg-start msg-end)
205 "Narrows buffer to displayable part of current message.
206 Its displayable part begins at optional MSG-START and ends at or before
207 MSG-END."
208 (if (hmail:reader-p) (rmail:msg-widen))
209 (setq msg-start (or msg-start (point-min))
210 msg-end (or msg-end (point-max)))
211 (narrow-to-region msg-start (hmail:hbdata-start msg-start msg-end)))
212
213 (defun hmail:reader-p ()
214 "Returns t iff current major mode shows received Hyperbole e-mail messages."
215 (memq major-mode (list hmail:reader hmail:modifier)))
216
217 (defun hmail:region (start end &optional buf invisible-flag)
218 "Start composing mail with region between START and END included in message.
219 Invisible text is expanded and included in the mail only if INVISIBLE-FLAG is
220 non-nil. Optional BUF contains the region and defaults to the current
221 buffer. It may be a buffer or buffer name."
222 (interactive (list (region-beginning) (region-end) (current-buffer)
223 (y-or-n-p "Include invisible text? ")))
224 (or buf (setq buf (current-buffer)))
225 (if (stringp buf) (setq buf (get-buffer buf)))
226 (let (mail-buf)
227 (hmail:invoke)
228 (setq mail-buf (current-buffer))
229 (save-excursion
230 (if (search-forward mail-header-separator nil t)
231 ;; Within header, so move to body
232 (goto-char (point-max)))
233 (set-buffer buf)
234 (hypb:insert-region mail-buf start end invisible-flag))))
235
236 ;;; ========================================================================
237 ;;; rmail class - mail reader interface - abstract
238 ;;; ========================================================================
239
240 (defun rmail:init ()
241 "Initializes Hyperbole abstract mail interface for a particular mail reader.
242 'hmail:reader' should be set appropriately before this is called."
243 (hmail:init "rmail:" '("msg-hdrs-full" "msg-narrow" "msg-num"
244 "msg-prev" "msg-next"
245 "msg-to-p" ;; 2 args: (mail-msg-id mail-file)
246 "msg-widen" "to"))
247 (hmail:init "lmail:" '("Summ-delete" "Summ-expunge" "Summ-goto" "Summ-to"
248 "Summ-undelete-all")))
249
250 (defvar rmail:msg-hdr-prefix "\\(^Date: \\|\n\nFrom [^ \n]+ \\)"
251 "String header preceding an e-mail received message-id.")
252
253 (defun rmail:msg-id-get ()
254 "Returns current msg id for an 'hmail:reader' buffer as a string, else nil.
255 Signals error when current mail reader is not supported."
256 (let* ((reader (symbol-name hmail:reader))
257 ;; (toggled)
258 )
259 (or (fboundp 'rmail:msg-hdrs-full)
260 (error "(rmail:msg-id-get): Invalid mail reader: %s" reader))
261 (save-excursion
262 (unwind-protect
263 (progn
264 ;; (setq toggled (rmail:msg-hdrs-full nil))
265 (goto-char (point-min))
266 (if (re-search-forward (concat rmail:msg-hdr-prefix
267 "\\(.+\\)"))
268 ;; Found matching msg
269 (buffer-substring (match-beginning 2) (match-end 2))))
270 ;; (rmail:msg-hdrs-full toggled)
271 ()
272 ))))
273
274 ;;; ------------------------------------------------------------------------
275 ;;; Each mail reader-specific Hyperbole support module must also define
276 ;;; the following functions, commonly aliased to existing mail reader
277 ;;; functions within the "-init" function of the Hyperbole module.
278 ;;; See "hrmail.el" for examples.
279 ;;;
280 ;;; rmail:get-new, rmail:msg-forward, rmail:summ-msg-to, rmail:summ-new
281
282 ;;; ************************************************************************
283 ;;; Private variables
284 ;;; ************************************************************************
285
286 (defvar hmail:hbdata-sep "\^Lbd"
287 "Text separating e-mail msg from any trailing Hyperbole button data.")
288
289 (provide 'hmail)