/[emacs]/emacs/lisp/mh-e/mh-comp.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-comp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by lektu, Tue Feb 4 13:15:32 2003 UTC revision 1.4 by wohler, Fri Apr 25 05:52:00 2003 UTC
# Line 1  Line 1 
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>
# Line 30  Line 31 
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)
# Line 309  See also documentation for `\\[mh-send]' Line 310  See also documentation for `\\[mh-send]'
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
# Line 337  See also documentation for `\\[mh-send]' Line 332  See also documentation for `\\[mh-send]'
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)
# Line 353  See also documentation for `\\[mh-send]' Line 349  See also documentation for `\\[mh-send]'
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
# Line 386  See also documentation for `\\[mh-send]' Line 380  See also documentation for `\\[mh-send]'
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)
# Line 439  setting of the variable `mh-redist-full- Line 431  setting of the variable `mh-redist-full-
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    
# Line 501  Optional argument BUFFER can be used to Line 482  Optional argument BUFFER can be used to
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,
# Line 706  reused." Line 688  reused."
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.
# Line 776  Returns t if found, nil if not." Line 759  Returns t if found, nil if not."
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))))))
# Line 812  Returns t if found, nil if not." Line 795  Returns t if found, nil if not."
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]))))
# Line 857  work better in MH-Letter mode." Line 840  work better in MH-Letter mode."
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>
# Line 918  When a message is composed, the hooks `t Line 906  When a message is composed, the hooks `t
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)
# Line 933  When a message is composed, the hooks `t Line 924  When a message is composed, the hooks `t
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
# Line 1055  called, with no arguments, before the si Line 1036  called, with no arguments, before the si
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.
# Line 1116  The versions of MH-E, Emacs, and MH are Line 1106  The versions of MH-E, Emacs, and MH are
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
# Line 1149  message.  In that case, the ANNOTATE-FIE Line 1157  message.  In that case, the ANNOTATE-FIE
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)
# Line 1169  CONFIG is the window configuration to re Line 1178  CONFIG is the window configuration to re
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)
# Line 1193  This should be the last function called Line 1203  This should be the last function called
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)
# Line 1232  Insert X-Face field if the file specifie Line 1239  Insert X-Face field if the file specifie
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)
# Line 1339  yanked message will be deleted." Line 1346  yanked message will be deleted."
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
# Line 1472  This is useful in breaking up paragraphs Line 1479  This is useful in breaking up paragraphs
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.
# Line 1480  by the function designated by `mh-letter Line 1514  by the function designated by `mh-letter
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.
# Line 1532  passing the prefix ARG if any." Line 1573  passing the prefix ARG if any."
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:

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26