comparison lisp/gnus/nnsoup.el @ 31716:9968f55ad26e

Update to emacs-21-branch of the Gnus CVS repository.

31715:7c896543d225

;;; nnsoup.el --- SOUP access for Gnus
;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; 	Masanobu UMEDA <[e-mail]>
;; Keywords: news, mail

(nnoo-declare nnsoup)

(defvoo nnsoup-directory "~/SOUP/"
  "*SOUP packet directory.")

(defvoo nnsoup-tmp-directory temporary-file-directory
  "*Where nnsoup will store temporary files.")

(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/")
  "*Directory where outgoing packets will be composed.")

(defvoo nnsoup-replies-format-type ?n
  "*Format of the replies packages.")

(defvoo nnsoup-replies-index-type ?n
  "*Index type of the replies packages.")

(defvoo nnsoup-active-file (concat nnsoup-directory "active")
  "Active file.")

(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
  "Format string command for packing a SOUP packet.
The SOUP files will be inserted where the %s is in the string.

(defvoo nnsoup-packet-regexp "Soupout"
  "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")

(defvoo nnsoup-always-save t
  "If non nil commit the reply buffer on each message send. 
This is necessary if using message mode outside Gnus with nnsoup as a 
backend for the messages.")



(defconst nnsoup-version "nnsoup 0.0"

    (let ((kind (gnus-soup-encoding-kind
		 (gnus-soup-area-encoding
		  (nth 1 (nnsoup-article-to-area
			  article nnsoup-current-group))))))
      (cond ((= kind ?m) 'mail)
	    ((= kind ?n) 'news)
	    (t 'unknown)))))

(deffoo nnsoup-close-group (group &optional server)
  ;; Kill all nnsoup buffers.
  (let ((buffers nnsoup-buffers)

	 info range-list mod-time prefix)
    (while infolist
      (setq info (pop infolist)
	    range-list (gnus-uncompress-range (car info))
	    prefix (gnus-soup-area-prefix (nth 1 info)))
      (when ;; All the articles in this file are marked for expiry.
	  (and (or (setq mod-time (nth 5 (file-attributes
					  (nnsoup-file prefix))))
		   (setq mod-time (nth 5 (file-attributes
					  (nnsoup-file prefix t)))))
	       (gnus-sublist-p articles range-list)

(defun nnsoup-write-active-file (&optional force)
  (when (and nnsoup-group-alist
	     (or force
		 nnsoup-group-alist-touched))
    (setq nnsoup-group-alist-touched nil)
    (nnheader-temp-write nnsoup-active-file
      (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
      (insert "\n")
      (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
      (insert "\n"))))

	  (while (setq area (pop areas))
	    ;; Change the name to the permanent name and move the files.
	    (setq cur-prefix (nnsoup-next-prefix))
	    (nnheader-message 5 "Incorporating file %s..." cur-prefix)
	    (when (file-exists-p
		   (setq file (concat nnsoup-tmp-directory
				      (gnus-soup-area-prefix area) ".IDX")))
	      (rename-file file (nnsoup-file cur-prefix)))
	    (when (file-exists-p
		   (setq file (concat nnsoup-tmp-directory
				      (gnus-soup-area-prefix area) ".MSG")))
	      (rename-file file (nnsoup-file cur-prefix t))
	      (gnus-soup-set-area-prefix area cur-prefix)
	      ;; Find the number of new articles in this area.
	      (setq number (nnsoup-number-of-articles area))
	      (if (not (setq entry (assoc (gnus-soup-area-name area)

	(i 0)
	alist len)
    (goto-char (point-min))
    (cond
     ;; rnews batch format
     ((= format ?n)
      (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
	(forward-line 1)
	(push (list
	       (incf i) (point)
	       (progn

(defun nnsoup-index-buffer (prefix &optional message)
  (let* ((file (concat prefix (if message ".MSG" ".IDX")))
	 (buffer-name (concat " *nnsoup " file "*")))
    (or (get-buffer buffer-name)	; File already loaded.
	(when (file-exists-p (concat nnsoup-directory file))
	  (save-excursion		; Load the file.
	    (set-buffer (get-buffer-create buffer-name))
	    (buffer-disable-undo (current-buffer))
	    (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
	    (nnheader-insert-file-contents (concat nnsoup-directory file))
	    (current-buffer))))))

(defun nnsoup-file (prefix &optional message)
  (expand-file-name
   (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))))

(defun nnsoup-message-buffer (prefix)
  (nnsoup-index-buffer prefix 'msg))

(defun nnsoup-unpack-packets ()

		(set-buffer msg-buf)
		(widen)
		(let ((format (gnus-soup-encoding-format
			       (gnus-soup-area-encoding (nth 1 area)))))
		  (goto-char end)
		  (when (or (= format ?n) (= format ?m))
		    (setq end (progn (forward-line -1) (point))))))
	    (set-buffer msg-buf))
	  (widen)
	  (narrow-to-region beg (or end (point-max))))
	 (t

(defun nnsoup-store-reply (kind)
  ;; Mostly stolen from `message.el'.
  (require 'mail-utils)
  (let ((tembuf (generate-new-buffer " message temp"))
	(case-fold-search nil)
	(real-header-separator mail-header-separator)
	(mail-header-separator "")
	delimline
	(mailbuf (current-buffer)))
    (unwind-protect
	(save-excursion
	  (save-restriction

	      (insert ?\n))
	  (let ((case-fold-search t))
	    ;; Change header-delimiter to be what sendmail expects.
	    (goto-char (point-min))
	    (re-search-forward
	     (concat "^" (regexp-quote real-header-separator) "\n"))
	    (replace-match "\n")
	    (backward-char 1)
	    (setq delimline (point-marker))
	    ;; Insert an extra newline if we need it to work around
	    ;; Sun's bug that swallows newlines.
	    (goto-char (1+ delimline))
	    (when (eval message-mailer-swallows-blank-line)
	      (newline))
	    (let ((msg-buf
		   (gnus-soup-store
		    nnsoup-replies-directory
		    (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
		    nnsoup-replies-index-type))

(defun nnsoup-kind-to-prefix (kind)
  (unless nnsoup-replies-list
    (setq nnsoup-replies-list
	  (gnus-soup-parse-replies
	   (concat nnsoup-replies-directory "REPLIES"))))
  (let ((replies nnsoup-replies-list))
    (while (and replies
		(not (string= kind (gnus-soup-reply-kind (car replies)))))
      (setq replies (cdr replies)))
    (if replies

				 (string-to-int (match-string 1 f1)))
			  (progn (string-match "/\\([0-9]+\\)\\." f2)
				 (string-to-int (match-string 1 f2)))))))
	active group lines ident elem min)
    (set-buffer (get-buffer-create " *nnsoup work*"))
    (buffer-disable-undo (current-buffer))
    (while files
      (nnheader-message 5 "Doing %s..." (car files))
      (erase-buffer)
      (nnheader-insert-file-contents (car files))
      (goto-char (point-min))

			  (car files) (match-beginning 1)
			  (match-end 1))))
      (if (not (setq elem (assoc group active)))
	  (push (list group (cons 1 lines)
		      (list (cons 1 lines)
			    (vector ident group "ncm" "" lines)))
		active)
	(nconc elem
	       (list
		(list (cons (1+ (setq min (cdadr elem)))
			    (+ min lines))
		      (vector ident group "ncm" "" lines))))
	(setcdr (cadr elem) (+ min lines)))
      (setq files (cdr files)))
    (nnheader-message 5 "")
    (setq nnsoup-group-alist active)
    (nnsoup-write-active-file t)))

      (unless (member (substring file 0 (match-beginning 0)) known)
	(push file non-files)))
    ;; Sort and delete the files.
    (setq non-files (sort non-files 'string<))
    (map-y-or-n-p "Delete file %s? "
		  (lambda (file) (delete-file (concat nnsoup-directory file)))
		  non-files)))

(provide 'nnsoup)

;;; nnsoup.el ends here

31716:9968f55ad26e

;;; nnsoup.el --- SOUP access for Gnus

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
;;	Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; 	Masanobu UMEDA <[e-mail]>
;; Keywords: news, mail

(nnoo-declare nnsoup)

(defvoo nnsoup-directory "~/SOUP/"
  "*SOUP packet directory.")

(defvoo nnsoup-tmp-directory
    (cond ((fboundp 'temp-directory) (temp-directory))
	  ((boundp 'temporary-file-directory) temporary-file-directory)
	  ("/tmp/"))
  "*Where nnsoup will store temporary files.")

(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
  "*Directory where outgoing packets will be composed.")

(defvoo nnsoup-replies-format-type ?u  ;; u is USENET news format.
  "*Format of the replies packages.")

(defvoo nnsoup-replies-index-type ?n
  "*Index type of the replies packages.")

(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
  "Active file.")

(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
  "Format string command for packing a SOUP packet.
The SOUP files will be inserted where the %s is in the string.

(defvoo nnsoup-packet-regexp "Soupout"
  "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")

(defvoo nnsoup-always-save t
  "If non nil commit the reply buffer on each message send.
This is necessary if using message mode outside Gnus with nnsoup as a
backend for the messages.")



(defconst nnsoup-version "nnsoup 0.0"

    (let ((kind (gnus-soup-encoding-kind
		 (gnus-soup-area-encoding
		  (nth 1 (nnsoup-article-to-area
			  article nnsoup-current-group))))))
      (cond ((= kind ?m) 'mail)
	    ((= kind ?n) 'news) 
	    (t 'unknown)))))

(deffoo nnsoup-close-group (group &optional server)
  ;; Kill all nnsoup buffers.
  (let ((buffers nnsoup-buffers)

	 info range-list mod-time prefix)
    (while infolist
      (setq info (pop infolist)
	    range-list (gnus-uncompress-range (car info))
	    prefix (gnus-soup-area-prefix (nth 1 info)))
      (when;; All the articles in this file are marked for expiry.
	  (and (or (setq mod-time (nth 5 (file-attributes
					  (nnsoup-file prefix))))
		   (setq mod-time (nth 5 (file-attributes
					  (nnsoup-file prefix t)))))
	       (gnus-sublist-p articles range-list)

(defun nnsoup-write-active-file (&optional force)
  (when (and nnsoup-group-alist
	     (or force
		 nnsoup-group-alist-touched))
    (setq nnsoup-group-alist-touched nil)
    (with-temp-file nnsoup-active-file
      (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
      (insert "\n")
      (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
      (insert "\n"))))

	  (while (setq area (pop areas))
	    ;; Change the name to the permanent name and move the files.
	    (setq cur-prefix (nnsoup-next-prefix))
	    (nnheader-message 5 "Incorporating file %s..." cur-prefix)
	    (when (file-exists-p
		   (setq file
			 (expand-file-name
			  (concat (gnus-soup-area-prefix area) ".IDX")
			  nnsoup-tmp-directory)))
	      (rename-file file (nnsoup-file cur-prefix)))
	    (when (file-exists-p
		   (setq file (expand-file-name
			       (concat (gnus-soup-area-prefix area) ".MSG")
			       nnsoup-tmp-directory)))
	      (rename-file file (nnsoup-file cur-prefix t))
	      (gnus-soup-set-area-prefix area cur-prefix)
	      ;; Find the number of new articles in this area.
	      (setq number (nnsoup-number-of-articles area))
	      (if (not (setq entry (assoc (gnus-soup-area-name area)

	(i 0)
	alist len)
    (goto-char (point-min))
    (cond
     ;; rnews batch format
     ((or (= format ?u)
	  (= format ?n)) ;; Gnus back compatibility.
      (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
	(forward-line 1)
	(push (list
	       (incf i) (point)
	       (progn

(defun nnsoup-index-buffer (prefix &optional message)
  (let* ((file (concat prefix (if message ".MSG" ".IDX")))
	 (buffer-name (concat " *nnsoup " file "*")))
    (or (get-buffer buffer-name)	; File already loaded.
	(when (file-exists-p (expand-file-name file nnsoup-directory))
	  (save-excursion		; Load the file.
	    (set-buffer (get-buffer-create buffer-name))
	    (buffer-disable-undo)
	    (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
	    (nnheader-insert-file-contents
	     (expand-file-name file nnsoup-directory))
	    (current-buffer))))))

(defun nnsoup-file (prefix &optional message)
  (expand-file-name
   (concat prefix (if message ".MSG" ".IDX"))
   nnsoup-directory))

(defun nnsoup-message-buffer (prefix)
  (nnsoup-index-buffer prefix 'msg))

(defun nnsoup-unpack-packets ()

		(set-buffer msg-buf)
		(widen)
		(let ((format (gnus-soup-encoding-format
			       (gnus-soup-area-encoding (nth 1 area)))))
		  (goto-char end)
		  (when (or (= format ?u) (= format ?n) (= format ?m))
		    (setq end (progn (forward-line -1) (point))))))
	    (set-buffer msg-buf))
	  (widen)
	  (narrow-to-region beg (or end (point-max))))
	 (t

(defun nnsoup-store-reply (kind)
  ;; Mostly stolen from `message.el'.
  (require 'mail-utils)
  (let ((tembuf (generate-new-buffer " message temp"))
	(case-fold-search nil)
	delimline
	(mailbuf (current-buffer)))
    (unwind-protect
	(save-excursion
	  (save-restriction

	      (insert ?\n))
	  (let ((case-fold-search t))
	    ;; Change header-delimiter to be what sendmail expects.
	    (goto-char (point-min))
	    (re-search-forward
	     (concat "^" (regexp-quote mail-header-separator) "\n"))
	    (replace-match "\n")
	    (backward-char 1)
	    (setq delimline (point-marker))
	    (goto-char (1+ delimline))
	    (let ((msg-buf
		   (gnus-soup-store
		    nnsoup-replies-directory
		    (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
		    nnsoup-replies-index-type))

(defun nnsoup-kind-to-prefix (kind)
  (unless nnsoup-replies-list
    (setq nnsoup-replies-list
	  (gnus-soup-parse-replies
	   (expand-file-name "REPLIES" nnsoup-replies-directory))))
  (let ((replies nnsoup-replies-list))
    (while (and replies
		(not (string= kind (gnus-soup-reply-kind (car replies)))))
      (setq replies (cdr replies)))
    (if replies

				 (string-to-int (match-string 1 f1)))
			  (progn (string-match "/\\([0-9]+\\)\\." f2)
				 (string-to-int (match-string 1 f2)))))))
	active group lines ident elem min)
    (set-buffer (get-buffer-create " *nnsoup work*"))
    (while files
      (nnheader-message 5 "Doing %s..." (car files))
      (erase-buffer)
      (nnheader-insert-file-contents (car files))
      (goto-char (point-min))

			  (car files) (match-beginning 1)
			  (match-end 1))))
      (if (not (setq elem (assoc group active)))
	  (push (list group (cons 1 lines)
		      (list (cons 1 lines)
			    (vector ident group "ucm" "" lines)))
		active)
	(nconc elem
	       (list
		(list (cons (1+ (setq min (cdadr elem)))
			    (+ min lines))
		      (vector ident group "ucm" "" lines))))
	(setcdr (cadr elem) (+ min lines)))
      (setq files (cdr files)))
    (nnheader-message 5 "")
    (setq nnsoup-group-alist active)
    (nnsoup-write-active-file t)))

      (unless (member (substring file 0 (match-beginning 0)) known)
	(push file non-files)))
    ;; Sort and delete the files.
    (setq non-files (sort non-files 'string<))
    (map-y-or-n-p "Delete file %s? "
		  (lambda (file) (delete-file
				  (expand-file-name file nnsoup-directory)))
		  non-files)))

(provide 'nnsoup)

;;; nnsoup.el ends here