2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-soup.el: Removed.
+
+ * nnsoup.el: Removed.
+
* nnultimate.el: Removed.
* gnus-html.el (gnus-blocked-images): New variable.
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
-(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
- "b" gnus-group-brew-soup
- "w" gnus-soup-save-areas
- "s" gnus-soup-send-replies
- "p" gnus-soup-pack-packet
- "r" nnsoup-pack-replies)
-
(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
"s" gnus-group-sort-groups
"a" gnus-group-sort-groups-by-alphabet
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
`("Gnus"
- ("SOUP"
- ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
- ["Send replies" gnus-soup-send-replies
- (fboundp 'gnus-soup-pack-packet)]
- ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
- ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
- ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
["Send a mail" gnus-group-mail t]
["Send a message (mail or news)" gnus-group-post-news t]
["Create a local message" gnus-group-news t]
+++ /dev/null
-;;; gnus-soup.el --- SOUP packet writing support for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-(require 'message)
-(require 'gnus-start)
-(require 'gnus-range)
-
-(defgroup gnus-soup nil
- "SOUP packet writing support for Gnus."
- :group 'gnus)
-
-;;; User Variables:
-
-(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
- "Directory containing an unpacked SOUP packet."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-replies-directory
- (nnheader-concat gnus-soup-directory "SoupReplies/")
- "Directory where Gnus will do processing of replies."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-prefix-file "gnus-prefix"
- "Name of the file where Gnus stores the last used prefix."
- :version "22.1" ;; Gnus 5.10.9
- :type 'file
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
- "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears."
- :version "22.1" ;; Gnus 5.10.9
- :type 'string
- :group 'gnus-soup)
-
-(defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -"
- "Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s."
- :version "22.1" ;; Gnus 5.10.9
- :type 'string
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packet-directory gnus-home-directory
- "Where gnus-soup will look for REPLIES packets."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packet-regexp "Soupin"
- "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'."
- :version "22.1" ;; Gnus 5.10.9
- :type 'regexp
- :group 'gnus-soup)
-
-(defcustom gnus-soup-ignored-headers "^Xref:"
- "Regexp to match headers to be removed when brewing SOUP packets."
- :version "22.1" ;; Gnus 5.10.9
- :type 'regexp
- :group 'gnus-soup)
-
-;;; Internal Variables:
-
-(defvar gnus-soup-encoding-type ?u
- "*Soup encoding type.
-`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
-format.")
-
-(defvar gnus-soup-index-type ?c
- "*Soup index type.
-`n' means no index file and `c' means standard Cnews overview
-format.")
-
-(defvar gnus-soup-areas nil)
-(defvar gnus-soup-last-prefix nil)
-(defvar gnus-soup-prev-prefix nil)
-(defvar gnus-soup-buffers nil)
-
-;;; Access macros:
-
-(defmacro gnus-soup-area-prefix (area)
- `(aref ,area 0))
-(defmacro gnus-soup-set-area-prefix (area prefix)
- `(aset ,area 0 ,prefix))
-(defmacro gnus-soup-area-name (area)
- `(aref ,area 1))
-(defmacro gnus-soup-area-encoding (area)
- `(aref ,area 2))
-(defmacro gnus-soup-area-description (area)
- `(aref ,area 3))
-(defmacro gnus-soup-area-number (area)
- `(aref ,area 4))
-(defmacro gnus-soup-area-set-number (area value)
- `(aset ,area 4 ,value))
-
-(defmacro gnus-soup-encoding-format (encoding)
- `(aref ,encoding 0))
-(defmacro gnus-soup-encoding-index (encoding)
- `(aref ,encoding 1))
-(defmacro gnus-soup-encoding-kind (encoding)
- `(aref ,encoding 2))
-
-(defmacro gnus-soup-reply-prefix (reply)
- `(aref ,reply 0))
-(defmacro gnus-soup-reply-kind (reply)
- `(aref ,reply 1))
-(defmacro gnus-soup-reply-encoding (reply)
- `(aref ,reply 2))
-
-;;; Commands:
-
-(defun gnus-soup-send-replies ()
- "Unpack and send all replies in the reply packet."
- (interactive)
- (let ((packets (directory-files
- gnus-soup-packet-directory t gnus-soup-packet-regexp)))
- (while packets
- (when (gnus-soup-send-packet (car packets))
- (delete-file (car packets)))
- (setq packets (cdr packets)))))
-
-(defun gnus-soup-add-article (n)
- "Add the current article to SOUP packet.
-If N is a positive number, add the N next articles.
-If N is a negative number, add the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-move those articles instead."
- (interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (tmp-buf (gnus-get-buffer-create "*soup work*"))
- (area (gnus-soup-area gnus-newsgroup-name))
- (prefix (gnus-soup-area-prefix area))
- headers)
- (buffer-disable-undo tmp-buf)
- (save-excursion
- (while articles
- ;; Put the article in a buffer.
- (set-buffer tmp-buf)
- (when (gnus-request-article-this-buffer
- (car articles) gnus-newsgroup-name)
- (setq headers (nnheader-parse-head t))
- (save-restriction
- (message-narrow-to-head)
- (message-remove-header gnus-soup-ignored-headers t))
- (gnus-soup-store gnus-soup-directory prefix headers
- gnus-soup-encoding-type
- gnus-soup-index-type)
- (gnus-soup-area-set-number
- area (1+ (or (gnus-soup-area-number area) 0)))
- ;; Mark article as read.
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
- (gnus-summary-remove-process-mark (car articles))
- (setq articles (cdr articles)))
- (kill-buffer tmp-buf))
- (gnus-soup-save-areas)
- (gnus-set-mode-line 'summary)))
-
-(defun gnus-soup-pack-packet ()
- "Make a SOUP packet from the SOUP areas."
- (interactive)
- (gnus-soup-read-areas)
- (if (file-exists-p gnus-soup-directory)
- (if (directory-files gnus-soup-directory nil "\\.MSG$")
- (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
- (message "No files to pack."))
- (message "No such directory: %s" gnus-soup-directory)))
-
-(defun gnus-group-brew-soup (n)
- "Make a soup packet from the current group.
-Uses the process/prefix convention."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n)))
- (while groups
- (gnus-group-remove-mark (car groups))
- (gnus-soup-group-brew (car groups) t)
- (setq groups (cdr groups)))
- (gnus-soup-save-areas)))
-
-(defun gnus-brew-soup (&optional level)
- "Go through all groups on LEVEL or less and make a soup packet."
- (interactive "P")
- (let ((level (or level gnus-level-subscribed))
- (newsrc (cdr gnus-newsrc-alist)))
- (while newsrc
- (when (<= (nth 1 (car newsrc)) level)
- (gnus-soup-group-brew (caar newsrc) t))
- (setq newsrc (cdr newsrc)))
- (gnus-soup-save-areas)))
-
-;;;###autoload
-(defun gnus-batch-brew-soup ()
- "Brew a SOUP packet from groups mention on the command line.
-Will use the remaining command line arguments as regular expressions
-for matching on group names.
-
-For instance, if you want to brew on all the nnml groups, as well as
-groups with \"emacs\" in the name, you could say something like:
-
-$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
-
-Note -- this function hasn't been implemented yet."
- (interactive)
- nil)
-
-;;; Internal Functions:
-
-;; Store the current buffer.
-(defun gnus-soup-store (directory prefix headers format index)
- ;; Create the directory, if needed.
- (gnus-make-directory directory)
- (let* ((msg-buf (nnheader-find-file-noselect
- (concat directory prefix ".MSG")))
- (idx-buf (if (= index ?n)
- nil
- (nnheader-find-file-noselect
- (concat directory prefix ".IDX"))))
- (article-buf (current-buffer))
- from head-line beg type)
- (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
- (buffer-disable-undo msg-buf)
- (when idx-buf
- (push idx-buf gnus-soup-buffers)
- (buffer-disable-undo idx-buf))
- (save-excursion
- ;; Make sure the last char in the buffer is a newline.
- (goto-char (point-max))
- (unless (= (current-column) 0)
- (insert "\n"))
- ;; Find the "from".
- (goto-char (point-min))
- (setq from
- (gnus-mail-strip-quoted-names
- (or (mail-fetch-field "from")
- (mail-fetch-field "really-from")
- (mail-fetch-field "sender"))))
- (goto-char (point-min))
- ;; Depending on what encoding is supposed to be used, we make
- ;; a soup header.
- (setq head-line
- (cond
- ((or (= gnus-soup-encoding-type ?u)
- (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
- (format "#! rnews %d\n" (buffer-size)))
- ((= gnus-soup-encoding-type ?m)
- (while (search-forward "\nFrom " nil t)
- (replace-match "\n>From " t t))
- (concat "From " (or from "unknown")
- " " (current-time-string) "\n"))
- ((= gnus-soup-encoding-type ?M)
- "\^a\^a\^a\^a\n")
- (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
- ;; Insert the soup header and the article in the MSG buf.
- (set-buffer msg-buf)
- (goto-char (point-max))
- (insert head-line)
- (setq beg (point))
- (insert-buffer-substring article-buf)
- ;; Insert the index in the IDX buf.
- (cond ((= index ?c)
- (set-buffer idx-buf)
- (gnus-soup-insert-idx beg headers))
- ((/= index ?n)
- (error "Unknown index type: %c" type)))
- ;; Return the MSG buf.
- msg-buf)))
-
-(defun gnus-soup-group-brew (group &optional not-all)
- "Enter GROUP and add all articles to a SOUP package.
-If NOT-ALL, don't pack ticked articles."
- (let ((gnus-expert-user t)
- (gnus-large-newsgroup nil)
- (entry (gnus-group-entry group)))
- (when (or (null entry)
- (eq (car entry) t)
- (and (car entry)
- (> (car entry) 0))
- (and (not not-all)
- (gnus-range-length (cdr (assq 'tick (gnus-info-marks
- (nth 2 entry)))))))
- (when (gnus-summary-read-group group nil t)
- (setq gnus-newsgroup-processable
- (reverse
- (if (not not-all)
- (append gnus-newsgroup-marked gnus-newsgroup-unreads)
- gnus-newsgroup-unreads)))
- (gnus-soup-add-article nil)
- (gnus-summary-exit)))))
-
-(defun gnus-soup-insert-idx (offset header)
- ;; [number subject from date id references chars lines xref]
- (goto-char (point-max))
- (insert
- (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
- offset
- (or (mail-header-subject header) "(none)")
- (or (mail-header-from header) "(nobody)")
- (or (mail-header-date header) "")
- (or (mail-header-id header)
- (concat "soup-dummy-id-"
- (mapconcat
- (lambda (time) (int-to-string time))
- (current-time) "-")))
- (or (mail-header-references header) "")
- (or (mail-header-chars header) 0)
- (or (mail-header-lines header) "0"))))
-
-(defun gnus-soup-save-areas ()
- "Write all SOUP buffers."
- (interactive)
- (gnus-soup-write-areas)
- (save-excursion
- (let (buf)
- (while gnus-soup-buffers
- (setq buf (car gnus-soup-buffers)
- gnus-soup-buffers (cdr gnus-soup-buffers))
- (if (not (buffer-name buf))
- ()
- (set-buffer buf)
- (when (buffer-modified-p)
- (save-buffer))
- (kill-buffer (current-buffer)))))
- (gnus-soup-write-prefixes)))
-
-(defun gnus-soup-write-prefixes ()
- (let ((prefixes gnus-soup-last-prefix)
- prefix)
- (save-excursion
- (gnus-set-work-buffer)
- (while (setq prefix (pop prefixes))
- (erase-buffer)
- (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
-
-(defun gnus-soup-pack (dir packer)
- (let* ((files (mapconcat 'identity
- '("AREAS" "*.MSG" "*.IDX" "INFO"
- "LIST" "REPLIES" "COMMANDS" "ERRORS")
- " "))
- (packer (if (< (string-match "%s" packer)
- (string-match "%d" packer))
- (format packer files
- (string-to-number (gnus-soup-unique-prefix dir)))
- (format packer
- (string-to-number (gnus-soup-unique-prefix dir))
- files)))
- (dir (expand-file-name dir)))
- (gnus-make-directory dir)
- (setq gnus-soup-areas nil)
- (gnus-message 4 "Packing %s..." packer)
- (if (eq 0 (call-process shell-file-name
- nil nil nil shell-command-switch
- (concat "cd " dir " ; " packer)))
- (progn
- (call-process shell-file-name nil nil nil shell-command-switch
- (concat "cd " dir " ; rm " files))
- (gnus-message 4 "Packing...done" packer))
- (error "Couldn't pack packet"))))
-
-(defun gnus-soup-parse-areas (file)
- "Parse soup area file FILE.
-The result is a of vectors, each containing one entry from the AREA file.
-The vector contain five strings,
- [prefix name encoding description number]
-though the two last may be nil if they are missing."
- (let (areas)
- (when (file-exists-p file)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file 'force))
- (buffer-disable-undo)
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field)
- (gnus-soup-field)
- (gnus-soup-field)
- (and (eq (preceding-char) ?\t)
- (gnus-soup-field))
- (and (eq (preceding-char) ?\t)
- (string-to-number (gnus-soup-field))))
- areas)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer))))
- areas))
-
-(defun gnus-soup-parse-replies (file)
- "Parse soup REPLIES file FILE.
-The result is a of vectors, each containing one entry from the REPLIES
-file. The vector contain three strings, [prefix name encoding]."
- (let (replies)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file))
- (buffer-disable-undo)
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field) (gnus-soup-field)
- (gnus-soup-field))
- replies)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer)))
- replies))
-
-(defun gnus-soup-field ()
- (prog1
- (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
- (forward-char 1)))
-
-(defun gnus-soup-read-areas ()
- (or gnus-soup-areas
- (setq gnus-soup-areas
- (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
-
-(defun gnus-soup-write-areas ()
- "Write the AREAS file."
- (interactive)
- (when gnus-soup-areas
- (with-temp-file (concat gnus-soup-directory "AREAS")
- (let ((areas gnus-soup-areas)
- area)
- (while (setq area (pop areas))
- (insert
- (format
- "%s\t%s\t%s%s\n"
- (gnus-soup-area-prefix area)
- (gnus-soup-area-name area)
- (gnus-soup-area-encoding area)
- (if (or (gnus-soup-area-description area)
- (gnus-soup-area-number area))
- (concat "\t" (or (gnus-soup-area-description
- area) "")
- (if (gnus-soup-area-number area)
- (concat "\t" (int-to-string
- (gnus-soup-area-number area)))
- "")) ""))))))))
-
-(defun gnus-soup-write-replies (dir areas)
- "Write a REPLIES file in DIR containing AREAS."
- (with-temp-file (concat dir "REPLIES")
- (let (area)
- (while (setq area (pop areas))
- (insert (format "%s\t%s\t%s\n"
- (gnus-soup-reply-prefix area)
- (gnus-soup-reply-kind area)
- (gnus-soup-reply-encoding area)))))))
-
-(defun gnus-soup-area (group)
- (gnus-soup-read-areas)
- (let ((areas gnus-soup-areas)
- (real-group (gnus-group-real-name group))
- area result)
- (while areas
- (setq area (car areas)
- areas (cdr areas))
- (when (equal (gnus-soup-area-name area) real-group)
- (setq result area)))
- (unless result
- (setq result
- (vector (gnus-soup-unique-prefix)
- real-group
- (format "%c%c%c"
- gnus-soup-encoding-type
- gnus-soup-index-type
- (if (gnus-member-of-valid 'mail group) ?m ?n))
- nil nil)
- gnus-soup-areas (cons result gnus-soup-areas)))
- result))
-
-(defun gnus-soup-unique-prefix (&optional dir)
- (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
- (entry (assoc dir gnus-soup-last-prefix))
- gnus-soup-prev-prefix)
- (if entry
- ()
- (when (file-exists-p (concat dir gnus-soup-prefix-file))
- (ignore-errors
- (load (concat dir gnus-soup-prefix-file) nil t t)))
- (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
- gnus-soup-last-prefix))
- (setcdr entry (1+ (cdr entry)))
- (gnus-soup-write-prefixes)
- (int-to-string (cdr entry))))
-
-(defun gnus-soup-unpack-packet (dir unpacker packet)
- "Unpack PACKET into DIR using UNPACKER.
-Return whether the unpacking was successful."
- (gnus-make-directory dir)
- (gnus-message 4 "Unpacking: %s" (format unpacker packet))
- (prog1
- (eq 0 (call-process
- shell-file-name nil nil nil shell-command-switch
- (format "cd %s ; %s" (expand-file-name dir)
- (format unpacker packet))))
- (gnus-message 4 "Unpacking...done")))
-
-(defun gnus-soup-send-packet (packet)
- (gnus-soup-unpack-packet
- gnus-soup-replies-directory gnus-soup-unpacker packet)
- (let ((replies (gnus-soup-parse-replies
- (concat gnus-soup-replies-directory "REPLIES"))))
- (save-excursion
- (while replies
- (let* ((msg-file (concat gnus-soup-replies-directory
- (gnus-soup-reply-prefix (car replies))
- ".MSG"))
- (msg-buf (and (file-exists-p msg-file)
- (nnheader-find-file-noselect msg-file)))
- (tmp-buf (gnus-get-buffer-create " *soup send*"))
- beg end)
- (cond
- ((and (/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?u)
- (/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?n)) ;; Gnus back compatibility.
- (error "Unsupported encoding"))
- ((null msg-buf)
- t)
- (t
- (buffer-disable-undo msg-buf)
- (set-buffer msg-buf)
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "#! *rnews +\\([0-9]+\\)")
- (error "Bad header"))
- (forward-line 1)
- (setq beg (point)
- end (+ (point) (string-to-number
- (buffer-substring
- (match-beginning 1) (match-end 1)))))
- (switch-to-buffer tmp-buf)
- (erase-buffer)
- (mm-disable-multibyte)
- (insert-buffer-substring msg-buf beg end)
- (cond
- ((string= (gnus-soup-reply-kind (car replies)) "news")
- (gnus-message 5 "Sending news message to %s..."
- (mail-fetch-field "newsgroups"))
- (sit-for 1)
- (let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me)
- (method (if (functionp message-post-method)
- (funcall message-post-method)
- message-post-method))
- result)
- (run-hooks 'message-send-news-hook)
- (gnus-open-server method)
- (message "Sending news via %s..."
- (gnus-server-string method))
- (unless (let ((mail-header-separator ""))
- (gnus-request-post method))
- (message "Couldn't send message via news: %s"
- (nnheader-get-report (car method))))))
- ((string= (gnus-soup-reply-kind (car replies)) "mail")
- (gnus-message 5 "Sending mail to %s..."
- (mail-fetch-field "to"))
- (sit-for 1)
- (let ((mail-header-separator ""))
- (funcall (or message-send-mail-real-function
- message-send-mail-function))))
- (t
- (error "Unknown reply kind")))
- (set-buffer msg-buf)
- (goto-char end))
- (delete-file (buffer-file-name))
- (kill-buffer msg-buf)
- (kill-buffer tmp-buf)
- (gnus-message 4 "Sent packet"))))
- (setq replies (cdr replies)))
- t)))
-
-(provide 'gnus-soup)
-
-;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c
-;;; gnus-soup.el ends here
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-souped-mark ?F
- "*Mark used for souped articles."
- :group 'gnus-summary-marks
- :type 'character)
-
(defcustom gnus-kill-file-mark ?X
"*Mark used for articles killed by kill files."
:group 'gnus-summary-marks
(defcustom gnus-auto-expirable-marks
(list gnus-killed-mark gnus-del-mark gnus-catchup-mark
gnus-low-score-mark gnus-ancient-mark gnus-read-mark
- gnus-souped-mark gnus-duplicate-mark)
+ gnus-duplicate-mark)
"*The list of marks converted into expiration if a group is auto-expirable."
:version "21.1"
:group 'gnus-summary
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint
- "s" gnus-soup-add-article)
+ "P" gnus-summary-muttprint)
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
"b" gnus-summary-display-buttonized
["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
["Save body in file..." gnus-summary-save-article-body-file t]
["Pipe through a filter..." gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t]
["Print with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article
,@(if (featurep 'xemacs) '(t)
gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark gnus-souped-mark)
+ gnus-duplicate-mark)
'reverse)))
(defun gnus-summary-limit-to-headers (match &optional reverse)
("nndoc" none address prompt-address)
("nnbabyl" mail address respool)
("nnkiboze" post virtual)
- ("nnsoup" post-mail address)
("nndraft" post-mail)
("nnfolder" mail respool address)
("nngateway" post-mail address prompt-address physical-address)
("rmailsum" rmail-update-summary)
("gnus-audio" :interactive t gnus-audio-play)
("gnus-xmas" gnus-xmas-splash)
- ("gnus-soup" :interactive t
- gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
- gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
- ("nnsoup" nnsoup-pack-replies)
("score-mode" :interactive t gnus-score-mode)
("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
+++ /dev/null
-;;; nnsoup.el --- SOUP access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-soup)
-(require 'gnus-msg)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnsoup)
-
-(defvoo nnsoup-directory (nnheader-concat gnus-home-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 (concat "tar cf - %s | gzip > "
- (expand-file-name gnus-home-directory)
- "Soupin%d.tgz")
- "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears.")
-
-(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
- "*Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s.")
-
-(defvoo nnsoup-packet-directory gnus-home-directory
- "*Where nnsoup will look for incoming packets.")
-
-(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"
- "nnsoup version.")
-
-(defvoo nnsoup-status-string "")
-(defvoo nnsoup-group-alist nil)
-(defvoo nnsoup-current-prefix 0)
-(defvoo nnsoup-replies-list nil)
-(defvoo nnsoup-buffers nil)
-(defvoo nnsoup-current-group nil)
-(defvoo nnsoup-group-alist-touched nil)
-(defvoo nnsoup-article-alist nil)
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nnsoup)
-
-(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
- (nnsoup-possibly-change-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
- (articles sequence)
- (use-nov t)
- useful-areas this-area-seq msg-buf)
- (if (stringp (car sequence))
- ;; We don't support fetching by Message-ID.
- 'headers
- ;; We go through all the areas and find which files the
- ;; articles in SEQUENCE come from.
- (while (and areas sequence)
- ;; Peel off areas that are below sequence.
- (while (and areas (< (cdar (car areas)) (car sequence)))
- (setq areas (cdr areas)))
- (when areas
- ;; This is a useful area.
- (push (car areas) useful-areas)
- (setq this-area-seq nil)
- ;; We take note whether this MSG has a corresponding IDX
- ;; for later use.
- (when (or (= (gnus-soup-encoding-index
- (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
- (not (file-exists-p
- (nnsoup-file
- (gnus-soup-area-prefix (nth 1 (car areas)))))))
- (setq use-nov nil))
- ;; We assign the portion of `sequence' that is relevant to
- ;; this MSG packet to this packet.
- (while (and sequence (<= (car sequence) (cdar (car areas))))
- (push (car sequence) this-area-seq)
- (setq sequence (cdr sequence)))
- (setcar useful-areas (cons (nreverse this-area-seq)
- (car useful-areas)))))
-
- ;; We now have a list of article numbers and corresponding
- ;; areas.
- (setq useful-areas (nreverse useful-areas))
-
- ;; Two different approaches depending on whether all the MSG
- ;; files have corresponding IDX files. If they all do, we
- ;; simply return the relevant IDX files and let Gnus sort out
- ;; what lines are relevant. If some of the IDX files are
- ;; missing, we must return HEADs for all the articles.
- (if use-nov
- ;; We have IDX files for all areas.
- (progn
- (while useful-areas
- (goto-char (point-max))
- (let ((b (point))
- (number (car (nth 1 (car useful-areas))))
- (index-buffer (nnsoup-index-buffer
- (gnus-soup-area-prefix
- (nth 2 (car useful-areas))))))
- (when index-buffer
- (insert-buffer-substring index-buffer)
- (goto-char b)
- ;; We have to remove the index number entries and
- ;; insert article numbers instead.
- (while (looking-at "[0-9]+")
- (replace-match (int-to-string number) t t)
- (incf number)
- (forward-line 1))))
- (setq useful-areas (cdr useful-areas)))
- 'nov)
- ;; We insert HEADs.
- (while useful-areas
- (setq articles (caar useful-areas)
- useful-areas (cdr useful-areas))
- (while articles
- (when (setq msg-buf
- (nnsoup-narrow-to-article
- (car articles) (cdar useful-areas) 'head))
- (goto-char (point-max))
- (insert (format "221 %d Article retrieved.\n" (car articles)))
- (insert-buffer-substring msg-buf)
- (goto-char (point-max))
- (insert ".\n"))
- (setq articles (cdr articles))))
-
- (nnheader-fold-continuation-lines)
- 'headers)))))
-
-(deffoo nnsoup-open-server (server &optional defs)
- (nnoo-change-server 'nnsoup server defs)
- (when (not (file-exists-p nnsoup-directory))
- (condition-case ()
- (make-directory nnsoup-directory t)
- (error t)))
- (cond
- ((not (file-exists-p nnsoup-directory))
- (nnsoup-close-server)
- (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
- ((not (file-directory-p (file-truename nnsoup-directory)))
- (nnsoup-close-server)
- (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
- (t
- (nnsoup-read-active-file)
- (nnheader-report 'nnsoup "Opened server %s using directory %s"
- server nnsoup-directory)
- t)))
-
-(deffoo nnsoup-request-close ()
- (nnsoup-write-active-file)
- (nnsoup-write-replies)
- (gnus-soup-save-areas)
- ;; Kill all nnsoup buffers.
- (let (buffer)
- (while nnsoup-buffers
- (setq buffer (cdr (pop nnsoup-buffers)))
- (and buffer
- (buffer-name buffer)
- (kill-buffer buffer))))
- (setq nnsoup-group-alist nil
- nnsoup-group-alist-touched nil
- nnsoup-current-group nil
- nnsoup-replies-list nil)
- (nnoo-close-server 'nnoo)
- t)
-
-(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
- (nnsoup-possibly-change-group newsgroup)
- (let (buf)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (when (and (not (stringp id))
- (setq buf (nnsoup-narrow-to-article id)))
- (insert-buffer-substring buf)
- t))))
-
-(deffoo nnsoup-request-group (group &optional server dont-check)
- (nnsoup-possibly-change-group group)
- (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"
- (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
- (cdar (car (cddr (assoc group nnsoup-group-alist))))))
- (if (not article)
- 'unknown
- (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)
- elem)
- (while buffers
- (when (equal (car (setq elem (pop buffers))) group)
- (setq nnsoup-buffers (delq elem nnsoup-buffers))
- (and (cdr elem) (buffer-name (cdr elem))
- (kill-buffer (cdr elem))))))
- t)
-
-(deffoo nnsoup-request-list (&optional server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (unless nnsoup-group-alist
- (nnsoup-read-active-file))
- (let ((alist nnsoup-group-alist)
- (standard-output (current-buffer))
- entry)
- (while (setq entry (pop alist))
- (insert (car entry) " ")
- (princ (cdadr entry))
- (insert " ")
- (princ (caadr entry))
- (insert " y\n"))
- t)))
-
-(deffoo nnsoup-request-scan (group &optional server)
- (nnsoup-unpack-packets))
-
-(deffoo nnsoup-request-newgroups (date &optional server)
- (nnsoup-request-list))
-
-(deffoo nnsoup-request-list-newsgroups (&optional server)
- nil)
-
-(deffoo nnsoup-request-post (&optional server)
- (nnsoup-store-reply "news")
- t)
-
-(deffoo nnsoup-request-mail (&optional server)
- (nnsoup-store-reply "mail")
- t)
-
-(deffoo nnsoup-request-expire-articles (articles group &optional server force)
- (nnsoup-possibly-change-group group)
- (let* ((total-infolist (assoc group nnsoup-group-alist))
- (active (cadr total-infolist))
- (infolist (cddr total-infolist))
- 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)
- ;; This file is old enough.
- (nnmail-expired-article-p group mod-time force))
- ;; Ok, we delete this file.
- (when (ignore-errors
- (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
- 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
- group)
- (when (file-exists-p (nnsoup-file prefix t))
- (delete-file (nnsoup-file prefix t)))
- t)
- (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
- (setq articles (gnus-sorted-difference articles range-list))))
- (when (not mod-time)
- (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
- (if (cddr total-infolist)
- (setcar active (caaadr (cdr total-infolist)))
- (setcar active (1+ (cdr active))))
- (nnsoup-write-active-file t)
- ;; Return the articles that weren't expired.
- articles))
-
-\f
-;;; Internal functions
-
-(defun nnsoup-possibly-change-group (group &optional force)
- (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)
- (when (file-exists-p nnsoup-active-file)
- (ignore-errors
- (load nnsoup-active-file t t t))
- ;; Be backwards compatible.
- (when (and nnsoup-group-alist
- (not (atom (caadar nnsoup-group-alist))))
- (let ((alist nnsoup-group-alist)
- entry e min max)
- (while (setq e (cdr (setq entry (pop alist))))
- (setq min (caaar e))
- (setq max (cdar (car (last e))))
- (setcdr entry (cons (cons min max) (cdr entry)))))
- (setq nnsoup-group-alist-touched t))
- nnsoup-group-alist))
-
-(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"))))
-
-(defun nnsoup-next-prefix ()
- "Return the next free prefix."
- (let (prefix)
- (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))
- (incf nnsoup-current-prefix)
- prefix))
-
-(defun nnsoup-file-name (dir file)
- "Return the full name 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 ()
- (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))
- (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)
- 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
- ;; If the number is in the area info, we just return it.
- ((gnus-soup-area-number area)
- (gnus-soup-area-number area))
- ;; If there is an index file, we just count the lines.
- ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
- (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.
- (t
- (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
- (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
- ((or (= format ?u)
- (= format ?n)) ;; Gnus back compatibility.
- (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")))
- (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 ()
- "Unpack all packets in `nnsoup-packet-directory'."
- (let ((packets (directory-files
- nnsoup-packet-directory t nnsoup-packet-regexp)))
- (dolist (packet packets)
- (nnheader-message 5 "nnsoup: unpacking %s..." packet)
- (if (not (gnus-soup-unpack-packet
- nnsoup-tmp-directory nnsoup-unpacker packet))
- (nnheader-message 5 "Couldn't unpack %s" packet)
- (delete-file packet)
- (nnsoup-read-areas)
- (nnheader-message 5 "Unpacking...done")))))
-
-(defun nnsoup-narrow-to-article (article &optional area head)
- (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
- (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
- (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
- beg end)
- (when area
- (save-excursion
- (cond
- ;; 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
- (gnus-soup-area-encoding (nth 1 area)))
- ?c)
- (file-exists-p (nnsoup-file prefix)))
- (set-buffer (nnsoup-index-buffer prefix))
- (widen)
- (goto-char (point-min))
- (forward-line (- article (caar area)))
- (setq beg (read (current-buffer)))
- (forward-line 1)
- (if (looking-at "[0-9]+")
- (progn
- (setq end (read (current-buffer)))
- (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
- (set-buffer msg-buf)
- (widen)
- (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)
- ()
- (narrow-to-region
- (point-min)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max))))
- msg-buf))))
-
-;;;###autoload
-(defun nnsoup-pack-replies ()
- "Make an outbound package of SOUP replies."
- (interactive)
- (unless (file-exists-p nnsoup-replies-directory)
- (nnheader-message 5 "No such directory: %s" nnsoup-replies-directory))
- ;; Write all data buffers.
- (gnus-soup-save-areas)
- ;; Write the active file.
- (nnsoup-write-active-file)
- ;; Write the REPLIES file.
- (nnsoup-write-replies)
- ;; Check whether there is anything here.
- (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
- (error "No files to pack"))
- ;; Pack all these files into a SOUP packet.
- (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
-
-(defun nnsoup-write-replies ()
- "Write the REPLIES file."
- (when nnsoup-replies-list
- (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
- (setq nnsoup-replies-list nil)))
-
-(defun nnsoup-article-to-area (article group)
- "Return the area that ARTICLE in GROUP is located in."
- (let ((areas (cddr (assoc group nnsoup-group-alist))))
- (while (and areas (< (cdar (car areas)) article))
- (setq areas (cdr areas)))
- (and areas (car areas))))
-
-(defvar nnsoup-old-functions
- (list message-send-mail-real-function message-send-news-function))
-
-;;;###autoload
-(defun nnsoup-set-variables ()
- "Use the SOUP methods for posting news and mailing mail."
- (interactive)
- (setq message-send-news-function 'nnsoup-request-post)
- (setq message-send-mail-real-function 'nnsoup-request-mail))
-
-;;;###autoload
-(defun nnsoup-revert-variables ()
- "Revert posting and mailing methods to the standard Emacs methods."
- (interactive)
- (setq message-send-mail-real-function (car nnsoup-old-functions))
- (setq message-send-news-function (cadr nnsoup-old-functions)))
-
-(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
- (message-narrow-to-headers)
- (if (equal kind "mail")
- (message-generate-headers message-required-mail-headers)
- (message-generate-headers message-required-news-headers)))
- (set-buffer tembuf)
- (erase-buffer)
- (insert-buffer-substring mailbuf)
- ;; Remove some headers.
- (save-restriction
- (message-narrow-to-headers)
- ;; Remove some headers.
- (message-remove-header message-ignored-mail-headers t))
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (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))
- (num 0))
- (when (and msg-buf (bufferp msg-buf))
- (save-excursion
- (set-buffer msg-buf)
- (goto-char (point-min))
- (while (re-search-forward "^#! *rnews" nil t)
- (incf num))
- (when nnsoup-always-save
- (save-buffer)))
- (nnheader-message 5 "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
- (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
- (gnus-soup-reply-prefix (car replies))
- (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
- kind
- (format "%c%c%c"
- nnsoup-replies-format-type
- nnsoup-replies-index-type
- (if (string= kind "news")
- ?n ?m)))
- nnsoup-replies-list)
- (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
-
-(defun nnsoup-make-active ()
- "(Re-)create the SOUP active file."
- (interactive)
- (let ((files (sort (directory-files nnsoup-directory t "IDX$")
- (lambda (f1 f2)
- (< (progn (string-match "/\\([0-9]+\\)\\." f1)
- (string-to-number (match-string 1 f1)))
- (progn (string-match "/\\([0-9]+\\)\\." f2)
- (string-to-number (match-string 1 f2)))))))
- active group lines ident elem min)
- (set-buffer (get-buffer-create " *nnsoup work*"))
- (dolist (file files)
- (nnheader-message 5 "Doing %s..." file)
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
- (setq group "unknown")
- (setq group (match-string 2)))
- (setq lines (count-lines (point-min) (point-max)))
- (setq ident (progn (string-match
- "/\\([0-9]+\\)\\." file)
- (match-string 1 file)))
- (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))))
- (nnheader-message 5 "")
- (setq nnsoup-group-alist active)
- (nnsoup-write-active-file t)))
-
-(defun nnsoup-delete-unreferenced-message-files ()
- "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
- (interactive)
- (let* ((known (apply 'nconc (mapcar
- (lambda (ga)
- (mapcar
- (lambda (area)
- (gnus-soup-area-prefix (cadr area)))
- (cddr ga)))
- nnsoup-group-alist)))
- (regexp "\\.MSG$\\|\\.IDX$")
- (files (directory-files nnsoup-directory nil regexp))
- non-files)
- ;; Find all files that aren't known by nnsoup.
- (dolist (file files)
- (string-match regexp file)
- (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)
-
-;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828
-;;; nnsoup.el ends here
* Getting Mail:: Reading your personal mail with Gnus.
* Browsing the Web:: Getting messages from a plethora of Web sources.
* IMAP:: Using Gnus as a @acronym{IMAP} client.
-* Other Sources:: Reading directories, files, SOUP packets.
+* Other Sources:: Reading directories, files.
* Combined Groups:: Combining groups into one group.
* Email Based Diary:: Using mails to manage diary events in Gnus.
* Gnus Unplugged:: Reading news and mail offline.
* Directory Groups:: You can read a directory as if it was a newsgroup.
* Anything Groups:: Dired? Who needs dired?
* Document Groups:: Single files can be the basis of a group.
-* SOUP:: Reading @sc{soup} packets ``offline''.
* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
Document Groups
* Document Server Internals:: How to add your own document types.
-SOUP
-
-* SOUP Commands:: Commands for creating and sending @sc{soup} packets
-* SOUP Groups:: A back end for reading @sc{soup} packets.
-* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
-
Combined Groups
* Virtual Groups:: Combining articles from many groups.
@vindex gnus-canceled-mark
Canceled article (@code{gnus-canceled-mark})
-@item F
-@vindex gnus-souped-mark
-@sc{soup}ed article (@code{gnus-souped-mark}). @xref{SOUP}.
-
@item Q
@vindex gnus-sparse-mark
Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing
* Getting Mail:: Reading your personal mail with Gnus.
* Browsing the Web:: Getting messages from a plethora of Web sources.
* IMAP:: Using Gnus as a @acronym{IMAP} client.
-* Other Sources:: Reading directories, files, SOUP packets.
+* Other Sources:: Reading directories, files.
* Combined Groups:: Combining groups into one group.
* Email Based Diary:: Using mails to manage diary events in Gnus.
* Gnus Unplugged:: Reading news and mail offline.
* Directory Groups:: You can read a directory as if it was a newsgroup.
* Anything Groups:: Dired? Who needs dired?
* Document Groups:: Single files can be the basis of a group.
-* SOUP:: Reading @sc{soup} packets ``offline''.
* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
@end menu
means low probability with @samp{0} being the lowest valid number.
-@node SOUP
-@subsection SOUP
-@cindex SOUP
-@cindex offline
-
-In the PC world people often talk about ``offline'' newsreaders. These
-are thingies that are combined reader/news transport monstrosities.
-With built-in modem programs. Yecchh!
-
-Of course, us Unix Weenie types of human beans use things like
-@code{uucp} and, like, @code{nntpd} and set up proper news and mail
-transport things like Ghod intended. And then we just use normal
-newsreaders.
-
-However, it can sometimes be convenient to do something that's a bit
-easier on the brain if you have a very slow modem, and you're not really
-that interested in doing things properly.
-
-A file format called @sc{soup} has been developed for transporting news
-and mail from servers to home machines and back again. It can be a bit
-fiddly.
-
-First some terminology:
-
-@table @dfn
-
-@item server
-This is the machine that is connected to the outside world and where you
-get news and/or mail from.
-
-@item home machine
-This is the machine that you want to do the actual reading and responding
-on. It is typically not connected to the rest of the world in any way.
-
-@item packet
-Something that contains messages and/or commands. There are two kinds
-of packets:
-
-@table @dfn
-@item message packets
-These are packets made at the server, and typically contain lots of
-messages for you to read. These are called @file{SoupoutX.tgz} by
-default, where @var{x} is a number.
-
-@item response packets
-These are packets made at the home machine, and typically contains
-replies that you've written. These are called @file{SoupinX.tgz} by
-default, where @var{x} is a number.
-
-@end table
-
-@end table
-
-
-@enumerate
-
-@item
-You log in on the server and create a @sc{soup} packet. You can either
-use a dedicated @sc{soup} thingie (like the @code{awk} program), or you
-can use Gnus to create the packet with its @sc{soup} commands (@kbd{O
-s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}).
-
-@item
-You transfer the packet home. Rail, boat, car or modem will do fine.
-
-@item
-You put the packet in your home directory.
-
-@item
-You fire up Gnus on your home machine using the @code{nnsoup} back end as
-the native or secondary server.
-
-@item
-You read articles and mail and answer and followup to the things you
-want (@pxref{SOUP Replies}).
-
-@item
-You do the @kbd{G s r} command to pack these replies into a @sc{soup}
-packet.
-
-@item
-You transfer this packet to the server.
-
-@item
-You use Gnus to mail this packet out with the @kbd{G s s} command.
-
-@item
-You then repeat until you die.
-
-@end enumerate
-
-So you basically have a bipartite system---you use @code{nnsoup} for
-reading and Gnus for packing/sending these @sc{soup} packets.
-
-@menu
-* SOUP Commands:: Commands for creating and sending @sc{soup} packets
-* SOUP Groups:: A back end for reading @sc{soup} packets.
-* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
-@end menu
-
-
-@node SOUP Commands
-@subsubsection SOUP Commands
-
-These are commands for creating and manipulating @sc{soup} packets.
-
-@table @kbd
-@item G s b
-@kindex G s b (Group)
-@findex gnus-group-brew-soup
-Pack all unread articles in the current group
-(@code{gnus-group-brew-soup}). This command understands the
-process/prefix convention.
-
-@item G s w
-@kindex G s w (Group)
-@findex gnus-soup-save-areas
-Save all @sc{soup} data files (@code{gnus-soup-save-areas}).
-
-@item G s s
-@kindex G s s (Group)
-@findex gnus-soup-send-replies
-Send all replies from the replies packet
-(@code{gnus-soup-send-replies}).
-
-@item G s p
-@kindex G s p (Group)
-@findex gnus-soup-pack-packet
-Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}).
-
-@item G s r
-@kindex G s r (Group)
-@findex nnsoup-pack-replies
-Pack all replies into a replies packet (@code{nnsoup-pack-replies}).
-
-@item O s
-@kindex O s (Summary)
-@findex gnus-soup-add-article
-This summary-mode command adds the current article to a @sc{soup} packet
-(@code{gnus-soup-add-article}). It understands the process/prefix
-convention (@pxref{Process/Prefix}).
-
-@end table
-
-
-There are a few variables to customize where Gnus will put all these
-thingies:
-
-@table @code
-
-@item gnus-soup-directory
-@vindex gnus-soup-directory
-Directory where Gnus will save intermediate files while composing
-@sc{soup} packets. The default is @file{~/SoupBrew/}.
-
-@item gnus-soup-replies-directory
-@vindex gnus-soup-replies-directory
-This is what Gnus will use as a temporary directory while sending our
-reply packets. @file{~/SoupBrew/SoupReplies/} is the default.
-
-@item gnus-soup-prefix-file
-@vindex gnus-soup-prefix-file
-Name of the file where Gnus stores the last used prefix. The default is
-@samp{gnus-prefix}.
-
-@item gnus-soup-packer
-@vindex gnus-soup-packer
-A format string command for packing a @sc{soup} packet. The default is
-@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}.
-
-@item gnus-soup-unpacker
-@vindex gnus-soup-unpacker
-Format string command for unpacking a @sc{soup} packet. The default is
-@samp{gunzip -c %s | tar xvf -}.
-
-@item gnus-soup-packet-directory
-@vindex gnus-soup-packet-directory
-Where Gnus will look for reply packets. The default is @file{~/}.
-
-@item gnus-soup-packet-regexp
-@vindex gnus-soup-packet-regexp
-Regular expression matching @sc{soup} reply packets in
-@code{gnus-soup-packet-directory}.
-
-@end table
-
-
-@node SOUP Groups
-@subsubsection SOUP Groups
-@cindex nnsoup
-
-@code{nnsoup} is the back end for reading @sc{soup} packets. It will
-read incoming packets, unpack them, and put them in a directory where
-you can read them at leisure.
-
-These are the variables you can use to customize its behavior:
-
-@table @code
-
-@item nnsoup-tmp-directory
-@vindex nnsoup-tmp-directory
-When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this
-directory. (@file{/tmp/} by default.)
-
-@item nnsoup-directory
-@vindex nnsoup-directory
-@code{nnsoup} then moves each message and index file to this directory.
-The default is @file{~/SOUP/}.
-
-@item nnsoup-replies-directory
-@vindex nnsoup-replies-directory
-All replies will be stored in this directory before being packed into a
-reply packet. The default is @file{~/SOUP/replies/}.
-
-@item nnsoup-replies-format-type
-@vindex nnsoup-replies-format-type
-The @sc{soup} format of the replies packets. The default is @samp{?n}
-(rnews), and I don't think you should touch that variable. I probably
-shouldn't even have documented it. Drats! Too late!
-
-@item nnsoup-replies-index-type
-@vindex nnsoup-replies-index-type
-The index type of the replies packet. The default is @samp{?n}, which
-means ``none''. Don't fiddle with this one either!
-
-@item nnsoup-active-file
-@vindex nnsoup-active-file
-Where @code{nnsoup} stores lots of information. This is not an ``active
-file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose
-this file or mess it up in any way, you're dead. The default is
-@file{~/SOUP/active}.
-
-@item nnsoup-packer
-@vindex nnsoup-packer
-Format string command for packing a reply @sc{soup} packet. The default
-is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}.
-
-@item nnsoup-unpacker
-@vindex nnsoup-unpacker
-Format string command for unpacking incoming @sc{soup} packets. The
-default is @samp{gunzip -c %s | tar xvf -}.
-
-@item nnsoup-packet-directory
-@vindex nnsoup-packet-directory
-Where @code{nnsoup} will look for incoming packets. The default is
-@file{~/}.
-
-@item nnsoup-packet-regexp
-@vindex nnsoup-packet-regexp
-Regular expression matching incoming @sc{soup} packets. The default is
-@samp{Soupout}.
-
-@item nnsoup-always-save
-@vindex nnsoup-always-save
-If non-@code{nil}, save the replies buffer after each posted message.
-
-@end table
-
-
-@node SOUP Replies
-@subsubsection SOUP Replies
-
-Just using @code{nnsoup} won't mean that your postings and mailings end
-up in @sc{soup} reply packets automagically. You have to work a bit
-more for that to happen.
-
-@findex nnsoup-set-variables
-The @code{nnsoup-set-variables} command will set the appropriate
-variables to ensure that all your followups and replies end up in the
-@sc{soup} system.
-
-In specific, this is what it does:
-
-@lisp
-(setq message-send-news-function 'nnsoup-request-post)
-(setq message-send-mail-function 'nnsoup-request-mail)
-@end lisp
-
-And that's it, really. If you only want news to go into the @sc{soup}
-system you just use the first line. If you only want mail to be
-@sc{soup}ed you use the second.
-
-
@node Mail-To-News Gateways
@subsection Mail-To-News Gateways
@cindex mail-to-news gateways
projects / gnus / commitdiff