;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
(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.")
+
\f
(defconst nnsoup-version "nnsoup 0.0"
(defvoo nnsoup-buffers nil)
(defvoo nnsoup-current-group nil)
(defvoo nnsoup-group-alist-touched nil)
-
+(defvoo nnsoup-article-alist nil)
\f
;;; Interface functions.
(setq this-area-seq nil)
;; We take note whether this MSG has a corresponding IDX
;; for later use.
- (when (or (= (gnus-soup-encoding-index
+ (when (or (= (gnus-soup-encoding-index
(gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
(not (file-exists-p
(nnsoup-file
(car useful-areas)))))
;; We now have a list of article numbers and corresponding
- ;; areas.
+ ;; areas.
(setq useful-areas (nreverse useful-areas))
;; Two different approaches depending on whether all the MSG
useful-areas (cdr useful-areas))
(while articles
(when (setq msg-buf
- (nnsoup-narrow-to-article
+ (nnsoup-narrow-to-article
(car articles) (cdar useful-areas) 'head))
(goto-char (point-max))
(insert (format "221 %d Article retrieved.\n" (car articles)))
(condition-case ()
(make-directory nnsoup-directory t)
(error t)))
- (cond
+ (cond
((not (file-exists-p nnsoup-directory))
(nnsoup-close-server)
(nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
(deffoo nnsoup-request-group (group &optional server dont-check)
(nnsoup-possibly-change-group group)
- (if dont-check
+ (if dont-check
t
(let ((active (cadr (assoc group nnsoup-group-alist))))
(if (not active)
(nnheader-report 'nnsoup "No such group: %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n"
+ (nnheader-insert
+ "211 %d %d %d %s\n"
(max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group)))))
(deffoo nnsoup-request-type (group &optional article)
(nnsoup-possibly-change-group group)
+ ;; Try to guess the type based on the first article in the group.
+ (when (not article)
+ (setq article
+ (cdaar (cddr (assoc group nnsoup-group-alist)))))
(if (not article)
'unknown
- (let ((kind (gnus-soup-encoding-kind
+ (let ((kind (gnus-soup-encoding-kind
(gnus-soup-area-encoding
(nth 1 (nnsoup-article-to-area
article nnsoup-current-group))))))
(setq mod-time (nth 5 (file-attributes
(nnsoup-file prefix t)))))
(gnus-sublist-p articles range-list)
- ;; This file is old enough.
+ ;; This file is old enough.
(nnmail-expired-article-p group mod-time force))
;; Ok, we delete this file.
(when (ignore-errors
- (nnheader-message
+ (nnheader-message
5 "Deleting %s in group %s..." (nnsoup-file prefix)
group)
(when (file-exists-p (nnsoup-file prefix))
(delete-file (nnsoup-file prefix)))
- (nnheader-message
+ (nnheader-message
5 "Deleting %s in group %s..." (nnsoup-file prefix t)
group)
(when (file-exists-p (nnsoup-file prefix t))
;;; Internal functions
(defun nnsoup-possibly-change-group (group &optional force)
- (if group
- (setq nnsoup-current-group group)
- t))
+ (when (and group
+ (not (equal nnsoup-current-group group)))
+ (setq nnsoup-article-alist nil)
+ (setq nnsoup-current-group group))
+ t)
(defun nnsoup-read-active-file ()
(setq nnsoup-group-alist nil)
(defun nnsoup-write-active-file (&optional force)
(when (and nnsoup-group-alist
- (or force
+ (or force
nnsoup-group-alist-touched))
(setq nnsoup-group-alist-touched nil)
(nnheader-temp-write nnsoup-active-file
(defun nnsoup-next-prefix ()
"Return the next free prefix."
(let (prefix)
- (while (or (file-exists-p
+ (while (or (file-exists-p
(nnsoup-file (setq prefix (int-to-string
nnsoup-current-prefix))))
(file-exists-p (nnsoup-file prefix t)))
(incf nnsoup-current-prefix)
prefix))
+(defun nnsoup-file-name (dir file)
+ "Return the full path of FILE (in any case) in DIR."
+ (let* ((case-fold-search t)
+ (files (directory-files dir t))
+ (regexp (concat (regexp-quote file) "$")))
+ (car (delq nil
+ (mapcar
+ (lambda (file)
+ (if (string-match regexp file)
+ file
+ nil))
+ files)))))
+
(defun nnsoup-read-areas ()
- (when (file-exists-p (concat nnsoup-tmp-directory "AREAS"))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let ((areas (gnus-soup-parse-areas
- (concat nnsoup-tmp-directory "AREAS")))
- entry number area lnum cur-prefix file)
- ;; Go through all areas in the new AREAS file.
- (while (setq area (pop areas))
- ;; Change the name to the permanent name and move the files.
- (setq cur-prefix (nnsoup-next-prefix))
- (message "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)
- nnsoup-group-alist)))
- ;; If this is a new area (group), we just add this info to
- ;; the group alist.
- (push (list (gnus-soup-area-name area)
- (cons 1 number)
- (list (cons 1 number) area))
- nnsoup-group-alist)
- ;; There are already articles in this group, so we add this
- ;; info to the end of the entry.
- (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
- (+ lnum number))
- area)))
- (setcdr (cadr entry) (+ lnum number))))))
- (nnsoup-write-active-file t)
- (delete-file (concat nnsoup-tmp-directory "AREAS")))))
+ (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
+ (when areas-file
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((areas (gnus-soup-parse-areas areas-file))
+ entry number area lnum cur-prefix file)
+ ;; Go through all areas in the new AREAS file.
+ (while (setq area (pop areas))
+ ;; Change the name to the permanent name and move the files.
+ (setq cur-prefix (nnsoup-next-prefix))
+ (message "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)
+ nnsoup-group-alist)))
+ ;; If this is a new area (group), we just add this info to
+ ;; the group alist.
+ (push (list (gnus-soup-area-name area)
+ (cons 1 number)
+ (list (cons 1 number) area))
+ nnsoup-group-alist)
+ ;; There are already articles in this group, so we add this
+ ;; info to the end of the entry.
+ (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
+ (+ lnum number))
+ area)))
+ (setcdr (cadr entry) (+ lnum number))))))
+ (nnsoup-write-active-file t)
+ (delete-file areas-file)))))
(defun nnsoup-number-of-articles (area)
(save-excursion
- (cond
+ (cond
;; If the number is in the area info, we just return it.
((gnus-soup-area-number area)
(gnus-soup-area-number area))
(set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
(count-lines (point-min) (point-max)))
;; We do it the hard way - re-searching through the message
- ;; buffer.
+ ;; buffer.
(t
(set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
- (goto-char (point-min))
- (let ((regexp (nnsoup-header (gnus-soup-encoding-format
- (gnus-soup-area-encoding area))))
- (num 0))
- (while (re-search-forward regexp nil t)
- (setq num (1+ num)))
- num)))))
+ (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
+ (nnsoup-dissect-buffer area))
+ (length (cdr (assoc (gnus-soup-area-prefix area)
+ nnsoup-article-alist)))))))
+
+(defun nnsoup-dissect-buffer (area)
+ (let ((mbox-delim (concat "^" message-unix-mail-delimiter))
+ (format (gnus-soup-encoding-format (gnus-soup-area-encoding 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
+ (forward-char (string-to-number (match-string 1)))
+ (point)))
+ alist)))
+ ;; Unix mbox format
+ ((= format ?m)
+ (while (looking-at mbox-delim)
+ (forward-line 1)
+ (push (list
+ (incf i) (point)
+ (progn
+ (if (re-search-forward mbox-delim nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ (point)))
+ alist)))
+ ;; MMDF format
+ ((= format ?M)
+ (while (looking-at "\^A\^A\^A\^A\n")
+ (forward-line 1)
+ (push (list
+ (incf i) (point)
+ (progn
+ (if (search-forward "\n\^A\^A\^A\^A\n" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ (point)))
+ alist)))
+ ;; Binary format
+ ((or (= format ?B) (= format ?b))
+ (while (not (eobp))
+ (setq len (+ (* (char-after (point)) (expt 2.0 24))
+ (* (char-after (+ (point) 1)) (expt 2 16))
+ (* (char-after (+ (point) 2)) (expt 2 8))
+ (char-after (+ (point) 3))))
+ (push (list
+ (incf i) (+ (point) 4)
+ (progn
+ (forward-char (floor (+ len 4)))
+ (point)))
+ alist)))
+ (t
+ (error "Unknown format: %c" format)))
+ (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
(defun nnsoup-index-buffer (prefix &optional message)
(let* ((file (concat prefix (if message ".MSG" ".IDX")))
packet)
(while (setq packet (pop packets))
(message "nnsoup: unpacking %s..." packet)
- (if (not (gnus-soup-unpack-packet
+ (if (not (gnus-soup-unpack-packet
nnsoup-tmp-directory nnsoup-unpacker packet))
(message "Couldn't unpack %s" packet)
(delete-file packet)
;; There is no MSG file.
((null msg-buf)
nil)
- ;; We use the index file to find out where the article
- ;; begins and ends.
- ((and (= (gnus-soup-encoding-index
+ ;; We use the index file to find out where the article
+ ;; begins and ends.
+ ((and (= (gnus-soup-encoding-index
(gnus-soup-area-encoding (nth 1 area)))
?c)
(file-exists-p (nnsoup-file prefix)))
(t
(set-buffer msg-buf)
(widen)
- (goto-char (point-min))
- (let ((header (nnsoup-header
- (gnus-soup-encoding-format
- (gnus-soup-area-encoding (nth 1 area))))))
- (re-search-forward header nil t (- article (caar area)))
- (narrow-to-region
- (match-beginning 0)
- (if (re-search-forward header nil t)
- (match-beginning 0)
- (point-max))))))
+ (unless (assoc (gnus-soup-area-prefix (nth 1 area))
+ nnsoup-article-alist)
+ (nnsoup-dissect-buffer (nth 1 area)))
+ (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
+ (nth 1 area))
+ nnsoup-article-alist)))))
+ (when entry
+ (narrow-to-region (cadr entry) (caddr entry))))))
(goto-char (point-min))
(if (not head)
()
(point-max))))
msg-buf))))
-(defun nnsoup-header (format)
- (cond
- ((= format ?n)
- "^#! *rnews +[0-9]+ *$")
- ((= format ?m)
- (concat "^" message-unix-mail-delimiter))
- ((= format ?M)
- "^\^A\^A\^A\^A\n")
- (t
- (error "Unknown format: %c" format))))
-
;;;###autoload
(defun nnsoup-pack-replies ()
"Make an outbound package of SOUP replies."
(nnsoup-write-replies)
;; Check whether there is anything here.
(when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
- (error "No files to pack."))
+ (error "No files to pack"))
;; Pack all these files into a SOUP packet.
(gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
(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
;; Change header-delimiter to be what sendmail expects.
(goto-char (point-min))
(re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (concat "^" (regexp-quote real-header-separator) "\n"))
(replace-match "\n")
(backward-char 1)
(setq delimline (point-marker))
(when (eval message-mailer-swallows-blank-line)
(newline))
(let ((msg-buf
- (gnus-soup-store
- nnsoup-replies-directory
+ (gnus-soup-store
+ nnsoup-replies-directory
(nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
nnsoup-replies-index-type))
(num 0))
(set-buffer msg-buf)
(goto-char (point-min))
(while (re-search-forward "^#! *rnews" nil t)
- (incf num)))
+ (incf num))
+ (when nnsoup-always-save
+ (save-buffer)))
(message "Stored %d messages" num)))
(nnsoup-write-replies)
(kill-buffer tembuf))))))
(defun nnsoup-kind-to-prefix (kind)
(unless nnsoup-replies-list
(setq nnsoup-replies-list
- (gnus-soup-parse-replies
+ (gnus-soup-parse-replies
(concat nnsoup-replies-directory "REPLIES"))))
(let ((replies nnsoup-replies-list))
- (while (and replies
+ (while (and replies
(not (string= kind (gnus-soup-reply-kind (car replies)))))
(setq replies (cdr replies)))
(if replies
(gnus-soup-reply-prefix (car replies))
(push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
- kind
+ kind
(format "%c%c%c"
nnsoup-replies-format-type
nnsoup-replies-index-type
(setq lines (count-lines (point-min) (point-max)))
(setq ident (progn (string-match
"/\\([0-9]+\\)\\." (car files))
- (substring
+ (substring
(car files) (match-beginning 1)
(match-end 1))))
(if (not (setq elem (assoc group active)))
(defun nnsoup-delete-unreferenced-message-files ()
"Delete any *.MSG and *.IDX files that aren't known by nnsoup."
(interactive)
- (let* ((known (apply 'nconc (mapcar
+ (let* ((known (apply 'nconc (mapcar
(lambda (ga)
(mapcar
(lambda (area)
projects / gnus / blobdiff