--- /dev/null
+;;; auc-menu.el - Easy menu support for GNU Emacs 19 and XEmacs.
+;;
+;; $Id: auc-menu.el,v 5.7 1994/11/28 01:41:22 amanda Exp $
+;;
+;; LCD Archive Entry:
+;; auc-menu|Per Abrahamsen|abraham@iesd.auc.dk|
+;; Easy menu support for GNU Emacs 19 and XEmacs|
+;; $Date: 1994/11/28 01:41:22 $|$Revision: 5.7 $|~/misc/auc-menu.el.gz|
+
+;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Commentary:
+;;
+;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
+;; The advantages of using easymenu are:
+;;
+;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
+;;
+;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
+;; (The code does nothing when run under Emacs 18).
+;;
+;; The public functions are:
+;;
+;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
+;; SYMBOL is both the name of the variable that holds the menu and
+;; the name of a function that will present a the menu.
+;; MAPS is a list of keymaps where the menu should appear in the menubar.
+;; DOC is the documentation string for the variable.
+;; MENU is an XEmacs style menu description.
+;;
+;; See the documentation for easy-menu-define for details.
+;;
+;; - Function: easy-menu-change PATH NAME ITEMS
+;; Change an existing menu.
+;; The menu must already exist an be visible on the menu bar.
+;; PATH is a list of strings used for locating the menu on the menu bar.
+;; NAME is the name of the menu.
+;; ITEMS is a list of menu items, as defined in `easy-menu-define'.
+;;
+;; - Function: easy-menu-add MENU [ MAP ]
+;; Add MENU to the current menubar in MAP.
+;;
+;; - Function: easy-menu-remove MENU
+;; Remove MENU from the current menubar.
+;;
+;; GNU Emacs 19 never uses `easy-menu-add' or `easy-menu-remove',
+;; menus automatically appear and disappear when the keymaps
+;; specified by the MAPS argument to `easy-menu-define' are
+;; activated.
+;;
+;; XEmacs will bind the map to button3 in each MAPS, but you must
+;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and
+;; remove menus from the menu bar.
+
+;; auc-menu.el define the easymenu API included in Emacs 19.29 and
+;; later. In fact, the Emacs 19 specific code should be identical.
+
+;;; Code:
+
+;;;###autoload
+(defmacro easy-menu-define (symbol maps doc menu)
+ "Define a menu bar submenu in maps MAPS, according to MENU.
+The arguments SYMBOL and DOC are ignored; they are present for
+compatibility only. SYMBOL is not evaluated. In other Emacs versions
+these arguments may be used as a variable to hold the menu data, and a
+doc string for that variable.
+
+The first element of MENU must be a string. It is the menu bar item name.
+The rest of the elements are menu items.
+
+A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
+
+NAME is a string--the menu item name.
+
+CALLBACK is a command to run when the item is chosen,
+or a list to evaluate when the item is chosen.
+
+ENABLE is an expression; the item is enabled for selection
+whenever this expression's value is non-nil.
+
+Alternatively, a menu item may have the form:
+
+ [ NAME CALLBACK [ KEYWORD ARG ] ... ]
+
+Where KEYWORD is one of the symbol defined below.
+
+ :keys KEYS
+
+KEYS is a string; a complex keyboard equivalent to this menu item.
+
+ :active ENABLE
+
+ENABLE is an expression; the item is enabled for selection
+whenever this expression's value is non-nil.
+
+ :suffix NAME
+
+NAME is a string; the name of an argument to CALLBACK.
+
+ :style STYLE
+
+STYLE is a symbol describing the type of menu item. The following are
+defined:
+
+toggle: A checkbox.
+ Currently just prepend the name with the string \"Toggle \".
+radio: A radio button.
+nil: An ordinary menu item.
+
+ :selected SELECTED
+
+SELECTED is an expression; the checkbox or radio button is selected
+whenever this expression's value is non-nil.
+Currently just disable radio buttons, no effect on checkboxes.
+
+A menu item can be a string. Then that string appears in the menu as
+unselectable text. A string consisting solely of hyphens is displayed
+as a solid horizontal line.
+
+A menu item can be a list. It is treated as a submenu.
+The first element should be the submenu name. That's used as the
+menu item in the top-level menu. The cdr of the submenu list
+is a list of menu items, as above."
+ (` (progn
+ (defvar (, symbol) nil (, doc))
+ (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
+
+(cond
+
+;;; Emacs 18
+
+((< (string-to-int emacs-version) 19)
+
+(defun easy-menu-do-define (symbol maps doc menu)
+ (fset symbol (symbol-function 'ignore)))
+
+(defun easy-menu-remove (menu))
+
+(defun easy-menu-add (menu &optional map))
+
+(defun easy-menu-change (path name items))
+
+) ;Emacs 18
+
+;;; XEmacs
+
+((string-match "XEmacs\\|Lucid" emacs-version)
+
+(defun easy-menu-do-define (symbol maps doc menu)
+ (set symbol menu)
+ (fset symbol (list 'lambda '(e)
+ doc
+ '(interactive "@e")
+ '(run-hooks 'activate-menubar-hook)
+ '(setq zmacs-region-stays 't)
+ (list 'popup-menu symbol)))
+ (mapcar (function (lambda (map) (define-key map 'button3 symbol)))
+ (if (keymapp maps) (list maps) maps)))
+
+(fset 'easy-menu-change (symbol-function 'add-menu))
+
+(defun easy-menu-add (menu &optional map)
+ "Add MENU to the current menu bar."
+ (cond ((null current-menubar)
+ ;; Don't add it to a non-existing menubar.
+ nil)
+ ((assoc (car menu) current-menubar)
+ ;; Already present.
+ nil)
+ ((equal current-menubar '(nil))
+ ;; Set at left if only contains right marker.
+ (set-buffer-menubar (list menu nil)))
+ (t
+ ;; Add at right.
+ (set-buffer-menubar (copy-sequence current-menubar))
+ (add-menu nil (car menu) (cdr menu)))))
+
+(defun easy-menu-remove (menu)
+ "Remove MENU from the current menu bar."
+ (and current-menubar
+ (assoc (car menu) current-menubar)
+ (delete-menu-item (list (car menu)))))
+
+) ;XEmacs
+
+;;; GNU Emacs 19
+
+(t
+
+(defun easy-menu-do-define (symbol maps doc menu)
+ ;; We can't do anything that might differ between Emacs dialects in
+ ;; `easy-menu-define' in order to make byte compiled files
+ ;; compatible. Therefore everything interesting is done in this
+ ;; function.
+ (set symbol (easy-menu-create-keymaps (car menu) (cdr menu)))
+ (fset symbol (` (lambda (event) (, doc) (interactive "@e")
+ (easy-popup-menu event (, symbol)))))
+ (mapcar (function (lambda (map)
+ (define-key map (vector 'menu-bar (intern (car menu)))
+ (cons (car menu) (symbol-value symbol)))))
+ (if (keymapp maps) (list maps) maps)))
+
+(defvar easy-menu-item-count 0)
+
+;; Return a menu keymap corresponding to a XEmacs style menu list
+;; MENU-ITEMS, and with name MENU-NAME.
+(defun easy-menu-create-keymaps (menu-name menu-items)
+ (let ((menu (make-sparse-keymap menu-name)))
+ ;; Process items in reverse order,
+ ;; since the define-key loop reverses them again.
+ (setq menu-items (reverse menu-items))
+ (while menu-items
+ (let* ((item (car menu-items))
+ (callback (if (vectorp item) (aref item 1)))
+ command enabler name)
+ (cond ((stringp item)
+ (setq command nil)
+ (setq name (if (string-match "^-+$" item) "" item)))
+ ((consp item)
+ (setq command (easy-menu-create-keymaps (car item) (cdr item)))
+ (setq name (car item)))
+ ((vectorp item)
+ (setq command (make-symbol (format "menu-function-%d"
+ easy-menu-item-count)))
+ (setq easy-menu-item-count (1+ easy-menu-item-count))
+ (setq name (aref item 0))
+ (let ((keyword (aref item 2)))
+ (if (and (symbolp keyword)
+ (= ?: (aref (symbol-name keyword) 0)))
+ (let ((count 2)
+ style selected active keys
+ arg)
+ (while (> (length item) count)
+ (setq keyword (aref item count))
+ (setq arg (aref item (1+ count)))
+ (setq count (+ 2 count))
+ (cond ((eq keyword ':keys)
+ (setq keys arg))
+ ((eq keyword ':active)
+ (setq active arg))
+ ((eq keyword ':suffix)
+ (setq name (concat name " " arg)))
+ ((eq keyword ':style)
+ (setq style arg))
+ ((eq keyword ':selected)
+ (setq selected arg))))
+ (if keys
+ (setq name (concat name " (" keys ")")))
+ (if (eq style 'toggle)
+ ;; Simulate checkboxes.
+ (setq name (concat "Toggle " name)))
+ (if active
+ (put command 'menu-enable active)
+ (and (eq style 'radio)
+ selected
+ ;; Simulate radio buttons with menu-enable.
+ (put command 'menu-enable
+ (list 'not selected)))))))
+ (if (keymapp callback)
+ (setq name (concat name " ...")))
+ (if (symbolp callback)
+ (fset command callback)
+ (fset command (list 'lambda () '(interactive) callback)))))
+ (if (null command)
+ ;; Handle inactive strings specially--allow any number
+ ;; of identical ones.
+ (setcdr menu (cons (list nil name) (cdr menu)))
+ (if name
+ (define-key menu (vector (intern name)) (cons name command)))))
+ (setq menu-items (cdr menu-items)))
+ menu))
+
+(defun easy-menu-change (path name items)
+ "Change menu found at PATH as item NAME to contain ITEMS.
+PATH is a list of strings for locating the menu containing NAME in the
+menu bar. ITEMS is a list of menu items, as in `easy-menu-define'.
+These items entirely replace the previous items in that map.
+
+Call this from `activate-menubar-hook' to implement dynamic menus."
+ (let ((map (key-binding (apply 'vector
+ 'menu-bar
+ (mapcar 'intern (append path (list name)))))))
+ (if (keymapp map)
+ (setcdr map (cdr (easy-menu-create-keymaps name items)))
+ (error "Malformed menu in `easy-menu-change'"))))
+
+(defun easy-menu-remove (menu))
+
+(defun easy-menu-add (menu &optional map))
+
+) ;GNU Emacs 19
+
+) ;cond
+
+(provide 'easymenu)
+(provide 'auc-menu)
+
+;;; auc-menu.el ends here
--- /dev/null
+;;; gnus-soup.el --- SOUP packet writing support for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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 2, 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; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus-msg)
+(require 'gnus)
+
+;;; User Variables:
+
+(defvar gnus-soup-directory "~/SoupBrew/"
+ "*Directory containing an unpacked SOUP packet.")
+
+(defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/")
+ "*Directory where Gnus will do processing of replies.")
+
+(defvar gnus-soup-prefix-file "gnus-prefix"
+ "*Name of the file where Gnus stores the last used prefix.")
+
+(defvar 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.")
+
+(defvar 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.")
+
+(defvar gnus-soup-packet-directory "~/"
+ "*Where gnus-soup will look for REPLIES packets.")
+
+(defvar gnus-soup-packet-regexp "Soupin"
+ "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.")
+
+;;; Internal Variables:
+
+(defvar gnus-soup-encoding-type ?n
+ "*Soup encoding type.
+`n' is 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-group-type ?u
+ "*Soup message area type.
+`u' is unknown, `m' is private mail, and `n' is news.
+Gnus will determine by itself what type to use in what group, so
+setting this variable won't do much.")
+
+(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-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
+ (and (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")
+ (gnus-set-global-variables)
+ (let* ((articles (gnus-summary-work-articles n))
+ (tmp-buf (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
+ ;; Find the header of the article.
+ (set-buffer gnus-summary-buffer)
+ (setq headers (gnus-summary-article-header (car articles)))
+ ;; Put the article in a buffer.
+ (set-buffer tmp-buf)
+ (gnus-request-article-this-buffer
+ (car articles) gnus-newsgroup-name)
+ (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-remove-process-mark (car articles))
+ (gnus-summary-mark-as-read (car articles) "F")
+ (setq articles (cdr articles)))
+ (kill-buffer tmp-buf))
+ (gnus-soup-save-areas)))
+
+(defun gnus-soup-pack-packet ()
+ "Make a SOUP packet from the SOUP areas."
+ (interactive)
+ (gnus-soup-read-areas)
+ (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
+
+(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))
+ (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
+ (and (<= (nth 1 (car newsrc)) level)
+ (gnus-soup-group-brew (car (car newsrc))))
+ (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.*\""
+ (interactive)
+ )
+
+;;; Internal Functions:
+
+;; Store the current buffer.
+(defun gnus-soup-store (directory prefix headers format index)
+ ;; Create the directory, if needed.
+ (or (file-directory-p directory)
+ (gnus-make-directory directory))
+ (let* ((msg-buf (find-file-noselect
+ (concat directory prefix ".MSG")))
+ (idx-buf (if (= index ?n)
+ nil
+ (find-file-noselect
+ (concat directory prefix ".IDX"))))
+ (article-buf (current-buffer))
+ from head-line beg type)
+ (setq gnus-soup-buffers (cons msg-buf gnus-soup-buffers))
+ (buffer-disable-undo msg-buf)
+ (and idx-buf
+ (progn
+ (setq gnus-soup-buffers (cons 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))
+ (or (= (current-column) 0)
+ (insert "\n"))
+ ;; Find the "from".
+ (goto-char (point-min))
+ (setq from
+ (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
+ ((= gnus-soup-encoding-type ?n)
+ (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))))))
+
+(defun gnus-soup-group-brew (group)
+ (let ((gnus-expert-user t)
+ (gnus-large-newsgroup nil))
+ (and (gnus-summary-read-group group)
+ (let ((gnus-newsgroup-processable
+ (gnus-sorted-complement
+ gnus-newsgroup-unreads
+ (append gnus-newsgroup-dormant gnus-newsgroup-marked))))
+ (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%s\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")
+ (or (mail-header-xref header) ""))))
+
+(defun gnus-soup-save-areas ()
+ (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)
+ (and (buffer-modified-p) (save-buffer))
+ (kill-buffer (current-buffer)))))
+ (let ((prefix gnus-soup-last-prefix))
+ (while prefix
+ (gnus-set-work-buffer)
+ (insert (format "(setq gnus-soup-prev-prefix %d)\n"
+ (cdr (car prefix))))
+ (write-region (point-min) (point-max)
+ (concat (car (car prefix))
+ gnus-soup-prefix-file)
+ nil 'nomesg)
+ (setq prefix (cdr prefix))))))
+
+(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-int (gnus-soup-unique-prefix dir)))
+ (format packer
+ (string-to-int (gnus-soup-unique-prefix dir))
+ files)))
+ (dir (expand-file-name dir)))
+ (setq gnus-soup-areas nil)
+ (message "Packing %s..." packer)
+ (if (zerop (call-process "sh" nil nil nil "-c"
+ (concat "cd " dir " ; " packer)))
+ (progn
+ (call-process "sh" nil nil nil "-c"
+ (concat "cd " dir " ; rm " files))
+ (message "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)
+ (save-excursion
+ (set-buffer (find-file-noselect file 'force))
+ (buffer-disable-undo (current-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq areas
+ (cons (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-int (gnus-soup-field))))
+ areas))
+ (if (eq (preceding-char) ?\t)
+ (beginning-of-line 2))))
+ 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 (find-file-noselect file))
+ (buffer-disable-undo (current-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq replies
+ (cons (vector (gnus-soup-field) (gnus-soup-field)
+ (gnus-soup-field))
+ replies))
+ (if (eq (preceding-char) ?\t)
+ (beginning-of-line 2))))
+ 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 all areas to disk."
+ (interactive)
+ (if (not gnus-soup-areas)
+ ()
+ (save-excursion
+ (set-buffer (find-file-noselect
+ (concat gnus-soup-directory "AREAS")))
+ (erase-buffer)
+ (let ((areas gnus-soup-areas)
+ area)
+ (while areas
+ (setq area (car areas)
+ areas (cdr 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)))
+ "")) "")))))
+ (write-region (point-min) (point-max)
+ (concat gnus-soup-directory "AREAS"))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))))
+
+(defun gnus-soup-write-replies (dir areas)
+ (save-excursion
+ (set-buffer (find-file-noselect (concat dir "REPLIES")))
+ (erase-buffer)
+ (let (area)
+ (while areas
+ (setq area (car areas)
+ areas (cdr areas))
+ (insert (format "%s\t%s\t%s\n"
+ (gnus-soup-reply-prefix area)
+ (gnus-soup-reply-kind area)
+ (gnus-soup-reply-encoding area)))))
+ (write-region (point-min) (point-max) (concat dir "REPLIES"))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer))))
+
+(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))
+ (if (equal (gnus-soup-area-name area) real-group)
+ (setq result area)))
+ (or 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
+ ()
+ (and (file-exists-p (concat dir gnus-soup-prefix-file))
+ (condition-case nil
+ (load-file (concat dir gnus-soup-prefix-file))
+ (error nil)))
+ (setq gnus-soup-last-prefix
+ (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
+ gnus-soup-last-prefix)))
+ (setcdr entry (1+ (cdr entry)))
+ (int-to-string (cdr entry))))
+
+(defun gnus-soup-unpack-packet (dir unpacker packet)
+ (gnus-make-directory dir)
+ (message "Unpacking: %s" (format unpacker packet))
+ (call-process
+ "sh" nil nil nil "-c"
+ (format "cd %s ; %s" (expand-file-name dir) (format unpacker packet)))
+ (message "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)
+ (find-file-noselect msg-file)))
+ (tmp-buf (get-buffer-create " *soup send*"))
+ beg end)
+ (cond
+ ((/= (gnus-soup-encoding-format
+ (gnus-soup-reply-encoding (car replies))) ?n)
+ (error "Unsupported encoding"))
+ ((null msg-buf)
+ t)
+ (t
+ (buffer-disable-undo msg-buf)
+ (buffer-disable-undo tmp-buf)
+ (set-buffer msg-buf)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (or (looking-at "#! *rnews +\\([0-9]+\\)")
+ (error "Bad header."))
+ (forward-line 1)
+ (setq beg (point)
+ end (+ (point) (string-to-int
+ (buffer-substring
+ (match-beginning 1) (match-end 1)))))
+ (switch-to-buffer tmp-buf)
+ (erase-buffer)
+ (insert-buffer-substring msg-buf beg end)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ (cond
+ ((string= (gnus-soup-reply-kind (car replies)) "news")
+ (message "Sending news message to %s..."
+ (mail-fetch-field "newsgroups"))
+ (sit-for 1)
+ (gnus-inews-article))
+ ((string= (gnus-soup-reply-kind (car replies)) "mail")
+ (message "Sending mail to %s..."
+ (mail-fetch-field "to"))
+ (sit-for 1)
+ (gnus-mail-send-and-exit))
+ (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)
+ (message "Sent packet"))))
+ (setq replies (cdr replies)))
+ t)))
+
+(provide 'gnus-soup)
+
+;;; gnus-soup.el ends here
--- /dev/null
+;;; nnsoup.el --- SOUP access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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 2, 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; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus-soup)
+(require 'gnus-msg)
+
+(defvar nnsoup-directory "~/SOUP/"
+ "*SOUP packet directory directory.")
+
+(defvar nnsoup-replies-directory (concat nnsoup-directory "replies/")
+ "*Directory where outgoing packets will be composed.")
+
+(defvar nnsoup-replies-format-type ?n
+ "*Format of the replies packages.")
+
+(defvar nnsoup-replies-index-type ?n
+ "*Index type of the replies packages.")
+
+(defvar nnsoup-active-file (concat nnsoup-directory "active")
+ "Active file.")
+
+(defvar 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.
+This string MUST contain both %s and %d. The file number will be
+inserted where %d appears.")
+
+(defvar 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.")
+
+(defvar nnsoup-packet-directory "~/"
+ "*Where nnsoup will look for incoming packets.")
+
+(defvar nnsoup-packet-regexp "Soupout"
+ "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
+
+\f
+
+(defconst nnsoup-version "nnsoup 0.0"
+ "nnsoup version.")
+
+(defvar nnsoup-status-string "")
+(defvar nnsoup-group-alist nil)
+(defvar nnsoup-replies-list nil)
+(defvar nnsoup-buffers nil)
+(defvar nnsoup-current-group nil)
+
+\f
+
+;; Server variables.
+
+(defvar nnsoup-current-server nil)
+(defvar nnsoup-server-alist nil)
+(defvar nnsoup-server-variables
+ (list
+ (list 'nnsoup-directory nnsoup-directory)
+ (list 'nnsoup-active-file nnsoup-active-file)
+ '(nnsoup-status-string "")
+ '(nnsoup-group-alist nil)))
+
+\f
+
+;;; Interface functions.
+
+(defun 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 (cdr (assoc nnsoup-current-group nnsoup-group-alist)))
+ (articles sequence)
+ (use-nov t)
+ useful-areas this-area-seq)
+ (if (stringp (car sequence))
+ '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 (< (cdr (car (car areas))) (car sequence)))
+ (setq areas (cdr areas)))
+ (if (not areas)
+ ()
+ ;; This is a useful area.
+ (setq useful-areas (cons (car areas) useful-areas)
+ this-area-seq nil)
+ ;; We take note whether this MSG has a corresponding IDX
+ ;; for later use.
+ (if (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 assing the portion of `sequence' that is relevant to
+ ;; this MSG packet to this packet.
+ (while (and sequence (<= (car sequence) (cdr (car (car areas)))))
+ (setq this-area-seq (cons (car sequence) this-area-seq)
+ 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
+ (while useful-areas
+ (goto-char (point-max))
+ (let ((b (point))
+ (number (car (nth 1 (car useful-areas)))))
+ (insert-buffer-substring
+ (nnsoup-index-buffer
+ (gnus-soup-area-prefix
+ (nth 2 (car useful-areas)))))
+ (goto-char b)
+ ;; We have to remove the index number entires and
+ ;; insert article numbers instead.
+ (while (looking-at "[0-9]+")
+ (replace-match (int-to-string number) t t)
+ (setq number (1+ number))
+ (forward-line 1)))
+ (setq useful-areas (cdr useful-areas)))
+ ;; We insert HEADs.
+ (while useful-areas
+ (setq articles (car (car useful-areas))
+ useful-areas (cdr useful-areas))
+ (while articles
+ (goto-char (point-max))
+ (insert (format "221 %d Article retrieved.\n" (car articles)))
+ (insert-buffer-substring
+ (nnsoup-narrow-to-article
+ (car articles) (cdr (car useful-areas)) 'head))
+ (goto-char (point-max))
+ (insert ".\n")
+ (setq articles (cdr articles))))
+
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t)))
+ (if use-nov 'nov 'headers)))))
+
+(defun nnsoup-open-server (server &optional defs)
+ (nnsoup-set-variables)
+ (nnheader-init-server-buffer)
+ (if (equal server nnsoup-current-server)
+ t
+ (if nnsoup-current-server
+ (setq nnsoup-server-alist
+ (cons (list nnsoup-current-server
+ (nnheader-save-variables nnsoup-server-variables))
+ nnsoup-server-alist)))
+ (let ((state (assoc server nnsoup-server-alist)))
+ (if state
+ (progn
+ (nnheader-restore-variables (nth 1 state))
+ (setq nnsoup-server-alist (delq state nnsoup-server-alist)))
+ (nnheader-set-init-variables nnsoup-server-variables defs)))
+ (setq nnsoup-current-server server))
+ (nnsoup-read-active-file))
+
+(defun nnsoup-request-close ()
+ (nnsoup-write-active-file)
+ (nnsoup-write-replies)
+ (while nnsoup-buffers
+ (and (car nnsoup-buffers)
+ (buffer-name (car nnsoup-buffers))
+ (kill-buffer (car nnsoup-buffers)))
+ (setq nnsoup-buffers (cdr nnsoup-buffers)))
+ (setq nnsoup-group-alist nil
+ nnsoup-current-group nil
+ nnsoup-current-server nil
+ nnsoup-server-alist nil
+ nnsoup-replies-list nil)
+ t)
+
+(defun nnsoup-close-server (&optional server)
+ t)
+
+(defun nnsoup-server-opened (&optional server)
+ (and (equal server nnsoup-current-server)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
+
+(defun nnsoup-status-message (&optional server)
+ nnsoup-status-string)
+
+(defun nnsoup-request-article (id &optional newsgroup server buffer)
+ (nnsoup-possibly-change-group newsgroup)
+ (let ((buffer (or buffer nntp-server-buffer)))
+ (save-excursion
+ (set-buffer buffer)
+ (erase-buffer)
+ (if (stringp id)
+ ()
+ (insert-buffer-substring
+ (nnsoup-narrow-to-article id))
+ t))))
+
+(defun nnsoup-request-group (group &optional server dont-check)
+ (nnsoup-possibly-change-group group)
+ (if dont-check
+ ()
+ (let ((area (cdr (assoc group nnsoup-group-alist)))
+ min max)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq min (car (car (car area))))
+ (while (cdr area)
+ (setq area (cdr area)))
+ (setq max (cdr (car (car area))))
+ (insert (format "211 %d %d %d %s\n"
+ (max (1+ (- max min)) 0) min max group)))))
+ t)
+
+(defun nnsoup-close-group (group &optional server)
+ t)
+
+(defun nnsoup-request-list (&optional server)
+ (or nnsoup-group-alist (nnsoup-read-areas))
+ (nnsoup-unpack-packets)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((alist nnsoup-group-alist)
+ min)
+ (while alist
+ (setq min (car (car (nth 1 (car alist)))))
+ (insert (format "%s %d %d y\n" (car (car alist))
+ (let ((areas (car alist)))
+ (while (cdr areas)
+ (setq areas (cdr areas)))
+ (cdr (car (car areas)))) min))
+ (setq alist (cdr alist)))
+ t)))
+
+(defun nnsoup-request-newgroups (date &optional server)
+ (nnsoup-request-list))
+
+(defun nnsoup-request-list-newsgroups (&optional server)
+ nil)
+
+(defun nnsoup-request-post (&optional server)
+ (nnsoup-store-reply "news")
+ t)
+
+(defun nnsoup-request-mail ()
+ (nnsoup-store-reply "mail")
+ t)
+
+(defun nnsoup-request-post-buffer (post group &rest args)
+ (nnsoup-possibly-change-group group)
+ (apply
+ ;; Find out whether the source for this group is a mail or a news
+ ;; group and call the right function for getting a buffer.
+ (let ((enc (nth 1 (car (cdr (assoc nnsoup-current-group
+ nnsoup-group-alist))))))
+ (if (and enc
+ (= (gnus-soup-encoding-kind (gnus-soup-area-encoding enc)) ?m))
+ 'nnmail-request-post-buffer
+ 'nntp-request-post-buffer))
+ post group args))
+
+\f
+;;; Internal functions
+
+(defun nnsoup-possibly-change-group (group &optional force)
+ (if group
+ (setq nnsoup-current-group group)
+ t))
+
+(defun nnsoup-read-active-file ()
+ (if (file-exists-p nnsoup-active-file)
+ (condition-case ()
+ (load nnsoup-active-file)
+ (error nil))))
+
+(defun nnsoup-write-active-file ()
+ (save-excursion
+ (set-buffer (get-buffer-create " *nnsoup work*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert (format "(setq nnsoup-group-alist '%S)\n" nnsoup-group-alist))
+ (write-region (point-min) (point-max) nnsoup-active-file
+ nil 'silent)
+ (kill-buffer (current-buffer))))
+
+(defun nnsoup-read-areas ()
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((areas (gnus-soup-parse-areas (concat nnsoup-directory "AREAS")))
+ entry number area lnum)
+ ;; Go through all areas in the new AREAS file.
+ (while areas
+ (setq area (car areas)
+ areas (cdr areas))
+ ;; 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.
+ (setq nnsoup-group-alist
+ (cons (list (gnus-soup-area-name area)
+ (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.
+ (let ((e (cdr entry)))
+ (while (cdr e)
+ (setq e (cdr e)))
+ (setcdr e (list (list (cons (setq lnum (1+ (cdr (car (car e)))))
+ (+ lnum number))
+ area)))))))
+ (nnsoup-write-active-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)))
+ (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)))))
+
+(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 aready loaded.
+ (save-excursion ; Load the file.
+ (set-buffer (get-buffer-create buffer-name))
+ (setq nnsoup-buffers (cons (current-buffer) nnsoup-buffers))
+ (insert-file-contents (concat nnsoup-directory file))
+ (current-buffer)))))
+
+(defun nnsoup-file (prefix &optional message)
+ (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))
+
+(defun nnsoup-message-buffer (prefix)
+ (nnsoup-index-buffer prefix 'msg))
+
+(defun nnsoup-unpack-packets ()
+ (let ((packets (directory-files
+ nnsoup-packet-directory t nnsoup-packet-regexp))
+ msg)
+ (while packets
+ (message (setq msg (format "nnsoup: unpacking %s..." (car packets))))
+ (gnus-soup-unpack-packet nnsoup-directory nnsoup-unpacker (car packets))
+ (delete-file (car packets))
+ (nnsoup-read-areas)
+ (message "%sdone" msg)
+ (setq packets (cdr packets)))))
+
+(defun nnsoup-narrow-to-article (article &optional area head)
+ (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
+ (prefix (gnus-soup-area-prefix (nth 1 area)))
+ beg end msg-buf)
+ (setq msg-buf (nnsoup-index-buffer prefix 'msg))
+ (save-excursion
+ (cond
+ ;; 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 (car (car 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)
+ (if (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
+ (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 (car (car area))))
+ (narrow-to-region
+ (match-beginning 0)
+ (if (re-search-forward header nil t)
+ (match-beginning 0)
+ (point-max))))))
+ (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)))
+
+(defun nnsoup-header (format)
+ (cond
+ ((= format ?n)
+ "^#! *rnews +[0-9]+ *$")
+ ((= format ?m)
+ (concat "^" rmail-unix-mail-delimiter))
+ ((= format ?M)
+ "^\^A\^A\^A\^A\n")
+ (t
+ (error "Unknown format: %c" format))))
+
+(defun nnsoup-pack-replies ()
+ "Make an outbound package of SOUP replies."
+ (interactive)
+ (nnsoup-write-active-file)
+ (nnsoup-write-replies)
+ (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
+
+(defun nnsoup-write-replies ()
+ (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list))
+
+(defun nnsoup-article-to-area (article group)
+ (let ((areas (cdr (assoc group nnsoup-group-alist))))
+ (while (and areas (< (cdr (car (car areas))) article))
+ (setq areas (cdr areas)))
+ (and areas (car areas))))
+
+(defun nnsoup-set-variables ()
+ (setq gnus-inews-article-function 'nnsoup-request-post)
+ (setq gnus-mail-send-method 'nnsoup-request-mail)
+ (setq send-mail-function 'nnsoup-request-mail))
+
+(defun nnsoup-store-reply (kind)
+ ;; Mostly stolen from `sendmail.el'.
+ (let ((tembuf (generate-new-buffer " sendmail temp"))
+ (case-fold-search nil)
+ (mailbuf (current-buffer))
+ delimline)
+ (save-excursion
+ (set-buffer tembuf)
+ (erase-buffer)
+ (insert-buffer-substring mailbuf)
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ ;; 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))
+ (if mail-aliases (expand-mail-aliases (point-min) delimline))
+ (goto-char (point-min))
+ ;; ignore any blank lines in the header
+ (while (and (re-search-forward "\n\n\n*" delimline t)
+ (< (point) delimline))
+ (replace-match "\n"))
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ ;; Find and handle any FCC fields.
+ (goto-char (point-min))
+ (if (re-search-forward "^FCC:" delimline t)
+ (mail-do-fcc delimline))
+ (goto-char (point-min))
+ ;; "S:" is an abbreviation for "Subject:".
+ (goto-char (point-min))
+ (if (re-search-forward "^S:" delimline t)
+ (replace-match "Subject:"))
+ ;; Don't send out a blank subject line
+ (goto-char (point-min))
+ (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
+ (replace-match ""))
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (if (eval mail-mailer-swallows-blank-line)
+ (newline)))
+ (gnus-soup-store
+ nnsoup-replies-directory
+ (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
+ nnsoup-replies-index-type)
+ (kill-buffer tembuf))))
+
+(defun nnsoup-kind-to-prefix (kind)
+ (or 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
+ (gnus-soup-reply-prefix (car replies))
+ (setq nnsoup-replies-list
+ (cons (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)))))
+
+(provide 'nnsoup)
+
+;;; nnsoup.el ends here
--- /dev/null
+Wed Sep 20 16:14:11 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Drafts): New.
+ (Thread Commands): Addition.
+ (Rejected Articles): New.
+
+Tue Sep 19 00:30:15 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Mail): Addition.
+ (Mail Group Commands): Addition.
+ (Group Parameters): Addition.
+ (Summary Buffer Mode Line): Addition.
+ (Finding the Parent): Addition.
+
+Mon Sep 18 11:49:16 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Limiting): New.
+ (Slave Gnusii): New.
+ (Setting Process Marks): Addition.
+ (The Server is Down): Change.
+ (Article Treatment): New.
+ (Article Hiding): New.
+ (Article Washing): New.
+ (Article Date): New.
+ (Finding the News): Addition.
+ (Customizing Threading): Addition.
projects / gnus / commitdiff