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

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

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

revision 1.5.18.1 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.5.18.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-soup.el --- SOUP packet writing support for Gnus  ;;; gnus-soup.el --- SOUP packet writing support for Gnus
2    
3  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
4  ;;      Free Software Foundation, Inc.  ;;      Free Software Foundation, Inc.
5    
6  ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>  ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
# Line 154  move those articles instead." Line 154  move those articles instead."
154                             gnus-soup-encoding-type                             gnus-soup-encoding-type
155                             gnus-soup-index-type)                             gnus-soup-index-type)
156            (gnus-soup-area-set-number            (gnus-soup-area-set-number
157             area (1+ (or (gnus-soup-area-number area) 0))))             area (1+ (or (gnus-soup-area-number area) 0)))
158          ;; Mark article as read.            ;; Mark article as read.
159          (set-buffer gnus-summary-buffer)            (set-buffer gnus-summary-buffer)
160              (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
161          (gnus-summary-remove-process-mark (car articles))          (gnus-summary-remove-process-mark (car articles))
         (gnus-summary-mark-as-read (car articles) gnus-souped-mark)  
162          (setq articles (cdr articles)))          (setq articles (cdr articles)))
163        (kill-buffer tmp-buf))        (kill-buffer tmp-buf))
164      (gnus-soup-save-areas)      (gnus-soup-save-areas)
# Line 357  If NOT-ALL, don't pack ticked articles." Line 357  If NOT-ALL, don't pack ticked articles."
357      (gnus-make-directory dir)      (gnus-make-directory dir)
358      (setq gnus-soup-areas nil)      (setq gnus-soup-areas nil)
359      (gnus-message 4 "Packing %s..." packer)      (gnus-message 4 "Packing %s..." packer)
360      (if (zerop (call-process shell-file-name      (if (eq 0 (call-process shell-file-name
361                               nil nil nil shell-command-switch                              nil nil nil shell-command-switch
362                               (concat "cd " dir " ; " packer)))                              (concat "cd " dir " ; " packer)))
363          (progn          (progn
364            (call-process shell-file-name nil nil nil shell-command-switch            (call-process shell-file-name nil nil nil shell-command-switch
365                          (concat "cd " dir " ; rm " files))                          (concat "cd " dir " ; rm " files))
# Line 496  Return whether the unpacking was success Line 496  Return whether the unpacking was success
496    (gnus-make-directory dir)    (gnus-make-directory dir)
497    (gnus-message 4 "Unpacking: %s" (format unpacker packet))    (gnus-message 4 "Unpacking: %s" (format unpacker packet))
498    (prog1    (prog1
499        (zerop (call-process        (eq 0 (call-process
500                shell-file-name nil nil nil shell-command-switch               shell-file-name nil nil nil shell-command-switch
501                (format "cd %s ; %s" (expand-file-name dir)               (format "cd %s ; %s" (expand-file-name dir)
502                        (format unpacker packet))))                       (format unpacker packet))))
503      (gnus-message 4 "Unpacking...done")))      (gnus-message 4 "Unpacking...done")))
504    
505  (defun gnus-soup-send-packet (packet)  (defun gnus-soup-send-packet (packet)
# Line 540  Return whether the unpacking was success Line 540  Return whether the unpacking was success
540                                       (match-beginning 1) (match-end 1)))))                                       (match-beginning 1) (match-end 1)))))
541                (switch-to-buffer tmp-buf)                (switch-to-buffer tmp-buf)
542                (erase-buffer)                (erase-buffer)
543                  (mm-disable-multibyte)
544                (insert-buffer-substring msg-buf beg end)                (insert-buffer-substring msg-buf beg end)
               (goto-char (point-min))  
               (search-forward "\n\n")  
               (forward-char -1)  
               (insert mail-header-separator)  
               (setq message-newsreader (setq message-mailer  
                                              (gnus-extended-version)))  
545                (cond                (cond
546                 ((string= (gnus-soup-reply-kind (car replies)) "news")                 ((string= (gnus-soup-reply-kind (car replies)) "news")
547                  (gnus-message 5 "Sending news message to %s..."                  (gnus-message 5 "Sending news message to %s..."
548                                (mail-fetch-field "newsgroups"))                                (mail-fetch-field "newsgroups"))
549                  (sit-for 1)                  (sit-for 1)
550                  (let ((message-syntax-checks                  (let ((message-syntax-checks
551                         'dont-check-for-anything-just-trust-me))                         'dont-check-for-anything-just-trust-me)
552                    (funcall message-send-news-function)))                        (method (if (functionp message-post-method)
553                                      (funcall message-post-method)
554                                    message-post-method))
555                          result)
556                      (run-hooks 'message-send-news-hook)
557                      (gnus-open-server method)
558                      (message "Sending news via %s..."
559                               (gnus-server-string method))
560                      (unless (let ((mail-header-separator ""))
561                                (gnus-request-post method))
562                        (message "Couldn't send message via news: %s"
563                                 (nnheader-get-report (car method))))))
564                 ((string= (gnus-soup-reply-kind (car replies)) "mail")                 ((string= (gnus-soup-reply-kind (car replies)) "mail")
565                  (gnus-message 5 "Sending mail to %s..."                  (gnus-message 5 "Sending mail to %s..."
566                                (mail-fetch-field "to"))                                (mail-fetch-field "to"))
567                  (sit-for 1)                  (sit-for 1)
568                  (message-send-mail))                  (let ((mail-header-separator ""))
569                      (mm-with-unibyte-current-buffer
570                        (funcall (or message-send-mail-real-function
571                                     message-send-mail-function)))))
572                 (t                 (t
573                  (error "Unknown reply kind")))                  (error "Unknown reply kind")))
574                (set-buffer msg-buf)                (set-buffer msg-buf)

Legend:
Removed from v.1.5.18.1  
changed lines
  Added in v.1.5.18.2

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