Mercurial > emacs
comparison lisp/mh-e/mh-comp.el @ 49459:06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
release version 7.2.
* lisp/mail/mh-alias.el, lisp/mail/mh-comp.el,
lisp/mail/mh-customize.el, lisp/mail/mh-e.el, lisp/mail/mh-funcs.el,
lisp/mail/mh-identity.el, lisp/mail/mh-index.el,
lisp/mail/mh-loaddefs.el, lisp/mail/mh-mime.el, lisp/mail/mh-pick.el,
lisp/mail/mh-seq.el, lisp/mail/mh-speed.el, lisp/mail/mh-utils.el,
lisp/mail/mh-xemacs-compat.el: Moved to mh-e. Note that reply2.pbm and
reply2.xpm, which were created by the MH-E package, were left in mail
since they can probably be used by other mail packages.
* makefile.w32-in (WINS): Added mh-e.
* makefile.nt (WINS): Added mh-e.
| author | Bill Wohler <wohler@newt.com> |
|---|---|
| date | Sun, 26 Jan 2003 02:38:37 +0000 |
| parents | |
| children | b35587af8747 |
comparison
equal
deleted
inserted
replaced
| 49458:5ddabc4c81b0 | 49459:06b77df47802 |
|---|---|
| 1 ;;; mh-comp.el --- MH-E functions for composing messages | |
| 2 | |
| 3 ;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Bill Wohler <wohler@newt.com> | |
| 6 ;; Maintainer: Bill Wohler <wohler@newt.com> | |
| 7 ;; Keywords: mail | |
| 8 ;; See: mh-e.el | |
| 9 | |
| 10 ;; This file is part of GNU Emacs. | |
| 11 | |
| 12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 13 ;; it under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 ;; GNU General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 25 ;; Boston, MA 02111-1307, USA. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; Internal support for MH-E package. | |
| 30 | |
| 31 ;;; Change Log: | |
| 32 | |
| 33 ;; $Id: mh-comp.el,v 1.26 2003/01/08 23:21:16 wohler Exp $ | |
| 34 | |
| 35 ;;; Code: | |
| 36 | |
| 37 (require 'mh-e) | |
| 38 (require 'gnus-util) | |
| 39 (require 'easymenu) | |
| 40 (require 'cl) | |
| 41 | |
| 42 ;; Shush the byte-compiler | |
| 43 (defvar adaptive-fill-first-line-regexp) | |
| 44 (defvar font-lock-defaults) | |
| 45 (defvar mark-active) | |
| 46 (defvar sendmail-coding-system) | |
| 47 (defvar mh-identity-list) | |
| 48 (defvar mh-identity-default) | |
| 49 (defvar mh-identity-menu) | |
| 50 | |
| 51 ;;; Autoloads | |
| 52 (autoload 'Info-goto-node "info") | |
| 53 (autoload 'mail-mode-fill-paragraph "sendmail") | |
| 54 (autoload 'mm-handle-displayed-p "mm-decode") | |
| 55 | |
| 56 (autoload 'sc-cite-original "sc" | |
| 57 "Workhorse citing function which performs the initial citation. | |
| 58 This is callable from the various mail and news readers' reply | |
| 59 function according to the agreed upon standard. See `\\[sc-describe]' | |
| 60 for more details. `sc-cite-original' does not do any yanking of the | |
| 61 original message but it does require a few things: | |
| 62 | |
| 63 1) The reply buffer is the current buffer. | |
| 64 | |
| 65 2) The original message has been yanked and inserted into the | |
| 66 reply buffer. | |
| 67 | |
| 68 3) Verbose mail headers from the original message have been | |
| 69 inserted into the reply buffer directly before the text of the | |
| 70 original message. | |
| 71 | |
| 72 4) Point is at the beginning of the verbose headers. | |
| 73 | |
| 74 5) Mark is at the end of the body of text to be cited. | |
| 75 | |
| 76 For Emacs 19's, the region need not be active (and typically isn't | |
| 77 when this function is called. Also, the hook `sc-pre-hook' is run | |
| 78 before, and `sc-post-hook' is run after the guts of this function.") | |
| 79 | |
| 80 ;;; Site customization (see also mh-utils.el): | |
| 81 | |
| 82 (defvar mh-send-prog "send" | |
| 83 "Name of the MH send program. | |
| 84 Some sites need to change this because of a name conflict.") | |
| 85 | |
| 86 (defvar mh-redist-full-contents nil | |
| 87 "Non-nil if the `dist' command needs whole letter for redistribution. | |
| 88 This is the case only when `send' is compiled with the BERK option. | |
| 89 If MH will not allow you to redist a previously redist'd msg, set to nil.") | |
| 90 | |
| 91 (defvar mh-redist-background nil | |
| 92 "If non-nil redist will be done in background like send. | |
| 93 This allows transaction log to be visible if -watch, -verbose or -snoop are | |
| 94 used.") | |
| 95 | |
| 96 (defvar mh-note-repl "-" | |
| 97 "String whose first character is used to notate replied to messages.") | |
| 98 | |
| 99 (defvar mh-note-forw "F" | |
| 100 "String whose first character is used to notate forwarded messages.") | |
| 101 | |
| 102 (defvar mh-note-dist "R" | |
| 103 "String whose first character is used to notate redistributed messages.") | |
| 104 | |
| 105 (defvar mh-yank-hooks nil | |
| 106 "Obsolete hook for modifying a citation just inserted in the mail buffer. | |
| 107 Each hook function can find the citation between point and mark. | |
| 108 And each hook function should leave point and mark around the citation | |
| 109 text as modified. | |
| 110 | |
| 111 This is a normal hook, misnamed for historical reasons. | |
| 112 It is semi-obsolete and is only used if `mail-citation-hook' is nil.") | |
| 113 | |
| 114 (defvar mail-citation-hook nil | |
| 115 "*Hook for modifying a citation just inserted in the mail buffer. | |
| 116 Each hook function can find the citation between point and mark. | |
| 117 And each hook function should leave point and mark around the citation | |
| 118 text as modified. | |
| 119 | |
| 120 If this hook is entirely empty (nil), the text of the message is inserted | |
| 121 with `mh-ins-buf-prefix' prefixed to each line. | |
| 122 | |
| 123 See also the variable `mh-yank-from-start-of-msg', which controls how | |
| 124 much of the message passed to the hook. | |
| 125 | |
| 126 This hook was historically provided to set up supercite. You may now leave | |
| 127 this nil and set up supercite by setting the variable | |
| 128 `mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, | |
| 129 to 'autosupercite.") | |
| 130 | |
| 131 (defvar mh-comp-formfile "components" | |
| 132 "Name of file to be used as a skeleton for composing messages. | |
| 133 Default is \"components\". If not an absolute file name, the file | |
| 134 is searched for first in the user's MH directory, then in the | |
| 135 system MH lib directory.") | |
| 136 | |
| 137 (defvar mh-repl-formfile "replcomps" | |
| 138 "Name of file to be used as a skeleton for replying to messages. | |
| 139 Default is \"replcomps\". If not an absolute file name, the file | |
| 140 is searched for first in the user's MH directory, then in the | |
| 141 system MH lib directory.") | |
| 142 | |
| 143 (defvar mh-repl-group-formfile "replgroupcomps" | |
| 144 "Name of file to be used as a skeleton for replying to messages. | |
| 145 This file is used to form replies to the sender and all recipients of a | |
| 146 message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\". | |
| 147 If not an absolute file name, the file is searched for first in the user's MH | |
| 148 directory, then in the system MH lib directory.") | |
| 149 | |
| 150 (defvar mh-rejected-letter-start | |
| 151 (format "^%s$" | |
| 152 (regexp-opt | |
| 153 '("Content-Type: message/rfc822" ;MIME MDN | |
| 154 " ----- Unsent message follows -----" ;from sendmail V5 | |
| 155 " --------Unsent Message below:" ; from sendmail at BU | |
| 156 " ----- Original message follows -----" ;from sendmail V8 | |
| 157 "------- Unsent Draft" ;from MH itself | |
| 158 "---------- Original Message ----------" ;from zmailer | |
| 159 " --- The unsent message follows ---" ;from AIX mail system | |
| 160 " Your message follows:" ;from MMDF-II | |
| 161 "Content-Description: Returned Content" ;1993 KJ sendmail | |
| 162 )))) | |
| 163 | |
| 164 (defvar mh-new-draft-cleaned-headers | |
| 165 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" | |
| 166 "Regexp of header lines to remove before offering a message as a new draft. | |
| 167 Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") | |
| 168 | |
| 169 (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") | |
| 170 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") | |
| 171 ("d" . "Dcc:")) | |
| 172 "Alist of (final-character . field-name) choices for `mh-to-field'.") | |
| 173 | |
| 174 (defvar mh-letter-mode-map (copy-keymap text-mode-map) | |
| 175 "Keymap for composing mail.") | |
| 176 | |
| 177 (defvar mh-letter-mode-syntax-table nil | |
| 178 "Syntax table used by MH-E while in MH-Letter mode.") | |
| 179 | |
| 180 (if mh-letter-mode-syntax-table | |
| 181 () | |
| 182 (setq mh-letter-mode-syntax-table | |
| 183 (make-syntax-table text-mode-syntax-table)) | |
| 184 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) | |
| 185 | |
| 186 (defvar mh-sent-from-folder nil | |
| 187 "Folder of msg assoc with this letter.") | |
| 188 | |
| 189 (defvar mh-sent-from-msg nil | |
| 190 "Number of msg assoc with this letter.") | |
| 191 | |
| 192 (defvar mh-send-args nil | |
| 193 "Extra args to pass to \"send\" command.") | |
| 194 | |
| 195 (defvar mh-annotate-char nil | |
| 196 "Character to use to annotate `mh-sent-from-msg'.") | |
| 197 | |
| 198 (defvar mh-annotate-field nil | |
| 199 "Field name for message annotation.") | |
| 200 | |
| 201 ;;;###autoload | |
| 202 (defun mh-smail () | |
| 203 "Compose and send mail with the MH mail system. | |
| 204 This function is an entry point to MH-E, the Emacs front end | |
| 205 to the MH mail system. | |
| 206 | |
| 207 See documentation of `\\[mh-send]' for more details on composing mail." | |
| 208 (interactive) | |
| 209 (mh-find-path) | |
| 210 (call-interactively 'mh-send)) | |
| 211 | |
| 212 (defvar mh-error-if-no-draft nil) ;raise error over using old draft | |
| 213 | |
| 214 ;;;###autoload | |
| 215 (defun mh-smail-batch (&optional to subject other-headers &rest ignored) | |
| 216 "Set up a mail composition draft with the MH mail system. | |
| 217 This function is an entry point to MH-E, the Emacs front end | |
| 218 to the MH mail system. This function does not prompt the user | |
| 219 for any header fields, and thus is suitable for use by programs | |
| 220 that want to create a mail buffer. | |
| 221 Users should use `\\[mh-smail]' to compose mail. | |
| 222 Optional arguments for setting certain fields include TO, SUBJECT, and | |
| 223 OTHER-HEADERS. Additional arguments are IGNORED." | |
| 224 (mh-find-path) | |
| 225 (let ((mh-error-if-no-draft t)) | |
| 226 (mh-send (or to "") "" (or subject "")))) | |
| 227 | |
| 228 ;; XEmacs needs this: | |
| 229 ;;;###autoload | |
| 230 (defun mh-user-agent-compose (&optional to subject other-headers continue | |
| 231 switch-function yank-action | |
| 232 send-actions) | |
| 233 "Set up mail composition draft with the MH mail system. | |
| 234 This is `mail-user-agent' entry point to MH-E. | |
| 235 | |
| 236 The optional arguments TO and SUBJECT specify recipients and the | |
| 237 initial Subject field, respectively. | |
| 238 | |
| 239 OTHER-HEADERS is an alist specifying additional | |
| 240 header fields. Elements look like (HEADER . VALUE) where both | |
| 241 HEADER and VALUE are strings. | |
| 242 | |
| 243 CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored." | |
| 244 (mh-find-path) | |
| 245 (let ((mh-error-if-no-draft t)) | |
| 246 (mh-send to "" subject) | |
| 247 (while other-headers | |
| 248 (mh-insert-fields (concat (car (car other-headers)) ":") | |
| 249 (cdr (car other-headers))) | |
| 250 (setq other-headers (cdr other-headers))))) | |
| 251 | |
| 252 ;;;###mh-autoload | |
| 253 (defun mh-edit-again (msg) | |
| 254 "Clean up a draft or a message MSG previously sent and make it resendable. | |
| 255 Default is the current message. | |
| 256 The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. | |
| 257 See also documentation for `\\[mh-send]' function." | |
| 258 (interactive (list (mh-get-msg-num t))) | |
| 259 (let* ((from-folder mh-current-folder) | |
| 260 (config (current-window-configuration)) | |
| 261 (draft | |
| 262 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) | |
| 263 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) | |
| 264 (rename-buffer (format "draft-%d" msg)) | |
| 265 ;; Make buffer writable... | |
| 266 (setq buffer-read-only nil) | |
| 267 ;; If buffer was being used to display the message reinsert | |
| 268 ;; from file... | |
| 269 (when (eq major-mode 'mh-show-mode) | |
| 270 (erase-buffer) | |
| 271 (insert-file-contents buffer-file-name)) | |
| 272 (buffer-name)) | |
| 273 (t | |
| 274 (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) | |
| 275 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) | |
| 276 (mh-insert-header-separator) | |
| 277 (goto-char (point-min)) | |
| 278 (save-buffer) | |
| 279 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil | |
| 280 config) | |
| 281 (mh-letter-mode-message))) | |
| 282 | |
| 283 ;;;###mh-autoload | |
| 284 (defun mh-extract-rejected-mail (msg) | |
| 285 "Extract message MSG returned by the mail system and make it resendable. | |
| 286 Default is the current message. The variable `mh-new-draft-cleaned-headers' | |
| 287 gives the headers to clean out of the original message. | |
| 288 See also documentation for `\\[mh-send]' function." | |
| 289 (interactive (list (mh-get-msg-num t))) | |
| 290 (let ((from-folder mh-current-folder) | |
| 291 (config (current-window-configuration)) | |
| 292 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) | |
| 293 (goto-char (point-min)) | |
| 294 (cond ((re-search-forward mh-rejected-letter-start nil t) | |
| 295 (skip-chars-forward " \t\n") | |
| 296 (delete-region (point-min) (point)) | |
| 297 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) | |
| 298 (t | |
| 299 (message "Does not appear to be a rejected letter."))) | |
| 300 (mh-insert-header-separator) | |
| 301 (goto-char (point-min)) | |
| 302 (save-buffer) | |
| 303 (mh-compose-and-send-mail draft "" from-folder msg | |
| 304 (mh-get-header-field "To:") | |
| 305 (mh-get-header-field "From:") | |
| 306 (mh-get-header-field "Cc:") | |
| 307 nil nil config) | |
| 308 (mh-letter-mode-message))) | |
| 309 | |
| 310 ;;;###mh-autoload | |
| 311 (defun mh-forward (to cc &optional msg-or-seq) | |
| 312 "Forward one or more messages to the recipients TO and CC. | |
| 313 | |
| 314 Use the optional MSG-OR-SEQ to specify a message or sequence to forward. | |
| 315 | |
| 316 Default is the displayed message. If optional prefix argument is given then | |
| 317 prompt for the message sequence. If variable `transient-mark-mode' is non-nil | |
| 318 and the mark is active, then the selected region is forwarded. | |
| 319 See also documentation for `\\[mh-send]' function." | |
| 320 (interactive (list (mh-read-address "To: ") | |
| 321 (mh-read-address "Cc: ") | |
| 322 (cond | |
| 323 ((mh-mark-active-p t) | |
| 324 (mh-region-to-msg-list (region-beginning) (region-end))) | |
| 325 (current-prefix-arg | |
| 326 (mh-read-seq-default "Forward" t)) | |
| 327 (t | |
| 328 (mh-get-msg-num t))))) | |
| 329 (let* ((folder mh-current-folder) | |
| 330 (msgs (cond ((numberp msg-or-seq) (list msg-or-seq)) | |
| 331 ((listp msg-or-seq) msg-or-seq) | |
| 332 (t (mh-seq-to-msgs msg-or-seq)))) | |
| 333 (config (current-window-configuration)) | |
| 334 (fwd-msg-file (mh-msg-filename (car msgs) folder)) | |
| 335 ;; forw always leaves file in "draft" since it doesn't have -draft | |
| 336 (draft-name (expand-file-name "draft" mh-user-path)) | |
| 337 (draft (cond ((or (not (file-exists-p draft-name)) | |
| 338 (y-or-n-p "The file 'draft' exists. Discard it? ")) | |
| 339 (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") | |
| 340 mh-current-folder msgs) | |
| 341 (prog1 | |
| 342 (mh-read-draft "" draft-name t) | |
| 343 (mh-insert-fields "To:" to "Cc:" cc) | |
| 344 (save-buffer))) | |
| 345 (t | |
| 346 (mh-read-draft "" draft-name nil))))) | |
| 347 (let (orig-from | |
| 348 orig-subject) | |
| 349 (save-excursion | |
| 350 (set-buffer (get-buffer-create mh-temp-buffer)) | |
| 351 (erase-buffer) | |
| 352 (insert-file-contents fwd-msg-file) | |
| 353 (setq orig-from (mh-get-header-field "From:")) | |
| 354 (setq orig-subject (mh-get-header-field "Subject:"))) | |
| 355 (let ((forw-subject | |
| 356 (mh-forwarded-letter-subject orig-from orig-subject)) | |
| 357 (compose)) | |
| 358 (mh-insert-fields "Subject:" forw-subject) | |
| 359 (goto-char (point-min)) | |
| 360 ;; If using MML, translate mhn | |
| 361 (if (equal mh-compose-insertion 'gnus) | |
| 362 (save-excursion | |
| 363 (setq compose t) | |
| 364 (re-search-forward (format "^\\(%s\\)?$" | |
| 365 mh-mail-header-separator)) | |
| 366 (while | |
| 367 (re-search-forward | |
| 368 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" | |
| 369 (point-max) t) | |
| 370 (let ((description (if (equal (match-string 1) | |
| 371 "forwarded messages") | |
| 372 "forwarded message %d" | |
| 373 (match-string 1))) | |
| 374 (msgs (split-string (match-string 3))) | |
| 375 (i 0)) | |
| 376 (beginning-of-line) | |
| 377 (delete-region (point) (progn (forward-line 1) (point))) | |
| 378 (dolist (msg msgs) | |
| 379 (setq i (1+ i)) | |
| 380 (mh-mml-forward-message (format description i) | |
| 381 folder msg)))))) | |
| 382 ;; Postition just before forwarded message | |
| 383 (if (re-search-forward "^------- Forwarded Message" nil t) | |
| 384 (forward-line -1) | |
| 385 (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator)) | |
| 386 (forward-line 1)) | |
| 387 (delete-other-windows) | |
| 388 (mh-add-msgs-to-seq msgs 'forwarded t) | |
| 389 (mh-compose-and-send-mail draft "" folder msg-or-seq | |
| 390 to forw-subject cc | |
| 391 mh-note-forw "Forwarded:" | |
| 392 config) | |
| 393 (if compose | |
| 394 (setq mh-mml-compose-insert-flag t)) | |
| 395 (mh-letter-mode-message))))) | |
| 396 | |
| 397 (defun mh-forwarded-letter-subject (from subject) | |
| 398 "Return a Subject suitable for a forwarded message. | |
| 399 Original message has headers FROM and SUBJECT." | |
| 400 (let ((addr-start (string-match "<" from)) | |
| 401 (comment (string-match "(" from))) | |
| 402 (cond ((and addr-start (> addr-start 0)) | |
| 403 ;; Full Name <luser@host> | |
| 404 (setq from (substring from 0 (1- addr-start)))) | |
| 405 (comment | |
| 406 ;; luser@host (Full Name) | |
| 407 (setq from (substring from (1+ comment) (1- (length from))))))) | |
| 408 (format mh-forward-subject-format from subject)) | |
| 409 | |
| 410 ;;;###autoload | |
| 411 (defun mh-smail-other-window () | |
| 412 "Compose and send mail in other window with the MH mail system. | |
| 413 This function is an entry point to MH-E, the Emacs front end | |
| 414 to the MH mail system. | |
| 415 | |
| 416 See documentation of `\\[mh-send]' for more details on composing mail." | |
| 417 (interactive) | |
| 418 (mh-find-path) | |
| 419 (call-interactively 'mh-send-other-window)) | |
| 420 | |
| 421 ;;;###mh-autoload | |
| 422 (defun mh-redistribute (to cc &optional msg) | |
| 423 "Redistribute displayed message to recipients TO and CC. | |
| 424 Use optional argument MSG to redistribute another message. | |
| 425 Depending on how your copy of MH was compiled, you may need to change the | |
| 426 setting of the variable `mh-redist-full-contents'. See its documentation." | |
| 427 (interactive (list (mh-read-address "Redist-To: ") | |
| 428 (mh-read-address "Redist-Cc: ") | |
| 429 (mh-get-msg-num t))) | |
| 430 (or msg | |
| 431 (setq msg (mh-get-msg-num t))) | |
| 432 (save-window-excursion | |
| 433 (let ((folder mh-current-folder) | |
| 434 (draft (mh-read-draft "redistribution" | |
| 435 (if mh-redist-full-contents | |
| 436 (mh-msg-filename msg) | |
| 437 nil) | |
| 438 nil))) | |
| 439 (mh-goto-header-end 0) | |
| 440 (insert "Resent-To: " to "\n") | |
| 441 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) | |
| 442 (mh-clean-msg-header (point-min) | |
| 443 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" | |
| 444 nil) | |
| 445 (save-buffer) | |
| 446 (message "Redistributing...") | |
| 447 (if (not mh-redist-background) | |
| 448 (if mh-redist-full-contents | |
| 449 (call-process "/bin/sh" nil 0 nil "-c" | |
| 450 (format "mhdist=1 mhaltmsg=%s %s -push %s" | |
| 451 buffer-file-name | |
| 452 (expand-file-name mh-send-prog mh-progs) | |
| 453 buffer-file-name)) | |
| 454 (call-process "/bin/sh" nil 0 nil "-c" | |
| 455 (format | |
| 456 "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" | |
| 457 (mh-msg-filename msg folder) | |
| 458 (expand-file-name mh-send-prog mh-progs) | |
| 459 buffer-file-name)))) | |
| 460 (mh-annotate-msg msg folder mh-note-dist | |
| 461 "-component" "Resent:" | |
| 462 "-text" (format "\"%s %s\"" to cc)) | |
| 463 (if mh-redist-background | |
| 464 (mh-exec-cmd-daemon "/bin/sh" "-c" | |
| 465 (format "mhdist=1 mhaltmsg=%s %s %s %s" | |
| 466 (if mh-redist-full-contents | |
| 467 buffer-file-name | |
| 468 (mh-msg-filename msg folder)) | |
| 469 (if mh-redist-full-contents | |
| 470 "" | |
| 471 "mhannotate=1") | |
| 472 (mh-expand-file-name "send" mh-progs) | |
| 473 buffer-file-name))) | |
| 474 (kill-buffer draft) | |
| 475 (message "Redistributing...done")))) | |
| 476 | |
| 477 (defun mh-show-buffer-message-number (&optional buffer) | |
| 478 "Message number of displayed message in corresponding show buffer. | |
| 479 Return nil if show buffer not displayed. | |
| 480 If in `mh-letter-mode', don't display the message number being replied to, | |
| 481 but rather the message number of the show buffer associated with our | |
| 482 originating folder buffer. | |
| 483 Optional argument BUFFER can be used to specify the buffer." | |
| 484 (save-excursion | |
| 485 (if buffer | |
| 486 (set-buffer buffer)) | |
| 487 (cond ((eq major-mode 'mh-show-mode) | |
| 488 (let ((number-start (mh-search-from-end ?/ buffer-file-name))) | |
| 489 (car (read-from-string (substring buffer-file-name | |
| 490 (1+ number-start)))))) | |
| 491 ((and (eq major-mode 'mh-folder-mode) | |
| 492 mh-show-buffer | |
| 493 (get-buffer mh-show-buffer)) | |
| 494 (mh-show-buffer-message-number mh-show-buffer)) | |
| 495 ((and (eq major-mode 'mh-letter-mode) | |
| 496 mh-sent-from-folder | |
| 497 (get-buffer mh-sent-from-folder)) | |
| 498 (mh-show-buffer-message-number mh-sent-from-folder)) | |
| 499 (t | |
| 500 nil)))) | |
| 501 | |
| 502 ;;;###mh-autoload | |
| 503 (defun mh-reply (message &optional reply-to includep) | |
| 504 "Reply to MESSAGE (default: current message). | |
| 505 If the optional argument REPLY-TO is not given, prompts for type of addresses | |
| 506 to reply to: | |
| 507 from sender only, | |
| 508 to sender and primary recipients, | |
| 509 cc/all sender and all recipients. | |
| 510 If optional prefix argument INCLUDEP provided, then include the message | |
| 511 in the reply using filter `mhl.reply' in your MH directory. | |
| 512 If the file named by `mh-repl-formfile' exists, it is used as a skeleton | |
| 513 for the reply. See also documentation for `\\[mh-send]' function." | |
| 514 (interactive (list | |
| 515 (mh-get-msg-num t) | |
| 516 (let ((minibuffer-help-form | |
| 517 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) | |
| 518 (or mh-reply-default-reply-to | |
| 519 (completing-read "Reply to whom? (from, to, all) [from]: " | |
| 520 '(("from") ("to") ("cc") ("all")) | |
| 521 nil | |
| 522 t))) | |
| 523 current-prefix-arg)) | |
| 524 (let* ((folder mh-current-folder) | |
| 525 (show-buffer mh-show-buffer) | |
| 526 (config (current-window-configuration)) | |
| 527 (group-reply (or (equal reply-to "cc") (equal reply-to "all"))) | |
| 528 (form-file (cond ((and mh-nmh-flag group-reply | |
| 529 (stringp mh-repl-group-formfile)) | |
| 530 mh-repl-group-formfile) | |
| 531 ((stringp mh-repl-formfile) mh-repl-formfile) | |
| 532 (t nil)))) | |
| 533 (message "Composing a reply...") | |
| 534 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" | |
| 535 (if form-file | |
| 536 (list "-form" form-file)) | |
| 537 mh-current-folder message | |
| 538 (cond ((or (equal reply-to "from") (equal reply-to "")) | |
| 539 '("-nocc" "all")) | |
| 540 ((equal reply-to "to") | |
| 541 '("-cc" "to")) | |
| 542 (group-reply (if mh-nmh-flag | |
| 543 '("-group" "-nocc" "me") | |
| 544 '("-cc" "all" "-nocc" "me")))) | |
| 545 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) | |
| 546 (eq mh-yank-from-start-of-msg 'autoattrib)) | |
| 547 '("-noformat")) | |
| 548 (includep '("-filter" "mhl.reply")) | |
| 549 (t '()))) | |
| 550 (let ((draft (mh-read-draft "reply" | |
| 551 (expand-file-name "reply" mh-user-path) | |
| 552 t))) | |
| 553 (delete-other-windows) | |
| 554 (save-buffer) | |
| 555 | |
| 556 (let ((to (mh-get-header-field "To:")) | |
| 557 (subject (mh-get-header-field "Subject:")) | |
| 558 (cc (mh-get-header-field "Cc:"))) | |
| 559 (goto-char (point-min)) | |
| 560 (mh-goto-header-end 1) | |
| 561 (or includep | |
| 562 (not mh-reply-show-message-flag) | |
| 563 (mh-in-show-buffer (show-buffer) | |
| 564 (mh-display-msg message folder))) | |
| 565 (mh-add-msgs-to-seq message 'answered t) | |
| 566 (message "Composing a reply...done") | |
| 567 (mh-compose-and-send-mail draft "" folder message to subject cc | |
| 568 mh-note-repl "Replied:" config)) | |
| 569 (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg) | |
| 570 (eq 'autoattrib mh-yank-from-start-of-msg)) | |
| 571 (eq (mh-show-buffer-message-number) mh-sent-from-msg)) | |
| 572 (undo-boundary) | |
| 573 (mh-yank-cur-msg)) | |
| 574 (mh-letter-mode-message)))) | |
| 575 | |
| 576 ;;;###mh-autoload | |
| 577 (defun mh-send (to cc subject) | |
| 578 "Compose and send a letter. | |
| 579 | |
| 580 Do not call this function from outside MH-E; use \\[mh-smail] instead. | |
| 581 | |
| 582 The file named by `mh-comp-formfile' will be used as the form. | |
| 583 The letter is composed in `mh-letter-mode'; see its documentation for more | |
| 584 details. | |
| 585 If `mh-compose-letter-function' is defined, it is called on the draft and | |
| 586 passed three arguments: TO, CC, and SUBJECT." | |
| 587 (interactive (list | |
| 588 (mh-read-address "To: ") | |
| 589 (mh-read-address "Cc: ") | |
| 590 (read-string "Subject: "))) | |
| 591 (let ((config (current-window-configuration))) | |
| 592 (delete-other-windows) | |
| 593 (mh-send-sub to cc subject config))) | |
| 594 | |
| 595 ;;;###mh-autoload | |
| 596 (defun mh-send-other-window (to cc subject) | |
| 597 "Compose and send a letter in another window. | |
| 598 | |
| 599 Do not call this function from outside MH-E; use \\[mh-smail-other-window] | |
| 600 instead. | |
| 601 | |
| 602 The file named by `mh-comp-formfile' will be used as the form. | |
| 603 The letter is composed in `mh-letter-mode'; see its documentation for more | |
| 604 details. | |
| 605 If `mh-compose-letter-function' is defined, it is called on the draft and | |
| 606 passed three arguments: TO, CC, and SUBJECT." | |
| 607 (interactive (list | |
| 608 (mh-read-address "To: ") | |
| 609 (mh-read-address "Cc: ") | |
| 610 (read-string "Subject: "))) | |
| 611 (let ((pop-up-windows t)) | |
| 612 (mh-send-sub to cc subject (current-window-configuration)))) | |
| 613 | |
| 614 (defun mh-send-sub (to cc subject config) | |
| 615 "Do the real work of composing and sending a letter. | |
| 616 Expects the TO, CC, and SUBJECT fields as arguments. | |
| 617 CONFIG is the window configuration before sending mail." | |
| 618 (let ((folder mh-current-folder) | |
| 619 (msg-num (mh-get-msg-num nil))) | |
| 620 (message "Composing a message...") | |
| 621 (let ((draft (mh-read-draft | |
| 622 "message" | |
| 623 (let (components) | |
| 624 (cond | |
| 625 ((file-exists-p | |
| 626 (setq components | |
| 627 (expand-file-name mh-comp-formfile mh-user-path))) | |
| 628 components) | |
| 629 ((file-exists-p | |
| 630 (setq components | |
| 631 (expand-file-name mh-comp-formfile mh-lib))) | |
| 632 components) | |
| 633 ((file-exists-p | |
| 634 (setq components | |
| 635 (expand-file-name mh-comp-formfile | |
| 636 ;; What is this mh-etc ?? -sm | |
| 637 ;; This is dead code, so | |
| 638 ;; remove it. | |
| 639 ;(and (boundp 'mh-etc) mh-etc) | |
| 640 ))) | |
| 641 components) | |
| 642 (t | |
| 643 (error (format "Can't find components file \"%s\"" | |
| 644 components))))) | |
| 645 nil))) | |
| 646 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) | |
| 647 (goto-char (point-max)) | |
| 648 (mh-compose-and-send-mail draft "" folder msg-num | |
| 649 to subject cc | |
| 650 nil nil config) | |
| 651 (mh-letter-mode-message)))) | |
| 652 | |
| 653 (defun mh-read-draft (use initial-contents delete-contents-file) | |
| 654 "Read draft file into a draft buffer and make that buffer the current one. | |
| 655 USE is a message used for prompting about the intended use of the message. | |
| 656 INITIAL-CONTENTS is filename that is read into an empty buffer, or nil | |
| 657 if buffer should not be modified. Delete the initial-contents file if | |
| 658 DELETE-CONTENTS-FILE flag is set. | |
| 659 Returns the draft folder's name. | |
| 660 If the draft folder facility is enabled in ~/.mh_profile, a new buffer is | |
| 661 used each time and saved in the draft folder. The draft file can then be | |
| 662 reused." | |
| 663 (cond (mh-draft-folder | |
| 664 (let ((orig-default-dir default-directory) | |
| 665 (draft-file-name (mh-new-draft-name))) | |
| 666 (pop-to-buffer (generate-new-buffer | |
| 667 (format "draft-%s" | |
| 668 (file-name-nondirectory draft-file-name)))) | |
| 669 (condition-case () | |
| 670 (insert-file-contents draft-file-name t) | |
| 671 (file-error)) | |
| 672 (setq default-directory orig-default-dir))) | |
| 673 (t | |
| 674 (let ((draft-name (expand-file-name "draft" mh-user-path))) | |
| 675 (pop-to-buffer "draft") ; Create if necessary | |
| 676 (if (buffer-modified-p) | |
| 677 (if (y-or-n-p "Draft has been modified; kill anyway? ") | |
| 678 (set-buffer-modified-p nil) | |
| 679 (error "Draft preserved"))) | |
| 680 (setq buffer-file-name draft-name) | |
| 681 (clear-visited-file-modtime) | |
| 682 (unlock-buffer) | |
| 683 (cond ((and (file-exists-p draft-name) | |
| 684 (not (equal draft-name initial-contents))) | |
| 685 (insert-file-contents draft-name) | |
| 686 (delete-file draft-name)))))) | |
| 687 (cond ((and initial-contents | |
| 688 (or (zerop (buffer-size)) | |
| 689 (if (y-or-n-p | |
| 690 (format "A draft exists. Use for %s? " use)) | |
| 691 (if mh-error-if-no-draft | |
| 692 (error "A prior draft exists")) | |
| 693 t))) | |
| 694 (erase-buffer) | |
| 695 (insert-file-contents initial-contents) | |
| 696 (if delete-contents-file (delete-file initial-contents)))) | |
| 697 (auto-save-mode 1) | |
| 698 (if mh-draft-folder | |
| 699 (save-buffer)) ; Do not reuse draft name | |
| 700 (buffer-name)) | |
| 701 | |
| 702 (defun mh-new-draft-name () | |
| 703 "Return the pathname of folder for draft messages." | |
| 704 (save-excursion | |
| 705 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new") | |
| 706 (buffer-substring (point-min) (1- (point-max))))) | |
| 707 | |
| 708 (defun mh-annotate-msg (msg buffer note &rest args) | |
| 709 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS." | |
| 710 (apply 'mh-exec-cmd "anno" buffer msg args) | |
| 711 (save-excursion | |
| 712 (cond ((get-buffer buffer) ; Buffer may be deleted | |
| 713 (set-buffer buffer) | |
| 714 (if (numberp msg) | |
| 715 (mh-notate msg note (1+ mh-cmd-note)) | |
| 716 (mh-notate-seq msg note (1+ mh-cmd-note))))))) | |
| 717 | |
| 718 (defun mh-insert-fields (&rest name-values) | |
| 719 "Insert the NAME-VALUES pairs in the current buffer. | |
| 720 If the field exists, append the value to it. | |
| 721 Do not insert any pairs whose value is the empty string." | |
| 722 (let ((case-fold-search t)) | |
| 723 (while name-values | |
| 724 (let ((field-name (car name-values)) | |
| 725 (value (car (cdr name-values)))) | |
| 726 (cond ((equal value "") | |
| 727 nil) | |
| 728 ((mh-position-on-field field-name) | |
| 729 (insert " " (or value ""))) | |
| 730 (t | |
| 731 (insert field-name " " value "\n"))) | |
| 732 (setq name-values (cdr (cdr name-values))))))) | |
| 733 | |
| 734 (defun mh-position-on-field (field &optional ignored) | |
| 735 "Move to the end of the FIELD in the header. | |
| 736 Move to end of entire header if FIELD not found. | |
| 737 Returns non-nil iff FIELD was found. | |
| 738 The optional second arg is for pre-version 4 compatibility and is IGNORED." | |
| 739 (cond ((mh-goto-header-field field) | |
| 740 (mh-header-field-end) | |
| 741 t) | |
| 742 ((mh-goto-header-end 0) | |
| 743 nil))) | |
| 744 | |
| 745 (defun mh-get-header-field (field) | |
| 746 "Find and return the body of FIELD in the mail header. | |
| 747 Returns the empty string if the field is not in the header of the | |
| 748 current buffer." | |
| 749 (if (mh-goto-header-field field) | |
| 750 (progn | |
| 751 (skip-chars-forward " \t") ;strip leading white space in body | |
| 752 (let ((start (point))) | |
| 753 (mh-header-field-end) | |
| 754 (buffer-substring-no-properties start (point)))) | |
| 755 "")) | |
| 756 | |
| 757 (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility | |
| 758 | |
| 759 (defun mh-goto-header-field (field) | |
| 760 "Move to FIELD in the message header. | |
| 761 Move to the end of the FIELD name, which should end in a colon. | |
| 762 Returns t if found, nil if not." | |
| 763 (goto-char (point-min)) | |
| 764 (let ((case-fold-search t) | |
| 765 (headers-end (save-excursion | |
| 766 (mh-goto-header-end 0) | |
| 767 (point)))) | |
| 768 (re-search-forward (format "^%s" field) headers-end t))) | |
| 769 | |
| 770 (defun mh-goto-header-end (arg) | |
| 771 "Move the cursor ARG lines after the header." | |
| 772 (if (re-search-forward "^-*$" nil nil) | |
| 773 (forward-line arg))) | |
| 774 | |
| 775 (defun mh-extract-from-header-value () | |
| 776 "Extract From: string from header." | |
| 777 (save-excursion | |
| 778 (if (not (mh-goto-header-field "From:")) | |
| 779 (error "No From header line found") | |
| 780 (skip-chars-forward " \t") | |
| 781 (buffer-substring-no-properties | |
| 782 (point) (progn (mh-header-field-end)(point)))))) | |
| 783 | |
| 784 | |
| 785 | |
| 786 ;;; Mode for composing and sending a draft message. | |
| 787 | |
| 788 (put 'mh-letter-mode 'mode-class 'special) | |
| 789 | |
| 790 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) | |
| 791 (eval-when-compile (defvar mh-letter-menu nil)) | |
| 792 (cond | |
| 793 ((fboundp 'easy-menu-define) | |
| 794 (easy-menu-define | |
| 795 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode." | |
| 796 '("Letter" | |
| 797 ["Send This Draft" mh-send-letter t] | |
| 798 ["Split Current Line" mh-open-line t] | |
| 799 ["Check Recipient" mh-check-whom t] | |
| 800 ["Yank Current Message" mh-yank-cur-msg t] | |
| 801 ["Insert a Message..." mh-insert-letter t] | |
| 802 ["Insert Signature" mh-insert-signature t] | |
| 803 ["GPG Sign message" | |
| 804 mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] | |
| 805 ["GPG Encrypt message" | |
| 806 mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] | |
| 807 ["Compose Insertion (MIME)..." mh-compose-insertion t] | |
| 808 ;; ["Compose Compressed tar (MIME)..." | |
| 809 ;;mh-mhn-compose-external-compressed-tar t] | |
| 810 ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] | |
| 811 ["Compose Forward (MIME)..." mh-compose-forward t] | |
| 812 ;; The next two will have to be merged. But I also need to make sure the | |
| 813 ;; user can't mix directives of both types. | |
| 814 ["Pull in All Compositions (mhn)" | |
| 815 mh-edit-mhn mh-mhn-compose-insert-flag] | |
| 816 ["Pull in All Compositions (gnus)" | |
| 817 mh-mml-to-mime mh-mml-compose-insert-flag] | |
| 818 ["Revert to Non-MIME Edit (mhn)" | |
| 819 mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] | |
| 820 ["Kill This Draft" mh-fully-kill-draft t])))) | |
| 821 | |
| 822 ;;; Help Messages | |
| 823 ;;; Group messages logically, more or less. | |
| 824 (defvar mh-letter-mode-help-messages | |
| 825 '((nil | |
| 826 "Send letter: \\[mh-send-letter]" | |
| 827 "\t\tOpen line: \\[mh-open-line]\n" | |
| 828 "Kill letter: \\[mh-fully-kill-draft]" | |
| 829 "\t\tInsert:\n" | |
| 830 "Check recipients: \\[mh-check-whom]" | |
| 831 "\t\t Current message: \\[mh-yank-cur-msg]\n" | |
| 832 "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]" | |
| 833 "\t\t Attachment: \\[mh-compose-insertion]\n" | |
| 834 "Sign message: \\[mh-mml-secure-message-sign-pgpmime]" | |
| 835 "\t\t Message to forward: \\[mh-compose-forward]\n" | |
| 836 " " | |
| 837 "\t\t Signature: \\[mh-insert-signature]")) | |
| 838 "Key binding cheat sheet. | |
| 839 | |
| 840 This is an associative array which is used to show the most common commands. | |
| 841 The key is a prefix char. The value is one or more strings which are | |
| 842 concatenated together and displayed in the minibuffer if ? is pressed after | |
| 843 the prefix character. The special key nil is used to display the | |
| 844 non-prefixed commands. | |
| 845 | |
| 846 The substitutions described in `substitute-command-keys' are performed as | |
| 847 well.") | |
| 848 | |
| 849 ;;;###mh-autoload | |
| 850 (defun mh-fill-paragraph-function (arg) | |
| 851 "Fill paragraph at or after point. | |
| 852 Prefix ARG means justify as well. This function enables `fill-paragraph' to | |
| 853 work better in MH-Letter mode." | |
| 854 (interactive "P") | |
| 855 (let ((fill-paragraph-function) (fill-prefix)) | |
| 856 (if (mh-in-header-p) | |
| 857 (mail-mode-fill-paragraph arg) | |
| 858 (fill-paragraph arg)))) | |
| 859 | |
| 860 ;;;###autoload | |
| 861 (define-derived-mode mh-letter-mode text-mode "MH-Letter" | |
| 862 "Mode for composing letters in MH-E.\\<mh-letter-mode-map> | |
| 863 | |
| 864 When you have finished composing, type \\[mh-send-letter] to send the message | |
| 865 using the MH mail handling system. | |
| 866 | |
| 867 There are two types of MIME directives used by MH-E: Gnus and MH. The option | |
| 868 `mh-compose-insertion' controls what type of directives are inserted by MH-E | |
| 869 commands. These directives can be converted to MIME body parts by running | |
| 870 \\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives. | |
| 871 This step is mandatory if these directives are added manually. If the | |
| 872 directives are inserted with MH-E commands such as \\[mh-compose-insertion], | |
| 873 the directives are expanded automatically when the letter is sent. | |
| 874 | |
| 875 Options that control this mode can be changed with | |
| 876 \\[customize-group]; specify the \"mh-compose\" group. | |
| 877 | |
| 878 When a message is composed, the hooks `text-mode-hook' and | |
| 879 `mh-letter-mode-hook' are run. | |
| 880 | |
| 881 \\{mh-letter-mode-map}" | |
| 882 | |
| 883 (or mh-user-path (mh-find-path)) | |
| 884 (make-local-variable 'mh-send-args) | |
| 885 (make-local-variable 'mh-annotate-char) | |
| 886 (make-local-variable 'mh-annotate-field) | |
| 887 (make-local-variable 'mh-previous-window-config) | |
| 888 (make-local-variable 'mh-sent-from-folder) | |
| 889 (make-local-variable 'mh-sent-from-msg) | |
| 890 (make-local-variable 'mail-header-separator) | |
| 891 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el | |
| 892 (make-local-variable 'mh-help-messages) | |
| 893 (setq mh-help-messages mh-letter-mode-help-messages) | |
| 894 | |
| 895 ;; From sendmail.el for proper paragraph fill | |
| 896 ;; sendmail.el also sets a normal-auto-fill-function (not done here) | |
| 897 (make-local-variable 'paragraph-separate) | |
| 898 (make-local-variable 'paragraph-start) | |
| 899 (make-local-variable 'fill-paragraph-function) | |
| 900 (setq fill-paragraph-function 'mh-fill-paragraph-function) | |
| 901 (make-local-variable 'adaptive-fill-regexp) | |
| 902 (setq adaptive-fill-regexp | |
| 903 (concat adaptive-fill-regexp | |
| 904 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) | |
| 905 (make-local-variable 'adaptive-fill-first-line-regexp) | |
| 906 (setq adaptive-fill-first-line-regexp | |
| 907 (concat adaptive-fill-first-line-regexp | |
| 908 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) | |
| 909 ;; `-- ' precedes the signature. `-----' appears at the start of the | |
| 910 ;; lines that delimit forwarded messages. | |
| 911 ;; Lines containing just >= 3 dashes, perhaps after whitespace, | |
| 912 ;; are also sometimes used and should be separators. | |
| 913 (setq paragraph-start (concat (regexp-quote mail-header-separator) | |
| 914 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" | |
| 915 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" | |
| 916 "-- $\\|---+$\\|" | |
| 917 page-delimiter)) | |
| 918 (setq paragraph-separate paragraph-start) | |
| 919 ;; --- End of code from sendmail.el --- | |
| 920 | |
| 921 (if (and (boundp 'tool-bar-mode) tool-bar-mode) | |
| 922 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) | |
| 923 (make-local-variable 'font-lock-defaults) | |
| 924 (cond | |
| 925 ((or (equal mh-highlight-citation-p 'font-lock) | |
| 926 (equal mh-highlight-citation-p 'gnus)) | |
| 927 ;; Let's use font-lock even if gnus is used in show-mode. The reason | |
| 928 ;; is that gnus uses static text properties which are not appropriate | |
| 929 ;; for a buffer that will be edited. So the choice here is either fontify | |
| 930 ;; the citations and header... | |
| 931 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) | |
| 932 (t | |
| 933 ;; ...or the header only | |
| 934 (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) | |
| 935 (easy-menu-add mh-letter-menu) | |
| 936 ;; See if a "forw: -mime" message containing a MIME composition. | |
| 937 ;; Mode clears local vars, so can't do this in mh-forward. | |
| 938 (save-excursion | |
| 939 (goto-char (point-min)) | |
| 940 (when (and (re-search-forward | |
| 941 (format "^\\(%s\\)?$" mail-header-separator) nil t) | |
| 942 (= 0 (forward-line 1)) | |
| 943 (looking-at "^#forw")) | |
| 944 (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var | |
| 945 (setq mh-mhn-compose-insert-flag t))) | |
| 946 (setq fill-column mh-letter-fill-column) | |
| 947 ;; If text-mode-hook turned on auto-fill, tune it for messages | |
| 948 (when auto-fill-function | |
| 949 (make-local-variable 'auto-fill-function) | |
| 950 (setq auto-fill-function 'mh-auto-fill-for-letter))) | |
| 951 | |
| 952 (defun mh-auto-fill-for-letter () | |
| 953 "Perform auto-fill for message. | |
| 954 Header is treated specially by inserting a tab before continuation lines." | |
| 955 (if (mh-in-header-p) | |
| 956 (let ((fill-prefix "\t")) | |
| 957 (do-auto-fill)) | |
| 958 (do-auto-fill))) | |
| 959 | |
| 960 (defun mh-insert-header-separator () | |
| 961 "Insert `mh-mail-header-separator', if absent." | |
| 962 (save-excursion | |
| 963 (goto-char (point-min)) | |
| 964 (rfc822-goto-eoh) | |
| 965 (if (looking-at "$") | |
| 966 (insert mh-mail-header-separator)))) | |
| 967 | |
| 968 ;;;###mh-autoload | |
| 969 (defun mh-to-field () | |
| 970 "Move point to the end of a specified header field. | |
| 971 The field is indicated by the previous keystroke (the last keystroke | |
| 972 of the command) according to the list in the variable `mh-to-field-choices'. | |
| 973 Create the field if it does not exist. Set the mark to point before moving." | |
| 974 (interactive) | |
| 975 (expand-abbrev) | |
| 976 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) | |
| 977 mh-to-field-choices) | |
| 978 ;; also look for a char for version 4 compat | |
| 979 (assoc (logior last-input-char ?`) | |
| 980 mh-to-field-choices)))) | |
| 981 (case-fold-search t)) | |
| 982 (push-mark) | |
| 983 (cond ((mh-position-on-field target) | |
| 984 (let ((eol (point))) | |
| 985 (skip-chars-backward " \t") | |
| 986 (delete-region (point) eol)) | |
| 987 (if (and (not (eq (logior last-input-char ?`) ?s)) | |
| 988 (save-excursion | |
| 989 (backward-char 1) | |
| 990 (not (looking-at "[:,]")))) | |
| 991 (insert ", ") | |
| 992 (insert " "))) | |
| 993 (t | |
| 994 (if (mh-position-on-field "To:") | |
| 995 (forward-line 1)) | |
| 996 (insert (format "%s \n" target)) | |
| 997 (backward-char 1))))) | |
| 998 | |
| 999 ;;;###mh-autoload | |
| 1000 (defun mh-to-fcc (&optional folder) | |
| 1001 "Insert an Fcc: FOLDER field in the current message. | |
| 1002 Prompt for the field name with a completion list of the current folders." | |
| 1003 (interactive) | |
| 1004 (or folder | |
| 1005 (setq folder (mh-prompt-for-folder | |
| 1006 "Fcc" | |
| 1007 (or (and mh-default-folder-for-message-function | |
| 1008 (save-excursion | |
| 1009 (goto-char (point-min)) | |
| 1010 (funcall | |
| 1011 mh-default-folder-for-message-function))) | |
| 1012 "") | |
| 1013 t))) | |
| 1014 (let ((last-input-char ?\C-f)) | |
| 1015 (expand-abbrev) | |
| 1016 (save-excursion | |
| 1017 (mh-to-field) | |
| 1018 (insert (if (mh-folder-name-p folder) | |
| 1019 (substring folder 1) | |
| 1020 folder))))) | |
| 1021 | |
| 1022 ;;;###mh-autoload | |
| 1023 (defun mh-insert-signature () | |
| 1024 "Insert the file named by `mh-signature-file-name' at point. | |
| 1025 The value of `mh-letter-insert-signature-hook' is a list of functions to be | |
| 1026 called, with no arguments, before the signature is actually inserted." | |
| 1027 (interactive) | |
| 1028 (let ((mh-signature-file-name mh-signature-file-name)) | |
| 1029 (run-hooks 'mh-letter-insert-signature-hook) | |
| 1030 (if mh-signature-file-name | |
| 1031 (insert-file-contents mh-signature-file-name))) | |
| 1032 (force-mode-line-update)) | |
| 1033 | |
| 1034 ;;;###mh-autoload | |
| 1035 (defun mh-check-whom () | |
| 1036 "Verify recipients of the current letter, showing expansion of any aliases." | |
| 1037 (interactive) | |
| 1038 (let ((file-name buffer-file-name)) | |
| 1039 (save-buffer) | |
| 1040 (message "Checking recipients...") | |
| 1041 (mh-in-show-buffer ("*Recipients*") | |
| 1042 (bury-buffer (current-buffer)) | |
| 1043 (erase-buffer) | |
| 1044 (mh-exec-cmd-output "whom" t file-name)) | |
| 1045 (message "Checking recipients...done"))) | |
| 1046 | |
| 1047 | |
| 1048 | |
| 1049 ;;; Routines to compose and send a letter. | |
| 1050 | |
| 1051 (defun mh-insert-x-face () | |
| 1052 "Append X-Face field to header. | |
| 1053 If the field already exists, this function does nothing." | |
| 1054 (when (and (file-exists-p mh-x-face-file) | |
| 1055 (file-readable-p mh-x-face-file)) | |
| 1056 (save-excursion | |
| 1057 (when (null (mh-position-on-field "X-Face")) | |
| 1058 (insert "X-Face: ") | |
| 1059 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file)))) | |
| 1060 (if (not (looking-at "^")) | |
| 1061 (insert "\n")))))) | |
| 1062 | |
| 1063 (defun mh-insert-x-mailer () | |
| 1064 "Append an X-Mailer field to the header. | |
| 1065 The versions of MH-E, Emacs, and MH are shown." | |
| 1066 | |
| 1067 ;; Lazily initialize mh-x-mailer-string. | |
| 1068 (when (null mh-x-mailer-string) | |
| 1069 (save-window-excursion | |
| 1070 (mh-version) | |
| 1071 (set-buffer mh-temp-buffer) | |
| 1072 (if mh-nmh-flag | |
| 1073 (search-forward-regexp "^nmh-\\(\\S +\\)") | |
| 1074 (search-forward-regexp "^MH \\(\\S +\\)" nil t)) | |
| 1075 (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1)))) | |
| 1076 (setq mh-x-mailer-string | |
| 1077 (format "MH-E %s; %s %s; %s %d.%d" | |
| 1078 mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh | |
| 1079 (if mh-xemacs-flag | |
| 1080 "XEmacs" | |
| 1081 "Emacs") | |
| 1082 emacs-major-version emacs-minor-version))) | |
| 1083 (kill-buffer mh-temp-buffer))) | |
| 1084 ;; Insert X-Mailer, but only if it doesn't already exist. | |
| 1085 (save-excursion | |
| 1086 (when (null (mh-goto-header-field "X-Mailer")) | |
| 1087 (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) | |
| 1088 | |
| 1089 (defun mh-regexp-in-field-p (regexp &rest fields) | |
| 1090 "Non-nil means REGEXP was found in FIELDS." | |
| 1091 (save-excursion | |
| 1092 (let ((search-result nil) | |
| 1093 (field)) | |
| 1094 (while fields | |
| 1095 (setq field (car fields)) | |
| 1096 (if (and (mh-goto-header-field field) | |
| 1097 (re-search-forward | |
| 1098 regexp (save-excursion (mh-header-field-end)(point)) t)) | |
| 1099 (setq fields nil | |
| 1100 search-result t) | |
| 1101 (setq fields (cdr fields)))) | |
| 1102 search-result))) | |
| 1103 | |
| 1104 (defun mh-insert-mail-followup-to () | |
| 1105 "Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'." | |
| 1106 (save-excursion | |
| 1107 (if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")) | |
| 1108 (not (mh-goto-header-field "Mail-Followup-To: "))) | |
| 1109 (let ((list mh-insert-mail-followup-to-list)) | |
| 1110 (while list | |
| 1111 (let ((regexp (nth 0 (car list))) | |
| 1112 (entry (nth 1 (car list)))) | |
| 1113 (when (mh-regexp-in-field-p regexp "To:" "cc:") | |
| 1114 (if (mh-goto-header-field "Mail-Followup-To: ") | |
| 1115 (insert entry ", ") | |
| 1116 (mh-goto-header-end 0) | |
| 1117 (insert "Mail-Followup-To: " entry "\n"))) | |
| 1118 (setq list (cdr list)))))))) | |
| 1119 | |
| 1120 (defun mh-compose-and-send-mail (draft send-args | |
| 1121 sent-from-folder sent-from-msg | |
| 1122 to subject cc | |
| 1123 annotate-char annotate-field | |
| 1124 config) | |
| 1125 "Edit and compose a draft message in buffer DRAFT and send or save it. | |
| 1126 SEND-ARGS is the argument passed to the send command. | |
| 1127 SENT-FROM-FOLDER is buffer containing scan listing of current folder, or | |
| 1128 nil if none exists. | |
| 1129 SENT-FROM-MSG is the message number or sequence name or nil. | |
| 1130 The TO, SUBJECT, and CC fields are passed to the | |
| 1131 `mh-compose-letter-function'. | |
| 1132 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the | |
| 1133 message. In that case, the ANNOTATE-FIELD is used to build a string | |
| 1134 for `mh-annotate-msg'. | |
| 1135 CONFIG is the window configuration to restore after sending the letter." | |
| 1136 (pop-to-buffer draft) | |
| 1137 (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to)) | |
| 1138 (mh-letter-mode) | |
| 1139 | |
| 1140 ;; mh-identity support | |
| 1141 (if (and (boundp 'mh-identity-default) | |
| 1142 mh-identity-default) | |
| 1143 (mh-insert-identity mh-identity-default)) | |
| 1144 (when (and (boundp 'mh-identity-list) | |
| 1145 mh-identity-list) | |
| 1146 (mh-identity-make-menu) | |
| 1147 (easy-menu-add mh-identity-menu)) | |
| 1148 | |
| 1149 (setq mh-sent-from-folder sent-from-folder) | |
| 1150 (setq mh-sent-from-msg sent-from-msg) | |
| 1151 (setq mh-send-args send-args) | |
| 1152 (setq mh-annotate-char annotate-char) | |
| 1153 (setq mh-annotate-field annotate-field) | |
| 1154 (setq mh-previous-window-config config) | |
| 1155 (setq mode-line-buffer-identification (list "{%b}")) | |
| 1156 (if (and (boundp 'mh-compose-letter-function) | |
| 1157 mh-compose-letter-function) | |
| 1158 ;; run-hooks will not pass arguments. | |
| 1159 (let ((value mh-compose-letter-function)) | |
| 1160 (if (and (listp value) (not (eq (car value) 'lambda))) | |
| 1161 (while value | |
| 1162 (funcall (car value) to subject cc) | |
| 1163 (setq value (cdr value))) | |
| 1164 (funcall mh-compose-letter-function to subject cc))))) | |
| 1165 | |
| 1166 (defun mh-letter-mode-message () | |
| 1167 "Display a help message for users of `mh-letter-mode'. | |
| 1168 This should be the last function called when composing the draft." | |
| 1169 (message "%s" (substitute-command-keys | |
| 1170 (concat "Type \\[mh-send-letter] to send message, " | |
| 1171 "\\[mh-help] for help.")))) | |
| 1172 | |
| 1173 ;;;###mh-autoload | |
| 1174 (defun mh-send-letter (&optional arg) | |
| 1175 "Send the draft letter in the current buffer. | |
| 1176 If optional prefix argument ARG is provided, monitor delivery. | |
| 1177 The value of `mh-before-send-letter-hook' is a list of functions to be called, | |
| 1178 with no arguments, before doing anything. | |
| 1179 Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set. | |
| 1180 Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set. | |
| 1181 Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. | |
| 1182 Insert X-Face field if the file specified by `mh-x-face-file' exists." | |
| 1183 (interactive "P") | |
| 1184 (run-hooks 'mh-before-send-letter-hook) | |
| 1185 (cond | |
| 1186 ((and (boundp 'mh-mhn-compose-insert-flag) | |
| 1187 mh-mhn-compose-insert-flag) | |
| 1188 (mh-edit-mhn)) | |
| 1189 ((and (boundp 'mh-mml-compose-insert-flag) | |
| 1190 mh-mml-compose-insert-flag) | |
| 1191 (mh-mml-to-mime))) | |
| 1192 (if mh-insert-x-mailer-flag (mh-insert-x-mailer)) | |
| 1193 (mh-insert-x-face) | |
| 1194 (save-buffer) | |
| 1195 (message "Sending...") | |
| 1196 (let ((draft-buffer (current-buffer)) | |
| 1197 (file-name buffer-file-name) | |
| 1198 (config mh-previous-window-config) | |
| 1199 (coding-system-for-write | |
| 1200 (if (and (local-variable-p 'buffer-file-coding-system | |
| 1201 (current-buffer)) ;XEmacs needs two args | |
| 1202 ;; We're not sure why, but buffer-file-coding-system | |
| 1203 ;; tends to get set to undecided-unix. | |
| 1204 (not (memq buffer-file-coding-system | |
| 1205 '(undecided undecided-unix undecided-dos)))) | |
| 1206 buffer-file-coding-system | |
| 1207 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) | |
| 1208 (and (boundp 'default-buffer-file-coding-system ) | |
| 1209 default-buffer-file-coding-system) | |
| 1210 'iso-latin-1)))) | |
| 1211 ;; The default BCC encapsulation will make a MIME message unreadable. | |
| 1212 ;; With nmh use the -mime arg to prevent this. | |
| 1213 (if (and mh-nmh-flag | |
| 1214 (mh-goto-header-field "Bcc:") | |
| 1215 (mh-goto-header-field "Content-Type:")) | |
| 1216 (setq mh-send-args (format "-mime %s" mh-send-args))) | |
| 1217 (cond (arg | |
| 1218 (pop-to-buffer "MH mail delivery") | |
| 1219 (erase-buffer) | |
| 1220 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" | |
| 1221 "-nodraftfolder" mh-send-args file-name) | |
| 1222 (goto-char (point-max)) ; show the interesting part | |
| 1223 (recenter -1) | |
| 1224 (set-buffer draft-buffer)) ; for annotation below | |
| 1225 (t | |
| 1226 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose" | |
| 1227 mh-send-args file-name))) | |
| 1228 (if mh-annotate-char | |
| 1229 (mh-annotate-msg mh-sent-from-msg | |
| 1230 mh-sent-from-folder | |
| 1231 mh-annotate-char | |
| 1232 "-component" mh-annotate-field | |
| 1233 "-text" (format "\"%s %s\"" | |
| 1234 (mh-get-header-field "To:") | |
| 1235 (mh-get-header-field "Cc:")))) | |
| 1236 | |
| 1237 (cond ((or (not arg) | |
| 1238 (y-or-n-p "Kill draft buffer? ")) | |
| 1239 (kill-buffer draft-buffer) | |
| 1240 (if config | |
| 1241 (set-window-configuration config)))) | |
| 1242 (if arg | |
| 1243 (message "Sending...done") | |
| 1244 (message "Sending...backgrounded")))) | |
| 1245 | |
| 1246 ;;;###mh-autoload | |
| 1247 (defun mh-insert-letter (folder message verbatim) | |
| 1248 "Insert a message into the current letter. | |
| 1249 Removes the header fields according to the variable `mh-invisible-headers'. | |
| 1250 Prefixes each non-blank line with `mh-ins-buf-prefix', unless | |
| 1251 `mh-yank-from-start-of-msg' is set for supercite in which case supercite is | |
| 1252 used to format the message. | |
| 1253 Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do | |
| 1254 not indent and do not delete headers. Leaves the mark before the letter | |
| 1255 and point after it." | |
| 1256 (interactive | |
| 1257 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | |
| 1258 (read-input (format "Message number%s: " | |
| 1259 (if (numberp mh-sent-from-msg) | |
| 1260 (format " [%d]" mh-sent-from-msg) | |
| 1261 ""))) | |
| 1262 current-prefix-arg)) | |
| 1263 (save-restriction | |
| 1264 (narrow-to-region (point) (point)) | |
| 1265 (let ((start (point-min))) | |
| 1266 (if (equal message "") (setq message (int-to-string mh-sent-from-msg))) | |
| 1267 (insert-file-contents | |
| 1268 (expand-file-name message (mh-expand-file-name folder))) | |
| 1269 (when (not verbatim) | |
| 1270 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) | |
| 1271 (goto-char (point-max)) ;Needed for sc-cite-original | |
| 1272 (push-mark) ;Needed for sc-cite-original | |
| 1273 (goto-char (point-min)) ;Needed for sc-cite-original | |
| 1274 (mh-insert-prefix-string mh-ins-buf-prefix))))) | |
| 1275 | |
| 1276 (defun mh-extract-from-attribution () | |
| 1277 "Extract phrase or comment from From header field." | |
| 1278 (save-excursion | |
| 1279 (if (not (mh-goto-header-field "From: ")) | |
| 1280 nil | |
| 1281 (skip-chars-forward " ") | |
| 1282 (cond | |
| 1283 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)") | |
| 1284 (format "%s %s %s" (match-string 1)(match-string 2) | |
| 1285 mh-extract-from-attribution-verb)) | |
| 1286 ((looking-at "\\([^<\n]+<.+>\\)$") | |
| 1287 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)) | |
| 1288 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$") | |
| 1289 (format "%s <%s> %s" (match-string 2)(match-string 1) | |
| 1290 mh-extract-from-attribution-verb)) | |
| 1291 ((looking-at " *\\(.+\\)$") | |
| 1292 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) | |
| 1293 | |
| 1294 ;;;###mh-autoload | |
| 1295 (defun mh-yank-cur-msg () | |
| 1296 "Insert the current message into the draft buffer. | |
| 1297 Prefix each non-blank line in the message with the string in | |
| 1298 `mh-ins-buf-prefix'. If a region is set in the message's buffer, then | |
| 1299 only the region will be inserted. Otherwise, the entire message will | |
| 1300 be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable | |
| 1301 is nil, the portion of the message following the point will be yanked. | |
| 1302 If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the | |
| 1303 yanked message will be deleted." | |
| 1304 (interactive) | |
| 1305 (if (and mh-sent-from-folder | |
| 1306 (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer) | |
| 1307 (save-excursion (set-buffer mh-sent-from-folder) | |
| 1308 (get-buffer mh-show-buffer)) | |
| 1309 mh-sent-from-msg) | |
| 1310 (let ((to-point (point)) | |
| 1311 (to-buffer (current-buffer))) | |
| 1312 (set-buffer mh-sent-from-folder) | |
| 1313 (if mh-delete-yanked-msg-window-flag | |
| 1314 (delete-windows-on mh-show-buffer)) | |
| 1315 (set-buffer mh-show-buffer) ; Find displayed message | |
| 1316 (let* ((from-attr (mh-extract-from-attribution)) | |
| 1317 (yank-region (mh-mark-active-p nil)) | |
| 1318 (mh-ins-str | |
| 1319 (cond ((and yank-region | |
| 1320 (or (eq 'supercite mh-yank-from-start-of-msg) | |
| 1321 (eq 'autosupercite mh-yank-from-start-of-msg) | |
| 1322 (eq t mh-yank-from-start-of-msg))) | |
| 1323 ;; supercite needs the full header | |
| 1324 (concat | |
| 1325 (buffer-substring (point-min) (mail-header-end)) | |
| 1326 "\n" | |
| 1327 (buffer-substring (region-beginning) (region-end)))) | |
| 1328 (yank-region | |
| 1329 (buffer-substring (region-beginning) (region-end))) | |
| 1330 ((or (eq 'body mh-yank-from-start-of-msg) | |
| 1331 (eq 'attribution | |
| 1332 mh-yank-from-start-of-msg) | |
| 1333 (eq 'autoattrib | |
| 1334 mh-yank-from-start-of-msg)) | |
| 1335 (buffer-substring | |
| 1336 (save-excursion | |
| 1337 (goto-char (point-min)) | |
| 1338 (mh-goto-header-end 1) | |
| 1339 (point)) | |
| 1340 (point-max))) | |
| 1341 ((or (eq 'supercite mh-yank-from-start-of-msg) | |
| 1342 (eq 'autosupercite mh-yank-from-start-of-msg) | |
| 1343 (eq t mh-yank-from-start-of-msg)) | |
| 1344 (buffer-substring (point-min) (point-max))) | |
| 1345 (t | |
| 1346 (buffer-substring (point) (point-max)))))) | |
| 1347 (set-buffer to-buffer) | |
| 1348 (save-restriction | |
| 1349 (narrow-to-region to-point to-point) | |
| 1350 (insert (mh-filter-out-non-text mh-ins-str)) | |
| 1351 (goto-char (point-max)) ;Needed for sc-cite-original | |
| 1352 (push-mark) ;Needed for sc-cite-original | |
| 1353 (goto-char (point-min)) ;Needed for sc-cite-original | |
| 1354 (mh-insert-prefix-string mh-ins-buf-prefix) | |
| 1355 (if (or (eq 'attribution mh-yank-from-start-of-msg) | |
| 1356 (eq 'autoattrib mh-yank-from-start-of-msg)) | |
| 1357 (insert from-attr "\n\n")) | |
| 1358 ;; If the user has selected a region, he has already "edited" the | |
| 1359 ;; text, so leave the cursor at the end of the yanked text. In | |
| 1360 ;; either case, leave a mark at the opposite end of the included | |
| 1361 ;; text to make it easy to jump or delete to the other end of the | |
| 1362 ;; text. | |
| 1363 (push-mark) | |
| 1364 (goto-char (point-max)) | |
| 1365 (if (null yank-region) | |
| 1366 (mh-exchange-point-and-mark-preserving-active-mark))))) | |
| 1367 (error "There is no current message"))) | |
| 1368 | |
| 1369 (defun mh-filter-out-non-text (string) | |
| 1370 "Return STRING but without adornments such as MIME buttons and smileys." | |
| 1371 (with-temp-buffer | |
| 1372 ;; Insert the string to filter | |
| 1373 (insert string) | |
| 1374 (goto-char (point-min)) | |
| 1375 | |
| 1376 ;; Remove the MIME buttons | |
| 1377 (let ((can-move-forward t) | |
| 1378 (in-button nil)) | |
| 1379 (while can-move-forward | |
| 1380 (cond ((and (not (get-text-property (point) 'mh-data)) | |
| 1381 in-button) | |
| 1382 (delete-region (1- (point)) (point)) | |
| 1383 (setq in-button nil)) | |
| 1384 ((get-text-property (point) 'mh-data) | |
| 1385 (delete-region (point) | |
| 1386 (save-excursion (forward-line) (point))) | |
| 1387 (setq in-button t)) | |
| 1388 (t (setq can-move-forward (= (forward-line) 0)))))) | |
| 1389 | |
| 1390 ;; Return the contents without properties... This gets rid of emphasis | |
| 1391 ;; and smileys | |
| 1392 (buffer-substring-no-properties (point-min) (point-max)))) | |
| 1393 | |
| 1394 (defun mh-insert-prefix-string (mh-ins-string) | |
| 1395 "Insert prefix string before each line in buffer. | |
| 1396 The inserted letter is cited using `sc-cite-original' if | |
| 1397 `mh-yank-from-start-of-msg' is one of 'supercite or 'autosupercite. Otherwise, | |
| 1398 simply insert MH-INS-STRING before each line." | |
| 1399 (goto-char (point-min)) | |
| 1400 (cond ((or (eq mh-yank-from-start-of-msg 'supercite) | |
| 1401 (eq mh-yank-from-start-of-msg 'autosupercite)) | |
| 1402 (sc-cite-original)) | |
| 1403 (mail-citation-hook | |
| 1404 (run-hooks 'mail-citation-hook)) | |
| 1405 (mh-yank-hooks ;old hook name | |
| 1406 (run-hooks 'mh-yank-hooks)) | |
| 1407 (t | |
| 1408 (or (bolp) (forward-line 1)) | |
| 1409 (while (< (point) (point-max)) | |
| 1410 (insert mh-ins-string) | |
| 1411 (forward-line 1)) | |
| 1412 (goto-char (point-min))))) ;leave point like sc-cite-original | |
| 1413 | |
| 1414 ;;;###mh-autoload | |
| 1415 (defun mh-fully-kill-draft () | |
| 1416 "Kill the draft message file and the draft message buffer. | |
| 1417 Use \\[kill-buffer] if you don't want to delete the draft message file." | |
| 1418 (interactive) | |
| 1419 (if (y-or-n-p "Kill draft message? ") | |
| 1420 (let ((config mh-previous-window-config)) | |
| 1421 (if (file-exists-p buffer-file-name) | |
| 1422 (delete-file buffer-file-name)) | |
| 1423 (set-buffer-modified-p nil) | |
| 1424 (kill-buffer (buffer-name)) | |
| 1425 (message "") | |
| 1426 (if config | |
| 1427 (set-window-configuration config))) | |
| 1428 (error "Message not killed"))) | |
| 1429 | |
| 1430 (defun mh-current-fill-prefix () | |
| 1431 "Return the `fill-prefix' on the current line as a string." | |
| 1432 (save-excursion | |
| 1433 (beginning-of-line) | |
| 1434 ;; This assumes that the major-mode sets up adaptive-fill-regexp | |
| 1435 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But | |
| 1436 ;; perhaps I should use the variable and simply inserts its value here, | |
| 1437 ;; and set it locally in a let scope. --psg | |
| 1438 (if (re-search-forward adaptive-fill-regexp nil t) | |
| 1439 (match-string 0) | |
| 1440 ""))) | |
| 1441 | |
| 1442 ;;;###mh-autoload | |
| 1443 (defun mh-open-line () | |
| 1444 "Insert a newline and leave point after it. | |
| 1445 In addition, insert newline and quoting characters before text after point. | |
| 1446 This is useful in breaking up paragraphs in replies." | |
| 1447 (interactive) | |
| 1448 (let ((column (current-column)) | |
| 1449 (prefix (mh-current-fill-prefix))) | |
| 1450 (if (> (length prefix) column) | |
| 1451 (message "Sorry, point seems to be within the line prefix") | |
| 1452 (newline 2) | |
| 1453 (insert prefix) | |
| 1454 (while (> column (current-column)) | |
| 1455 (insert " ")) | |
| 1456 (forward-line -1)))) | |
| 1457 | |
| 1458 ;;;###mh-autoload | |
| 1459 (defun mh-letter-complete (arg) | |
| 1460 "Perform completion on header field or word preceding point. | |
| 1461 Alias completion is done within the mail header on selected fields and | |
| 1462 by the function designated by `mh-letter-complete-function' elsewhere, | |
| 1463 passing the prefix ARG if any." | |
| 1464 (interactive "P") | |
| 1465 (let ((case-fold-search t)) | |
| 1466 (if (and (mh-in-header-p) | |
| 1467 (save-excursion | |
| 1468 (mh-header-field-beginning) | |
| 1469 (looking-at "^.*\\(to\\|cc\\|from\\):"))) | |
| 1470 (mh-alias-letter-expand-alias) | |
| 1471 (funcall mh-letter-complete-function arg)))) | |
| 1472 | |
| 1473 ;;; Build the letter-mode keymap: | |
| 1474 ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. | |
| 1475 (gnus-define-keys mh-letter-mode-map | |
| 1476 "\C-c?" mh-help | |
| 1477 "\C-c\C-c" mh-send-letter | |
| 1478 "\C-c\C-d" mh-insert-identity | |
| 1479 "\C-c\C-e" mh-edit-mhn | |
| 1480 "\C-c\C-f\C-b" mh-to-field | |
| 1481 "\C-c\C-f\C-c" mh-to-field | |
| 1482 "\C-c\C-f\C-d" mh-to-field | |
| 1483 "\C-c\C-f\C-f" mh-to-fcc | |
| 1484 "\C-c\C-f\C-r" mh-to-field | |
| 1485 "\C-c\C-f\C-s" mh-to-field | |
| 1486 "\C-c\C-f\C-t" mh-to-field | |
| 1487 "\C-c\C-fb" mh-to-field | |
| 1488 "\C-c\C-fc" mh-to-field | |
| 1489 "\C-c\C-fd" mh-to-field | |
| 1490 "\C-c\C-ff" mh-to-fcc | |
| 1491 "\C-c\C-fr" mh-to-field | |
| 1492 "\C-c\C-fs" mh-to-field | |
| 1493 "\C-c\C-ft" mh-to-field | |
| 1494 "\C-c\C-i" mh-insert-letter | |
| 1495 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime | |
| 1496 "\C-c\C-m\C-f" mh-compose-forward | |
| 1497 "\C-c\C-m\C-i" mh-compose-insertion | |
| 1498 "\C-c\C-m\C-m" mh-mml-to-mime | |
| 1499 "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime | |
| 1500 "\C-c\C-m\C-u" mh-revert-mhn-edit | |
| 1501 "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime | |
| 1502 "\C-c\C-mf" mh-compose-forward | |
| 1503 "\C-c\C-mi" mh-compose-insertion | |
| 1504 "\C-c\C-mm" mh-mml-to-mime | |
| 1505 "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime | |
| 1506 "\C-c\C-mu" mh-revert-mhn-edit | |
| 1507 "\C-c\C-o" mh-open-line | |
| 1508 "\C-c\C-q" mh-fully-kill-draft | |
| 1509 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q | |
| 1510 "\C-c\C-s" mh-insert-signature | |
| 1511 "\C-c\C-^" mh-insert-signature ;if no C-s | |
| 1512 "\C-c\C-w" mh-check-whom | |
| 1513 "\C-c\C-y" mh-yank-cur-msg | |
| 1514 "\M-\t" mh-letter-complete) | |
| 1515 | |
| 1516 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. | |
| 1517 | |
| 1518 (provide 'mh-comp) | |
| 1519 | |
| 1520 ;;; Local Variables: | |
| 1521 ;;; indent-tabs-mode: nil | |
| 1522 ;;; sentence-end-double-space: nil | |
| 1523 ;;; End: | |
| 1524 | |
| 1525 ;;; mh-comp.el ends here |