*** pub/dgnus/lisp/custom.el Wed May 31 02:08:51 1995 --- dgnus/lisp/custom.el Thu Jun 1 12:41:32 1995 *************** *** 77,82 **** --- 77,84 ---- (setq intangible 'intangible) (setq intangible 'intangible-if-it-had-been-working)) + (defvar custom-modified-list nil) + ;;; Faces: ;; ;; The following variables define the faces used in the customization *************** *** 713,719 **** (setq alist (cons (cons (custom-tag-or-type current) current) alist))) (let ((answer (if (listp last-input-event) (x-popup-menu last-input-event ! (list tag (cons "" (reverse alist)))) (let ((choice (completing-read (concat tag " (default " default "): ") alist nil t))) --- 715,721 ---- (setq alist (cons (cons (custom-tag-or-type current) current) alist))) (let ((answer (if (listp last-input-event) (x-popup-menu last-input-event ! (list tag (cons "" (reverse alist)))) (let ((choice (completing-read (concat tag " (default " default "): ") alist nil t))) *** pub/dgnus/lisp/gnus-edit.el Wed May 31 02:08:51 1995 --- dgnus/lisp/gnus-edit.el Fri Jun 2 01:24:06 1995 *************** *** 3,9 **** ;; ;; Author: Per Abrahamsen ;; Keywords: news, help ! ;; Version: 0.0 ;;; Commentary: ;; --- 3,9 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: news, help ! ;; Version: 0.1 ;;; Commentary: ;; *************** *** 12,17 **** --- 12,18 ---- ;;; Code: (require 'custom) + (require 'gnus-score) (autoload 'gnus-score-load "gnus-score") *************** *** 456,462 **** (t (setcdr (assoc name gnus-score-alist) (list value))))) ((null value)) ! ((litsp value) (setq gnus-score-alist (cons (cons name value) gnus-score-alist))) (t (setq gnus-score-alist --- 457,463 ---- (t (setcdr (assoc name gnus-score-alist) (list value))))) ((null value)) ! ((listp value) (setq gnus-score-alist (cons (cons name value) gnus-score-alist))) (t (setq gnus-score-alist *** pub/dgnus/lisp/gnus-ems.el Wed May 31 02:08:51 1995 --- dgnus/lisp/gnus-ems.el Fri Jun 2 01:36:41 1995 *************** *** 39,45 **** (setq gnus-easymenu 'auc-menu) (or (memq 'underline (list-faces)) ! (make-face 'underline)) (or (face-differs-from-default-p 'underline) (set-face-underline-p 'underline t)) (or (fboundp 'set-text-properties) --- 39,45 ---- (setq gnus-easymenu 'auc-menu) (or (memq 'underline (list-faces)) ! (funcall (intern "make-face") 'underline)) (or (face-differs-from-default-p 'underline) (set-face-underline-p 'underline t)) (or (fboundp 'set-text-properties) *************** *** 99,106 **** (cond ((not window-system) (defun gnus-dummy-func (&rest args)) ! (let ((funcs '(mouse-set-point make-face set-face-foreground ! set-face-background))) (while funcs (or (fboundp (car funcs)) (fset (car funcs) 'gnus-dummy-func)) --- 99,106 ---- (cond ((not window-system) (defun gnus-dummy-func (&rest args)) ! (let ((funcs '(mouse-set-point set-face-foreground ! set-face-background x-popup-menu))) (while funcs (or (fboundp (car funcs)) (fset (car funcs) 'gnus-dummy-func)) *** pub/dgnus/lisp/gnus-msg.el Wed May 31 02:08:51 1995 --- dgnus/lisp/gnus-msg.el Fri Jun 2 15:20:03 1995 *************** *** 148,153 **** --- 148,156 ---- Message-ID. Organization, Lines and X-Newsreader are optional. If you want Gnus not to insert some header, remove it from this list.") + (defvar gnus-deletable-headers '(Message-ID) + "*Headers to be deleted if they already exists.") + (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text *************** *** 192,197 **** --- 195,203 ---- The message must have To or Cc header. The default is copied from the variable `send-mail-function'.") + (defvar gnus-inews-article-function 'gnus-inews-article + "*Function to post an article.") + (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc) "*A hook called before finally posting an article. The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves *************** *** 374,379 **** --- 380,386 ---- (buffer-name (get-buffer article-buffer))) (save-excursion (set-buffer article-buffer) + (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-text-properties (point-min) (point-max) nil gnus-article-copy))))) *************** *** 442,450 **** (setq gnus-article-reply sumart) ;; Handle `gnus-auto-mail-to-author'. ;; Suggested by Daniel Quinlan . ! (let ((to (if (eq gnus-auto-mail-to-author 'ask) ! (and (y-or-n-p "Also send mail to author? ") from) ! (and gnus-auto-mail-to-author from)))) (if to (progn (if (mail-fetch-field "To") --- 449,458 ---- (setq gnus-article-reply sumart) ;; Handle `gnus-auto-mail-to-author'. ;; Suggested by Daniel Quinlan . ! (let ((to (and (not post) ! (if (eq gnus-auto-mail-to-author 'ask) ! (and (y-or-n-p "Also send mail to author? ") from) ! (and gnus-auto-mail-to-author from))))) (if to (progn (if (mail-fetch-field "To") *************** *** 614,619 **** --- 622,634 ---- (forward-line -1) (gnus-delete-line))) + ;; We generate a Message-ID so that the mail and the + ;; news copy of the message both get the same ID. + (or (mail-fetch-field "message-id") + (progn + (goto-char (point-max)) + (insert "Message-ID: " (gnus-inews-message-id) "\n"))) + (save-restriction (widen) (gnus-message 5 "Sending via mail...") *************** *** 653,661 **** (goto-char (point-max)) (insert fcc-line)))))))) ! ;; Send to NNTP server. (gnus-message 5 "Posting to USENET...") ! (if (gnus-inews-article use-group-method) (progn (gnus-message 5 "Posting to USENET...done") (if (gnus-buffer-exists-p (car-safe reply)) --- 668,676 ---- (goto-char (point-max)) (insert fcc-line)))))))) ! ;; Send to server. (gnus-message 5 "Posting to USENET...") ! (if (funcall gnus-inews-article-function use-group-method) (progn (gnus-message 5 "Posting to USENET...done") (if (gnus-buffer-exists-p (car-safe reply)) *************** *** 853,859 **** "This is a cancel message from " from ".\n") ;; Send the control article to NNTP server. (gnus-message 5 "Canceling your article...") ! (if (gnus-inews-article) (gnus-message 5 "Canceling your article...done") (ding) (gnus-message 1 "Cancel failed; %s" --- 868,874 ---- "This is a cancel message from " from ".\n") ;; Send the control article to NNTP server. (gnus-message 5 "Canceling your article...") ! (if (funcall gnus-inews-article-function) (gnus-message 5 "Canceling your article...done") (ding) (gnus-message 1 "Cancel failed; %s" *************** *** 866,897 **** (defun gnus-inews-article (&optional use-group-method) "Post an article in current buffer using NNTP protocol." ! ;; Check whether the article is a good Net Citizen. ! (if (and gnus-article-check-size (not (gnus-inews-check-post))) ! ;; Aber nein! ! () ! ;; Looks ok, so we do the nasty. ! (let ((artbuf (current-buffer)) ! (tmpbuf (get-buffer-create " *Gnus-posting*"))) ! (widen) ! (goto-char (point-max)) ! ;; require a newline at the end for inews to append .signature to ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! ;; Prepare article headers. All message body such as signature ! ;; must be inserted before Lines: field is prepared. ! (save-restriction ! (goto-char (point-min)) ! (narrow-to-region ! (point-min) ! (save-excursion ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (match-beginning 0))) ! (gnus-inews-remove-headers) ! (gnus-inews-insert-headers) ! (run-hooks gnus-inews-article-header-hook) ! (widen)) (save-excursion (set-buffer tmpbuf) (buffer-disable-undo (current-buffer)) --- 881,913 ---- (defun gnus-inews-article (&optional use-group-method) "Post an article in current buffer using NNTP protocol." ! (let ((artbuf (current-buffer)) ! (tmpbuf (get-buffer-create " *Gnus-posting*"))) ! (widen) ! (goto-char (point-max)) ! ;; require a newline at the end for inews to append .signature to ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! ;; Prepare article headers. All message body such as signature ! ;; must be inserted before Lines: field is prepared. ! (save-restriction ! (goto-char (point-min)) ! (narrow-to-region ! (point-min) ! (save-excursion ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (match-beginning 0))) ! (gnus-inews-remove-headers) ! (gnus-inews-insert-headers) ! (run-hooks gnus-inews-article-header-hook) ! (widen)) ! ;; Check whether the article is a good Net Citizen. ! (if (and gnus-article-check-size ! (not (gnus-inews-check-post))) ! ;; Aber nein! ! () ! ;; Looks ok, so we do the nasty. (save-excursion (set-buffer tmpbuf) (buffer-disable-undo (current-buffer)) *************** *** 947,960 **** (headers gnus-required-headers) (case-fold-search t) header value elem) ! ;; First we remove any old Message-IDs. This might be slightly ! ;; fascist, but if the user really wants to generate Message-IDs ! ;; by herself, she should remove it from the `gnus-required-list'. ! (goto-char (point-min)) ! (and (memq 'Message-ID headers) ! (re-search-forward "^Message-ID:" nil t) ! (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point)))) ;; Insert new Sender if the From is strange. (let ((from (mail-fetch-field "from"))) (if (and from (not (string= (downcase from) (downcase From)))) --- 963,977 ---- (headers gnus-required-headers) (case-fold-search t) header value elem) ! ;; First we remove any old generated headers. ! (let ((headers gnus-deletable-headers)) ! (while headers ! (goto-char (point-min)) ! (and (re-search-forward ! (concat "^" (symbol-name (car headers)) ": *") nil t) ! (get-text-property 'gnus-delete (match-end 0)) ! (gnus-delete-line)) ! (setq headers (cdr headers)))) ;; Insert new Sender if the From is strange. (let ((from (mail-fetch-field "from"))) (if (and from (not (string= (downcase from) (downcase From)))) *************** *** 1010,1015 **** --- 1027,1037 ---- ;; so we just ask the user. (read-from-minibuffer (format "Empty header for %s; enter value: " header)))) + ;; Add the deletable property to the headers that require it. + (and (memq header gnus-deletable-headers) + (add-text-properties + 0 (length value) '(gnus-deletable t) value)) + ;; Finally insert the header. (if (bolp) (save-excursion (goto-char (point-max)) *** pub/dgnus/lisp/gnus-score.el Wed May 31 02:08:53 1995 --- dgnus/lisp/gnus-score.el Fri Jun 2 01:24:09 1995 *************** *** 105,110 **** --- 105,111 ---- (define-key gnus-summary-score-map "e" 'gnus-score-edit-alist) (define-key gnus-summary-score-map "f" 'gnus-score-edit-file) (define-key gnus-summary-score-map "t" 'gnus-score-find-trace) + (define-key gnus-summary-score-map "C" 'gnus-score-customize) *** pub/dgnus/lisp/gnus-soup.el Wed May 31 02:08:53 1995 --- dgnus/lisp/gnus-soup.el Fri Jun 2 16:58:16 1995 *************** *** 61,74 **** ;;; Code: ! ;;; Hack `gnus.el': ! (require 'gnus) ;;; User Variables: ! (defvar gnus-soup-directory "~/SOUP/" ! "*Directory containing unpacked SOUP packet.") (defvar gnus-soup-prefix-file "gnus-prefix" "*Name of the file where Gnus stores the last used prefix.") --- 61,76 ---- ;;; 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.") *************** *** 79,84 **** --- 81,96 ---- 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 *************** *** 97,108 **** Gnus will determine by itself what type to use in what group, so setting this variable won't do much.") ! (defconst gnus-soup-areas nil) (defvar gnus-soup-last-prefix nil) (defvar gnus-soup-buffers nil) ;;; Commands: (defun gnus-soup-add-article (n) "Add the current article to SOUP packet. If N is a positive number, add the N next articles. --- 109,160 ---- 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. *************** *** 111,204 **** move those articles instead." (interactive "P") (gnus-set-global-variables) - (add-hook 'gnus-exit-gnus-hook 'gnus-soup-save) - (or (file-directory-p gnus-soup-directory) - (gnus-make-directory gnus-soup-directory)) (let* ((articles (gnus-summary-work-articles n)) (tmp-buf (get-buffer-create "*soup work*")) ! (prefix (aref (gnus-soup-area gnus-newsgroup-name) 0)) ! (msg-buf (find-file-noselect ! (concat gnus-soup-directory prefix ".MSG"))) ! (idx-buf (find-file-noselect ! (concat gnus-soup-directory prefix ".IDX"))) ! from head-line beg type headers) ! (setq gnus-soup-buffers (cons msg-buf (cons idx-buf gnus-soup-buffers))) (buffer-disable-undo tmp-buf) - (buffer-disable-undo msg-buf) - (buffer-disable-undo idx-buf) (save-excursion (while articles ;; Put the article in a buffer. (set-buffer tmp-buf) (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) ! ;; 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)))) ! ;; Find the header of the article. ! (set-buffer gnus-summary-buffer) ! (setq headers (gnus-get-header-by-number (car articles))) ! ;; 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 tmp-buf) ! ;; Insert the index in the IDX buf. ! (cond ((= gnus-soup-index-type ?c) ! (set-buffer idx-buf) ! (gnus-soup-insert-idx beg headers)) ! ((/= gnus-soup-index-type ?n) ! (error "Unknown index type: %c" type))) (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)))) ! (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-group-brew-soup (n) ! "Make a soup packet from the current group." (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))) (defun gnus-brew-soup (&optional level) "Go through all groups on LEVEL or less and make a soup packet." --- 163,211 ---- 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-get-header-by-number (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)))) ! (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." *************** *** 209,218 **** (and (<= (nth 1 (car newsrc)) level) (gnus-soup-group-brew (car (car newsrc)))) (setq newsrc (cdr newsrc))) ! (gnus-soup-save))) ;;; Internal Functions: (defun gnus-soup-insert-idx (offset header) ;; [number subject from date id references chars lines xref] (goto-char (point-max)) --- 216,309 ---- (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 article in the current buffer. + (defun gnus-soup-store (directory prefix headers format index) + (add-hook 'gnus-exit-gnus-hook 'gnus-soup-save-areas) + ;; Create the directory, if needed. + (or (file-directory-p directory) + (gnus-make-directory directory)) + (let* ((msg-buf (gnus-find-file-noselect + (concat directory prefix ".MSG"))) + (idx-buf (if (= index ?n) + nil + (gnus-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)) *************** *** 232,238 **** (or (header-lines header) "0") (or (header-xref header) "")))) ! (defun gnus-soup-save () (gnus-soup-write-areas) (save-excursion (let (buf) --- 323,329 ---- (or (header-lines header) "0") (or (header-xref header) "")))) ! (defun gnus-soup-save-areas () (gnus-soup-write-areas) (save-excursion (let (buf) *************** *** 244,275 **** (set-buffer buf) (and (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer))))) ! (gnus-set-work-buffer) ! (insert (format "(setq gnus-soup-last-prefix %d)\n" ! gnus-soup-last-prefix)) ! (write-region (point-min) (point-max) gnus-soup-prefix-file nil 'nomesg))) ! ! (defun gnus-soup-pack () ! (let* ((dir (file-name-nondirectory ! (directory-file-name ! (file-name-as-directory gnus-soup-directory)))) ! (top (file-name-directory ! (directory-file-name ! (file-name-as-directory gnus-soup-directory)))) ! (files (mapconcat (lambda (f) (concat dir "/" f)) '("AREAS" "*.MSG" "*.IDX" "INFO" "LIST" "REPLIES" "COMMANDS" "ERRORS") " ")) ! (packer (if (< (string-match "%s" gnus-soup-packer) ! (string-match "%d" gnus-soup-packer)) ! (format gnus-soup-packer files (string-to-int (gnus-soup-unique-prefix))) ! (format gnus-soup-packer ! (string-to-int (gnus-soup-unique-prefix)) files)))) (if (zerop (call-process "sh" nil nil nil "-c" ! (concat "cd " top " ; " packer))) ! (call-process "sh" nil nil nil "-c" ! (concat "cd " top " ; rm " files)) (error "Couldn't pack packet.")))) (defun gnus-soup-parse-areas (file) --- 335,370 ---- (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))) ! (format packer ! (string-to-int (gnus-soup-unique-prefix)) files))) ! (dir (expand-file-name dir))) ! (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) *************** *** 280,286 **** though the two last may be nil if they are missing." (let (areas) (save-excursion ! (set-buffer (find-file-noselect file)) (buffer-disable-undo) (goto-char (point-min)) (while (not (eobp)) --- 375,381 ---- though the two last may be nil if they are missing." (let (areas) (save-excursion ! (set-buffer (gnus-find-file-noselect file 'force)) (buffer-disable-undo) (goto-char (point-min)) (while (not (eobp)) *************** *** 288,300 **** (cons (vector (gnus-soup-field) (gnus-soup-field) (gnus-soup-field) ! (and (eq (preceding-char) ?\t) (gnus-soup-field)) ! (and (eq (preceding-char) ?\t) (gnus-soup-field))) areas)) (if (eq (preceding-char) ?\t) (beginning-of-line 2)))) areas)) (defun gnus-soup-field () (prog1 (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) --- 383,415 ---- (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 (gnus-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))) *************** *** 306,359 **** (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) (defun gnus-soup-write-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 (aref area 0) ?\t (aref area 1) ?\t (aref area 2) ?\n))) ! (write-region (point-min) (point-max) ! (concat gnus-soup-directory "AREAS")) (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) (defun gnus-soup-area (group) (gnus-soup-read-areas) (let ((areas gnus-soup-areas) area result) (while areas (setq area (car areas) areas (cdr areas)) ! (if (equal (aref area 1) group) (setq result area))) (or result (setq result (vector (gnus-soup-unique-prefix) ! 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 () ! (if gnus-soup-last-prefix ! () ! (if (file-exists-p gnus-soup-prefix-file) ! (condition-case nil ! (load-file gnus-soup-prefix-file) ! (error 0)) ! (setq gnus-soup-last-prefix 0))) ! (int-to-string (setq gnus-soup-last-prefix (1+ gnus-soup-last-prefix)))) ! (provide 'gnus-soup) ;;; gnus-soup.el ends here - - - --- 421,581 ---- (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) (defun gnus-soup-write-areas () + (if (not gnus-soup-areas) + () + (save-excursion + (set-buffer (gnus-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 (gnus-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)) ! (setq 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) ! (gnus-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 *** pub/dgnus/lisp/gnus-vis.el Wed May 31 02:08:53 1995 --- dgnus/lisp/gnus-vis.el Fri Jun 2 01:24:04 1995 *************** *** 208,215 **** ["Read init file" gnus-group-read-init-file t] ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ! ["Edit the global kill file" gnus-group-edit-global-kill t] ! ["Expire all expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] ["Save .newsrc files" gnus-group-save-newsrc t] --- 208,214 ---- ["Read init file" gnus-group-read-init-file t] ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ! ["Expire expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] ["Save .newsrc files" gnus-group-save-newsrc t] *************** *** 217,224 **** ["Clear dribble buffer" gnus-group-clear-dribble t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] ["Sort group buffer" gnus-group-sort-groups t] - ["Edit global KILL file" gnus-group-edit-global-kill t] )) ) --- 216,223 ---- ["Clear dribble buffer" gnus-group-clear-dribble t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t] + ["Edit global kill file" gnus-group-edit-global-kill t] ["Sort group buffer" gnus-group-sort-groups t] )) ) *************** *** 402,408 **** ["Expire expirable articles" gnus-summary-expire-articles t] ["Describe group" gnus-summary-describe-group t] ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit global kill file" gnus-summary-edit-global-kill t] )) (easy-menu-define --- 401,406 ---- *************** *** 438,443 **** --- 436,442 ---- ["Current score" gnus-summary-current-score t] ["Set score" gnus-summary-set-score t] ("Score file" + ["Customize score file" gnus-score-customize t] ["Switch current score file" gnus-score-change-score-file t] ["Set mark below" gnus-score-set-mark-below t] ["Set expunge below" gnus-score-set-expunge-below t] *** pub/dgnus/lisp/gnus.el Wed May 31 02:08:54 1995 --- dgnus/lisp/gnus.el Fri Jun 2 17:05:07 1995 *************** *** 1275,1281 **** (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)" "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.80" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1275,1281 ---- (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)" "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.81" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1500,1505 **** --- 1500,1506 ---- (autoload 'mail-extract-address-components "mail-extr") (autoload 'nnmail-split-fancy "nnmail") + (autoload 'nnvirtual-catchup-group "nnvirtual") ;; timezone (autoload 'timezone-make-date-arpa-standard "timezone") *************** *** 1522,1527 **** --- 1523,1532 ---- (autoload 'gnus-group-brew-soup "gnus-soup" nil t) (autoload 'gnus-brew-soup "gnus-soup" nil t) (autoload 'gnus-soup-add-article "gnus-soup" nil t) + (autoload 'gnus-soup-send-replies "gnus-soup" nil t) + (autoload 'gnus-soup-save-areas "gnus-soup" nil t) + (autoload 'gnus-soup-pack-packet "gnus-soup" nil t) + (autoload 'nnsoup-pack-replies "nnsoup" nil t) ;; gnus-mh (autoload 'gnus-mail-reply-using-mhe "gnus-mh") *************** *** 1588,1593 **** --- 1593,1601 ---- (autoload 'gnus-possibly-score-headers "gnus-score") (autoload 'gnus-score-find-trace "gnus-score") + ;; gnus-edit + (autoload 'gnus-score-customize "gnus-edit" nil t) + ;; gnus-uu (autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap) (autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap) *************** *** 1790,1796 **** (if (and (string-match "%D" gnus-group-line-format) (not gnus-description-hashtb) gnus-read-active-file) ! (gnus-read-descriptions-file)) (setq gnus-summary-mode-line-format-spec (gnus-parse-format gnus-summary-mode-line-format gnus-summary-mode-line-format-alist)) --- 1798,1804 ---- (if (and (string-match "%D" gnus-group-line-format) (not gnus-description-hashtb) gnus-read-active-file) ! (gnus-read-all-descriptions-files)) (setq gnus-summary-mode-line-format-spec (gnus-parse-format gnus-summary-mode-line-format gnus-summary-mode-line-format-alist)) *************** *** 2662,2667 **** --- 2670,2693 ---- (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) name)) + (defun gnus-find-file-noselect (file &optional force) + "Does vaguely the same as find-file-noselect. No hooks are run." + (let (buf insert) + (if (setq buf (get-file-buffer file)) + (setq insert force) + (setq buf (create-file-buffer file)) + (setq insert t)) + (if (not insert) + buf + (save-excursion + (set-buffer buf) + (erase-buffer) + (and (file-readable-p file) + (insert-file-contents file)) + (set-visited-file-name file) + (set-buffer-modified-p nil) + (current-buffer))))) + ;;; List and range functions (defun gnus-last-element (list) *************** *** 2985,2990 **** --- 3011,3021 ---- (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual) (define-key gnus-group-group-map "D" 'gnus-group-enter-directory) (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group) + (define-key gnus-group-group-map "sb" 'gnus-group-brew-soup) + (define-key gnus-group-group-map "sw" 'gnus-soup-save-areas) + (define-key gnus-group-group-map "ss" 'gnus-soup-send-replies) + (define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet) + (define-key gnus-group-group-map "sr" 'nnsoup-pack-replies) (define-prefix-command 'gnus-group-list-map) (define-key gnus-group-mode-map "A" 'gnus-group-list-map) *************** *** 3234,3240 **** (string-match regexp group)) (progn (setq beg (point)) ! (insert (format " %c *: %s\n" mark group)) (add-text-properties beg (1+ beg) (list 'gnus-group (intern group) --- 3265,3271 ---- (string-match regexp group)) (progn (setq beg (point)) ! (insert (format " %c *: %s\n" mark group)) (add-text-properties beg (1+ beg) (list 'gnus-group (intern group) *************** *** 3470,3476 **** ;; go, and insert it there (or at the end of the buffer). ;; Fix by Per Abrahamsen . (or visible-only ! (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb)))) (while (and entry (car entry) (not --- 3501,3508 ---- ;; go, and insert it there (or at the end of the buffer). ;; Fix by Per Abrahamsen . (or visible-only ! (let ((entry ! (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb))))) (while (and entry (car entry) (not *************** *** 3479,3486 **** (point-min) (point-max) 'gnus-group (intern (car (car entry))))))) (setq entry (cdr entry))) ! (if entry (forward-line 1) ! (goto-char (point-max))))))) (if (or visible (not visible-only)) (gnus-group-insert-group-line-info group)) (gnus-group-set-mode-line)))) --- 3511,3517 ---- (point-min) (point-max) 'gnus-group (intern (car (car entry))))))) (setq entry (cdr entry))) ! (or entry (goto-char (point-max))))))) (if (or visible (not visible-only)) (gnus-group-insert-group-line-info group)) (gnus-group-set-mode-line)))) *************** *** 3687,3700 **** (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." ! (interactive (list (completing-read "Group: " gnus-active-hashtb nil ! (not (not gnus-read-active-file))))) (if (equal group "") ! (error "empty group name")) ! (let ((b (text-property-any (point-min) (point-max) ! 'gnus-group (intern group)))) (if b ;; Either go to the line in the group buffer... (goto-char b) --- 3718,3732 ---- (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." ! (interactive ! (list (completing-read ! "Group: " gnus-active-hashtb nil (not (not gnus-read-active-file))))) (if (equal group "") ! (error "Empty group name")) ! (let ((b (text-property-any ! (point-min) (point-max) 'gnus-group (intern group)))) (if b ;; Either go to the line in the group buffer... (goto-char b) *************** *** 3705,3712 **** (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) ! (goto-char (text-property-any (point-min) (point-max) ! 'gnus-group (intern group))))) ;; Adjust cursor point. (gnus-group-position-cursor)) --- 3737,3744 ---- (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) ! (goto-char (text-property-any ! (point-min) (point-max) 'gnus-group (intern group))))) ;; Adjust cursor point. (gnus-group-position-cursor)) *************** *** 4047,4053 **** (defun gnus-group-make-empty-virtual (group) "Create a new, fresh, empty virtual group." (interactive "sCreate new, empty virtual group: ") ! (let* ((method (list 'nnvirtual "")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. (and (gnus-gethash pgroup gnus-newsrc-hashtb) --- 4079,4085 ---- (defun gnus-group-make-empty-virtual (group) "Create a new, fresh, empty virtual group." (interactive "sCreate new, empty virtual group: ") ! (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. (and (gnus-gethash pgroup gnus-newsrc-hashtb) *************** *** 4083,4089 **** (setq gnus-newsrc-alist (sort (cdr gnus-newsrc-alist) gnus-group-sort-function)) (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups nil)) (defun gnus-group-sort-by-alphabet (info1 info2) (string< (car info1) (car info2))) --- 4115,4121 ---- (setq gnus-newsrc-alist (sort (cdr gnus-newsrc-alist) gnus-group-sort-function)) (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups nil gnus-have-all-newsgroups)) (defun gnus-group-sort-by-alphabet (info1 info2) (string< (car info1) (car info2))) *************** *** 4117,4127 **** (let ((groups (gnus-group-process-prefix n)) (ret 0)) (while groups (gnus-group-remove-mark (car groups)) ! (if (not (gnus-group-goto-group (car groups))) ! (setq ret (1+ ret)) ! (gnus-group-catchup (car groups) all) ! (gnus-group-update-group-line)) (setq groups (cdr groups))) (gnus-group-next-unread-group 1) ret))) --- 4149,4165 ---- (let ((groups (gnus-group-process-prefix n)) (ret 0)) (while groups + ;; Virtual groups have to be given special treatment. + (let ((method (gnus-find-method-for-group (car groups)))) + (if (eq 'nnvirtual (car method)) + (nnvirtual-catchup-group + (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) ! (if (prog1 ! (gnus-group-goto-group (car groups)) ! (gnus-group-catchup (car groups) all)) ! (gnus-group-update-group-line) ! (setq ret (1+ ret))) (setq groups (cdr groups))) (gnus-group-next-unread-group 1) ret))) *************** *** 4411,4417 **** ;; the first line in the group buffer, but it does. So we set the ;; window start forcibly. ; (set-window-start (get-buffer-window (current-buffer)) w-p) ! (forward-line 1) (gnus-summary-position-cursor) ret)) --- 4449,4455 ---- ;; the first line in the group buffer, but it does. So we set the ;; window start forcibly. ; (set-window-start (get-buffer-window (current-buffer)) w-p) ! (gnus-group-next-unread-group 1 t) (gnus-summary-position-cursor) ret)) *************** *** 4436,4449 **** (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." ! (interactive "P") (and force (setq gnus-description-hashtb nil)) ! (let ((group (or group (gnus-group-group-name))) desc) (or group (error "No group name given")) ! (and (or gnus-description-hashtb (setq desc (gnus-group-get-description group)) ! (gnus-read-descriptions-file)) (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) --- 4474,4492 ---- (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." ! (interactive (list current-prefix-arg (gnus-group-group-name))) (and force (setq gnus-description-hashtb nil)) ! (let ((method (gnus-find-method-for-group group)) desc) (or group (error "No group name given")) ! (and (or (and gnus-description-hashtb ! ;; We check whether this group's method has been ! ;; queried for a description file. ! (gnus-gethash ! (gnus-group-prefixed-name "" method) ! gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) ! (gnus-read-descriptions-file method)) (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) *************** *** 4454,4460 **** (interactive "P") (and force (setq gnus-description-hashtb nil)) (if (not (or gnus-description-hashtb ! (gnus-read-descriptions-file))) (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) b) --- 4497,4503 ---- (interactive "P") (and force (setq gnus-description-hashtb nil)) (if (not (or gnus-description-hashtb ! (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (let ((buffer-read-only nil) b) *************** *** 4518,4524 **** "List all newsgroups that have names or desccriptions that match a regexp." (interactive "sGnus description apropos (regexp): ") (if (not (or gnus-description-hashtb ! (gnus-read-descriptions-file))) (error "Couldn't request descriptions file")) (gnus-group-apropos regexp t)) --- 4561,4567 ---- "List all newsgroups that have names or desccriptions that match a regexp." (interactive "sGnus description apropos (regexp): ") (if (not (or gnus-description-hashtb ! (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) (gnus-group-apropos regexp t)) *************** *** 4561,4570 **** (interactive) (gnus-read-init-file)) ! (defun gnus-group-check-bogus-groups () ! "Check bogus newsgroups." ! (interactive) ! (gnus-check-bogus-newsgroups (not gnus-expert-user)) ;Require confirmation. (gnus-group-list-groups nil gnus-have-all-newsgroups)) (defun gnus-group-edit-global-kill (article &optional group) --- 4604,4615 ---- (interactive) (gnus-read-init-file)) ! (defun gnus-group-check-bogus-groups (silent) ! "Check bogus newsgroups. ! If given a prefix, don't ask for confirmation before removing a bogus ! group." ! (interactive "P") ! (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) (gnus-group-list-groups nil gnus-have-all-newsgroups)) (defun gnus-group-edit-global-kill (article &optional group) *************** *** 4625,4632 **** (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) (progn (run-hooks 'gnus-exit-gnus-hook) - (gnus-save-newsrc-file) (gnus-offer-save-summaries) (gnus-close-backends) (gnus-clear-system)))) --- 4670,4677 ---- (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) (progn (run-hooks 'gnus-exit-gnus-hook) (gnus-offer-save-summaries) + (gnus-save-newsrc-file) (gnus-close-backends) (gnus-clear-system)))) *************** *** 6764,6769 **** --- 6809,6815 ---- (let ((headers (save-excursion (set-buffer gnus-summary-buffer) gnus-current-headers))) (or (not gnus-use-cross-reference) + (not headers) (and (header-xref headers) (not (string= (header-xref headers) ""))) (let ((case-fold-search t) *************** *** 7491,7496 **** --- 7537,7543 ---- If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." (interactive "P") + (gnus-set-global-variables) (let ((opoint (point)) (method (car (gnus-find-method-for-group gnus-newsgroup-name))) header) *************** *** 7561,7569 **** (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group group) - (execute-kbd-macro (char-to-string key)) (setq group (gnus-group-group-name)) ! (switch-to-buffer obuf))))) (if (eq key cmd) (if (or (not group) (assoc 'quit-config (gnus-find-method-for-group --- 7608,7616 ---- (let ((obuf (current-buffer))) (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group group) (setq group (gnus-group-group-name)) ! (switch-to-buffer obuf) ! (execute-kbd-macro (char-to-string key)))))) (if (eq key cmd) (if (or (not group) (assoc 'quit-config (gnus-find-method-for-group *************** *** 8303,8309 **** ;; really expired articles as non-existant. (while expirable (or (memq (car expirable) gnus-newsgroup-expirable) ! (gnus-summary-mark-as-read (car expirable) "%")) (setq expirable (cdr expirable)))))) ;; Suggested by Jack Vinson . --- 8350,8356 ---- ;; really expired articles as non-existant. (while expirable (or (memq (car expirable) gnus-newsgroup-expirable) ! (gnus-summary-mark-as-read (car expirable) gnus-canceled-mark)) (setq expirable (cdr expirable)))))) ;; Suggested by Jack Vinson . *************** *** 10216,10221 **** --- 10263,10276 ---- (delete-char 2)) ((gnus-message 3 "Malformed MIME quoted-printable message")))))) + (defvar gnus-article-time-units + (list (cons 'year (* 365.25 24 60 60)) + (cons 'week (* 7 24 60 60)) + (cons 'day (* 24 60 60)) + (cons 'hour (* 60 60)) + (cons 'minute 60) + (cons 'second 1))) + (defun gnus-article-date-ut (&optional type) "Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output *************** *** 10225,10231 **** (gnus-get-header-by-number (gnus-summary-article-number))""))) (date-regexp "^Date: \\|^X-Sent: ")) ! (if (not date) () (save-excursion (set-buffer gnus-article-buffer) --- 10280,10287 ---- (gnus-get-header-by-number (gnus-summary-article-number))""))) (date-regexp "^Date: \\|^X-Sent: ")) ! (if (or (not date) ! (string= date "")) () (save-excursion (set-buffer gnus-article-buffer) *************** *** 10247,10263 **** (concat "Date: " (timezone-make-date-arpa-standard date nil "UT") "\n")) ((eq type 'lapsed) ! (let* ((sec (- (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! (current-time-string) (current-time-zone) "UT")) ! (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard date nil "UT")))) ! (units (list (cons 'year (* 365.25 24 60 60)) ! (cons 'week (* 7 24 60 60)) ! (cons 'day (* 24 60 60)) ! (cons 'hour (* 60 60)) ! (cons 'minute 60) ! (cons 'second 1))) num prev) (concat "X-Sent: " --- 10303,10316 ---- (concat "Date: " (timezone-make-date-arpa-standard date nil "UT") "\n")) ((eq type 'lapsed) ! (let* ((sec (max (- (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! (current-time-string) ! (current-time-zone) "UT")) ! (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! date nil "UT"))) ! 0)) num prev) (concat "X-Sent: " *************** *** 10271,10277 **** " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) ! units "") " ago\n"))) (t (error "Unknown conversion type: %s" type))))))))) --- 10324,10330 ---- " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) ! gnus-article-time-units "") " ago\n"))) (t (error "Unknown conversion type: %s" type))))))))) *************** *** 11299,11312 **** ;; Go thorugh both primary and secondary select methods and ;; request new newsgroups. (while methods ! (if (gnus-request-newgroups date (car methods)) ! (save-excursion ! (setq got-new t) ! (or hashtb (setq hashtb (gnus-make-hashtable ! (count-lines (point-min) (point-max))))) ! (set-buffer nntp-server-buffer) ! ;; Enter all the new groups in a hashtable. ! (gnus-active-to-gnus-format (car methods) hashtb))) (setq methods (cdr methods))) (and got-new (setq gnus-newsrc-last-checked-date new-date)) ;; Now all new groups from all select methods are in `hashtb'. --- 11352,11367 ---- ;; Go thorugh both primary and secondary select methods and ;; request new newsgroups. (while methods ! (and (or (gnus-server-opened (car methods)) ! (gnus-open-server (car methods))) ! (gnus-request-newgroups date (car methods)) ! (save-excursion ! (setq got-new t) ! (set-buffer nntp-server-buffer) ! (or hashtb (setq hashtb (gnus-make-hashtable ! (count-lines (point-min) (point-max))))) ! ;; Enter all the new groups in a hashtable. ! (gnus-active-to-gnus-format (car methods) hashtb))) (setq methods (cdr methods))) (and got-new (setq gnus-newsrc-last-checked-date new-date)) ;; Now all new groups from all select methods are in `hashtb'. *************** *** 11415,11421 **** (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) ! (listp entry)) (setq oldlevel (car (cdr (nth 2 entry))))) (if (stringp previous) (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) --- 11470,11476 ---- (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) ! (consp entry)) (setq oldlevel (car (cdr (nth 2 entry))))) (if (stringp previous) (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) *************** *** 11508,11525 **** If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) ! bogus group) (gnus-message 5 "Checking bogus newsgroups...") (or gnus-have-read-active-file (gnus-read-active-file)) ;; Find all bogus newsgroup that are subscribed. (while newsrc (setq group (car (car newsrc))) ! (if (or (gnus-gethash group gnus-active-hashtb) ! (nth 4 (car newsrc)) (and confirm (not (gnus-y-or-n-p (format "Remove bogus newsgroup: %s " group))))) ! ;; Active newsgroup. () ;; Found a bogus newsgroup. (setq bogus (cons group bogus))) --- 11563,11580 ---- If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) ! bogus group entry) (gnus-message 5 "Checking bogus newsgroups...") (or gnus-have-read-active-file (gnus-read-active-file)) ;; Find all bogus newsgroup that are subscribed. (while newsrc (setq group (car (car newsrc))) ! (if (or (gnus-gethash group gnus-active-hashtb) ; Active ! (nth 4 (car newsrc)) ; Foreign (and confirm (not (gnus-y-or-n-p (format "Remove bogus newsgroup: %s " group))))) ! ;; Don't remove. () ;; Found a bogus newsgroup. (setq bogus (cons group bogus))) *************** *** 11527,11535 **** ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. (while bogus ! (gnus-group-change-level ! (gnus-gethash (car bogus) gnus-newsrc-hashtb) gnus-level-killed) ! (setq gnus-killed-list (delete (car bogus) gnus-killed-list)) (setq bogus (cdr bogus))) ;; Then we remove all bogus groups from the list of killed and ;; zombie groups. They are are removed without confirmation. --- 11582,11591 ---- ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. (while bogus ! (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb)) ! (progn ! (gnus-group-change-level entry gnus-level-killed) ! (setq gnus-killed-list (delete (car bogus) gnus-killed-list)))) (setq bogus (cdr bogus))) ;; Then we remove all bogus groups from the list of killed and ;; zombie groups. They are are removed without confirmation. *************** *** 11889,11895 **** (gnus-active-to-gnus-format (and gnus-have-read-active-file (car methods))) (setq gnus-have-read-active-file t) ! (gnus-message 5 "%s...done" mesg))))) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. --- 11945,11951 ---- (gnus-active-to-gnus-format (and gnus-have-read-active-file (car methods))) (setq gnus-have-read-active-file t) ! (gnus-message 5 "%sdone" mesg))))) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. *************** *** 11909,11920 **** (progn (goto-char (point-min)) (delete-matching-lines gnus-ignored-newsgroups))) (and method (not (eq method gnus-select-method)) (let ((prefix (gnus-group-prefixed-name "" method))) (goto-char (point-min)) (while (and (not (eobp)) ! (null (insert prefix)) ! (zerop (forward-line 1)))))) (goto-char (point-min)) ;; Store active file in hashtable. (goto-char (point-min)) --- 11965,11978 ---- (progn (goto-char (point-min)) (delete-matching-lines gnus-ignored-newsgroups))) + ;; If these are groups from a foreign select method, we insert the + ;; group prefix in front of the group names. (and method (not (eq method gnus-select-method)) (let ((prefix (gnus-group-prefixed-name "" method))) (goto-char (point-min)) (while (and (not (eobp)) ! (progn (insert prefix) ! (zerop (forward-line 1))))))) (goto-char (point-min)) ;; Store active file in hashtable. (goto-char (point-min)) *************** *** 12483,12530 **** (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg) (kill-buffer (current-buffer))))) ! (defun gnus-read-descriptions-file () ! (gnus-message 5 "Reading descriptions file...") ! (cond ! ((not (or (gnus-server-opened gnus-select-method) ! (gnus-open-server gnus-select-method))) ! (gnus-message 1 "Couldn't open server") ! nil) ! ((not (gnus-request-list-newsgroups gnus-select-method)) ! (gnus-message 1 "Couldn't read newsgroups descriptions") ! nil) ! (t ! (let (group) ! (setq gnus-description-hashtb ! (gnus-make-hashtable (length gnus-active-hashtb))) ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (if (or (search-forward "\n.\n" nil t) ! (goto-char (point-max))) ! (progn ! (beginning-of-line) ! (narrow-to-region (point-min) (point)))) ! (goto-char (point-min)) ! (while (not (eobp)) ! ;; If we get an error, we set group to 0, which is not a ! ;; symbol... ! (setq group ! (condition-case () ! (let ((obarray gnus-description-hashtb)) ! ;; Group is set to a symbol interned in this ! ;; hash table. ! (read nntp-server-buffer)) ! (error 0))) ! (skip-chars-forward " \t") ! ;; ... which leads to this line being effectively ignored. ! (and (symbolp group) ! (set group (buffer-substring ! (point) (progn (end-of-line) (point))))) ! (forward-line 1)))) ! (gnus-message 5 "Reading descriptions file...done") ! t)))) (defun gnus-group-get-description (group) ;; Get the description of a group by sending XGTITLE to the server. --- 12541,12600 ---- (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg) (kill-buffer (current-buffer))))) ! (defun gnus-read-all-descriptions-files () ! (let ((methods (nconc (list gnus-select-method) ! gnus-secondary-select-methods))) ! (while methods ! (gnus-read-descriptions-file (car methods)) ! (setq methods (cdr methods))))) ! ! (defun gnus-read-descriptions-file (&optional method) ! (let ((method (or method gnus-select-method))) ! (gnus-message 5 "Reading descriptions file via %s..." (car method)) ! (cond ! ((not (or (gnus-server-opened method) ! (gnus-open-server method))) ! (gnus-message 1 "Couldn't open server") ! nil) ! ((not (gnus-request-list-newsgroups method)) ! (gnus-message 1 "Couldn't read newsgroups descriptions") ! nil) ! (t ! (let (group) ! (or gnus-description-hashtb ! (setq gnus-description-hashtb ! (gnus-make-hashtable (length gnus-active-hashtb)))) ! ;; Mark this method's desc file as read. ! (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" ! gnus-description-hashtb) ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (if (or (search-forward "\n.\n" nil t) ! (goto-char (point-max))) ! (progn ! (beginning-of-line) ! (narrow-to-region (point-min) (point)))) ! (goto-char (point-min)) ! (while (not (eobp)) ! ;; If we get an error, we set group to 0, which is not a ! ;; symbol... ! (setq group ! (condition-case () ! (let ((obarray gnus-description-hashtb)) ! ;; Group is set to a symbol interned in this ! ;; hash table. ! (read nntp-server-buffer)) ! (error 0))) ! (skip-chars-forward " \t") ! ;; ... which leads to this line being effectively ignored. ! (and (symbolp group) ! (set group (buffer-substring ! (point) (progn (end-of-line) (point))))) ! (forward-line 1)))) ! (gnus-message 5 "Reading descriptions file...done") ! t))))) (defun gnus-group-get-description (group) ;; Get the description of a group by sending XGTITLE to the server. *** pub/dgnus/lisp/nnbabyl.el Wed May 31 02:08:54 1995 --- dgnus/lisp/nnbabyl.el Fri Jun 2 00:04:12 1995 *************** *** 340,345 **** --- 340,346 ---- ;; Beginning of the article. (save-excursion (save-restriction + (widen) (narrow-to-region (save-excursion (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) *** pub/dgnus/lisp/nndoc.el Wed May 31 02:08:55 1995 --- dgnus/lisp/nndoc.el Fri Jun 2 15:14:22 1995 *************** *** 39,48 **** nil "^$" nil nil) (list 'babyl "\^_\^L *\n" "\^_" nil "^$" nil nil) (list 'digest "^------------------------------[\n \t]+" ! "^------------------------------[\n \t]+" ! nil "^$" ! "^------------------------------*[\n \t]*\n[^ ]+: " "End of")) "Regular expressions for articles of the various types.") --- 39,48 ---- nil "^$" nil nil) (list 'babyl "\^_\^L *\n" "\^_" nil "^$" nil nil) (list 'digest + "^------------------------------*[\n \t]+" "^------------------------------[\n \t]+" ! nil "^ ?$" ! "^------------------------------*[\n \t]+" "End of")) "Regular expressions for articles of the various types.") *************** *** 97,103 **** 'headers (set-buffer nndoc-current-buffer) (goto-char (point-min)) ! (re-search-forward nndoc-article-begin nil t) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t) --- 97,103 ---- 'headers (set-buffer nndoc-current-buffer) (goto-char (point-min)) ! (re-search-forward nndoc-first-article nil t) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t) *************** *** 274,286 **** (widen) (goto-char (point-min)) (let ((num 0)) ! (while (and (re-search-forward nndoc-article-begin nil t) (or (not nndoc-end-of-file) (not (looking-at nndoc-end-of-file))) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t)) ! (setq num (1+ num))) num))) (defun nndoc-narrow-to-article (article) --- 274,289 ---- (widen) (goto-char (point-min)) (let ((num 0)) ! (if (re-search-forward nndoc-first-article nil t) ! (progn ! (setq num 1) ! (while (and (re-search-forward nndoc-article-begin nil t) (or (not nndoc-end-of-file) (not (looking-at nndoc-end-of-file))) (or (not nndoc-head-begin) (re-search-forward nndoc-head-begin nil t)) (re-search-forward nndoc-head-end nil t)) ! (setq num (1+ num))))) num))) (defun nndoc-narrow-to-article (article) *** pub/dgnus/lisp/nnmh.el Wed May 31 02:08:55 1995 --- dgnus/lisp/nnmh.el Thu Jun 1 23:02:17 1995 *************** *** 217,222 **** --- 217,223 ---- () (save-excursion (set-buffer nntp-server-buffer) + (goto-char (point-max)) (insert (format "%s %d %d y\n" *************** *** 253,269 **** (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (if (setq mod-time (nth 5 (file-attributes article))) ! (if (or force ! (> (nnmail-days-between ! (current-time-string) ! (current-time-string mod-time)) ! days)) ! (progn ! (message "Deleting %s..." article) ! (condition-case () ! (delete-file article) ! (file-error nil))) ! (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) rest)) --- 254,272 ---- (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (if (setq mod-time (nth 5 (file-attributes article))) ! (and (or force ! (> (nnmail-days-between ! (current-time-string) ! (current-time-string mod-time)) ! days)) ! (progn ! (message "Deleting %s..." article) ! (condition-case () ! (progn ! (delete-file article) ! t) ! (file-error nil))) ! (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) rest)) *** pub/dgnus/lisp/nnml.el Wed May 31 02:08:55 1995 --- dgnus/lisp/nnml.el Wed May 31 15:45:50 1995 *************** *** 286,292 **** (and gnus-verbose-backends (message "Deleting %s..." article)) (condition-case () (delete-file article) ! (file-error nil)) (setq active-articles (delq (car articles) active-articles)) (nnml-nov-delete-article newsgroup (car articles))) (setq rest (cons (car articles) rest)))) --- 286,293 ---- (and gnus-verbose-backends (message "Deleting %s..." article)) (condition-case () (delete-file article) ! (file-error ! (setq rest (cons (car articles) rest)))) (setq active-articles (delq (car articles) active-articles)) (nnml-nov-delete-article newsgroup (car articles))) (setq rest (cons (car articles) rest)))) *** pub/dgnus/lisp/nnsoup.el Wed May 31 02:08:55 1995 --- dgnus/lisp/nnsoup.el Fri Jun 2 02:19:18 1995 *************** *** 1,8 **** ! ;;; nnsoup.el --- SOUP packet reading access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ! ;; Author: Per Abrahamsen ! ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail --- 1,7 ---- ! ;;; nnsoup.el --- SOUP access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ! ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail *************** *** 24,339 **** ;;; Commentary: - ;; For an overview of what the interface functions do, please see the - ;; Gnus sources. - - ;; For more information on SOUP, see the comments in the file - ;; `gnus-soup.el'. - ;;; Code: - (require 'gnus-soup) (require 'nnheader) - (require 'rmail) (require 'nnmail) ! (defvar nnsoup-directory (expand-file-name "~/SOUP/") ! "The name of the directory containing the unpacket SOUP packet.") (defconst nnsoup-version "nnsoup 0.0" "nnsoup version.") - (defconst nnsoup-areas-file (concat nnsoup-directory "AREAS")) - (defconst nnsoup-list-file (concat nnsoup-directory "LIST")) - (defconst nnsoup-gnus-file (concat nnsoup-directory "gnus.touched")) - - (defvar nnsoup-current-group nil) - (defvar nnsoup-current-buffer nil) (defvar nnsoup-status-string "") (defvar nnsoup-group-alist nil) ! (defvar nnsoup-buffer-alist nil) ! (defconst nnsoup-areas-list nil) ! ;;; Interface functions ! (defun nnsoup-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((file nil) ! (number (length sequence)) ! beg article art-string start stop) ! (nnsoup-possibly-change-group newsgroup) ! (while sequence ! (setq article (car sequence)) ! (setq art-string (nnsoup-article-string article)) ! (set-buffer nnsoup-current-buffer) ! (if (or (search-forward art-string nil t) ! (progn (goto-char 1) ! (search-forward art-string nil t))) ! (progn ! (setq start ! (save-excursion ! (re-search-backward ! (concat "^" rmail-unix-mail-delimiter) nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (setq beg (point)) ! (insert-buffer-substring nnsoup-current-buffer start stop) (goto-char (point-max)) ! (insert ".\n"))) ! (setq sequence (cdr sequence))) ! ;; Fold continuation lines. ! (goto-char 1) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! 'headers))) ! ! (defun nnsoup-open-server (host &optional service) ! (setq nnsoup-status-string "") ! (setq nnsoup-group-alist nil) ! (nnheader-init-server-buffer)) (defun nnsoup-close-server (&optional server) t) (defun nnsoup-server-opened (&optional server) ! (and nntp-server-buffer (buffer-name nntp-server-buffer))) (defun nnsoup-status-message (&optional server) nnsoup-status-string) ! (defun nnsoup-request-article (article &optional newsgroup server buffer) (nnsoup-possibly-change-group newsgroup) ! (if (stringp article) ! nil (save-excursion ! (set-buffer nnsoup-current-buffer) ! (goto-char 1) ! (if (search-forward (nnsoup-article-string article) nil t) ! (let (start stop) ! (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) ! (setq start (point)) ! (forward-line 1) ! (or (and (re-search-forward ! (concat "^" rmail-unix-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring nnsoup-current-buffer start stop) ! (goto-char (point-min)) ! (while (looking-at "From ") ! (delete-char 5) ! (insert "X-From-Line: ") ! (forward-line 1)) ! t)))))) (defun nnsoup-request-group (group &optional server dont-check) ! (save-excursion ! (nnsoup-possibly-change-group group) ! (and (assoc group nnsoup-group-alist) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if dont-check ! t ! (nnsoup-request-list) ! (setq nnsoup-group-alist (nnmail-get-active)) ! (let ((active (assoc group nnsoup-group-alist))) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) ! t))))) (defun nnsoup-close-group (group &optional server) t) (defun nnsoup-request-list (&optional server) ! (if server ! (if (or (file-exists-p nnsoup-gnus-file) ! (not (file-directory-p nnsoup-directory))) ! () ! (write-region 1 1 nnsoup-gnus-file) ! (setq nnsoup-areas-list nil ! nnsoup-current-group nil ! nnsoup-current-buffer nil ! nnsoup-group-alist nil) ! (let ((buffer (get-file-buffer nnsoup-areas-file)) ! (groups gnus-newsrc-assoc) ! group) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (if (eq (car (gnus-group-method-name (car group))) 'nnsoup) ! (progn ! (setcar (nthcdr 2 group) nil) ! (setcar (nthcdr 3 group) nil)))) ! (gnus-make-hashtable-from-newsrc-alist) ! (if buffer ! (kill-buffer buffer)) ! (while nnsoup-buffer-alist ! (setq buffer (nth 1 (car nnsoup-buffer-alist)) ! nnsoup-buffer-alist (cdr nnsoup-buffer-alist)) ! (if (buffer-name buffer) ! (kill-buffer buffer)))))) ! (nnsoup-find-active)) (defun nnsoup-request-newgroups (date &optional server) ! (nnsoup-request-list server)) (defun nnsoup-request-list-newsgroups (&optional server) ! (nnmail-find-file nnsoup-newsgroups-file)) (defun nnsoup-request-post (&optional server) ! (mail-send-and-exit nil)) ! ! (fset 'nnsoup-request-post-buffer 'nnmail-request-post-buffer) ! ! (defun nnsoup-request-expire-articles (articles newsgroup &optional server force) ! (setq nnsoup-status-string "nnsoup: expire not possible") ! nil) ! (defun nnsoup-request-move-article (article group server accept-form) ! (setq nnsoup-status-string "nnsoup: move not possible") ! nil) ! (defun nnsoup-request-accept-article (group) ! (setq nnsoup-status-string "nnsoup: accept not possible") ! nil) ! ;;; Internal functions. ! (defun nnsoup-possibly-change-group (group) ! (or (file-exists-p nnsoup-directory) ! (make-directory (directory-file-name nnsoup-directory))) ! (if (not nnsoup-group-alist) ! (progn ! (nnsoup-request-list) ! (setq nnsoup-group-alist (nnmail-get-active)))) ! (let (inf file) ! (if (and (equal group nnsoup-current-group) ! (buffer-name nnsoup-current-buffer)) ! () ! (if (setq inf (member group nnsoup-buffer-alist)) ! (setq nnsoup-current-buffer (nth 1 inf))) (setq nnsoup-current-group group) ! (if (not (buffer-name nnsoup-current-buffer)) ! (progn ! (setq nnsoup-buffer-alist (delq inf nnsoup-buffer-alist)) ! (setq inf nil))) ! (if inf ! () ! (save-excursion ! (setq file (nnsoup-group-file group)) ! ;;;; (if (not (file-exists-p file)) ! ;;;; (write-region 1 1 file t 'nomesg)) ! (set-buffer (nnsoup-read-folder file)) ! (setq nnsoup-buffer-alist (cons (list group (current-buffer)) ! nnsoup-buffer-alist)))))) ! (setq nnsoup-current-group group)) ! ! (defun nnsoup-article-string (article) ! (concat "\nX-Gnus-Article-Number: " (int-to-string article) " ")) ! ! (defun nnsoup-read-folder (file) ! (nnsoup-request-list) ! (setq nnsoup-group-alist (nnmail-get-active)) (save-excursion ! (set-buffer ! (setq nnsoup-current-buffer ! (find-file-noselect file))) (buffer-disable-undo (current-buffer)) ! (let ((delim (concat "^" rmail-unix-mail-delimiter)) ! start end ! (number 1)) ! (goto-char (point-min)) ! (while (re-search-forward delim nil t) ! (setq start (match-beginning 0)) ! (save-excursion ! (setq end (or (and (re-search-forward delim nil t) ! (match-beginning 0)) ! (point-max)))) ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (nnmail-insert-lines) ! (save-excursion ! (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (progn ! (forward-char -1) ! (insert (format "X-Gnus-Article-Number: %d %s\n" ! number (current-time-string)))))) ! (setq number (1+ number)))) ! (goto-char end))) ! (set-buffer-modified-p nil) ! (current-buffer))) ! ! (defun nnsoup-find-active () ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (or nnsoup-areas-list (nnsoup-read-areas)) ! (condition-case () ! (progn ! (let ((areas nnsoup-areas-list) ! area) ! (while areas ! (setq area (car areas) ! areas (cdr areas)) ! (insert (format "%s %s 1 y\n" (aref area 1) (aref area 4))))) ! t) ! (file-error nil))) (defun nnsoup-read-areas () ! (setq nnsoup-areas-list (gnus-soup-parse-areas nnsoup-areas-file)) ! (let ((areas nnsoup-areas-list) ! area) ! (while areas ! (setq area (car areas) ! areas (cdr areas)) ! (aset area 4 (nnsoup-count-area area))))) ! ! (defun nnsoup-count-area (area) ! (or (aref area 4) ! (number-to-string ! (nnsoup-count-mbox (concat nnsoup-directory (aref area 0) ".MSG"))))) ! ! (defun nnsoup-count-mbox (file) ! (let ((delete (find-buffer-visiting file)) ! (num 0) ! (delim (concat "^" rmail-unix-mail-delimiter))) (save-excursion ! (set-buffer (find-file-noselect file)) (goto-char (point-min)) ! (while (re-search-forward delim nil t) ! (setq num (1+ num))) ! (if delete (kill-buffer delete)) ! num))) ! ! (defun nnsoup-group-file (group) ! (let ((areas nnsoup-areas-list) ! area result) ! (while areas ! (setq area (car areas) ! areas (cdr areas)) ! (if (equal (aref area 1) group) ! (setq result (concat nnsoup-directory (aref area 0) ".MSG")))) ! result)) ! (provide 'nnsoup) ;;; nnsoup.el ends here --- 23,558 ---- ;;; 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'.") (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) ! ! ! ;; 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))) ! ! ! ! ;;; Interface functions. ! ! (defun nnsoup-retrieve-headers (sequence &optional group server) ! (nnsoup-possibly-change-group group) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((count 0) ! (areas (cdr (assoc nnsoup-current-group nnsoup-group-alist))) ! (articles sequence) ! (use-nov t) ! beg article 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))) ! ! (defun nnsoup-request-close () ! (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) ! 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) ! (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)) ! ;;; 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 (nth 1 (car e))))) ! (+ lnum number)) ! area))))))))) ! ! (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)) ! (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 -2) (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-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 ! prefix) ! (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 *** pub/dgnus/lisp/nnvirtual.el Wed May 31 02:08:55 1995 --- dgnus/lisp/nnvirtual.el Fri Jun 2 15:00:58 1995 *************** *** 73,79 **** (setq active (nth 2 (car map))) (setq articles nil) (while (and sequence (<= (car sequence) top)) ! (setq articles (cons (- (+ active (car sequence)) offset) articles)) (setq sequence (cdr sequence))) (setq articles (nreverse articles)) (if (and articles --- 73,80 ---- (setq active (nth 2 (car map))) (setq articles nil) (while (and sequence (<= (car sequence) top)) ! (setq articles (cons (- (+ active (car sequence)) offset) ! articles)) (setq sequence (cdr sequence))) (setq articles (nreverse articles)) (if (and articles *************** *** 93,99 **** (delete-region beg (point)) (insert (int-to-string (+ (- article active) offset))) (beginning-of-line) ! (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) (or (search-forward "\t" (save-excursion (end-of-line) (point)) t) --- 94,101 ---- (delete-region beg (point)) (insert (int-to-string (+ (- article active) offset))) (beginning-of-line) ! (looking-at ! "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) (or (search-forward "\t" (save-excursion (end-of-line) (point)) t) *************** *** 140,145 **** --- 142,154 ---- "Close news server." t) + (defun nnvirtual-request-close () + (setq nnvirtual-current-group nil + nnvirtual-current-groups nil + nnvirtual-current-mapping nil + nnvirtual-group-alist nil) + t) + (defun nnvirtual-server-opened (&optional server) "Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL." *************** *** 417,422 **** --- 426,438 ---- (- (+ article (nth 2 (car map))) offset) (cons (- (+ (car article) (nth 2 (car map))) offset) (cdr article)))))) + + (defun nnvirtual-catchup-group (group &optional server all) + (nnvirtual-possibly-change-newsgroups group server) + (let ((gnus-group-marked nnvirtual-current-groups) + (gnus-expert-user t)) + (set-buffer gnus-group-buffer) + (gnus-group-catchup-current nil all))) (provide 'nnvirtual) *** pub/dgnus/lisp/ChangeLog Wed May 31 02:08:59 1995 --- dgnus/lisp/ChangeLog Fri Jun 2 15:03:09 1995 *************** *** 1,3 **** --- 1,83 ---- + Fri Jun 2 14:56:40 1995 Lars Ingebrigtsen + + * gnus.el (gnus-group-exit): Would offer to save summaries after + it was too late. + + * nnvirtual.el (nnvirtual-request-close): Function for cleaning up + nnvirtual. + + Wed May 31 16:37:02 1995 Per Abrahamsen + + * gnus-vis.el (gnus-summary-make-menu-bar): Added menu entry to + highlight article. + + Fri Jun 2 00:29:57 1995 Lars Ingebrigtsen + + * gnus.el (gnus-read-descriptions-file): Allow reading from + different servers. + (gnus-group-describe-group): Wouldn't describe foreign groups. + (gnus-read-all-descriptions-files): New function. + (gnus-group-get-new-news-this-group): Would step to the bottom of + the list. + (gnus-group-update-group): Would often insert groups one below + where they were supposed to go. + + * gnus-msg.el (gnus-copy-article-buffer): Didn't widen before + copying. + + * gnus.el (gnus-article-get-xrefs): Would bug out in obscure + circumstances. + + * gnus-ems.el: Would define make-face, which would confuse Info. + + * gnus.el (gnus-summary-next-article): Execute keystroke after `n' + in the right buffer. + + * gnus-edit.el (gnus-score-customize): Added keystroke and + autoload. + + * gnus.el (gnus-ask-server-for-new-groups): Did not open servers + before requesting. + (gnus-group-check-bogus-groups): Prefix now means "don't ask". + (gnus-check-bogus-newsgroups): Would bug out on several bogus + groups with the same name. + + Thu Jun 1 01:17:01 1995 Lars Ingebrigtsen + + * gnus-msg.el (gnus-post-news): Would 'ask even when posting. + (gnus-inews-insert-headers): Only remove message-id previously + generated by Gnus. + (gnus-inews-news): Insert the same message-id in mail copies of + news articles. + (gnus-deletable-headers): New variable. + + * nnmh.el (nnmh-request-list): Would mess up the list. + + * gnus.el (gnus-group-make-empty-virtual): Create a group that + matches nothing, not everything. + (gnus-group-catchup-current): Catch up component nnvirtual + groups. + + * gnus-soup.el: New file. + + * nnsoup.el: New file. + + * gnus-msg.el (gnus-inews-article-function): New variable. + (gnus-inews-article): Check headers after they have been + generated. + + Wed May 31 11:37:22 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-expire-articles): Cancelled instead of + canceled. + + Wed May 31 03:45:35 1995 Lars Magne Ingebrigtsen + + * nnmh.el (nnmh-request-expire-articles): If a file can't be + deleted, don't remove it from the list of expirables. + + * gnus.el: 0.80 is released. + Tue May 30 10:59:22 1995 Per Abrahamsen * gnus-cite.el (gnus-cite-attribution-postfix): Accept VinVN *** pub/dgnus/texi/gnus.texi Wed May 31 02:09:03 1995 --- dgnus/texi/gnus.texi Fri Jun 2 16:07:31 1995 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @comment %**start of header (This is for running Texinfo on a region.) @setfilename gnus ! @settitle Gnus 0.70 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @comment %**start of header (This is for running Texinfo on a region.) @setfilename gnus ! @settitle (ding) Gnus 0.80 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 43,49 **** @end ifinfo @titlepage ! @title Gnus Manual @author by Lars Magne Ingebrigtsen @page --- 43,49 ---- @end ifinfo @titlepage ! @title (ding) Gnus Manual @author by Lars Magne Ingebrigtsen @page *************** *** 3316,3321 **** --- 3316,3333 ---- This function will be called narrowed to header of the article that is being followed up. + @item gnus-deletable-headers + @vindex gnus-deletable-headers + Headers in this list that were previously generated by Gnus will be + deleted before posting. Let's say you post an article. Then you decide + to post it again to some other group, you naughty boy, so you jump back + to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and + ship it off again. By default, this variable makes sure that the old + generated @code{Message-ID} is deleted, and a new one generated. If + this isn't done, the entire empire would probably crumble, anarchy would + prevail, and cats would start walking on two legs and rule the world. + Allegedly. + @item gnus-signature-function @vindex gnus-signature-function If non-@code{nil}, this variable should be a function that returns a *************** *** 3368,3373 **** --- 3380,3390 ---- This hook is called before the headers have been prepared. By default it inserts the signature specified by @code{gnus-signature-file}. + @item gnus-inews-article-function + @vindex gnus-inews-article-function + This function is used to do the actual article processing and header + checking/generation. + @item gnus-inews-article-hook @vindex gnus-inews-article-hook This hook is called right before the article is posted. By default it *************** *** 5418,5429 **** group name with @code{gnus-adaptive-file-suffix} appended. @vindex gnus-score-exact-adapt-limit ! When doing adaptive scoring, one normally uses substring matching. ! However, if the header one matches is short, the possibility for false ! positives is great, so if the length of the match is less than ! @code{gnus-score-exact-adapt-limit}, exact matching will be used. ! If this variable is @code{nil}, which it is by default, exact matching ! will always be used. @node Scoring Tips @subsection Scoring Tips --- 5435,5446 ---- group name with @code{gnus-adaptive-file-suffix} appended. @vindex gnus-score-exact-adapt-limit ! When doing adaptive scoring, substring matching would probably give you ! the best results in most cases. However, if the header one matches is ! short, the possibility for false positives is great, so if the length of ! the match is less than @code{gnus-score-exact-adapt-limit}, exact ! matching will be used. If this variable is @code{nil}, which it is by ! default, exact matching will always be used to avoid this problem. @node Scoring Tips @subsection Scoring Tips *************** *** 5578,5590 **** This will mark every article written by me as read, and remove them from the summary buffer. Very useful, you'll agree. ! Two functions for entering kill file editing: @table @kbd @item V k @kindex V k (Summary) @findex gnus-summary-edit-local-kill Edit this group's kill file (@code{gnus-summary-edit-local-kill}). @item V K @kindex V K (Summary) @findex gnus-summary-edit-global-kill --- 5595,5612 ---- This will mark every article written by me as read, and remove them from the summary buffer. Very useful, you'll agree. ! Other programs use a totally different kill file syntax. If Gnus ! encounters what looks like a @code{rn} kill file, it will take a stab at ! interpreting it. ! ! Two functions for editing a GNUS kill file: @table @kbd @item V k @kindex V k (Summary) @findex gnus-summary-edit-local-kill Edit this group's kill file (@code{gnus-summary-edit-local-kill}). + @item V K @kindex V K (Summary) @findex gnus-summary-edit-global-kill *************** *** 5625,5636 **** --- 5647,5660 ---- @item B m @kindex B m (Summary) + @cindex move mail @findex gnus-summary-move-article Move the article from one mail group to another (@code{gnus-summary-move-article}). @item B c @kindex B c (Summary) + @kindex copy mail @findex gnus-summary-copy-article Copy the article from one group (mail group or not) to a mail group (@code{gnus-summary-copy-article}).