/[emacs]/emacs/lisp/gnus/gnus-draft.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-draft.el

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

revision 1.4.18.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.4.18.3 by miles, Thu Sep 16 00:12:15 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-draft.el --- draft message support for Gnus  ;;; gnus-draft.el --- draft message support for Gnus
2  ;; Copyright (C) 1997, 1998, 1999, 2000  ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003
3  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
4    
5  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 46  Line 46 
46    
47    (gnus-define-keys gnus-draft-mode-map    (gnus-define-keys gnus-draft-mode-map
48      "Dt" gnus-draft-toggle-sending      "Dt" gnus-draft-toggle-sending
49        "e"  gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article'
50      "De" gnus-draft-edit-message      "De" gnus-draft-edit-message
51      "Ds" gnus-draft-send-message      "Ds" gnus-draft-send-message
52      "DS" gnus-draft-send-all-messages))      "DS" gnus-draft-send-all-messages))
# Line 94  Line 95 
95  (defun gnus-draft-edit-message ()  (defun gnus-draft-edit-message ()
96    "Enter a mail/post buffer to edit and send the draft."    "Enter a mail/post buffer to edit and send the draft."
97    (interactive)    (interactive)
98    (let ((article (gnus-summary-article-number)))    (let ((article (gnus-summary-article-number))
99            (group gnus-newsgroup-name))
100      (gnus-summary-mark-as-read article gnus-canceled-mark)      (gnus-summary-mark-as-read article gnus-canceled-mark)
101      (gnus-draft-setup article gnus-newsgroup-name t)      (gnus-draft-setup article group t)
102      (set-buffer-modified-p t)      (set-buffer-modified-p t)
103        (save-excursion
104          (save-restriction
105            (message-narrow-to-headers)
106            (message-remove-header "date")))
107      (save-buffer)      (save-buffer)
108      (let ((gnus-verbose-backends nil))      (let ((gnus-verbose-backends nil))
109        (gnus-request-expire-articles (list article) gnus-newsgroup-name t))        (gnus-request-expire-articles (list article) group t))
110      (push      (push
111       `((lambda ()       `((lambda ()
112           (when (gnus-buffer-exists-p ,gnus-summary-buffer)           (when (gnus-buffer-exists-p ,gnus-summary-buffer)
# Line 126  Line 132 
132    
133  (defun gnus-draft-send (article &optional group interactive)  (defun gnus-draft-send (article &optional group interactive)
134    "Send message ARTICLE."    "Send message ARTICLE."
135    (let ((message-syntax-checks (if interactive nil    (let ((message-syntax-checks (if interactive message-syntax-checks
136                                   'dont-check-for-anything-just-trust-me))                                   'dont-check-for-anything-just-trust-me))
137            (message-hidden-headers nil)
138          (message-inhibit-body-encoding (or (not group)          (message-inhibit-body-encoding (or (not group)
139                                             (equal group "nndraft:queue")                                             (equal group "nndraft:queue")
140                                             message-inhibit-body-encoding))                                             message-inhibit-body-encoding))
# Line 135  Line 142 
142                                  message-send-hook))                                  message-send-hook))
143          (message-setup-hook (and group (not (equal group "nndraft:queue"))          (message-setup-hook (and group (not (equal group "nndraft:queue"))
144                                   message-setup-hook))                                   message-setup-hook))
145          type method)          type method move-to)
146      (gnus-draft-setup article (or group "nndraft:queue"))      (gnus-draft-setup article (or group "nndraft:queue"))
147      ;; We read the meta-information that says how and where      ;; We read the meta-information that says how and where
148      ;; this message is to be sent.      ;; this message is to be sent.
149      (save-restriction      (save-restriction
150        (message-narrow-to-head)        (message-narrow-to-head)
151        (when (re-search-forward        (when (re-search-forward
152                 (concat "^" (regexp-quote gnus-agent-target-move-group-header)
153                         ":") nil t)
154            (skip-syntax-forward "-")
155            (setq move-to (buffer-substring (point) (gnus-point-at-eol)))
156            (message-remove-header gnus-agent-target-move-group-header))
157          (goto-char (point-min))
158          (when (re-search-forward
159               (concat "^" (regexp-quote gnus-agent-meta-information-header) ":")               (concat "^" (regexp-quote gnus-agent-meta-information-header) ":")
160               nil t)               nil t)
161          (setq type (ignore-errors (read (current-buffer)))          (setq type (ignore-errors (read (current-buffer)))
# Line 159  Line 173 
173                           (message-this-is-mail (eq type 'mail))                           (message-this-is-mail (eq type 'mail))
174                           (gnus-post-method method)                           (gnus-post-method method)
175                           (message-post-method method))                           (message-post-method method))
176                       (message-send-and-exit))                       (if move-to
177                   (message-send-and-exit)))                           (gnus-inews-do-gcc move-to)
178                           (message-send-and-exit)))
179                     (if move-to
180                         (gnus-inews-do-gcc move-to)
181                       (message-send-and-exit))))
182        (let ((gnus-verbose-backends nil))        (let ((gnus-verbose-backends nil))
183          (gnus-request-expire-articles          (gnus-request-expire-articles
184           (list article) (or group "nndraft:queue") t)))))           (list article) (or group "nndraft:queue") t)))))
# Line 168  Line 186 
186  (defun gnus-draft-send-all-messages ()  (defun gnus-draft-send-all-messages ()
187    "Send all the sendable drafts."    "Send all the sendable drafts."
188    (interactive)    (interactive)
189    (gnus-uu-mark-buffer)    (when (or
190    (gnus-draft-send-message))           gnus-expert-user
191             (gnus-y-or-n-p
192              "Send all drafts? "))
193        (gnus-uu-mark-buffer)
194        (gnus-draft-send-message)))
195    
196  (defun gnus-group-send-drafts ()  (defun gnus-group-send-queue ()
197    "Send all sendable articles from the queue group."    "Send all sendable articles from the queue group."
198    (interactive)    (interactive)
199    (gnus-activate-group "nndraft:queue")    (gnus-activate-group "nndraft:queue")
# Line 181  Line 203 
203                          (cdr (assq 'unsend                          (cdr (assq 'unsend
204                                     (gnus-info-marks                                     (gnus-info-marks
205                                      (gnus-get-info "nndraft:queue"))))))                                      (gnus-get-info "nndraft:queue"))))))
206               (gnus-posting-styles nil)
207             (total (length articles))             (total (length articles))
208             article)             article)
209        (while (setq article (pop articles))        (while (setq article (pop articles))
# Line 190  Line 213 
213                           (- total (length articles)) total)))                           (- total (length articles)) total)))
214              (gnus-draft-send article)))))))              (gnus-draft-send article)))))))
215    
216    ;;;###autoload
217    (defun gnus-draft-reminder ()
218      "Reminder user if there are unsent drafts."
219      (interactive)
220      (if (gnus-alive-p)
221          (let (active)
222            (catch 'continue
223              (dolist (group '("nndraft:drafts" "nndraft:queue"))
224                (setq active (gnus-activate-group group))
225                (if (and active (>= (cdr active) (car active)))
226                    (if (y-or-n-p "There are unsent drafts.  Confirm to exit? ")
227                        (throw 'continue t)
228                      (error "Stop!"))))))))
229    
230  ;;; Utility functions  ;;; Utility functions
231    
232  ;;;!!!If this is byte-compiled, it fails miserably.  ;;;!!!If this is byte-compiled, it fails miserably.
# Line 199  Line 236 
236    
237  (progn  (progn
238    (defun gnus-draft-setup (narticle group &optional restore)    (defun gnus-draft-setup (narticle group &optional restore)
239      (gnus-setup-message 'forward      (let (ga)
240        (let ((article narticle))        (gnus-setup-message 'forward
241          (message-mail)          (let ((article narticle))
242          (erase-buffer)            (message-mail)
243          (if (not (gnus-request-restore-buffer article group))            (erase-buffer)
244              (error "Couldn't restore the article")            (if (not (gnus-request-restore-buffer article group))
245            (if (and restore (equal group "nndraft:queue"))                (error "Couldn't restore the article")
246                (when (and restore
247                           (equal group "nndraft:queue"))
248                (mime-to-mml))                (mime-to-mml))
249            ;; Insert the separator.              ;; Insert the separator.
250            (goto-char (point-min))              (goto-char (point-min))
251            (search-forward "\n\n")              (search-forward "\n\n")
252            (forward-char -1)              (forward-char -1)
253            (insert mail-header-separator)              (insert mail-header-separator)
254            (forward-line 1)              (forward-line 1)
255            (message-set-auto-save-file-name))))))              (setq ga (message-fetch-field gnus-draft-meta-information-header))
256                (message-set-auto-save-file-name))))
257          (gnus-backlog-remove-article group narticle)
258          (when (and ga
259                     (ignore-errors (setq ga (car (read-from-string ga)))))
260            (setq gnus-newsgroup-name
261                  (if (equal (car ga) "") nil (car ga)))
262            (gnus-configure-posting-styles)
263            (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
264            (setq message-post-method
265                  `(lambda (arg)
266                     (gnus-post-method arg ,(car ga))))
267            (unless (equal (cadr ga) "")
268              (message-add-action
269               `(progn
270                  (gnus-add-mark ,(car ga) 'replied ,(cadr ga))
271                  (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga))
272                                                               'add '(reply)))))
273               'send))))))
274    
275  (defun gnus-draft-article-sendable-p (article)  (defun gnus-draft-article-sendable-p (article)
276    "Say whether ARTICLE is sendable."    "Say whether ARTICLE is sendable."

Legend:
Removed from v.1.4.18.2  
changed lines
  Added in v.1.4.18.3

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