1 |
;;; mh-comp.el --- MH-E functions for composing messages |
;;; mh-comp.el --- MH-E functions for composing messages |
2 |
|
|
3 |
;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 95, 1997, |
4 |
|
;; 2000, 01, 02, 2003 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Bill Wohler <wohler@newt.com> |
;; Author: Bill Wohler <wohler@newt.com> |
7 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
31 |
|
|
32 |
;;; Change Log: |
;;; Change Log: |
33 |
|
|
|
;; $Id$ |
|
|
|
|
34 |
;;; Code: |
;;; Code: |
35 |
|
|
36 |
(require 'mh-e) |
(require 'mh-e) |
37 |
(require 'gnus-util) |
(require 'gnus-util) |
38 |
(require 'easymenu) |
(require 'easymenu) |
39 |
(require 'cl) |
(require 'cl) |
40 |
|
(eval-when (compile load eval) |
41 |
|
(ignore-errors (require 'mailabbrev))) |
42 |
|
|
43 |
;; Shush the byte-compiler |
;; Shush the byte-compiler |
44 |
(defvar adaptive-fill-first-line-regexp) |
(defvar adaptive-fill-first-line-regexp) |
310 |
|
|
311 |
;;;###mh-autoload |
;;;###mh-autoload |
312 |
(defun mh-forward (to cc &optional msg-or-seq) |
(defun mh-forward (to cc &optional msg-or-seq) |
313 |
"Forward one or more messages to the recipients TO and CC. |
"Forward messages to the recipients TO and CC. |
314 |
|
Use optional MSG-OR-SEQ argument to specify a message or sequence to forward. |
315 |
Use the optional MSG-OR-SEQ to specify a message or sequence to forward. |
Default is the displayed message. |
316 |
|
If optional prefix argument is provided, then prompt for the message sequence. |
317 |
|
If variable `transient-mark-mode' is non-nil and the mark is active, then the |
318 |
|
selected region is forwarded. |
319 |
|
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a |
320 |
|
region in a cons cell, or a sequence. |
321 |
|
|
|
Default is the displayed message. If optional prefix argument is given then |
|
|
prompt for the message sequence. If variable `transient-mark-mode' is non-nil |
|
|
and the mark is active, then the selected region is forwarded. |
|
322 |
See also documentation for `\\[mh-send]' function." |
See also documentation for `\\[mh-send]' function." |
323 |
(interactive (list (mh-read-address "To: ") |
(interactive (list (mh-read-address "To: ") |
324 |
(mh-read-address "Cc: ") |
(mh-read-address "Cc: ") |
325 |
(cond |
(mh-interactive-msg-or-seq "Forward"))) |
|
((mh-mark-active-p t) |
|
|
(mh-region-to-msg-list (region-beginning) (region-end))) |
|
|
(current-prefix-arg |
|
|
(mh-read-seq-default "Forward" t)) |
|
|
(t |
|
|
(mh-get-msg-num t))))) |
|
326 |
(let* ((folder mh-current-folder) |
(let* ((folder mh-current-folder) |
327 |
(msgs (cond ((numberp msg-or-seq) (list msg-or-seq)) |
(msgs (mh-msg-or-seq-to-msg-list msg-or-seq)) |
|
((listp msg-or-seq) msg-or-seq) |
|
|
(t (mh-seq-to-msgs msg-or-seq)))) |
|
328 |
(config (current-window-configuration)) |
(config (current-window-configuration)) |
329 |
(fwd-msg-file (mh-msg-filename (car msgs) folder)) |
(fwd-msg-file (mh-msg-filename (car msgs) folder)) |
330 |
;; forw always leaves file in "draft" since it doesn't have -draft |
;; forw always leaves file in "draft" since it doesn't have -draft |
332 |
(draft (cond ((or (not (file-exists-p draft-name)) |
(draft (cond ((or (not (file-exists-p draft-name)) |
333 |
(y-or-n-p "The file 'draft' exists. Discard it? ")) |
(y-or-n-p "The file 'draft' exists. Discard it? ")) |
334 |
(mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") |
(mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") |
335 |
mh-current-folder msgs) |
mh-current-folder |
336 |
|
(mh-coalesce-msg-list msgs)) |
337 |
(prog1 |
(prog1 |
338 |
(mh-read-draft "" draft-name t) |
(mh-read-draft "" draft-name t) |
339 |
(mh-insert-fields "To:" to "Cc:" cc) |
(mh-insert-fields "To:" to "Cc:" cc) |
349 |
(setq orig-from (mh-get-header-field "From:")) |
(setq orig-from (mh-get-header-field "From:")) |
350 |
(setq orig-subject (mh-get-header-field "Subject:"))) |
(setq orig-subject (mh-get-header-field "Subject:"))) |
351 |
(let ((forw-subject |
(let ((forw-subject |
352 |
(mh-forwarded-letter-subject orig-from orig-subject)) |
(mh-forwarded-letter-subject orig-from orig-subject))) |
|
(compose)) |
|
353 |
(mh-insert-fields "Subject:" forw-subject) |
(mh-insert-fields "Subject:" forw-subject) |
354 |
(goto-char (point-min)) |
(goto-char (point-min)) |
355 |
;; If using MML, translate mhn |
;; If using MML, translate mhn |
356 |
(if (equal mh-compose-insertion 'gnus) |
(if (equal mh-compose-insertion 'gnus) |
357 |
(save-excursion |
(save-excursion |
|
(setq compose t) |
|
358 |
(re-search-forward (format "^\\(%s\\)?$" |
(re-search-forward (format "^\\(%s\\)?$" |
359 |
mh-mail-header-separator)) |
mh-mail-header-separator)) |
360 |
(while |
(while |
380 |
(forward-line 1)) |
(forward-line 1)) |
381 |
(delete-other-windows) |
(delete-other-windows) |
382 |
(mh-add-msgs-to-seq msgs 'forwarded t) |
(mh-add-msgs-to-seq msgs 'forwarded t) |
383 |
(mh-compose-and-send-mail draft "" folder msg-or-seq |
(mh-compose-and-send-mail draft "" folder msgs |
384 |
to forw-subject cc |
to forw-subject cc |
385 |
mh-note-forw "Forwarded:" |
mh-note-forw "Forwarded:" |
386 |
config) |
config) |
|
(if compose |
|
|
(setq mh-mml-compose-insert-flag t)) |
|
387 |
(mh-letter-mode-message))))) |
(mh-letter-mode-message))))) |
388 |
|
|
389 |
(defun mh-forwarded-letter-subject (from subject) |
(defun mh-forwarded-letter-subject (from subject) |
431 |
(mh-goto-header-end 0) |
(mh-goto-header-end 0) |
432 |
(insert "Resent-To: " to "\n") |
(insert "Resent-To: " to "\n") |
433 |
(if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) |
(if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) |
434 |
(mh-clean-msg-header (point-min) |
(mh-clean-msg-header |
435 |
"^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" |
(point-min) |
436 |
nil) |
"^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" |
437 |
|
nil) |
438 |
(save-buffer) |
(save-buffer) |
439 |
(message "Redistributing...") |
(message "Redistributing...") |
440 |
(if (not mh-redist-background) |
(let ((env "mhdist=1")) |
441 |
(if mh-redist-full-contents |
;; Setup environment... |
442 |
(call-process "/bin/sh" nil 0 nil "-c" |
(setq env (concat env " mhaltmsg=" (if mh-redist-full-contents |
443 |
(format "mhdist=1 mhaltmsg=%s %s -push %s" |
buffer-file-name |
444 |
buffer-file-name |
(mh-msg-filename msg folder)))) |
445 |
(expand-file-name mh-send-prog mh-progs) |
(unless mh-redist-full-contents |
446 |
buffer-file-name)) |
(setq env (concat env " mhannotate=1"))) |
447 |
(call-process "/bin/sh" nil 0 nil "-c" |
;; Redistribute... |
448 |
(format |
(if mh-redist-background |
449 |
"mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" |
(mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name) |
450 |
(mh-msg-filename msg folder) |
(mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name)) |
451 |
(expand-file-name mh-send-prog mh-progs) |
;; Annotate... |
452 |
buffer-file-name)))) |
(mh-annotate-msg msg folder mh-note-dist |
453 |
(mh-annotate-msg msg folder mh-note-dist |
"-component" "Resent:" |
454 |
"-component" "Resent:" |
"-text" (format "\"%s %s\"" to cc))) |
|
"-text" (format "\"%s %s\"" to cc)) |
|
|
(if mh-redist-background |
|
|
(mh-exec-cmd-daemon "/bin/sh" nil "-c" |
|
|
(format "mhdist=1 mhaltmsg=%s %s %s %s" |
|
|
(if mh-redist-full-contents |
|
|
buffer-file-name |
|
|
(mh-msg-filename msg folder)) |
|
|
(if mh-redist-full-contents |
|
|
"" |
|
|
"mhannotate=1") |
|
|
(mh-expand-file-name "send" mh-progs) |
|
|
buffer-file-name))) |
|
455 |
(kill-buffer draft) |
(kill-buffer draft) |
456 |
(message "Redistributing...done")))) |
(message "Redistributing...done")))) |
457 |
|
|
482 |
|
|
483 |
;;;###mh-autoload |
;;;###mh-autoload |
484 |
(defun mh-reply (message &optional reply-to includep) |
(defun mh-reply (message &optional reply-to includep) |
485 |
"Reply to MESSAGE (default: current message). |
"Reply to MESSAGE. |
486 |
|
Default is the displayed message. |
487 |
If the optional argument REPLY-TO is not given, prompts for type of addresses |
If the optional argument REPLY-TO is not given, prompts for type of addresses |
488 |
to reply to: |
to reply to: |
489 |
from sender only, |
from sender only, |
688 |
(buffer-substring (point-min) (1- (point-max))))) |
(buffer-substring (point-min) (1- (point-max))))) |
689 |
|
|
690 |
(defun mh-annotate-msg (msg buffer note &rest args) |
(defun mh-annotate-msg (msg buffer note &rest args) |
691 |
"Mark MSG in BUFFER with character NOTE and annotate message with ARGS." |
"Mark MSG in BUFFER with character NOTE and annotate message with ARGS. |
692 |
(apply 'mh-exec-cmd "anno" buffer msg args) |
MSG can be a message number, a list of message numbers, or a sequence." |
693 |
|
(apply 'mh-exec-cmd "anno" buffer |
694 |
|
(if (listp msg) (append msg args) (cons msg args))) |
695 |
(save-excursion |
(save-excursion |
696 |
(cond ((get-buffer buffer) ; Buffer may be deleted |
(cond ((get-buffer buffer) ; Buffer may be deleted |
697 |
(set-buffer buffer) |
(set-buffer buffer) |
698 |
(if (numberp msg) |
(mh-iterate-on-msg-or-seq nil msg |
699 |
(mh-notate msg note (1+ mh-cmd-note)) |
(mh-notate nil note (1+ mh-cmd-note))))))) |
|
(mh-notate-seq msg note (1+ mh-cmd-note))))))) |
|
700 |
|
|
701 |
(defun mh-insert-fields (&rest name-values) |
(defun mh-insert-fields (&rest name-values) |
702 |
"Insert the NAME-VALUES pairs in the current buffer. |
"Insert the NAME-VALUES pairs in the current buffer. |
759 |
"Extract From: string from header." |
"Extract From: string from header." |
760 |
(save-excursion |
(save-excursion |
761 |
(if (not (mh-goto-header-field "From:")) |
(if (not (mh-goto-header-field "From:")) |
762 |
(error "No From header line found") |
nil |
763 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
764 |
(buffer-substring-no-properties |
(buffer-substring-no-properties |
765 |
(point) (progn (mh-header-field-end)(point)))))) |
(point) (progn (mh-header-field-end)(point)))))) |
795 |
;; The next two will have to be merged. But I also need to make sure the |
;; The next two will have to be merged. But I also need to make sure the |
796 |
;; user can't mix directives of both types. |
;; user can't mix directives of both types. |
797 |
["Pull in All Compositions (mhn)" |
["Pull in All Compositions (mhn)" |
798 |
mh-edit-mhn mh-mhn-compose-insert-flag] |
mh-edit-mhn (mh-mhn-directive-present-p)] |
799 |
["Pull in All Compositions (gnus)" |
["Pull in All Compositions (gnus)" |
800 |
mh-mml-to-mime mh-mml-compose-insert-flag] |
mh-mml-to-mime (mh-mml-directive-present-p)] |
801 |
["Revert to Non-MIME Edit (mhn)" |
["Revert to Non-MIME Edit (mhn)" |
802 |
mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] |
mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] |
803 |
["Kill This Draft" mh-fully-kill-draft t])))) |
["Kill This Draft" mh-fully-kill-draft t])))) |
840 |
(mail-mode-fill-paragraph arg) |
(mail-mode-fill-paragraph arg) |
841 |
(fill-paragraph arg)))) |
(fill-paragraph arg)))) |
842 |
|
|
843 |
|
;; Avoid compiler warnings in XEmacs and Emacs 20 |
844 |
|
(eval-when-compile |
845 |
|
(defvar tool-bar-mode) |
846 |
|
(defvar tool-bar-map)) |
847 |
|
|
848 |
;;;###autoload |
;;;###autoload |
849 |
(define-derived-mode mh-letter-mode text-mode "MH-Letter" |
(define-derived-mode mh-letter-mode text-mode "MH-Letter" |
850 |
"Mode for composing letters in MH-E.\\<mh-letter-mode-map> |
"Mode for composing letters in MH-E.\\<mh-letter-mode-map> |
906 |
(setq paragraph-separate paragraph-start) |
(setq paragraph-separate paragraph-start) |
907 |
;; --- End of code from sendmail.el --- |
;; --- End of code from sendmail.el --- |
908 |
|
|
909 |
|
;; Enable undo since a show-mode buffer might have been reused. |
910 |
|
(buffer-enable-undo) |
911 |
(if (and (boundp 'tool-bar-mode) tool-bar-mode) |
(if (and (boundp 'tool-bar-mode) tool-bar-mode) |
912 |
(set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) |
(set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) |
913 |
|
(mh-funcall-if-exists mh-toolbar-init :letter) |
914 |
(make-local-variable 'font-lock-defaults) |
(make-local-variable 'font-lock-defaults) |
915 |
(cond |
(cond |
916 |
((or (equal mh-highlight-citation-p 'font-lock) |
((or (equal mh-highlight-citation-p 'font-lock) |
924 |
;; ...or the header only |
;; ...or the header only |
925 |
(setq font-lock-defaults '(mh-show-font-lock-keywords t)))) |
(setq font-lock-defaults '(mh-show-font-lock-keywords t)))) |
926 |
(easy-menu-add mh-letter-menu) |
(easy-menu-add mh-letter-menu) |
|
;; See if a "forw: -mime" message containing a MIME composition. |
|
|
;; Mode clears local vars, so can't do this in mh-forward. |
|
|
(save-excursion |
|
|
(goto-char (point-min)) |
|
|
(when (and (re-search-forward |
|
|
(format "^\\(%s\\)?$" mail-header-separator) nil t) |
|
|
(= 0 (forward-line 1)) |
|
|
(looking-at "^#forw")) |
|
|
(require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var |
|
|
(setq mh-mhn-compose-insert-flag t))) |
|
927 |
(setq fill-column mh-letter-fill-column) |
(setq fill-column mh-letter-fill-column) |
928 |
;; If text-mode-hook turned on auto-fill, tune it for messages |
;; If text-mode-hook turned on auto-fill, tune it for messages |
929 |
(when auto-fill-function |
(when auto-fill-function |
1036 |
;;; Routines to compose and send a letter. |
;;; Routines to compose and send a letter. |
1037 |
|
|
1038 |
(defun mh-insert-x-face () |
(defun mh-insert-x-face () |
1039 |
"Append X-Face field to header. |
"Append X-Face, Face or X-Image-URL field to header. |
1040 |
If the field already exists, this function does nothing." |
If the field already exists, this function does nothing." |
1041 |
(when (and (file-exists-p mh-x-face-file) |
(when (and (file-exists-p mh-x-face-file) |
1042 |
(file-readable-p mh-x-face-file)) |
(file-readable-p mh-x-face-file)) |
1043 |
(save-excursion |
(save-excursion |
1044 |
(when (null (mh-position-on-field "X-Face")) |
(unless (or (mh-position-on-field "X-Face") |
1045 |
(insert "X-Face: ") |
(mh-position-on-field "Face") |
1046 |
(goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file)))) |
(mh-position-on-field "X-Image-URL")) |
1047 |
(if (not (looking-at "^")) |
(save-excursion |
1048 |
(insert "\n")))))) |
(goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file)))) |
1049 |
|
(if (not (looking-at "^")) |
1050 |
|
(insert "\n"))) |
1051 |
|
(unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ") |
1052 |
|
(insert "X-Face: ")))))) |
1053 |
|
|
1054 |
|
(defvar mh-x-mailer-string nil |
1055 |
|
"*String containing the contents of the X-Mailer header field. |
1056 |
|
If nil, this variable is initialized to show the version of MH-E, Emacs, and |
1057 |
|
MH the first time a message is composed.") |
1058 |
|
|
1059 |
(defun mh-insert-x-mailer () |
(defun mh-insert-x-mailer () |
1060 |
"Append an X-Mailer field to the header. |
"Append an X-Mailer field to the header. |
1106 |
(setq fields (cdr fields)))) |
(setq fields (cdr fields)))) |
1107 |
search-result))) |
search-result))) |
1108 |
|
|
1109 |
(defun mh-insert-mail-followup-to () |
(defun mh-insert-auto-fields () |
1110 |
"Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'." |
"Insert custom fields if To or Cc match `mh-auto-fields-list'." |
1111 |
(save-excursion |
(save-excursion |
1112 |
(if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")) |
(when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))) |
1113 |
(not (mh-goto-header-field "Mail-Followup-To: "))) |
(let ((list mh-auto-fields-list)) |
1114 |
(let ((list mh-insert-mail-followup-to-list)) |
(while list |
1115 |
(while list |
(let ((regexp (nth 0 (car list))) |
1116 |
(let ((regexp (nth 0 (car list))) |
(entries (nth 1 (car list)))) |
1117 |
(entry (nth 1 (car list)))) |
(when (mh-regexp-in-field-p regexp "To:" "cc:") |
1118 |
(when (mh-regexp-in-field-p regexp "To:" "cc:") |
(let ((entry-list entries)) |
1119 |
(if (mh-goto-header-field "Mail-Followup-To: ") |
(while entry-list |
1120 |
(insert entry ", ") |
(let ((field (caar entry-list)) |
1121 |
(mh-goto-header-end 0) |
(value (cdar entry-list))) |
1122 |
(insert "Mail-Followup-To: " entry "\n"))) |
(cond |
1123 |
(setq list (cdr list)))))))) |
((equal "identity" field) |
1124 |
|
(when (assoc value mh-identity-list) |
1125 |
|
(mh-insert-identity value))) |
1126 |
|
(t |
1127 |
|
(mh-modify-header-field field value |
1128 |
|
(equal field "From"))))) |
1129 |
|
(setq entry-list (cdr entry-list)))))) |
1130 |
|
(setq list (cdr list))))))) |
1131 |
|
|
1132 |
|
(defun mh-modify-header-field (field value &optional overwrite-flag) |
1133 |
|
"To header FIELD add VALUE. |
1134 |
|
If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded." |
1135 |
|
(cond ((mh-goto-header-field (concat field ":")) |
1136 |
|
(insert value) |
1137 |
|
(if overwrite-flag |
1138 |
|
(delete-region (point) (line-end-position)) |
1139 |
|
(insert ", "))) |
1140 |
|
(t (mh-goto-header-end 0) |
1141 |
|
(insert field ": " value "\n")))) |
1142 |
|
|
1143 |
(defun mh-compose-and-send-mail (draft send-args |
(defun mh-compose-and-send-mail (draft send-args |
1144 |
sent-from-folder sent-from-msg |
sent-from-folder sent-from-msg |
1157 |
for `mh-annotate-msg'. |
for `mh-annotate-msg'. |
1158 |
CONFIG is the window configuration to restore after sending the letter." |
CONFIG is the window configuration to restore after sending the letter." |
1159 |
(pop-to-buffer draft) |
(pop-to-buffer draft) |
1160 |
(if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to)) |
(mh-insert-auto-fields) |
1161 |
(mh-letter-mode) |
(mh-letter-mode) |
1162 |
|
|
1163 |
;; mh-identity support |
;; mh-identity support |
1164 |
(if (and (boundp 'mh-identity-default) |
(if (and (boundp 'mh-identity-default) |
1165 |
mh-identity-default) |
mh-identity-default |
1166 |
|
(not mh-identity-local)) |
1167 |
(mh-insert-identity mh-identity-default)) |
(mh-insert-identity mh-identity-default)) |
1168 |
(when (and (boundp 'mh-identity-list) |
(when (and (boundp 'mh-identity-list) |
1169 |
mh-identity-list) |
mh-identity-list) |
1178 |
(setq mh-previous-window-config config) |
(setq mh-previous-window-config config) |
1179 |
(setq mode-line-buffer-identification (list " {%b}")) |
(setq mode-line-buffer-identification (list " {%b}")) |
1180 |
(mh-logo-display) |
(mh-logo-display) |
1181 |
|
(mh-make-local-hook 'kill-buffer-hook) |
1182 |
(add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t) |
(add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t) |
1183 |
(if (and (boundp 'mh-compose-letter-function) |
(if (and (boundp 'mh-compose-letter-function) |
1184 |
mh-compose-letter-function) |
mh-compose-letter-function) |
1203 |
If optional prefix argument ARG is provided, monitor delivery. |
If optional prefix argument ARG is provided, monitor delivery. |
1204 |
The value of `mh-before-send-letter-hook' is a list of functions to be called, |
The value of `mh-before-send-letter-hook' is a list of functions to be called, |
1205 |
with no arguments, before doing anything. |
with no arguments, before doing anything. |
1206 |
Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set. |
Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise |
1207 |
Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set. |
run `\\[mh-mml-to-mime]' if mml directives are present. |
1208 |
Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. |
Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. |
1209 |
Insert X-Face field if the file specified by `mh-x-face-file' exists." |
Insert X-Face field if the file specified by `mh-x-face-file' exists." |
1210 |
(interactive "P") |
(interactive "P") |
1211 |
(run-hooks 'mh-before-send-letter-hook) |
(run-hooks 'mh-before-send-letter-hook) |
1212 |
(cond |
(cond ((mh-mhn-directive-present-p) |
1213 |
((and (boundp 'mh-mhn-compose-insert-flag) |
(mh-edit-mhn)) |
1214 |
mh-mhn-compose-insert-flag) |
((mh-mml-directive-present-p) |
1215 |
(mh-edit-mhn)) |
(mh-mml-to-mime))) |
|
((and (boundp 'mh-mml-compose-insert-flag) |
|
|
mh-mml-compose-insert-flag) |
|
|
(mh-mml-to-mime))) |
|
1216 |
(if mh-insert-x-mailer-flag (mh-insert-x-mailer)) |
(if mh-insert-x-mailer-flag (mh-insert-x-mailer)) |
1217 |
(mh-insert-x-face) |
(mh-insert-x-face) |
1218 |
(save-buffer) |
(save-buffer) |
1239 |
(mh-goto-header-field "Content-Type:")) |
(mh-goto-header-field "Content-Type:")) |
1240 |
(setq mh-send-args (format "-mime %s" mh-send-args))) |
(setq mh-send-args (format "-mime %s" mh-send-args))) |
1241 |
(cond (arg |
(cond (arg |
1242 |
(pop-to-buffer "MH mail delivery") |
(pop-to-buffer mh-mail-delivery-buffer) |
1243 |
(erase-buffer) |
(erase-buffer) |
1244 |
(mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" |
(mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" |
1245 |
"-nodraftfolder" mh-send-args file-name) |
"-nodraftfolder" mh-send-args file-name) |
1346 |
(eq t mh-yank-from-start-of-msg))) |
(eq t mh-yank-from-start-of-msg))) |
1347 |
;; supercite needs the full header |
;; supercite needs the full header |
1348 |
(concat |
(concat |
1349 |
(buffer-substring (point-min) (mail-header-end)) |
(buffer-substring (point-min) (mh-mail-header-end)) |
1350 |
"\n" |
"\n" |
1351 |
(buffer-substring (region-beginning) (region-end)))) |
(buffer-substring (region-beginning) (region-end)))) |
1352 |
(yank-region |
(yank-region |
1479 |
(insert " ")) |
(insert " ")) |
1480 |
(forward-line -1)))) |
(forward-line -1)))) |
1481 |
|
|
1482 |
|
(mh-do-in-xemacs (defvar mail-abbrevs)) |
1483 |
|
|
1484 |
|
(defun mh-folder-expand-at-point () |
1485 |
|
"Do folder name completion in Fcc header field." |
1486 |
|
(let* ((end (point)) |
1487 |
|
(syntax-table (syntax-table)) |
1488 |
|
(beg (unwind-protect |
1489 |
|
(save-excursion |
1490 |
|
(mh-funcall-if-exists mail-abbrev-make-syntax-table) |
1491 |
|
(set-syntax-table mail-abbrev-syntax-table) |
1492 |
|
(backward-word 1) |
1493 |
|
(point)) |
1494 |
|
(set-syntax-table syntax-table))) |
1495 |
|
(folder (buffer-substring beg end)) |
1496 |
|
(leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+))) |
1497 |
|
(last-slash (mh-search-from-end ?/ folder)) |
1498 |
|
(prefix (and last-slash (substring folder 0 last-slash))) |
1499 |
|
(mail-abbrevs |
1500 |
|
(mapcar #'(lambda (x) |
1501 |
|
(list (cond (prefix (format "%s/%s" prefix x)) |
1502 |
|
(leading-plus (format "+%s" x)) |
1503 |
|
(t x)))) |
1504 |
|
(mh-folder-completion-function folder nil t)))) |
1505 |
|
(if (fboundp 'mail-abbrev-complete-alias) |
1506 |
|
(mh-funcall-if-exists mail-abbrev-complete-alias) |
1507 |
|
(error "Fcc completion not supported in your version of Emacs")))) |
1508 |
|
|
1509 |
;;;###mh-autoload |
;;;###mh-autoload |
1510 |
(defun mh-letter-complete (arg) |
(defun mh-letter-complete (arg) |
1511 |
"Perform completion on header field or word preceding point. |
"Perform completion on header field or word preceding point. |
1514 |
passing the prefix ARG if any." |
passing the prefix ARG if any." |
1515 |
(interactive "P") |
(interactive "P") |
1516 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
1517 |
(if (and (mh-in-header-p) |
(cond |
1518 |
(save-excursion |
((and (mh-in-header-p) |
1519 |
(mh-header-field-beginning) |
(save-excursion |
1520 |
(looking-at "^.*\\(to\\|cc\\|from\\):"))) |
(mh-header-field-beginning) |
1521 |
(mh-alias-letter-expand-alias) |
(looking-at "^fcc:"))) |
1522 |
(funcall mh-letter-complete-function arg)))) |
(mh-folder-expand-at-point)) |
1523 |
|
((and (mh-in-header-p) |
1524 |
|
(save-excursion |
1525 |
|
(mh-header-field-beginning) |
1526 |
|
(looking-at "^.*\\(to\\|cc\\|from\\):"))) |
1527 |
|
(mh-alias-letter-expand-alias)) |
1528 |
|
(t |
1529 |
|
(funcall mh-letter-complete-function arg))))) |
1530 |
|
|
1531 |
;;; Build the letter-mode keymap: |
;;; Build the letter-mode keymap: |
1532 |
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. |
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. |
1573 |
|
|
1574 |
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. |
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. |
1575 |
|
|
1576 |
|
;;;###autoload(add-to-list 'auto-mode-alist '("/drafts/[0-9]+\\'" . mh-letter-mode)) |
1577 |
|
|
1578 |
(provide 'mh-comp) |
(provide 'mh-comp) |
1579 |
|
|
1580 |
;;; Local Variables: |
;;; Local Variables: |