X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-draft.el;h=4bad775bece5afa7f62859979991c53588337365;hb=30e5707a7503b9147f566e53163484a99bdb83e9;hp=9b18989add79df26bb0f0e34349b1c760f5ca0d2;hpb=3738187cad20787b5b99c4061256e30e19ee721a;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 9b18989..4bad775 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,9 +1,11 @@ -;;; gnus-draft.el --- draft message support for Gnus -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002 +;;; gnus-draft.el --- draft message support for Semi-gnus +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Tatsuya Ichikawa +;; Keywords: mail, news, MIME, offline ;; This file is part of GNU Emacs. @@ -74,7 +76,6 @@ (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) - (mml-mode) (gnus-run-hooks 'gnus-draft-mode-hook)))) ;;; Commands @@ -131,8 +132,9 @@ (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (let ((message-syntax-checks (if interactive nil + (let ((message-syntax-checks (if interactive message-syntax-checks 'dont-check-for-anything-just-trust-me)) + (message-hidden-headers nil) (message-inhibit-body-encoding (or (not group) (equal group "nndraft:queue") message-inhibit-body-encoding)) @@ -140,13 +142,20 @@ message-send-hook)) (message-setup-hook (and group (not (equal group "nndraft:queue")) message-setup-hook)) - type method) + type method move-to) (gnus-draft-setup article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction (message-narrow-to-head) (when (re-search-forward + (concat "^" (regexp-quote gnus-agent-target-move-group-header) + ":") nil t) + (skip-syntax-forward "-") + (setq move-to (buffer-substring (point) (gnus-point-at-eol))) + (message-remove-header gnus-agent-target-move-group-header)) + (goto-char (point-min)) + (when (re-search-forward (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") nil t) (setq type (ignore-errors (read (current-buffer))) @@ -164,8 +173,12 @@ (message-this-is-mail (eq type 'mail)) (gnus-post-method method) (message-post-method method)) - (message-send-and-exit)) - (message-send-and-exit))) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit))) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit)))) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) (or group "nndraft:queue") t))))) @@ -186,6 +199,7 @@ (cdr (assq 'unsend (gnus-info-marks (gnus-get-info "nndraft:queue")))))) + (gnus-posting-styles nil) (total (length articles)) article) (while (setq article (pop articles)) @@ -211,46 +225,53 @@ ;;; Utility functions +(defcustom gnus-draft-decoding-function + #'mime-edit-decode-message-in-buffer + "*Function called to decode the message from network representation." + :group 'gnus-agent + :type 'function) + ;;;!!!If this is byte-compiled, it fails miserably. ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. -(progn - (defun gnus-draft-setup (narticle group &optional restore) - (let (ga) - (gnus-setup-message 'forward - (let ((article narticle)) - (message-mail) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - (when (and restore - (equal group "nndraft:queue")) - (mime-to-mml)) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (forward-line 1) - (setq ga (message-fetch-field gnus-draft-meta-information-header)) - (message-set-auto-save-file-name)))) - (gnus-backlog-remove-article group narticle) - (when (and ga - (ignore-errors (setq ga (car (read-from-string ga))))) - (setq gnus-newsgroup-name - (if (equal (car ga) "") nil (car ga))) - (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,(car ga)))) - (unless (equal (cadr ga) "") - (message-add-action - `(progn - (gnus-add-mark ,(car ga) 'replied ,(cadr ga)) - (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) - 'add '(reply))))) - 'send)))))) +(defun gnus-draft-setup (narticle group &optional restore) + (let (ga) + (gnus-setup-message 'forward + (let ((article narticle)) + (message-mail) + (erase-buffer) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article") + (when (and restore + (equal group "nndraft:queue")) + (funcall gnus-draft-decoding-function)) + ;; Insert the separator. + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (insert mail-header-separator) + (forward-line 1) + (setq ga (message-fetch-field gnus-draft-meta-information-header)) + (message-set-auto-save-file-name)))) + (gnus-backlog-remove-article group narticle) + (when (and ga + (ignore-errors (setq ga (car (read-from-string ga))))) + (setq gnus-newsgroup-name + (if (equal (car ga) "") nil (car ga))) + (gnus-configure-posting-styles) + (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) + (setq message-post-method + `(lambda (arg) + (gnus-post-method arg ,(car ga)))) + (unless (equal (cadr ga) "") + (message-add-action + `(progn + (gnus-add-mark ,(car ga) 'replied ,(cadr ga)) + (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) + 'add '(reply))))) + 'send))))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable."