|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hsmail.el
|
|
|
4 ;; SUMMARY: Support for Hyperbole buttons in mail composer: mail and mh-letter.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, mail
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Brown U.
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 9-May-91 at 04:50:20
|
|
|
12 ;; LAST-MOD: 8-Aug-95 at 10:55:17 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 ;; DESCRIP-END.
|
|
|
22
|
|
|
23 ;;; ************************************************************************
|
|
|
24 ;;; Other required Elisp libraries
|
|
|
25 ;;; ************************************************************************
|
|
|
26
|
|
|
27 (require 'sendmail)
|
|
|
28
|
|
|
29 ;;; ************************************************************************
|
|
|
30 ;;; Public variables
|
|
|
31 ;;; ************************************************************************
|
|
|
32
|
|
|
33
|
|
|
34 (defvar smail:comment '(format
|
|
|
35 "Comments: Hyperbole mail buttons accepted, v%s.\n"
|
|
|
36 hyperb:version)
|
|
|
37 "Default comment form to evaluate and add to outgoing mail.
|
|
|
38 Set to the empty string, \"\", for no comment.")
|
|
|
39
|
|
|
40 ;;; Used by 'mail-send' in Emacs "sendmail.el".
|
|
|
41 (if (boundp 'send-mail-function)
|
|
|
42 (or (if (listp send-mail-function)
|
|
|
43 (if (equal (nth 2 send-mail-function) '(smail:widen))
|
|
|
44 nil
|
|
|
45 (error
|
|
|
46 "(hsmail): Set 'send-mail-function' to a symbol-name, not a list, before load.")))
|
|
|
47 (setq send-mail-function
|
|
|
48 (list 'lambda nil '(smail:widen) (list send-mail-function))))
|
|
|
49 (error "(hsmail): Install an Emacs \"sendmail.el\" which includes 'send-mail-function'."))
|
|
|
50
|
|
|
51 (if (fboundp 'mail-prefix-region)
|
|
|
52 ;;
|
|
|
53 ;; For compatibility with rsw-modified sendmail.el.
|
|
|
54 (defvar mail-yank-hook
|
|
|
55 (function
|
|
|
56 (lambda ()
|
|
|
57 ;; Set off original message.
|
|
|
58 (mail-prefix-region (hypb:mark t) (point))))
|
|
|
59 "*Hook to run mail yank preface function.
|
|
|
60 Expects point and mark to be set to the region to preface.")
|
|
|
61 ;;
|
|
|
62 ;; Else for compatibility with Supercite and Emacs V19.
|
|
|
63 ;; If you create your own yank hook, set this variable rather than
|
|
|
64 ;; 'mail-yank-hook' from above.
|
|
|
65 (defvar mail-citation-hook nil
|
|
|
66 "*Hook for modifying a citation just inserted in the mail buffer.
|
|
|
67 Each hook function can find the citation between (point) and (mark t).
|
|
|
68 And each hook function should leave point and mark around the citation
|
|
|
69 text as modified.
|
|
|
70
|
|
|
71 If this hook is entirely empty (nil), a default action is taken
|
|
|
72 instead of no action.")
|
|
|
73 (defvar mail-yank-hooks '(mail-indent-citation)
|
|
|
74 "*Obsolete hook to run mail yank citation function. Use mail-citation-hook instead.
|
|
|
75 Expects point and mark to be set to the region to cite."))
|
|
|
76
|
|
|
77 ;; For compatibility with Supercite and Emacs V19.
|
|
|
78 (defvar mail-yank-prefix nil
|
|
|
79 "*Prefix insert on lines of yanked message being replied to.
|
|
|
80 nil means use indentation.")
|
|
|
81 (defvar mail-indentation-spaces 3
|
|
|
82 "*Number of spaces to insert at the beginning of each cited line.")
|
|
|
83
|
|
|
84 ;;; ************************************************************************
|
|
|
85 ;;; Public functions
|
|
|
86 ;;; ************************************************************************
|
|
|
87
|
|
|
88 (defun smail:comment-add (&optional comment-form)
|
|
|
89 "Adds a comment to the current outgoing message if Hyperbole has been loaded.
|
|
|
90 Optional COMMENT-FORM is evaluated to obtain the string to add to the
|
|
|
91 message. If not given, 'smail:comment' is evaluated by default."
|
|
|
92 (let ((comment (eval (or comment-form smail:comment))))
|
|
|
93 (if (and comment (featurep 'hsite))
|
|
|
94 (save-excursion
|
|
|
95 (goto-char (point-min))
|
|
|
96 (and (or (search-forward mail-header-separator nil t)
|
|
|
97 (if (eq major-mode 'mh-letter-mode)
|
|
|
98 (search-forward "\n--------" nil t)))
|
|
|
99 (not (search-backward comment nil t))
|
|
|
100 (progn (beginning-of-line) (insert comment)))))))
|
|
|
101
|
|
|
102 (defun smail:widen ()
|
|
|
103 "Widens outgoing mail buffer to include Hyperbole button data."
|
|
|
104 (if (fboundp 'mail+narrow) (mail+narrow) (widen)))
|
|
|
105
|
|
|
106 ;; Overlay this function from V19 "sendmail.el" to work with V18.
|
|
|
107 (defun mail-indent-citation ()
|
|
|
108 "Modify text just inserted from a message to be cited.
|
|
|
109 The inserted text should be the region.
|
|
|
110 When this function returns, the region is again around the modified text.
|
|
|
111
|
|
|
112 Normally, indent each nonblank line `mail-indentation-spaces' spaces.
|
|
|
113 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
|
|
|
114 (let ((start (point)))
|
|
|
115 ;; Don't ever remove headers if user uses Supercite package,
|
|
|
116 ;; since he can set an option in that package to do
|
|
|
117 ;; the removal.
|
|
|
118 (or (hypb:supercite-p)
|
|
|
119 (mail-yank-clear-headers start (hypb:mark t)))
|
|
|
120 (if (null mail-yank-prefix)
|
|
|
121 (indent-rigidly start (hypb:mark t) mail-indentation-spaces)
|
|
|
122 (save-excursion
|
|
|
123 (goto-char start)
|
|
|
124 (while (< (point) (hypb:mark t))
|
|
|
125 (insert mail-yank-prefix)
|
|
|
126 (forward-line 1))))))
|
|
|
127
|
|
|
128 ;; Overlay this function from "sendmail.el" to include Hyperbole button
|
|
|
129 ;; data when yanking in a message and to highlight buttons if possible.
|
|
|
130 (defun mail-yank-original (arg)
|
|
|
131 "Insert the message being replied to, if any.
|
|
|
132 Puts point before the text and mark after.
|
|
|
133 Applies 'mail-citation-hook', 'mail-yank-hook' or 'mail-yank-hooks'
|
|
|
134 to text (in decreasing order of precedence).
|
|
|
135 Just \\[universal-argument] as argument means don't apply hooks
|
|
|
136 and don't delete any header fields.
|
|
|
137
|
|
|
138 If supercite is in use, header fields are never deleted.
|
|
|
139 Use (setq sc-nuke-mail-headers-p t) to have them removed."
|
|
|
140 (interactive "P")
|
|
|
141 (if mail-reply-buffer
|
|
|
142 (let ((start (point)) opoint)
|
|
|
143 (delete-windows-on mail-reply-buffer)
|
|
|
144 (unwind-protect
|
|
|
145 (progn
|
|
|
146 (save-excursion
|
|
|
147 (set-buffer mail-reply-buffer)
|
|
|
148 ;; Might be called from newsreader before any
|
|
|
149 ;; Hyperbole mail reader support has been autoloaded.
|
|
|
150 (cond ((fboundp 'rmail:msg-widen) (rmail:msg-widen))
|
|
|
151 ((eq major-mode 'news-reply-mode) (widen))))
|
|
|
152 (setq opoint (point))
|
|
|
153 (insert-buffer mail-reply-buffer)
|
|
|
154 (hmail:msg-narrow)
|
|
|
155 (if (fboundp 'hproperty:but-create) (hproperty:but-create))
|
|
|
156 (if (consp arg)
|
|
|
157 nil
|
|
|
158 ;; Don't ever remove headers if user uses Supercite package,
|
|
|
159 ;; since he can set an option in that package to do
|
|
|
160 ;; the removal.
|
|
|
161 (or (hypb:supercite-p)
|
|
|
162 (mail-yank-clear-headers
|
|
|
163 start (marker-position (hypb:mark-marker t))))
|
|
|
164 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
|
|
|
165 mail-indentation-spaces)))
|
|
|
166 (cond ((and (boundp 'mail-citation-hook) mail-citation-hook)
|
|
|
167 (run-hooks 'mail-citation-hook))
|
|
|
168 ((and (boundp 'mail-yank-hook) mail-yank-hook)
|
|
|
169 (run-hooks 'mail-yank-hook))
|
|
|
170 ((and (boundp 'mail-yank-hooks) mail-yank-hooks)
|
|
|
171 (run-hooks 'mail-yank-hooks))
|
|
|
172 (t (mail-indent-citation))))
|
|
|
173 (goto-char (min (point-max) (hypb:mark t)))
|
|
|
174 (set-mark opoint)
|
|
|
175 (delete-region (point) ; Remove trailing blank lines.
|
|
|
176 (progn (re-search-backward "[^ \^I\^L\n]")
|
|
|
177 (end-of-line)
|
|
|
178 (point))))
|
|
|
179 (or (eq major-mode 'news-reply-mode)
|
|
|
180 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
|
|
|
181 ;; It is cleaner to avoid activation, even though the command
|
|
|
182 ;; loop would deactivate the mark because we inserted text.
|
|
|
183 (goto-char (prog1 (hypb:mark t)
|
|
|
184 (set-marker (hypb:mark-marker t)
|
|
|
185 (point) (current-buffer)))))
|
|
|
186 (if (not (eolp)) (insert ?\n))
|
|
|
187 )
|
|
|
188 (save-excursion
|
|
|
189 (set-buffer mail-reply-buffer)
|
|
|
190 (hmail:msg-narrow))))))
|
|
|
191
|
|
|
192 ;;; ************************************************************************
|
|
|
193 ;;; Private variables
|
|
|
194 ;;; ************************************************************************
|
|
|
195
|
|
|
196 ;;; Try to setup comment addition as the first element of these hooks.
|
|
|
197 (if (fboundp 'add-hook)
|
|
|
198 (progn
|
|
|
199 (add-hook 'mail-setup-hook 'smail:comment-add)
|
|
|
200 (add-hook 'mh-letter-mode-hook 'smail:comment-add))
|
|
|
201 (var:append 'mail-setup-hook '(smail:comment-add))
|
|
|
202 (var:append 'mh-letter-mode-hook '(smail:comment-add)))
|
|
|
203
|
|
|
204 (provide 'hsmail)
|
