*** pub/qgnus/lisp/gnus-agent.el Sat Sep 13 21:57:00 1997 --- qgnus/lisp/gnus-agent.el Sat Sep 13 21:56:41 1997 *************** *** 0 **** --- 1,1187 ---- + ;;; gnus-agent.el --- unplugged support for Gnus + ;; Copyright (C) 1997 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; (add-hook 'gnus-before-startup-hook 'gnus-open-agent) + + ;;; Code: + + (require 'gnus) + (require 'gnus-cache) + (require 'nnvirtual) + (require 'gnus-sum) + + (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") + "Where the Gnus agent will store its files." + :group 'gnus-agent + :type 'directory) + + (defcustom gnus-agent-plugged-hook nil + "Hook run when plugging into the network." + :group 'gnus-agent + :type 'hook) + + (defcustom gnus-agent-unplugged-hook nil + "Hook run when unplugging from the network." + :group 'gnus-agent + :type 'hook) + + ;;; Internal variables + + (defvar gnus-agent-history-buffers nil) + (defvar gnus-agent-buffer-alist nil) + (defvar gnus-agent-article-alist nil) + (defvar gnus-agent-group-alist nil) + (defvar gnus-agent-covered-methods nil) + (defvar gnus-category-alist nil) + (defvar gnus-agent-current-history nil) + (defvar gnus-agent-overview-buffer nil) + (defvar gnus-category-predicate-cache nil) + (defvar gnus-category-group-cache nil) + (defvar gnus-agent-spam-hashtb nil) + (defvar gnus-agent-file-name nil) + + (defvar gnus-plugged t + "Whether Gnus is plugged or not.") + + ;; Dynamic variables + (defvar gnus-headers) + (defvar gnus-score) + + ;;; + ;;; Setup + ;;; + + (defun gnus-open-agent () + (setq gnus-agent t) + (gnus-agent-read-servers) + (gnus-category-read) + (setq gnus-agent-overview-buffer + (get-buffer-create " *Gnus agent overview*")) + (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) + (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) + (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) + + (gnus-add-shutdown 'gnus-close-agent 'gnus) + + (defun gnus-close-agent () + (setq gnus-agent-covered-methods nil + gnus-category-predicate-cache nil + gnus-category-group-cache nil + gnus-agent-spam-hashtb nil) + (gnus-kill-buffer gnus-agent-overview-buffer)) + + ;;; + ;;; Utility functions + ;;; + + (defun gnus-agent-read-file (file) + "Load FILE and do a `read' there." + (nnheader-temp-write nil + (ignore-errors + (insert-file-contents file) + (goto-char (point-min)) + (read (current-buffer))))) + + (defsubst gnus-agent-method () + (concat (symbol-name (car gnus-command-method)) "/" + (if (equal (cadr gnus-command-method) "") + "unnamed" + (cadr gnus-command-method)))) + + (defsubst gnus-agent-directory () + "Path of the Gnus agent directory." + (nnheader-concat gnus-agent-directory (gnus-agent-method) "/")) + + (defun gnus-agent-lib-file (file) + "The full path of the Gnus agent library FILE." + (concat (gnus-agent-directory) "lib/" file)) + + ;;; + ;;; Mode infestation + ;;; + + (defvar gnus-agent-mode-hook nil + "Hook run when installing agent mode.") + + (defvar gnus-agent-mode nil) + (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged")) + + (defun gnus-agent-mode () + "Minor mode for providing a agent support in Gnus buffers." + (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$" + (symbol-name major-mode)) + (match-string 1 (symbol-name major-mode)))) + (mode (intern (format "gnus-agent-%s-mode" buffer)))) + (set (make-local-variable 'gnus-agent-mode) t) + (set mode nil) + (set (make-local-variable mode) t) + ;; Set up the menu. + (when (gnus-visual-p 'agent-menu 'menu) + (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer)))) + (unless (assq 'gnus-agent-mode minor-mode-alist) + (push gnus-agent-mode-status minor-mode-alist)) + (unless (assq mode minor-mode-map-alist) + (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" + buffer)))) + minor-mode-map-alist)) + (gnus-agent-toggle-plugged gnus-plugged) + (run-hooks 'gnus-agent-mode-hook))) + + (defvar gnus-agent-group-mode-map (make-sparse-keymap)) + (gnus-define-keys gnus-agent-group-mode-map + "Ju" gnus-agent-fetch-group + "Jc" gnus-enter-category-buffer + "Jj" gnus-agent-toggle-plugged + "Js" gnus-agent-fetch-session + "Ja" gnus-agent-add-group) + + (defun gnus-agent-group-make-menu-bar () + (unless (boundp 'gnus-agent-group-menu) + (easy-menu-define + gnus-agent-group-menu gnus-agent-group-mode-map "" + '("Agent" + ["Toggle plugged" gnus-agent-toggle-plugged t] + ["List categories" gnus-enter-category-buffer t] + ("Fetch" + ["Group" gnus-agent-fetch-group t]))))) + + (defvar gnus-agent-summary-mode-map (make-sparse-keymap)) + (gnus-define-keys gnus-agent-summary-mode-map + "Jj" gnus-agent-toggle-plugged + "J#" gnus-agent-mark-article + "J\M-#" gnus-agent-unmark-article + "@" gnus-agent-toggle-mark + "Jc" gnus-agent-catchup) + + (defun gnus-agent-summary-make-menu-bar () + (unless (boundp 'gnus-agent-summary-menu) + (easy-menu-define + gnus-agent-summary-menu gnus-agent-summary-mode-map "" + '("Agent" + ["Toggle plugged" gnus-agent-toggle-plugged t] + ["Mark as downloadable" gnus-agent-mark-article t] + ["Unmark as downloadable" gnus-agent-unmark-article t] + ["Toggle mark" gnus-agent-toggle-mark t] + ["Catchup undownloaded" gnus-agent-catchup t])))) + + (defvar gnus-agent-server-mode-map (make-sparse-keymap)) + (gnus-define-keys gnus-agent-server-mode-map + "Jj" gnus-agent-toggle-plugged + "Ja" gnus-agent-add-server + "Jr" gnus-agent-remove-server) + + (defun gnus-agent-server-make-menu-bar () + (unless (boundp 'gnus-agent-server-menu) + (easy-menu-define + gnus-agent-server-menu gnus-agent-server-mode-map "" + '("Agent" + ["Toggle plugged" gnus-agent-toggle-plugged t] + ["Add" gnus-agent-add-server t] + ["Remove" gnus-agent-remove-server t])))) + + (defun gnus-agent-toggle-plugged (plugged) + "Toggle whether Gnus is unplugged or not." + (interactive (list (not gnus-plugged))) + (if plugged + (progn + (run-hooks 'gnus-agent-plugged-hook) + (setcar (cdr gnus-agent-mode-status) " Plugged")) + (gnus-agent-close-connections) + (run-hooks 'gnus-agent-unplugged-hook) + (setcar (cdr gnus-agent-mode-status) " Unplugged")) + (setq gnus-plugged plugged) + (set-buffer-modified-p t)) + + (defun gnus-agent-close-connections () + "Close all methods covered by the Gnus agent." + (let ((methods gnus-agent-covered-methods)) + (while methods + (gnus-close-server (pop methods))))) + + ;;;###autoload + (defun gnus-unplugged () + "Start Gnus unplugged." + (interactive) + (setq gnus-plugged nil) + (gnus)) + + ;;; + ;;; Group mode commands + ;;; + + (defun gnus-agent-fetch-group (group) + "Put all new articles in GROUP into the agent." + (interactive (list (gnus-group-group-name))) + (unless group + (error "No group on the current line")) + (let ((articles (gnus-list-of-unread-articles group)) + (gnus-command-method (gnus-find-method-for-group group))) + (gnus-agent-with-fetch + (gnus-agent-fetch-articles group articles)))) + + (defun gnus-agent-add-group (category arg) + "Add the current group to an agent category." + (interactive + (list + (intern + (completing-read + "Add to category: " + (mapcar (lambda (cat) (list (symbol-name (car cat)))) + gnus-category-alist) + nil t)) + current-prefix-arg)) + (let ((cat (assq category gnus-category-alist)) + c groups) + (gnus-group-iterate arg + (lambda (group) + (when (cadddr (setq c (gnus-group-category group))) + (setf (cadddr c) (delete group (cadddr c)))) + (push group groups))) + (setf (cadddr cat) (nconc (cadddr cat) groups)) + (gnus-category-write))) + + ;;; + ;;; Server mode commands + ;;; + + (defun gnus-agent-add-server (server) + "Enroll SERVER in the agent program." + (interactive (list (gnus-server-server-name))) + (unless server + (error "No server on the current line")) + (let ((method (gnus-server-get-method nil (gnus-server-server-name)))) + (when (member method gnus-agent-covered-methods) + (error "Server already in the agent program")) + (push method gnus-agent-covered-methods) + (gnus-agent-write-servers) + (message "Entered %s into the agent" server))) + + (defun gnus-agent-remove-server (server) + "Remove SERVER from the agent program." + (interactive (list (gnus-server-server-name))) + (unless server + (error "No server on the current line")) + (let ((method (gnus-server-get-method nil (gnus-server-server-name)))) + (unless (member method gnus-agent-covered-methods) + (error "Server not in the agent program")) + (setq gnus-agent-covered-methods + (delete method gnus-agent-covered-methods)) + (gnus-agent-write-servers) + (message "Removed %s from the agent" server))) + + (defun gnus-agent-read-servers () + "Read the alist of covered servers." + (setq gnus-agent-covered-methods + (gnus-agent-read-file + (nnheader-concat gnus-agent-directory "lib/servers")))) + + (defun gnus-agent-write-servers () + "Write the alist of covered servers." + (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers") + (prin1 gnus-agent-covered-methods (current-buffer)))) + + ;;; + ;;; Summary commands + ;;; + + (defun gnus-agent-mark-article (n &optional unmark) + "Mark the next N articles as downloadable. + If N is negative, mark backward instead. If UNMARK is non-nil, remove + the mark instead. The difference between N and the actual number of + articles marked is returned." + (interactive "p") + (gnus-set-global-variables) + (let ((backward (< n 0)) + (n (abs n))) + (while (and + (> n 0) + (progn + (gnus-summary-set-agent-mark + (gnus-summary-article-number) unmark) + (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))) + (setq n (1- n))) + (when (/= 0 n) + (gnus-message 7 "No more articles")) + (gnus-summary-recenter) + (gnus-summary-position-point) + n)) + + (defun gnus-agent-unmark-article (n) + "Remove the downloadable mark from the next N articles. + If N is negative, unmark backward instead. The difference between N and + the actual number of articles unmarked is returned." + (interactive "p") + (gnus-set-global-variables) + (gnus-agent-mark-article n t)) + + (defun gnus-agent-toggle-mark (n) + "Toggle the downloadable mark from the next N articles. + If N is negative, toggle backward instead. The difference between N and + the actual number of articles toggled is returned." + (interactive "p") + (gnus-set-global-variables) + (gnus-agent-mark-article n 'toggle)) + + (defun gnus-summary-set-agent-mark (article &optional unmark) + "Mark ARTICLE as downloadable." + (let ((unmark (if (and (not (null unmark)) (not (eq t unmark))) + (memq article gnus-newsgroup-downloadable) + unmark))) + (setq gnus-newsgroup-downloadable + (delq article gnus-newsgroup-downloadable)) + (unless unmark + (push article gnus-newsgroup-downloadable)) + (gnus-summary-update-mark + (if unmark gnus-undownloaded-mark gnus-downloadable-mark) + 'unread))) + + (defun gnus-agent-get-undownloaded-list () + "Mark all unfetched articles as read." + (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) + (when (and (not gnus-plugged) + (gnus-agent-method-p gnus-command-method)) + (gnus-agent-load-alist gnus-newsgroup-name) + (let ((articles gnus-newsgroup-unreads) + article) + (while (setq article (pop articles)) + (unless (or (cdr (assq article gnus-agent-article-alist)) + (memq article gnus-newsgroup-downloadable)) + (push article gnus-newsgroup-undownloaded))))))) + + (defun gnus-agent-catchup () + "Mark all undownloaded articles as read." + (interactive) + (save-excursion + (while gnus-newsgroup-undownloaded + (gnus-summary-mark-article + (pop gnus-newsgroup-undownloaded) gnus-catchup-mark))) + (gnus-summary-position-point)) + + ;;; + ;;; Internal functions + ;;; + + (defun gnus-agent-save-active (method) + (when (gnus-agent-method-p method) + (let* ((gnus-command-method method) + (file (gnus-agent-lib-file "active"))) + (gnus-make-directory (file-name-directory file)) + (write-region (point-min) (point-max) file nil 'silent) + (when (file-exists-p (gnus-agent-lib-file "groups")) + (delete-file (gnus-agent-lib-file "groups")))))) + + (defun gnus-agent-save-groups (method) + (let* ((gnus-command-method method) + (file (gnus-agent-lib-file "groups"))) + (gnus-make-directory (file-name-directory file)) + (write-region (point-min) (point-max) file nil 'silent)) + (when (file-exists-p (gnus-agent-lib-file "active")) + (delete-file (gnus-agent-lib-file "active")))) + + (defun gnus-agent-group-path (group) + "Translate GROUP into a path." + (nnheader-replace-chars-in-string group ?. ?/)) + + + + (defun gnus-agent-method-p (method) + "Say whether METHOD is covered by the agent." + (member method gnus-agent-covered-methods)) + + (defun gnus-agent-get-function (method) + (if (and (not gnus-plugged) + (gnus-agent-method-p method)) + (progn + (require 'nnagent) + 'nnagent) + (car method))) + + ;;; History functions + + (defun gnus-agent-history-buffer () + (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers))) + + (defun gnus-agent-open-history () + (save-excursion + (push (cons (gnus-agent-method) + (set-buffer (get-buffer-create + (format " *Gnus agent %s history*" + (gnus-agent-method))))) + gnus-agent-history-buffers) + (erase-buffer) + (insert "\n") + (let ((file (gnus-agent-lib-file "history"))) + (when (file-exists-p file) + (insert-file file)) + (set (make-local-variable 'gnus-agent-file-name) file)))) + + (defun gnus-agent-save-history () + (save-excursion + (set-buffer gnus-agent-current-history) + (gnus-make-directory (file-name-directory gnus-agent-file-name)) + (write-region (1+ (point-min)) (point-max) + gnus-agent-file-name nil 'silent))) + + (defun gnus-agent-close-history () + (when (gnus-buffer-live-p gnus-agent-current-history) + (kill-buffer gnus-agent-current-history) + (setq gnus-agent-history-buffers + (delq (assoc (gnus-agent-method) gnus-agent-history-buffers) + gnus-agent-history-buffers)))) + + (defun gnus-agent-enter-history (id group-arts date) + (save-excursion + (set-buffer gnus-agent-current-history) + (goto-char (point-max)) + (insert id "\t" (number-to-string date) "\t") + (while group-arts + (insert (caar group-arts) "/" (number-to-string (cdr (pop group-arts))) + " ")) + (insert "\n"))) + + (defun gnus-agent-article-in-history-p (id) + (save-excursion + (set-buffer (gnus-agent-history-buffer)) + (goto-char (point-min)) + (search-forward (concat "\n" id "\t") nil t))) + + (defun gnus-agent-history-path (id) + (save-excursion + (set-buffer (gnus-agent-history-buffer)) + (goto-char (point-min)) + (when (search-forward (concat "\n" id "\t") nil t) + (let ((method (gnus-agent-method))) + (let (paths group) + (while (not (numberp (setq group (read (current-buffer))))) + (push (concat method "/" group) paths)) + (nreverse paths)))))) + + ;;; + ;;; Fetching + ;;; + + (defun gnus-agent-start-fetch () + "Initialize data structures for efficient fetching." + (gnus-agent-open-history) + (setq gnus-agent-current-history (gnus-agent-history-buffer))) + + (defun gnus-agent-stop-fetch () + "Save all data structures and clean up." + (gnus-agent-save-history) + (gnus-agent-close-history) + (setq gnus-agent-spam-hashtb nil) + (save-excursion + (set-buffer nntp-server-buffer) + (widen))) + + (defmacro gnus-agent-with-fetch (&rest forms) + "Do FORMS safely." + `(unwind-protect + (progn + (gnus-agent-start-fetch) + ,@forms) + (gnus-agent-stop-fetch))) + + (put 'gnus-agent-with-fetch 'lisp-indent-function 0) + (put 'gnus-agent-with-fetch 'edebug-form-spec '(body)) + + (defun gnus-agent-fetch-articles (group articles) + "Fetch ARTICLES from GROUP and put them into the agent." + (when articles + ;; Prune off articles that we have already fetched. + (while (and articles + (cdr (assq (car articles) gnus-agent-article-alist))) + (pop articles)) + (let ((arts articles)) + (while (cdr arts) + (if (cdr (assq (cadr arts) gnus-agent-article-alist)) + (setcdr arts (cddr arts)) + (setq arts (cdr arts))))) + (when articles + (let ((dir (concat + (gnus-agent-directory) + (gnus-agent-group-path group) "/")) + (date (gnus-time-to-day (current-time))) + (case-fold-search t) + pos alists crosses id elem) + (gnus-make-directory dir) + (gnus-message 7 "Fetching articles for %s..." group) + ;; Fetch the articles from the backend. + (if (gnus-check-backend-function 'retrieve-articles group) + (setq pos (gnus-retrieve-articles articles group)) + (nnheader-temp-write nil + (let ((buf (current-buffer)) + article) + (while (setq article (pop articles)) + (when (gnus-request-article article group) + (goto-char (point-max)) + (push (cons article (point)) pos) + (insert-buffer-substring nntp-server-buffer))) + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (setq pos (nreverse pos))))) + ;; Then save these articles into the agent. + (save-excursion + (set-buffer nntp-server-buffer) + (while pos + (narrow-to-region (cdar pos) (or (cdadr pos) (point-max))) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (when (search-backward "\nXrefs: " nil t) + ;; Handle crossposting. + (skip-chars-forward "^ ") + (skip-chars-forward " ") + (setq crosses nil) + (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +") + (push (cons (buffer-substring (match-beginning 1) + (match-end 1)) + (buffer-substring (match-beginning 2) + (match-end 2))) + crosses) + (goto-char (match-end 0))) + (gnus-agent-crosspost crosses (caar pos)))) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) + (setq id "No-Message-ID-in-article") + (setq id (buffer-substring (match-beginning 1) (match-end 1)))) + (write-region (point-min) (point-max) + (concat dir (number-to-string (caar pos))) + nil 'silent) + (when (setq elem (assq (caar pos) gnus-agent-article-alist)) + (setcdr elem t)) + (gnus-agent-enter-history + id (or crosses (list (cons group (caar pos)))) date) + (widen) + (pop pos))) + (gnus-agent-save-alist group))))) + + (defun gnus-agent-crosspost (crosses article) + (let (gnus-agent-article-alist group alist beg end) + (save-excursion + (set-buffer gnus-agent-overview-buffer) + (when (nnheader-find-nov-line article) + (forward-word 1) + (setq beg (point)) + (setq end (progn (forward-line 1) (point))))) + (while crosses + (setq group (caar crosses)) + (unless (setq alist (assoc group gnus-agent-group-alist)) + (push (setq alist (list group (gnus-agent-load-alist (caar crosses)))) + gnus-agent-group-alist)) + (setcdr alist (cons (cons (cdar crosses) t) (cdr alist))) + (save-excursion + (set-buffer (get-buffer-create (format " *Gnus agent overview %s*" + group))) + (when (= (point-max) (point-min)) + (push (cons group (current-buffer)) gnus-agent-buffer-alist) + (ignore-errors + (insert-file-contents + (gnus-agent-article-name ".overview" group)))) + (nnheader-find-nov-line (string-to-number (cdar crosses))) + (insert (string-to-number (cdar crosses))) + (insert-buffer-substring gnus-agent-overview-buffer beg end)) + (pop crosses)))) + + (defun gnus-agent-flush-cache () + (save-excursion + (while gnus-agent-buffer-alist + (set-buffer (cdar gnus-agent-buffer-alist)) + (write-region (point-min) (point-max) + (gnus-agent-article-name ".overview" + (caar gnus-agent-buffer-alist)) + nil 'silent) + (pop gnus-agent-buffer-alist)) + (while gnus-agent-group-alist + (nnheader-temp-write (caar gnus-agent-group-alist) + (princ (cdar gnus-agent-group-alist)) + (insert "\n")) + (pop gnus-agent-group-alist)))) + + (defun gnus-agent-fetch-headers (group articles &optional force) + (gnus-agent-load-alist group) + ;; Find out what headers we need to retrieve. + (when articles + (while (and articles + (assq (car articles) gnus-agent-article-alist)) + (pop articles)) + (let ((arts articles)) + (while (cdr arts) + (if (assq (cadr arts) gnus-agent-article-alist) + (setcdr arts (cddr arts)) + (setq arts (cdr arts))))) + ;; Fetch them. + (when articles + (gnus-message 7 "Fetching headers for %s..." group) + (save-excursion + (set-buffer nntp-server-buffer) + (unless (eq 'nov (gnus-retrieve-headers articles group)) + (nnvirtual-convert-headers)) + ;; Save these headers for later processing. + (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + (let (file) + (when (file-exists-p + (setq file (gnus-agent-article-name ".overview" group))) + (gnus-agent-braid-nov group articles file)) + (gnus-make-directory (file-name-directory file)) + (write-region (point-min) (point-max) file nil 'silent) + (gnus-agent-save-alist group articles nil)) + t)))) + + (defsubst gnus-agent-copy-nov-line (article) + (let (b e) + (set-buffer gnus-agent-overview-buffer) + (setq b (point)) + (if (eq article (read (current-buffer))) + (setq e (progn (forward-line 1) (point))) + (setq e b)) + (set-buffer nntp-server-buffer) + (insert-buffer-substring gnus-agent-overview-buffer b e))) + + (defun gnus-agent-braid-nov (group articles file) + (let (beg end) + (set-buffer gnus-agent-overview-buffer) + (goto-char (point-min)) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-file-contents file) + (goto-char (point-min)) + (if (or (= (point-min) (point-max)) + (progn + (forward-line -1) + (< (read (current-buffer)) (car articles)))) + ;; We have only headers that are after the older headers, + ;; so we just append them. + (progn + (goto-char (point-max)) + (insert-buffer-substring gnus-agent-overview-buffer)) + ;; We do it the hard way. + (nnheader-find-nov-line (car articles)) + (gnus-agent-copy-nov-line (car articles)) + (pop articles) + (while (and articles + (not (eobp))) + (while (and (not (eobp)) + (< (read (current-buffer)) (car articles))) + (forward-line 1)) + (beginning-of-line) + (unless (eobp) + (gnus-agent-copy-nov-line (car articles)) + (setq articles (cdr articles)))) + (when articles + (let (b e) + (set-buffer gnus-agent-overview-buffer) + (setq b (point) + e (point-max)) + (set-buffer nntp-server-buffer) + (insert-buffer-substring gnus-agent-overview-buffer b e)))))) + + (defun gnus-agent-load-alist (group &optional dir) + "Load the article-state alist for GROUP." + (setq gnus-agent-article-alist + (gnus-agent-read-file + (if dir + (concat dir ".agentview") + (gnus-agent-article-name ".agentview" group))))) + + (defun gnus-agent-save-alist (group &optional articles state dir) + "Load the article-state alist for GROUP." + (nnheader-temp-write (if dir + (concat dir ".agentview") + (gnus-agent-article-name ".agentview" group)) + (princ (setq gnus-agent-article-alist + (nconc gnus-agent-article-alist + (mapcar (lambda (article) (cons article state)) + articles))) + (current-buffer)) + (insert "\n"))) + + (defun gnus-agent-article-name (article group) + (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" + (if (stringp article) article (string-to-number article)))) + + (defun gnus-agent-fetch-session () + "Fetch all articles and headers that are eligible for fetching." + (interactive) + (unless gnus-agent-covered-methods + (error "No servers are covered by the Gnus agent")) + (unless gnus-plugged + (error "Can't fetch articles while Gnus is unplugged")) + (let ((methods gnus-agent-covered-methods) + gnus-newsgroup-dependencies gnus-newsgroup-headers + gnus-newsgroup-scored + gnus-headers gnus-score + gnus-use-cache + gnus-command-method groups group articles score arts + category predicate info marks score-param) + (save-excursion + (while methods + (setq gnus-command-method (car methods) + groups (gnus-groups-from-server (pop methods))) + (gnus-agent-with-fetch + (while (setq group (pop groups)) + ;; Fetch headers. + (when (and (setq articles (gnus-list-of-unread-articles group)) + (gnus-agent-fetch-headers group articles)) + ;; Parse them and see which articles we want to fetch. + (setq gnus-newsgroup-dependencies + (make-vector (length articles) 0)) + (setq gnus-newsgroup-headers + (gnus-get-newsgroup-headers-xover articles nil nil group)) + (setq category (gnus-group-category group)) + (setq predicate + (gnus-get-predicate + (or (gnus-group-get-parameter group 'agent-predicate) + (cadr category)))) + (setq score-param + (or (gnus-group-get-parameter group 'agent-score) + (caddr category))) + (when score-param + (gnus-score-headers (list (list score-param)))) + (setq arts nil) + (while (setq gnus-headers (pop gnus-newsgroup-headers)) + (setq gnus-score + (or (cdr (assq (mail-header-number gnus-headers) + gnus-newsgroup-scored)) + gnus-summary-default-score)) + (when (funcall predicate) + (push (mail-header-number gnus-headers) + arts))) + ;; Fetch the articles. + (when arts + (gnus-agent-fetch-articles group arts))) + ;; Perhaps we have some additional articles to fetch. + (setq arts (assq 'download (gnus-info-marks + (setq info (gnus-get-info group))))) + (when (cdr arts) + (gnus-agent-fetch-articles + group (gnus-uncompress-range (cdr arts))) + (setq marks (delq arts (gnus-info-marks info))) + (gnus-info-set-marks info marks))))) + (gnus-message 6 "Finished fetching articles into the Gnus agent")))) + + ;;; + ;;; Agent Category Mode + ;;; + + (defvar gnus-category-mode-hook nil + "Hook run in `gnus-category-mode' buffers.") + + (defvar gnus-category-line-format " %(%20c%): %g\n" + "Format of category lines.") + + (defvar gnus-category-mode-line-format "Gnus: %%b" + "The format specification for the category mode line.") + + ;;; Internal variables. + + (defvar gnus-category-buffer "*Agent Category*") + + (defvar gnus-category-line-format-alist + `((?c name ?s) + (?g groups ?d))) + + (defvar gnus-category-mode-line-format-alist + `((?u user-defined ?s))) + + (defvar gnus-category-line-format-spec nil) + (defvar gnus-category-mode-line-format-spec nil) + + (defvar gnus-category-mode-map nil) + (put 'gnus-category-mode 'mode-class 'special) + + (unless gnus-category-mode-map + (setq gnus-category-mode-map (make-sparse-keymap)) + (suppress-keymap gnus-category-mode-map) + + (gnus-define-keys gnus-category-mode-map + "q" gnus-category-exit + "k" gnus-category-kill + "c" gnus-category-copy + "a" gnus-category-add + "p" gnus-category-edit-predicate + "g" gnus-category-edit-groups + "s" gnus-category-edit-score + "l" gnus-category-list + + "\C-c\C-i" gnus-info-find-node + "\C-c\C-b" gnus-bug)) + + (defvar gnus-category-menu-hook nil + "*Hook run after the creation of the menu.") + + (defun gnus-category-make-menu-bar () + (gnus-turn-off-edit-menu 'category) + (unless (boundp 'gnus-category-menu) + (easy-menu-define + gnus-category-menu gnus-category-mode-map "" + '("Categories" + ["Add" gnus-category-add t] + ["Kill" gnus-category-kill t] + ["Copy" gnus-category-copy t] + ["Edit predicate" gnus-category-edit-predicate t] + ["Edit score" gnus-category-edit-score t] + ["Edit groups" gnus-category-edit-groups t] + ["Exit" gnus-category-exit t])) + + (run-hooks 'gnus-category-menu-hook))) + + (defun gnus-category-mode () + "Major mode for listing and editing agent categories. + + All normal editing commands are switched off. + \\ + For more in-depth information on this mode, read the manual + (`\\[gnus-info-find-node]'). + + The following commands are available: + + \\{gnus-category-mode-map}" + (interactive) + (when (gnus-visual-p 'category-menu 'menu) + (gnus-category-make-menu-bar)) + (kill-all-local-variables) + (gnus-simplify-mode-line) + (setq major-mode 'gnus-category-mode) + (setq mode-name "Category") + (gnus-set-default-directory) + (setq mode-line-process nil) + (use-local-map gnus-category-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (run-hooks 'gnus-category-mode-hook)) + + (defalias 'gnus-category-position-point 'gnus-goto-colon) + + (defun gnus-category-insert-line (category) + (let* ((name (car category)) + (groups (length (cadddr category)))) + (beginning-of-line) + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + ;; Insert the text. + (eval gnus-category-line-format-spec)) + (list 'gnus-category name)))) + + (defun gnus-enter-category-buffer () + "Go to the Category buffer." + (interactive) + (gnus-category-setup-buffer) + (gnus-configure-windows 'category) + (gnus-category-prepare)) + + (defun gnus-category-setup-buffer () + (unless (get-buffer gnus-category-buffer) + (save-excursion + (set-buffer (get-buffer-create gnus-category-buffer)) + (gnus-add-current-to-buffer-list) + (gnus-category-mode)))) + + (defun gnus-category-prepare () + (gnus-set-format 'category-mode) + (gnus-set-format 'category t) + (let ((alist gnus-category-alist) + (buffer-read-only nil)) + (erase-buffer) + (while alist + (gnus-category-insert-line (pop alist))) + (goto-char (point-min)) + (gnus-category-position-point))) + + (defun gnus-category-name () + (or (get-text-property (gnus-point-at-bol) 'gnus-category) + (error "No category on the current line"))) + + (defun gnus-category-read () + "Read the category alist." + (setq gnus-category-alist + (or (gnus-agent-read-file + (nnheader-concat gnus-agent-directory "lib/categories")) + (list (list 'default 'true nil nil))))) + + (defun gnus-category-write () + "Write the category alist." + (setq gnus-category-predicate-cache nil + gnus-category-group-cache nil) + (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories") + (prin1 gnus-category-alist (current-buffer)))) + + (defun gnus-category-edit-predicate (category) + "Edit the predicate for CATEGORY." + (interactive (list (gnus-category-name))) + (let ((info (assq category gnus-category-alist))) + (gnus-edit-form + (cadr info) (format "Editing the predicate for category %s" category) + `(lambda (predicate) + (setf (cadr (assq ',category gnus-category-alist)) predicate) + (gnus-category-write) + (gnus-category-list))))) + + (defun gnus-category-edit-score (category) + "Edit the score expression for CATEGORY." + (interactive (list (gnus-category-name))) + (let ((info (assq category gnus-category-alist))) + (gnus-edit-form + (caddr info) + (format "Editing the score expression for category %s" category) + `(lambda (groups) + (setf (caddr (assq ',category gnus-category-alist)) groups) + (gnus-category-write) + (gnus-category-list))))) + + (defun gnus-category-edit-groups (category) + "Edit the group list for CATEGORY." + (interactive (list (gnus-category-name))) + (let ((info (assq category gnus-category-alist))) + (gnus-edit-form + (cadddr info) (format "Editing the group list for category %s" category) + `(lambda (groups) + (setf (cadddr (assq ',category gnus-category-alist)) groups) + (gnus-category-write) + (gnus-category-list))))) + + (defun gnus-category-kill (category) + "Kill the current category." + (interactive (list (gnus-category-name))) + (let ((info (assq category gnus-category-alist)) + (buffer-read-only nil)) + (gnus-delete-line) + (gnus-category-write) + (setq gnus-category-alist (delq info gnus-category-alist)))) + + (defun gnus-category-copy (category to) + "Copy the current category." + (interactive (list (gnus-category-name) (intern (read-string "New name: ")))) + (let ((info (assq category gnus-category-alist))) + (push (list to (gnus-copy-sequence (cadr info)) + (gnus-copy-sequence (caddr info)) nil) + gnus-category-alist) + (gnus-category-write) + (gnus-category-list))) + + (defun gnus-category-add (category) + "Create a new category." + (interactive "SCategory name: ") + (when (assq category gnus-category-alist) + (error "Category %s already exists" category)) + (push (list category 'true nil nil) + gnus-category-alist) + (gnus-category-write) + (gnus-category-list)) + + (defun gnus-category-list () + "List all categories." + (interactive) + (gnus-category-prepare)) + + (defun gnus-category-exit () + "Return to the group buffer." + (interactive) + (kill-buffer (current-buffer)) + (gnus-configure-windows 'group t)) + + ;; To avoid having 8-bit characters in the source file. + (defvar gnus-category-not (list '! 'not (intern (format "%c" 172)))) + + (defvar gnus-category-predicate-alist + '((spam . gnus-agent-spam-p) + (short . gnus-agent-short-p) + (long . gnus-agent-long-p) + (low . gnus-agent-low-scored-p) + (high . gnus-agent-high-scored-p) + (true . gnus-agent-true) + (false . gnus-agent-false)) + "Mapping from short score predicate symbols to predicate functions.") + + (defun gnus-agent-spam-p () + "Say whether an article is spam or not." + (unless gnus-agent-spam-hashtb + (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000))) + (if (not (equal (mail-header-references gnus-headers) "")) + nil + (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers)))) + (prog1 + (gnus-gethash string gnus-agent-spam-hashtb) + (gnus-sethash string t gnus-agent-spam-hashtb))))) + + (defun gnus-agent-short-p () + "Say whether an article is short (less than 100 lines) or not." + (< (mail-header-lines gnus-headers) 100)) + + (defun gnus-agent-long-p () + "Say whether an article is long (more than 200 lines) or not." + (> (mail-header-lines gnus-headers) 200)) + + (defun gnus-agent-low-scored-p () + "Say whether an article has a low score or not." + (< gnus-score gnus-summary-default-score)) + + (defun gnus-agent-high-scored-p () + "Say whether an article has a high score or not." + (> gnus-score gnus-summary-default-score)) + + (defun gnus-category-make-function (cat) + "Make a function from category CAT." + `(lambda () ,(gnus-category-make-function-1 cat))) + + (defun gnus-agent-true () + "Return t." + t) + + (defun gnus-agent-false () + "Return nil." + nil) + + (defun gnus-category-make-function-1 (cat) + "Make a function from category CAT." + (cond + ;; Functions are just returned as is. + ((or (symbolp cat) + (gnus-functionp cat)) + `(,(or (cdr (assq cat gnus-category-predicate-alist)) + cat))) + ;; More complex category. + ((consp cat) + `(,(cond + ((memq (car cat) '(& and)) + 'and) + ((memq (car cat) '(| or)) + 'or) + ((memq (car cat) gnus-category-not) + 'not)) + ,@(mapcar 'gnus-category-make-function-1 (cdr cat)))) + (t + (error "Unknown category type: %s" cat)))) + + (defun gnus-get-predicate (predicate) + "Return the predicate for CATEGORY." + (or (cdr (assoc predicate gnus-category-predicate-cache)) + (cdar (push (cons predicate + (gnus-category-make-function predicate)) + gnus-category-predicate-cache)))) + + (defun gnus-group-category (group) + "Return the category GROUP belongs to." + (unless gnus-category-group-cache + (setq gnus-category-group-cache (gnus-make-hashtable 1000)) + (let ((cs gnus-category-alist) + groups cat) + (while (setq cat (pop cs)) + (setq groups (cadddr cat)) + (while groups + (gnus-sethash (pop groups) cat gnus-category-group-cache))))) + (or (gnus-gethash group gnus-category-group-cache) + (assq 'default gnus-category-alist))) + + (defun gnus-agent-expire () + "Expire all old articles." + (interactive) + (let ((methods gnus-agent-covered-methods) + (alist (cdr gnus-newsrc-alist)) + gnus-command-method ofiles info method file group) + (while (setq gnus-command-method (pop methods)) + (setq ofiles (nconc ofiles (gnus-agent-expire-directory + (gnus-agent-directory))))) + (while (setq info (pop alist)) + (when (and (gnus-agent-method-p + (setq gnus-command-method + (gnus-find-method-for-group + (setq group (gnus-info-group info))))) + (member + (setq file + (concat + (gnus-agent-directory) + (gnus-agent-group-path group) "/.overview")) + ofiles)) + (setq ofiles (delete file ofiles)) + (gnus-agent-expire-group file group))) + (while ofiles + (gnus-agent-expire-group (pop ofiles))))) + + (defun gnus-agent-expire-directory (dir) + "Expire all groups in DIR recursively." + (when (file-directory-p dir) + (let ((files (directory-files dir t)) + file ofiles) + (while (setq file (pop files)) + (cond + ((member (file-name-nondirectory file) '("." "..")) + ;; Do nothing. + ) + ((file-directory-p file) + ;; Recurse. + (setq ofiles (nconc ofiles (gnus-agent-expire-directory file)))) + ((string-match "\\.overview$" file) + ;; Expire group. + (push file ofiles)))) + ofiles))) + + (defun gnus-agent-expire-group (overview &optional group) + "Expire articles in OVERVIEW." + (gnus-message 5 "Expiring %s..." overview) + (let ((odate (- (gnus-time-to-day (current-time)) 4)) + (dir (file-name-directory overview)) + (info (when group (gnus-get-info group))) + headers article file point unreads) + (gnus-agent-load-alist nil dir) + (when info + (setq unreads + (nconc + (gnus-list-of-unread-articles group) + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant (gnus-info-marks info))))))) + (nnheader-temp-write overview + (insert-file-contents overview) + (goto-char (point-min)) + (while (not (eobp)) + (setq point (point)) + (condition-case () + (setq headers (inline (nnheader-parse-nov))) + (error + (goto-char point) + (gnus-delete-line) + (setq headers nil))) + (when headers + (unless (memq (setq article (mail-header-number headers)) unreads) + (if (not (< (inline + (gnus-time-to-day + (inline (nnmail-date-to-time + (mail-header-date headers))))) + odate)) + (forward-line 1) + (gnus-delete-line) + (setq gnus-agent-article-alist + (delq (assq article gnus-agent-article-alist) + gnus-agent-article-alist)) + (when (file-exists-p + (setq file (concat dir (number-to-string article)))) + (delete-file file)))))) + (gnus-agent-save-alist nil nil nil dir)))) + + (provide 'gnus-agent) + + ;;; gnus-agent.el ends here *** pub/qgnus/lisp/gnus-cite.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-cite.el Sat Sep 13 21:56:41 1997 *************** *** 107,113 **** :type 'regexp) (defcustom gnus-cite-attribution-suffix ! "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ ]*$" "Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite --- 107,113 ---- :type 'regexp) (defcustom gnus-cite-attribution-suffix ! "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ \t]*$" "Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite *************** *** 449,457 **** If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (append (gnus-article-hidden-arg) (list 'force))) ! (setq gnus-cited-text-button-line-format-spec ! (gnus-parse-format gnus-cited-text-button-line-format ! gnus-cited-text-button-line-format-alist t)) (save-excursion (set-buffer gnus-article-buffer) (cond --- 449,455 ---- If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (append (gnus-article-hidden-arg) (list 'force))) ! (gnus-set-format 'cited-text-button t) (save-excursion (set-buffer gnus-article-buffer) (cond *** pub/qgnus/lisp/gnus-demon.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-demon.el Sat Sep 13 21:56:42 1997 *************** *** 105,113 **** "Initialize the Gnus daemon." (interactive) (gnus-demon-cancel) ! (if (null gnus-demon-handlers) ! () ; Nothing to do. ! ;; Set up timer. (setq gnus-demon-timer (nnheader-run-at-time gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) --- 105,112 ---- "Initialize the Gnus daemon." (interactive) (gnus-demon-cancel) ! (when gnus-demon-handlers ! ;; Set up the timer. (setq gnus-demon-timer (nnheader-run-at-time gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) *************** *** 130,136 **** (when gnus-demon-timer (nnheader-cancel-timer gnus-demon-timer)) (setq gnus-demon-timer nil ! gnus-use-demon nil) (condition-case () (nnheader-cancel-function-timers 'gnus-demon) (error t))) --- 129,136 ---- (when gnus-demon-timer (nnheader-cancel-timer gnus-demon-timer)) (setq gnus-demon-timer nil ! gnus-use-demon nil ! gnus-demon-idle-has-been-called nil) (condition-case () (nnheader-cancel-function-timers 'gnus-demon) (error t))) *** pub/qgnus/lisp/gnus-dup.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-dup.el Sat Sep 13 21:56:42 1997 *************** *** 118,124 **** (while (setq datum (pop data)) (when (and (not (gnus-data-pseudo-p datum)) (> (gnus-data-number datum) 0) ! (gnus-data-read-p datum) (not (= (gnus-data-mark datum) gnus-canceled-mark)) (setq msgid (mail-header-id (gnus-data-header datum))) (not (nnheader-fake-message-id-p msgid)) --- 118,124 ---- (while (setq datum (pop data)) (when (and (not (gnus-data-pseudo-p datum)) (> (gnus-data-number datum) 0) ! (not (memq (gnus-data-number datum) gnus-newsgroup-unreads)) (not (= (gnus-data-mark datum) gnus-canceled-mark)) (setq msgid (mail-header-id (gnus-data-header datum))) (not (nnheader-fake-message-id-p msgid)) *** pub/qgnus/lisp/gnus-group.el Sat Sep 13 18:09:18 1997 --- qgnus/lisp/gnus-group.el Sat Sep 13 21:56:43 1997 *************** *** 1052,1058 **** (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-method ! (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string --- 1052,1058 ---- (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-method ! (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ; (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string *************** *** 1198,1207 **** (save-excursion (set-buffer gnus-group-buffer) (let* ((gformat (or gnus-group-mode-line-format-spec ! (setq gnus-group-mode-line-format-spec ! (gnus-parse-format ! gnus-group-mode-line-format ! gnus-group-mode-line-format-alist)))) (gnus-tmp-news-server (cadr gnus-select-method)) (gnus-tmp-news-method (car gnus-select-method)) (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) --- 1198,1204 ---- (save-excursion (set-buffer gnus-group-buffer) (let* ((gformat (or gnus-group-mode-line-format-spec ! (gnus-set-format 'group-mode))) (gnus-tmp-news-server (cadr gnus-select-method)) (gnus-tmp-news-method (car gnus-select-method)) (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) *************** *** 1447,1466 **** (let ((group (gnus-group-group-name))) (and group (list group)))))) ! (defun gnus-group-iterate (arg function) "Iterate FUNCTION over all process/prefixed groups. ! FUNCTION will be called with the group name as the paremeter ! and with point over the group in question." (let ((groups (gnus-group-process-prefix arg)) ! (window (selected-window)) ! group) (while (setq group (pop groups)) (select-window window) (gnus-group-remove-mark group) (save-selected-window ! (save-excursion ! (funcall function group)))))) ! (put 'gnus-group-iterate 'lisp-indent-function 1) ;; Selecting groups. --- 1444,1464 ---- (let ((group (gnus-group-group-name))) (and group (list group)))))) ! ;;;!!! All the variables below should be gensymmed. ! (defun gnus-group-iterate (arg gnus-group-iterate-function) "Iterate FUNCTION over all process/prefixed groups. ! FUNCTION will be called with the group name as the paremeter ! and with point over the group in question." (let ((groups (gnus-group-process-prefix arg)) ! (window (selected-window)) ! group) (while (setq group (pop groups)) (select-window window) (gnus-group-remove-mark group) (save-selected-window ! (save-excursion ! (funcall function group)))))) ! (put 'gnus-group-iterate 'lisp-indent-function 1) ;; Selecting groups. *** pub/qgnus/lisp/gnus-int.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-int.el Sat Sep 13 21:56:43 1997 *************** *** 134,140 **** (error "Attempted use of a nil select method")) (when (stringp method) (setq method (gnus-server-to-method method))) ! (let ((func (intern (format "%s-%s" (car method) function)))) ;; If the functions isn't bound, we require the backend in ;; question. (unless (fboundp func) --- 134,143 ---- (error "Attempted use of a nil select method")) (when (stringp method) (setq method (gnus-server-to-method method))) ! (let ((func (intern (format "%s-%s" (if gnus-agent ! (gnus-agent-get-function method) ! (car method)) ! function)))) ;; If the functions isn't bound, we require the backend in ;; question. (unless (fboundp func) *************** *** 150,160 **** ;;; Interface functions to the backends. ;;; ! (defun gnus-open-server (method) ! "Open a connection to METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((elem (assoc method gnus-opened-servers))) ;; If this method was previously denied, we just return nil. (if (eq (nth 1 elem) 'denied) (progn --- 153,163 ---- ;;; Interface functions to the backends. ;;; ! (defun gnus-open-server (gnus-command-method) ! "Open a connection to GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (let ((elem (assoc gnus-command-method gnus-opened-servers))) ;; If this method was previously denied, we just return nil. (if (eq (nth 1 elem) 'denied) (progn *************** *** 162,298 **** nil) ;; Open the server. (let ((result ! (funcall (gnus-get-function method 'open-server) ! (nth 1 method) (nthcdr 2 method)))) ;; If this hasn't been opened before, we add it to the list. (unless elem ! (setq elem (list method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. (setcar (cdr elem) (if result 'ok 'denied)) ;; Return the result from the "open" call. result)))) ! (defun gnus-close-server (method) ! "Close the connection to METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'close-server) (nth 1 method))) ! ! (defun gnus-request-list (method) ! "Request the active file from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-list) (nth 1 method))) ! ! (defun gnus-request-list-newsgroups (method) ! "Request the newsgroups file from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) ! ! (defun gnus-request-newgroups (date method) ! "Request all new groups since DATE from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((func (gnus-get-function method 'request-newgroups t))) (when func ! (funcall func date (nth 1 method))))) ! (defun gnus-server-opened (method) ! "Check whether a connection to METHOD has been opened." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (inline (gnus-get-function method 'server-opened)) (nth 1 method))) ! ! (defun gnus-status-message (method) ! "Return the status message from METHOD. ! If METHOD is a string, it is interpreted as a group name. The method this group uses will be queried." ! (let ((method (if (stringp method) (gnus-find-method-for-group method) ! method))) ! (funcall (gnus-get-function method 'status-message) (nth 1 method)))) ! ! (defun gnus-request-regenerate (method) ! "Request a data generation from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-regenerate) (nth 1 method))) ! (defun gnus-request-group (group &optional dont-check method) "Request GROUP. If DONT-CHECK, no information is required." ! (let ((method (or method (inline (gnus-find-method-for-group group))))) ! (when (stringp method) ! (setq method (inline (gnus-server-to-method method)))) ! (funcall (inline (gnus-get-function method 'request-group)) ! (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-list-active-group (group) "Request active information on GROUP." ! (let ((method (gnus-find-method-for-group group)) (func 'list-active-group)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) ! (gnus-group-real-name group) (nth 1 method))))) (defun gnus-request-group-description (group) "Request a description of GROUP." ! (let ((method (gnus-find-method-for-group group)) (func 'request-group-description)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) ! (gnus-group-real-name group) (nth 1 method))))) (defun gnus-close-group (group) "Request the GROUP be closed." ! (let ((method (inline (gnus-find-method-for-group group)))) ! (funcall (gnus-get-function method 'close-group) ! (gnus-group-real-name group) (nth 1 method)))) (defun gnus-retrieve-headers (articles group &optional fetch-old) "Request headers for ARTICLES in GROUP. If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." ! (let ((method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old) ! (funcall (gnus-get-function method 'retrieve-headers) ! articles (gnus-group-real-name group) (nth 1 method) ! fetch-old)))) ! ! (defun gnus-retrieve-groups (groups method) ! "Request active information on GROUPS from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) (defun gnus-request-type (group &optional article) "Return the type (`post' or `mail') of GROUP (and ARTICLE)." ! (let ((method (gnus-find-method-for-group group))) ! (if (not (gnus-check-backend-function 'request-type (car method))) 'unknown ! (funcall (gnus-get-function method 'request-type) (gnus-group-real-name group) article)))) (defun gnus-request-update-mark (group article mark) "Return the type (`post' or `mail') of GROUP (and ARTICLE)." ! (let ((method (gnus-find-method-for-group group))) ! (if (not (gnus-check-backend-function 'request-update-mark (car method))) mark ! (funcall (gnus-get-function method 'request-update-mark) (gnus-group-real-name group) article mark)))) (defun gnus-request-article (article group &optional buffer) "Request the ARTICLE in GROUP. ARTICLE can either be an article number or an article Message-ID. If BUFFER, insert the article in that group." ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-article) ! article (gnus-group-real-name group) (nth 1 method) buffer))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." ! (let* ((method (gnus-find-method-for-group group)) ! (head (gnus-get-function method 'request-head t)) res clean-up) (cond ;; Check the cache. --- 165,324 ---- nil) ;; Open the server. (let ((result ! (funcall (gnus-get-function gnus-command-method 'open-server) ! (nth 1 gnus-command-method) ! (nthcdr 2 gnus-command-method)))) ;; If this hasn't been opened before, we add it to the list. (unless elem ! (setq elem (list gnus-command-method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. (setcar (cdr elem) (if result 'ok 'denied)) ;; Return the result from the "open" call. result)))) ! (defun gnus-close-server (gnus-command-method) ! "Close the connection to GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'close-server) ! (nth 1 gnus-command-method))) ! ! (defun gnus-request-list (gnus-command-method) ! "Request the active file from GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'request-list) ! (nth 1 gnus-command-method))) ! ! (defun gnus-request-list-newsgroups (gnus-command-method) ! "Request the newsgroups file from GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) ! (nth 1 gnus-command-method))) ! ! (defun gnus-request-newgroups (date gnus-command-method) ! "Request all new groups since DATE from GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) (when func ! (funcall func date (nth 1 gnus-command-method))))) ! (defun gnus-server-opened (gnus-command-method) ! "Check whether a connection to GNUS-COMMAND-METHOD has been opened." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (inline (gnus-get-function gnus-command-method 'server-opened)) ! (nth 1 gnus-command-method))) ! ! (defun gnus-status-message (gnus-command-method) ! "Return the status message from GNUS-COMMAND-METHOD. ! If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method this group uses will be queried." ! (let ((gnus-command-method ! (if (stringp gnus-command-method) ! (gnus-find-method-for-group gnus-command-method) ! gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'status-message) ! (nth 1 gnus-command-method)))) ! ! (defun gnus-request-regenerate (gnus-command-method) ! "Request a data generation from GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'request-regenerate) ! (nth 1 gnus-command-method))) ! (defun gnus-request-group (group &optional dont-check gnus-command-method) "Request GROUP. If DONT-CHECK, no information is required." ! (let ((gnus-command-method ! (or gnus-command-method (inline (gnus-find-method-for-group group))))) ! (when (stringp gnus-command-method) ! (setq gnus-command-method ! (inline (gnus-server-to-method gnus-command-method)))) ! (funcall (inline (gnus-get-function gnus-command-method 'request-group)) ! (gnus-group-real-name group) (nth 1 gnus-command-method) ! dont-check))) (defun gnus-list-active-group (group) "Request active information on GROUP." ! (let ((gnus-command-method (gnus-find-method-for-group group)) (func 'list-active-group)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function gnus-command-method func) ! (gnus-group-real-name group) (nth 1 gnus-command-method))))) (defun gnus-request-group-description (group) "Request a description of GROUP." ! (let ((gnus-command-method (gnus-find-method-for-group group)) (func 'request-group-description)) (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function gnus-command-method func) ! (gnus-group-real-name group) (nth 1 gnus-command-method))))) (defun gnus-close-group (group) "Request the GROUP be closed." ! (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) ! (funcall (gnus-get-function gnus-command-method 'close-group) ! (gnus-group-real-name group) (nth 1 gnus-command-method)))) (defun gnus-retrieve-headers (articles group &optional fetch-old) "Request headers for ARTICLES in GROUP. If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." ! (let ((gnus-command-method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old) ! (funcall (gnus-get-function gnus-command-method 'retrieve-headers) ! articles (gnus-group-real-name group) ! (nth 1 gnus-command-method) fetch-old)))) ! ! (defun gnus-retrieve-articles (articles group) ! "Request ARTICLES in GROUP." ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'retrieve-articles) ! articles (gnus-group-real-name group) ! (nth 1 gnus-command-method)))) ! ! (defun gnus-retrieve-groups (groups gnus-command-method) ! "Request active information on GROUPS from GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'retrieve-groups) ! groups (nth 1 gnus-command-method))) (defun gnus-request-type (group &optional article) "Return the type (`post' or `mail') of GROUP (and ARTICLE)." ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (if (not (gnus-check-backend-function ! 'request-type (car gnus-command-method))) 'unknown ! (funcall (gnus-get-function gnus-command-method 'request-type) (gnus-group-real-name group) article)))) (defun gnus-request-update-mark (group article mark) "Return the type (`post' or `mail') of GROUP (and ARTICLE)." ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (if (not (gnus-check-backend-function ! 'request-update-mark (car gnus-command-method))) mark ! (funcall (gnus-get-function gnus-command-method 'request-update-mark) (gnus-group-real-name group) article mark)))) (defun gnus-request-article (article group &optional buffer) "Request the ARTICLE in GROUP. ARTICLE can either be an article number or an article Message-ID. If BUFFER, insert the article in that group." ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-article) ! article (gnus-group-real-name group) ! (nth 1 gnus-command-method) buffer))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." ! (let* ((gnus-command-method (gnus-find-method-for-group group)) ! (head (gnus-get-function gnus-command-method 'request-head t)) res clean-up) (cond ;; Check the cache. *************** *** 304,310 **** ;; Use `head' function. ((fboundp head) (setq res (funcall head article (gnus-group-real-name group) ! (nth 1 method)))) ;; Use `article' function. (t (setq res (gnus-request-article article group) --- 330,336 ---- ;; Use `head' function. ((fboundp head) (setq res (funcall head article (gnus-group-real-name group) ! (nth 1 gnus-command-method)))) ;; Use `article' function. (t (setq res (gnus-request-article article group) *************** *** 320,379 **** (defun gnus-request-body (article group) "Request the body of ARTICLE in GROUP." ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-body) ! article (gnus-group-real-name group) (nth 1 method)))) ! ! (defun gnus-request-post (method) ! "Post the current buffer using METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-post) (nth 1 method))) ! ! (defun gnus-request-scan (group method) ! "Request a SCAN being performed in GROUP from METHOD. ! If GROUP is nil, all groups on METHOD are scanned." ! (let ((method (if group (gnus-find-method-for-group group) method)) ! (gnus-inhibit-demon t)) ! (funcall (gnus-get-function method 'request-scan) ! (and group (gnus-group-real-name group)) (nth 1 method)))) ! (defsubst gnus-request-update-info (info method) ! "Request that METHOD update INFO." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (when (gnus-check-backend-function 'request-update-info (car method)) ! (funcall (gnus-get-function method 'request-update-info) (gnus-group-real-name (gnus-info-group info)) ! info (nth 1 method)))) (defun gnus-request-expire-articles (articles group &optional force) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-expire-articles) ! articles (gnus-group-real-name group) (nth 1 method) force))) (defun gnus-request-move-article (article group server accept-function &optional last) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-move-article) article (gnus-group-real-name group) ! (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group method &optional last) ;; Make sure there's a newline at the end of the article. ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (when (and (not method) (stringp group)) ! (setq method (gnus-group-name-to-method group))) (goto-char (point-max)) (unless (bolp) (insert "\n")) ! (let ((func (car (or method (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) ! (cadr method) last))) (defun gnus-request-replace-article (article group buffer) --- 346,411 ---- (defun gnus-request-body (article group) "Request the body of ARTICLE in GROUP." ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-body) ! article (gnus-group-real-name group) ! (nth 1 gnus-command-method)))) ! (defun gnus-request-post (gnus-command-method) ! "Post the current buffer using GNUS-COMMAND-METHOD." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (funcall (gnus-get-function gnus-command-method 'request-post) ! (nth 1 gnus-command-method))) ! ! (defun gnus-request-scan (group gnus-command-method) ! "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. ! If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." ! (let ((gnus-command-method ! (if group (gnus-find-method-for-group group) gnus-command-method)) ! (gnus-inhibit-demon t)) ! (funcall (gnus-get-function gnus-command-method 'request-scan) ! (and group (gnus-group-real-name group)) ! (nth 1 gnus-command-method)))) ! ! (defsubst gnus-request-update-info (info gnus-command-method) ! "Request that GNUS-COMMAND-METHOD update INFO." ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (when (gnus-check-backend-function ! 'request-update-info (car gnus-command-method)) ! (funcall (gnus-get-function gnus-command-method 'request-update-info) (gnus-group-real-name (gnus-info-group info)) ! info (nth 1 gnus-command-method)))) (defun gnus-request-expire-articles (articles group &optional force) ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-expire-articles) ! articles (gnus-group-real-name group) (nth 1 gnus-command-method) force))) (defun gnus-request-move-article (article group server accept-function &optional last) ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-move-article) article (gnus-group-real-name group) ! (nth 1 gnus-command-method) accept-function last))) ! (defun gnus-request-accept-article (group gnus-command-method &optional last) ;; Make sure there's a newline at the end of the article. ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (when (and (not gnus-command-method) (stringp group)) ! (setq gnus-command-method (gnus-group-name-to-method group))) (goto-char (point-max)) (unless (bolp) (insert "\n")) ! (let ((func (car (or gnus-command-method ! (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) ! (cadr gnus-command-method) last))) (defun gnus-request-replace-article (article group buffer) *************** *** 382,434 **** article (gnus-group-real-name group) buffer))) (defun gnus-request-associate-buffer (group) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-associate-buffer) (gnus-group-real-name group)))) (defun gnus-request-restore-buffer (article group) "Request a new buffer restored to the state of ARTICLE." ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-restore-buffer) ! article (gnus-group-real-name group) (nth 1 method)))) ! ! (defun gnus-request-create-group (group &optional method args) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((method (or method (gnus-find-method-for-group group)))) ! (funcall (gnus-get-function method 'request-create-group) ! (gnus-group-real-name group) (nth 1 method) args))) (defun gnus-request-delete-group (group &optional force) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-delete-group) ! (gnus-group-real-name group) force (nth 1 method)))) (defun gnus-request-rename-group (group new-name) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-rename-group) (gnus-group-real-name group) ! (gnus-group-real-name new-name) (nth 1 method)))) (defun gnus-close-backends () ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) (gnus-inhibit-demon t) ! func method) ! (while (setq method (pop methods)) (when (fboundp (setq func (intern ! (concat (car method) "-request-close")))) (funcall func))))) ! (defun gnus-asynchronous-p (method) ! (let ((func (gnus-get-function method 'asynchronous-p t))) (when (fboundp func) (funcall func)))) ! (defun gnus-remove-denial (method) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let* ((elem (assoc method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. (when (eq status 'denied) --- 414,469 ---- article (gnus-group-real-name group) buffer))) (defun gnus-request-associate-buffer (group) ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-associate-buffer) (gnus-group-real-name group)))) (defun gnus-request-restore-buffer (article group) "Request a new buffer restored to the state of ARTICLE." ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-restore-buffer) ! article (gnus-group-real-name group) ! (nth 1 gnus-command-method)))) ! ! (defun gnus-request-create-group (group &optional gnus-command-method args) ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (let ((gnus-command-method ! (or gnus-command-method (gnus-find-method-for-group group)))) ! (funcall (gnus-get-function gnus-command-method 'request-create-group) ! (gnus-group-real-name group) (nth 1 gnus-command-method) args))) (defun gnus-request-delete-group (group &optional force) ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-delete-group) ! (gnus-group-real-name group) force (nth 1 gnus-command-method)))) (defun gnus-request-rename-group (group new-name) ! (let ((gnus-command-method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function gnus-command-method 'request-rename-group) (gnus-group-real-name group) ! (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) (defun gnus-close-backends () ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) (gnus-inhibit-demon t) ! func gnus-command-method) ! (while (setq gnus-command-method (pop methods)) (when (fboundp (setq func (intern ! (concat (car gnus-command-method) ! "-request-close")))) (funcall func))))) ! (defun gnus-asynchronous-p (gnus-command-method) ! (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t))) (when (fboundp func) (funcall func)))) ! (defun gnus-remove-denial (gnus-command-method) ! (when (stringp gnus-command-method) ! (setq gnus-command-method (gnus-server-to-method gnus-command-method))) ! (let* ((elem (assoc gnus-command-method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. (when (eq status 'denied) *** pub/qgnus/lisp/gnus-picon.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-picon.el Sat Sep 13 21:56:44 1997 *************** *** 130,136 **** (defcustom gnus-picons-piconsearch-url nil "*The url to query for picons. Setting this to nil will disable it. ! The only plublicly available address currently known is http://www.cs.indiana.edu:800/piconsearch. If you know of any other, please tell me so that we can list it." :type '(choice (const :tag "Disable" :value nil) --- 130,136 ---- (defcustom gnus-picons-piconsearch-url nil "*The url to query for picons. Setting this to nil will disable it. ! The only publicly available address currently known is http://www.cs.indiana.edu:800/piconsearch. If you know of any other, please tell me so that we can list it." :type '(choice (const :tag "Disable" :value nil) *** pub/qgnus/lisp/gnus-salt.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-salt.el Sat Sep 13 21:56:44 1997 *************** *** 70,94 **** (unless gnus-pick-mode-map (setq gnus-pick-mode-map (make-sparse-keymap)) ! (gnus-define-keys ! gnus-pick-mode-map ! "t" gnus-uu-mark-thread ! "T" gnus-uu-unmark-thread ! " " gnus-pick-next-page ! "u" gnus-summary-unmark-as-processable ! "U" gnus-summary-unmark-all-processable ! "v" gnus-uu-mark-over ! "r" gnus-uu-mark-region ! "R" gnus-uu-unmark-region ! "e" gnus-uu-mark-by-regexp ! "E" gnus-uu-mark-by-regexp ! "b" gnus-uu-mark-buffer ! "B" gnus-uu-unmark-buffer ! "." gnus-pick-article ! gnus-down-mouse-2 gnus-pick-mouse-pick-region ! ;;gnus-mouse-2 gnus-pick-mouse-pick ! "X" gnus-pick-start-reading ! "\r" gnus-pick-start-reading)) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) --- 70,93 ---- (unless gnus-pick-mode-map (setq gnus-pick-mode-map (make-sparse-keymap)) ! (gnus-define-keys gnus-pick-mode-map ! "t" gnus-uu-mark-thread ! "T" gnus-uu-unmark-thread ! " " gnus-pick-next-page ! "u" gnus-summary-unmark-as-processable ! "U" gnus-summary-unmark-all-processable ! "v" gnus-uu-mark-over ! "r" gnus-uu-mark-region ! "R" gnus-uu-unmark-region ! "e" gnus-uu-mark-by-regexp ! "E" gnus-uu-mark-by-regexp ! "b" gnus-uu-mark-buffer ! "B" gnus-uu-unmark-buffer ! "." gnus-pick-article ! gnus-down-mouse-2 gnus-pick-mouse-pick-region ! ;;gnus-mouse-2 gnus-pick-mouse-pick ! "X" gnus-pick-start-reading ! "\r" gnus-pick-start-reading)) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) *************** *** 445,456 **** (defun gnus-tree-mode () "Major mode for displaying thread trees." (interactive) ! (setq gnus-tree-mode-line-format-spec ! (gnus-parse-format gnus-tree-mode-line-format ! gnus-summary-mode-line-format-alist)) ! (setq gnus-tree-line-format-spec ! (gnus-parse-format gnus-tree-line-format ! gnus-tree-line-format-alist t)) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) (kill-all-local-variables) --- 444,451 ---- (defun gnus-tree-mode () "Major mode for displaying thread trees." (interactive) ! (gnus-set-format 'tree-mode) ! (gnus-set-format 'tree t) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) (kill-all-local-variables) *** pub/qgnus/lisp/gnus-spec.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-spec.el Sat Sep 13 21:56:44 1997 *************** *** 525,530 **** --- 525,538 ---- (gnus-dribble-enter " ") (gnus-message 7 "Compiling user specs...done")))) + (defun gnus-set-format (type &optional insertable) + (set (intern (format "gnus-%s-line-format-spec" type)) + (gnus-parse-format + (symbol-value (intern (format "gnus-%s-line-format" type))) + (symbol-value (intern (format "gnus-%s-line-format-alist" type))) + insertable))) + + (provide 'gnus-spec) ;;; gnus-spec.el ends here *** pub/qgnus/lisp/gnus-srvr.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-srvr.el Sat Sep 13 21:56:45 1997 *************** *** 39,47 **** (defconst gnus-server-line-format " {%(%h:%w%)} %s\n" "Format of server lines. It works along the same lines as a normal formatting string, ! with some simple extensions.") ! (defvar gnus-server-mode-line-format "Gnus List of servers" "The format specification for the server mode line.") (defvar gnus-server-exit-hook nil --- 39,54 ---- (defconst gnus-server-line-format " {%(%h:%w%)} %s\n" "Format of server lines. It works along the same lines as a normal formatting string, ! with some simple extensions. ! The following specs are understood: ! ! %h backend ! %n name ! %w address ! %s status") ! ! (defvar gnus-server-mode-line-format "Gnus: %%b" "The format specification for the server mode line.") (defvar gnus-server-exit-hook nil *************** *** 108,135 **** (setq gnus-server-mode-map (make-sparse-keymap)) (suppress-keymap gnus-server-mode-map) ! (gnus-define-keys ! gnus-server-mode-map ! " " gnus-server-read-server ! "\r" gnus-server-read-server ! gnus-mouse-2 gnus-server-pick-server ! "q" gnus-server-exit ! "l" gnus-server-list-servers ! "k" gnus-server-kill-server ! "y" gnus-server-yank-server ! "c" gnus-server-copy-server ! "a" gnus-server-add-server ! "e" gnus-server-edit-server ! "s" gnus-server-scan-server ! ! "O" gnus-server-open-server ! "\M-o" gnus-server-open-all-servers ! "C" gnus-server-close-server ! "\M-c" gnus-server-close-all-servers ! "D" gnus-server-deny-server ! "R" gnus-server-remove-denials ! "g" gnus-server-regenerate-server "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) --- 115,141 ---- (setq gnus-server-mode-map (make-sparse-keymap)) (suppress-keymap gnus-server-mode-map) ! (gnus-define-keys gnus-server-mode-map ! " " gnus-server-read-server ! "\r" gnus-server-read-server ! gnus-mouse-2 gnus-server-pick-server ! "q" gnus-server-exit ! "l" gnus-server-list-servers ! "k" gnus-server-kill-server ! "y" gnus-server-yank-server ! "c" gnus-server-copy-server ! "a" gnus-server-add-server ! "e" gnus-server-edit-server ! "s" gnus-server-scan-server ! ! "O" gnus-server-open-server ! "\M-o" gnus-server-open-all-servers ! "C" gnus-server-close-server ! "\M-c" gnus-server-close-all-servers ! "D" gnus-server-deny-server ! "R" gnus-server-remove-denials ! "g" gnus-server-regenerate-server "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) *************** *** 195,206 **** (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () ! (setq gnus-server-mode-line-format-spec ! (gnus-parse-format gnus-server-mode-line-format ! gnus-server-mode-line-format-alist)) ! (setq gnus-server-line-format-spec ! (gnus-parse-format gnus-server-line-format ! gnus-server-line-format-alist t)) (let ((alist gnus-server-alist) (buffer-read-only nil) (opened gnus-opened-servers) --- 201,208 ---- (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () ! (gnus-set-format 'server-mode) ! (gnus-set-format 'server t) (let ((alist gnus-server-alist) (buffer-read-only nil) (opened gnus-opened-servers) *************** *** 638,644 **** (defun gnus-browse-read-group (&optional no-article) "Enter the group at the current line." (interactive) ! (let ((group (gnus-group-real-name (gnus-browse-group-name)))) (unless (gnus-group-read-ephemeral-group group gnus-browse-current-method nil (cons (current-buffer) 'browse)) --- 640,646 ---- (defun gnus-browse-read-group (&optional no-article) "Enter the group at the current line." (interactive) ! (let ((group (gnus-browse-group-name))) (unless (gnus-group-read-ephemeral-group group gnus-browse-current-method nil (cons (current-buffer) 'browse)) *** pub/qgnus/lisp/gnus-start.el Sat Sep 13 15:43:22 1997 --- qgnus/lisp/gnus-start.el Sat Sep 13 21:56:45 1997 *************** *** 337,342 **** --- 337,348 ---- :group 'gnus-start :type 'hook) + (defcustom gnus-before-startup-hook nil + "A hook called at before startup. + This hook is called as the first thing when Gnus is started." + :group 'gnus-start + :type 'hook) + (defcustom gnus-started-hook nil "A hook called as the last thing after startup." :group 'gnus-start *************** *** 642,647 **** --- 648,654 ---- (gnus-splash) (gnus-clear-system) + (run-hooks 'gnus-before-startup-hook) (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) *************** *** 1621,1629 **** 1.2 "Cannot read partial active file from %s server." (car method))) ((eq list-type 'active) ! (gnus-active-to-gnus-format method gnus-active-hashtb)) (t ! (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) ((null method) t) (t --- 1628,1638 ---- 1.2 "Cannot read partial active file from %s server." (car method))) ((eq list-type 'active) ! (gnus-active-to-gnus-format ! method gnus-active-hashtb nil t)) (t ! (gnus-groups-to-gnus-format ! method gnus-active-hashtb t)))))) ((null method) t) (t *************** *** 1632,1638 **** (gnus-error 1 "Cannot read active file from %s server" (car method))) (gnus-message 5 mesg) ! (gnus-active-to-gnus-format method gnus-active-hashtb) ;; We mark this active file as read. (push method gnus-have-read-active-file) (gnus-message 5 "%sdone" mesg)))))) --- 1641,1647 ---- (gnus-error 1 "Cannot read active file from %s server" (car method))) (gnus-message 5 mesg) ! (gnus-active-to-gnus-format method gnus-active-hashtb nil t) ;; We mark this active file as read. (push method gnus-have-read-active-file) (gnus-message 5 "%sdone" mesg)))))) *************** *** 1647,1653 **** gnus-ignored-newsgroups)) ;; Read an active file and place the results in `gnus-active-hashtb'. ! (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) (unless method (setq method gnus-select-method)) (let ((cur (current-buffer)) --- 1656,1663 ---- gnus-ignored-newsgroups)) ;; Read an active file and place the results in `gnus-active-hashtb'. ! (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors ! real-active) (unless method (setq method gnus-select-method)) (let ((cur (current-buffer)) *************** *** 1676,1681 **** --- 1686,1695 ---- (while (re-search-backward "[][';?()#]" nil t) (insert ?\\)) + ;; Let the Gnus agent save the active file. + (when (and gnus-agent real-active) + (gnus-agent-save-active method)) + ;; If these are groups from a foreign select method, we insert the ;; group prefix in front of the group names. (when (not (gnus-server-equal *************** *** 1724,1730 **** (widen) (forward-line 1))))) ! (defun gnus-groups-to-gnus-format (method &optional hashtb) ;; Parse a "groups" active file. (let ((cur (current-buffer)) (hashtb (or hashtb --- 1738,1744 ---- (widen) (forward-line 1))))) ! (defun gnus-groups-to-gnus-format (method &optional hashtb real-active) ;; Parse a "groups" active file. (let ((cur (current-buffer)) (hashtb (or hashtb *************** *** 1739,1744 **** --- 1753,1762 ---- (gnus-server-get-method nil gnus-select-method))) (gnus-group-prefixed-name "" method)))) + ;; Let the Gnus agent save the active file. + (when (and gnus-agent real-active) + (gnus-agent-save-groups method)) + (goto-char (point-min)) ;; We split this into to separate loops, one with the prefix ;; and one without to speed the reading up somewhat. *** pub/qgnus/lisp/gnus-sum.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/gnus-sum.el Sat Sep 13 21:56:47 1997 *************** *** 413,418 **** --- 413,428 ---- :group 'gnus-summary-marks :type 'character) + (defcustom gnus-undownloaded-mark ?@ + "*Mark used for articles that weren't downloaded." + :group 'gnus-summary-marks + :type 'character) + + (defcustom gnus-downloadable-mark ?% + "*Mark used for articles that are to be downloaded." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-score-over-mark ?+ "*Score mark used for articles with high scores." :group 'gnus-summary-marks *************** *** 870,875 **** --- 880,891 ---- (defvar gnus-newsgroup-processable nil "List of articles in the current newsgroup that can be processed.") + (defvar gnus-newsgroup-downloadable nil + "List of articles in the current newsgroup that can be processed.") + + (defvar gnus-newsgroup-undownloaded nil + "List of articles in the current newsgroup that haven't been downloaded..") + (defvar gnus-newsgroup-bookmarks nil "List of articles in the current newsgroup that have bookmarks.") *************** *** 909,914 **** --- 925,931 ---- gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed + gnus-newsgroup-downloadable gnus-newsgroup-undownloaded gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads gnus-newsgroup-prepared gnus-summary-highlight-line-function *************** *** 2153,2158 **** --- 2170,2177 ---- (defmacro gnus-article-mark (number) `(cond + ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) + ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) *************** *** 2316,2326 **** (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) (spec gnus-summary-line-format-spec) thread gnus-visual pos) (save-excursion (gnus-set-work-buffer) ! (let ((gnus-summary-line-format-spec spec)) (gnus-summary-insert-line [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) (goto-char (point-min)) --- 2335,2347 ---- (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) + (gnus-download-mark 131) (spec gnus-summary-line-format-spec) thread gnus-visual pos) (save-excursion (gnus-set-work-buffer) ! (let ((gnus-summary-line-format-spec spec) ! (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) (goto-char (point-min)) *************** *** 2332,2337 **** --- 2353,2362 ---- pos) (goto-char (point-min)) (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) + pos) + (goto-char (point-min)) + (push (cons 'download + (and (search-forward "\203" nil t) (- (point) 2))) pos))) (setq gnus-summary-mark-positions pos)))) *************** *** 3704,3709 **** --- 3729,3737 ---- ;; Removed marked articles that do not exist. (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) + ;; Let the Gnus agent mark articles as read. + (when gnus-agent + (gnus-agent-get-undownloaded-list)) ;; We might want to build some more threads first. (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov) *************** *** 4048,4111 **** (info (nth 2 entry)) (active (gnus-active group)) range) ! ;; First peel off all illegal article numbers. ! (when active ! (let ((ids articles) ! id first) ! (while (setq id (pop ids)) ! (when (and first (> id (cdr active))) ! ;; We'll end up in this situation in one particular ! ;; obscure situation. If you re-scan a group and get ! ;; a new article that is cross-posted to a different ! ;; group that has not been re-scanned, you might get ! ;; crossposted article that has a higher number than ! ;; Gnus believes possible. So we re-activate this ! ;; group as well. This might mean doing the ! ;; crossposting thingy will *increase* the number ! ;; of articles in some groups. Tsk, tsk. ! (setq active (or (gnus-activate-group group) active))) ! (when (or (> id (cdr active)) ! (< id (car active))) ! (setq articles (delq id articles)))))) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-undo-register ! `(progn ! (gnus-info-set-marks ',info ',(gnus-info-marks info) t) ! (gnus-info-set-read ',info ',(gnus-info-read info)) ! (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) ! (gnus-group-update-group ,group t)))) ! ;; If the read list is nil, we init it. ! (and active ! (null (gnus-info-read info)) ! (> (car active) 1) ! (gnus-info-set-read info (cons 1 (1- (car active))))) ! ;; Then we add the read articles to the range. ! (gnus-info-set-read ! info ! (setq range ! (gnus-add-to-range ! (gnus-info-read info) (setq articles (sort articles '<))))) ! ;; Then we have to re-compute how many unread ! ;; articles there are in this group. ! (when active ! (cond ! ((not range) ! (setq num (- (1+ (cdr active)) (car active)))) ! ((not (listp (cdr range))) ! (setq num (- (cdr active) (- (1+ (cdr range)) ! (car range))))) ! (t ! (while range ! (if (numberp (car range)) ! (setq num (1+ num)) ! (setq num (+ num (- (1+ (cdar range)) (caar range))))) ! (setq range (cdr range))) ! (setq num (- (cdr active) num)))) ! ;; Update the number of unread articles. ! (setcar entry num) ! ;; Update the group buffer. ! (gnus-group-update-group group t)))) (defun gnus-methods-equal-p (m1 m2) (let ((m1 (or m1 gnus-select-method)) --- 4076,4140 ---- (info (nth 2 entry)) (active (gnus-active group)) range) ! (when entry ! ;; First peel off all illegal article numbers. ! (when active ! (let ((ids articles) ! id first) ! (while (setq id (pop ids)) ! (when (and first (> id (cdr active))) ! ;; We'll end up in this situation in one particular ! ;; obscure situation. If you re-scan a group and get ! ;; a new article that is cross-posted to a different ! ;; group that has not been re-scanned, you might get ! ;; crossposted article that has a higher number than ! ;; Gnus believes possible. So we re-activate this ! ;; group as well. This might mean doing the ! ;; crossposting thingy will *increase* the number ! ;; of articles in some groups. Tsk, tsk. ! (setq active (or (gnus-activate-group group) active))) ! (when (or (> id (cdr active)) ! (< id (car active))) ! (setq articles (delq id articles)))))) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-undo-register ! `(progn ! (gnus-info-set-marks ',info ',(gnus-info-marks info) t) ! (gnus-info-set-read ',info ',(gnus-info-read info)) ! (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) ! (gnus-group-update-group ,group t)))) ! ;; If the read list is nil, we init it. ! (and active ! (null (gnus-info-read info)) ! (> (car active) 1) ! (gnus-info-set-read info (cons 1 (1- (car active))))) ! ;; Then we add the read articles to the range. ! (gnus-info-set-read ! info ! (setq range ! (gnus-add-to-range ! (gnus-info-read info) (setq articles (sort articles '<))))) ! ;; Then we have to re-compute how many unread ! ;; articles there are in this group. ! (when active ! (cond ! ((not range) ! (setq num (- (1+ (cdr active)) (car active)))) ! ((not (listp (cdr range))) ! (setq num (- (cdr active) (- (1+ (cdr range)) ! (car range))))) ! (t ! (while range ! (if (numberp (car range)) ! (setq num (1+ num)) ! (setq num (+ num (- (1+ (cdar range)) (caar range))))) ! (setq range (cdr range))) ! (setq num (- (cdr active) num)))) ! ;; Update the number of unread articles. ! (setcar entry num) ! ;; Update the group buffer. ! (gnus-group-update-group group t))))) (defun gnus-methods-equal-p (m1 m2) (let ((m1 (or m1 gnus-select-method)) *************** *** 4745,4751 **** (push first unread) (setq first (1+ first))) ;; Return the list of unread articles. ! (nreverse unread))) (defun gnus-list-of-read-articles (group) "Return a list of unread, unticked and non-dormant articles." --- 4774,4780 ---- (push first unread) (setq first (1+ first))) ;; Return the list of unread articles. ! (delq 0 (nreverse unread)))) (defun gnus-list-of-read-articles (group) "Return a list of unread, unticked and non-dormant articles." *************** *** 7257,7264 **** (defun gnus-summary-unmark-as-processable (n) "Remove the process mark from the next N articles. ! If N is negative, mark backward instead. The difference between N and ! the actual number of articles marked is returned." (interactive "p") (gnus-set-global-variables) (gnus-summary-mark-as-processable n t)) --- 7286,7293 ---- (defun gnus-summary-unmark-as-processable (n) "Remove the process mark from the next N articles. ! If N is negative, unmark backward instead. The difference between N and ! the actual number of articles unmarked is returned." (interactive "p") (gnus-set-global-variables) (gnus-summary-mark-as-processable n t)) *** pub/qgnus/lisp/gnus-topic.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/gnus-topic.el Sat Sep 13 21:56:48 1997 *************** *** 181,190 **** (beginning-of-line) (get-text-property (point) 'gnus-active))) ! (defun gnus-topic-find-groups (topic &optional level all) "Return entries for all visible groups in TOPIC." (let ((groups (cdr (assoc topic gnus-topic-alist))) ! info clevel unread group lowest params visible-groups entry active) (setq lowest (or lowest 1)) (setq level (or level 7)) ;; We go through the newsrc to look for matches. --- 181,190 ---- (beginning-of-line) (get-text-property (point) 'gnus-active))) ! (defun gnus-topic-find-groups (topic &optional level all lowest) "Return entries for all visible groups in TOPIC." (let ((groups (cdr (assoc topic gnus-topic-alist))) ! info clevel unread group params visible-groups entry active) (setq lowest (or lowest 1)) (setq level (or level 7)) ;; We go through the newsrc to look for matches. *************** *** 371,377 **** (erase-buffer)) ;; List dead groups? ! (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z --- 371,378 ---- (erase-buffer)) ;; List dead groups? ! (when (and (>= level gnus-level-zombie) ! (<= lowest gnus-level-zombie)) (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z *************** *** 389,408 **** (if list-topic (let ((top (gnus-topic-find-topology list-topic))) (gnus-topic-prepare-topic (cdr top) (car top) ! (or topic-level level) all)) (gnus-topic-prepare-topic gnus-topic-topology 0 ! (or topic-level level) all))) (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) (run-hooks 'gnus-group-prepare-hook)))) ! (defun gnus-topic-prepare-topic (topicl level &optional list-level all silent) "Insert TOPIC into the group buffer. If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) ! (entries (gnus-topic-find-groups (car type) list-level all)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) --- 390,412 ---- (if list-topic (let ((top (gnus-topic-find-topology list-topic))) (gnus-topic-prepare-topic (cdr top) (car top) ! (or topic-level level) all ! nil lowest)) (gnus-topic-prepare-topic gnus-topic-topology 0 ! (or topic-level level) all ! nil lowest))) (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) (run-hooks 'gnus-group-prepare-hook)))) ! (defun gnus-topic-prepare-topic (topicl level &optional list-level all silent ! lowest) "Insert TOPIC into the group buffer. If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) ! (entries (gnus-topic-find-groups (car type) list-level all lowest)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) *************** *** 418,424 **** (incf unread (gnus-topic-prepare-topic (pop topicl) (1+ level) list-level all ! (not visiblep)))) (setq end (point)) (goto-char beg) ;; Insert all the groups that belong in this topic. --- 422,428 ---- (incf unread (gnus-topic-prepare-topic (pop topicl) (1+ level) list-level all ! (not visiblep) lowest))) (setq end (point)) (goto-char beg) ;; Insert all the groups that belong in this topic. *************** *** 943,955 **** (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. ! (if (not gnus-topic-mode) ! (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) ! (setq gnus-topic-line-format-spec ! (gnus-parse-format gnus-topic-line-format ! gnus-topic-line-format-alist t)) (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) --- 947,957 ---- (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. ! (if (not gnus-topic-mode) ! (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) ! (gnus-set-format 'topic t) (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) *** pub/qgnus/lisp/gnus-util.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/gnus-util.el Sat Sep 13 21:56:48 1997 *************** *** 381,387 **** (defun gnus-date-iso8601 (header) "Convert the date field in HEADER to YYMMDDTHHMMSS" (condition-case () ! (gnus-time-iso8601 (gnus-date-get-time (mail-header-date header))) (error ""))) (defun gnus-mode-string-quote (string) --- 381,387 ---- (defun gnus-date-iso8601 (header) "Convert the date field in HEADER to YYMMDDTHHMMSS" (condition-case () ! (gnus-time-iso8601 (gnus-date-get-time header)) (error ""))) (defun gnus-mode-string-quote (string) *** pub/qgnus/lisp/gnus-win.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/gnus-win.el Sat Sep 13 21:56:48 1997 *************** *** 157,162 **** --- 157,165 ---- (vertical 1.0 (summary 0.5 point) ("*Score Words*" 1.0))) + (category + (vertical 1.0 + (category 1.0))) (compose-bounce (vertical 1.0 (article 0.5) *************** *** 186,191 **** --- 189,195 ---- (tree . gnus-tree-buffer) (score-trace . "*Score Trace*") (info . gnus-info-buffer) + (category . gnus-category-buffer) (article-copy . gnus-article-copy) (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") *** pub/qgnus/lisp/gnus-xmas.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/gnus-xmas.el Sat Sep 13 21:56:49 1997 *************** *** 56,62 **** (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") ! (defcustom gnus-xmas-logo-color-style 'flame "Color styles used for the Gnus logo." :type '(choice (const flame) (const pine) (const moss) (const irish) (const sky) (const tin) --- 56,62 ---- (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") ! (defcustom gnus-xmas-logo-color-style 'moss "Color styles used for the Gnus logo." :type '(choice (const flame) (const pine) (const moss) (const irish) (const sky) (const tin) *** pub/qgnus/lisp/gnus.el Sat Sep 13 15:48:38 1997 --- qgnus/lisp/gnus.el Sat Sep 13 21:56:50 1997 *************** *** 203,208 **** --- 203,212 ---- :group 'gnus :group 'faces) + (defgroup gnus-agent nil + "Offline support for Gnus." + :group 'gnus) + (defgroup gnus-files nil "Files used by Gnus." :group 'gnus) *************** *** 636,645 **** (defface gnus-splash-face '((((class color) (background dark)) ! (:foreground "red")) (((class color) (background light)) ! (:foreground "red")) (t ())) "Level 1 newsgroup face.") --- 640,649 ---- (defface gnus-splash-face '((((class color) (background dark)) ! (:foreground "green")) (((class color) (background light)) ! (:foreground "green")) (t ())) "Level 1 newsgroup face.") *************** *** 1155,1161 **** ("nndraft" post-mail) ("nnfolder" mail respool address) ("nngateway" none address prompt-address physical-address) ! ("nnweb" none)) "An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be the category of --- 1159,1166 ---- ("nndraft" post-mail) ("nnfolder" mail respool address) ("nngateway" none address prompt-address physical-address) ! ("nnweb" none) ! ("nnagent" post-mail)) "An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be the category of *************** *** 1397,1402 **** --- 1402,1413 ---- (defvar gnus-original-article-buffer " *Original Article*") (defvar gnus-newsgroup-name nil) + (defvar gnus-agent nil + "Whether we want to use the Gnus agent or not.") + + (defvar gnus-command-method nil + "Dynamically bound variable that says what the current backend is.") + (defvar gnus-current-select-method nil "The current method for selecting a newsgroup.") *************** *** 1434,1440 **** (expirable . expire) (killed . killed) (bookmarks . bookmark) (dormant . dormant) (scored . score) (saved . save) ! (cached . cache))) (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) --- 1445,1451 ---- (expirable . expire) (killed . killed) (bookmarks . bookmark) (dormant . dormant) (scored . score) (saved . save) ! (cached . cache) (downloadable . download))) (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) *************** *** 1576,1582 **** gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close gnus-nocem-unwanted-article-p) ! ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) ("gnus-srvr" gnus-browse-foreign-server) ("gnus-cite" :interactive t gnus-article-highlight-citation gnus-article-hide-citation-maybe --- 1587,1594 ---- gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close gnus-nocem-unwanted-article-p) ! ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info ! gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) ("gnus-cite" :interactive t gnus-article-highlight-citation gnus-article-hide-citation-maybe *************** *** 1683,1688 **** --- 1695,1704 ---- ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group gnus-async-halt-prefetch) + ("gnus-agent" gnus-open-agent gnus-agent-get-function + gnus-agent-save-groups gnus-agent-save-active) + ("gnus-agent" :interactive t + gnus-unplugged) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm)))) *************** *** 1725,1730 **** --- 1741,1747 ---- %l GroupLens score (string). %V Total thread score (number). %P The line number (number). + %O Download mark (character). %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the *************** *** 2245,2250 **** --- 2262,2276 ---- gmethod))) (setq methods (cdr methods))) methods)) + + (defun gnus-groups-from-server (server) + "Return a list of all groups that are fetched from SERVER." + (let ((alist (cdr gnus-newsrc-alist)) + info groups) + (while (setq info (pop alist)) + (when (gnus-server-equal (gnus-info-method info) server) + (push (gnus-info-group info) groups))) + (sort groups 'string<))) (defun gnus-group-foreign-p (group) "Say whether a group is foreign or not." *** pub/qgnus/lisp/nnagent.el Sat Sep 13 21:57:08 1997 --- qgnus/lisp/nnagent.el Sat Sep 13 21:56:51 1997 *************** *** 0 **** --- 1,116 ---- + ;;; nnagent.el --- offline backend for Gnus + ;; Copyright (C) 1997 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news, mail + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'nnheader) + (require 'nnoo) + (require 'cl) + (require 'gnus-agent) + (require 'nnml) + + (nnoo-declare nnagent + nnml) + + + + (defconst nnagent-version "nnagent 1.0") + + (defvoo nnagent-directory nil + "Internal variable." + nnml-directory) + + (defvoo nnagent-active-file nil + "Internal variable." + nnml-active-file) + + (defvoo nnagent-newsgroups-file nil + "Internal variable." + nnml-newsgroups-file) + + (defvoo nnagent-get-new-mail nil + "Internal variable." + nnml-get-new-mail) + + ;;; Interface functions. + + (nnoo-define-basics nnagent) + + (deffoo nnagent-open-server (server &optional defs) + (setq defs + `((nnagent-directory ,(gnus-agent-directory)) + (nnagent-active-file ,(gnus-agent-lib-file "active")) + (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups")) + (nnagent-get-new-mail nil))) + (nnoo-change-server 'nnagent server defs) + (let ((dir (gnus-agent-directory)) + err) + (cond + ((not (condition-case arg + (file-exists-p dir) + (ftp-error (setq err (format "%s" arg))))) + (nnagent-close-server) + (nnheader-report + 'nnagent (or err "No such file or directory: %s" dir))) + ((not (file-directory-p (file-truename dir))) + (nnagent-close-server) + (nnheader-report 'nnagent "Not a directory: %s" dir)) + (t + (nnheader-report 'nnagent "Opened server %s using directory %s" + server dir) + t)))) + + (deffoo nnagent-retrieve-groups (groups &optional server) + (save-excursion + (cond + ((file-exists-p (gnus-agent-lib-file "groups")) + (nnmail-find-file (gnus-agent-lib-file "groups")) + 'groups) + ((file-exists-p (gnus-agent-lib-file "active")) + (nnmail-find-file (gnus-agent-lib-file "active")) + 'active) + (t nil)))) + + (defun nnagent-request-type (group article) + (let ((gnus-plugged t)) + (if (not (gnus-check-backend-function + 'request-type (car gnus-command-method))) + 'unknown + (funcall (gnus-get-function gnus-command-method 'request-type) + (gnus-group-real-name group) article)))) + + (deffoo nnagent-request-newgroups (date server) + nil) + + ;; Use nnml functions for just about everything. + (nnoo-import nnagent + (nnml)) + + + ;;; Internal functions. + + (provide 'nnagent) + + ;;; nnagent.el ends here *** pub/qgnus/lisp/nnheader.el Sat Sep 13 15:58:41 1997 --- qgnus/lisp/nnheader.el Sat Sep 13 21:56:51 1997 *************** *** 341,347 **** (eobp)) (setq found t) (setq prev (point)) ! (cond ((> (setq num (read cur)) article) (setq max (point))) ((< num article) (setq min (point))) --- 341,350 ---- (eobp)) (setq found t) (setq prev (point)) ! (while (and (not (numberp (setq num (read cur)))) ! (not (eobp))) ! (gnus-delete-line)) ! (cond ((> num article) (setq max (point))) ((< num article) (setq min (point))) *** pub/qgnus/lisp/nnkiboze.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/nnkiboze.el Sat Sep 13 21:56:51 1997 *************** *** 283,289 **** (car ginfo))) 0)) (progn ! (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode))) ;; We are now in the group where we want to be. (setq method (gnus-find-method-for-group --- 283,290 ---- (car ginfo))) 0)) (progn ! (ignore-errors ! (gnus-group-select-group nil)) (eq major-mode 'gnus-summary-mode))) ;; We are now in the group where we want to be. (setq method (gnus-find-method-for-group *** pub/qgnus/lisp/nnml.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/nnml.el Sat Sep 13 21:56:52 1997 *************** *** 264,273 **** (deffoo nnml-request-expire-articles (articles group &optional server force) (nnml-possibly-change-directory group server) ! (let* ((active-articles ! (nnheader-directory-articles nnml-current-directory)) ! (is-old t) ! article rest mod-time number) (nnmail-activate 'nnml) (while (and articles is-old) --- 264,273 ---- (deffoo nnml-request-expire-articles (articles group &optional server force) (nnml-possibly-change-directory group server) ! (let ((active-articles ! (nnheader-directory-articles nnml-current-directory)) ! (is-old t) ! article rest mod-time number) (nnmail-activate 'nnml) (while (and articles is-old) *** pub/qgnus/lisp/nnoo.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/nnoo.el Sat Sep 13 21:56:52 1997 *************** *** 96,109 **** (pop functions))))) (defun nnoo-parent-function (backend function args) ! (let* ((pbackend (nnoo-backend function))) (nnoo-change-server pbackend (nnoo-current-server backend) (cdr (assq pbackend (nnoo-parents backend)))) (apply function args))) (defun nnoo-execute (backend function &rest args) "Execute FUNCTION on behalf of BACKEND." ! (let* ((pbackend (nnoo-backend function))) (nnoo-change-server pbackend (nnoo-current-server backend) (cdr (assq pbackend (nnoo-parents backend)))) (apply function args))) --- 96,109 ---- (pop functions))))) (defun nnoo-parent-function (backend function args) ! (let ((pbackend (nnoo-backend function))) (nnoo-change-server pbackend (nnoo-current-server backend) (cdr (assq pbackend (nnoo-parents backend)))) (apply function args))) (defun nnoo-execute (backend function &rest args) "Execute FUNCTION on behalf of BACKEND." ! (let ((pbackend (nnoo-backend function))) (nnoo-change-server pbackend (nnoo-current-server backend) (cdr (assq pbackend (nnoo-parents backend)))) (apply function args))) *** pub/qgnus/lisp/nntp.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/nntp.el Sat Sep 13 21:56:52 1997 *************** *** 1,5 **** ;;; nntp.el --- nntp access for Gnus ! ;;; Copyright (C) 1987,88,89,90,92,93,94,95,96,97 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news --- 1,5 ---- ;;; nntp.el --- nntp access for Gnus ! ;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 339,344 **** --- 339,358 ---- (nnoo-define-basics nntp) + (defsubst nntp-next-result-arrived-p () + (let ((point (point))) + (cond + ((eq (following-char) ?2) + (if (re-search-forward "\n\\.\r?\n" nil t) + t + (goto-char point) + nil)) + ((looking-at "[34]") + (forward-line 1) + t) + (t + nil)))) + (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) "Retrieve the headers of ARTICLES." (nntp-possibly-change-group group server) *************** *** 358,405 **** (last-point (point-min)) (buf (nntp-find-connection-buffer nntp-server-buffer)) (nntp-inhibit-erase t)) ! ;; Send HEAD command. ! (while articles ! (nntp-send-command ! nil ! "HEAD" (if (numberp (car articles)) ! (int-to-string (car articles)) ! ;; `articles' is either a list of article numbers ! ;; or a list of article IDs. ! (car articles))) ! (setq articles (cdr articles) ! count (1+ count)) ! ;; Every 400 header requests we have to read the stream in ! ;; order to avoid deadlocks. ! (when (or (null articles) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) ! (while (progn ! (progn ! (set-buffer buf) ! (goto-char last-point)) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (incf received)) ! (setq last-point (point)) ! (< received count)) ! ;; If number of headers is greater than 100, give ! ;; informative messages. ! (and (numberp nntp-large-newsgroup) ! (> number nntp-large-newsgroup) ! (zerop (% received 20)) ! (nnheader-message 6 "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) ! (nntp-accept-response)))) ! ;; Wait for text of last command. ! (goto-char (point-max)) ! (re-search-backward "^[0-9]" nil t) ! (when (looking-at "^[23]") (while (progn ! (goto-char (point-max)) ! (forward-line -1) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (nnheader-message 6 "NNTP: Receiving headers...done")) --- 372,408 ---- (last-point (point-min)) (buf (nntp-find-connection-buffer nntp-server-buffer)) (nntp-inhibit-erase t)) ! ;; Send HEAD commands. ! (while (setq article (pop articles)) ! (nntp-send-command ! nil ! "HEAD" (if (numberp article) ! (int-to-string article) ! ;; `articles' is either a list of article numbers ! ;; or a list of article IDs. ! article)) ! (incf count) ! ;; Every 400 requests we have to read the stream in ! ;; order to avoid deadlocks. ! (when (or (null articles) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) (while (progn ! (set-buffer buf) ! (goto-char last-point) ! ;; Count replies. ! (while (nntp-next-result-arrived-p) ! (setq last-point (point)) ! (incf received)) ! (< received count)) ! ;; If number of headers is greater than 100, give ! ;; informative messages. ! (and (numberp nntp-large-newsgroup) ! (> number nntp-large-newsgroup) ! (zerop (% received 20)) ! (nnheader-message 6 "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) ! (nntp-accept-response)))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (nnheader-message 6 "NNTP: Receiving headers...done")) *************** *** 487,493 **** article alist) (set-buffer buf) (erase-buffer) ! ;; Send HEAD command. (while (setq article (pop articles)) (nntp-send-command nil --- 490,496 ---- article alist) (set-buffer buf) (erase-buffer) ! ;; Send ARTICLE command. (while (setq article (pop articles)) (nntp-send-command nil *************** *** 503,516 **** (zerop (% count nntp-maximum-request))) (nntp-accept-response) (while (progn ! (progn ! (set-buffer buf) ! (goto-char last-point)) ;; Count replies. (while (nntp-next-result-arrived-p) (aset map received (cons (aref map received) (point))) (incf received)) - (setq last-point (point)) (< received count)) ;; If number of headers is greater than 100, give ;; informative messages. --- 506,518 ---- (zerop (% count nntp-maximum-request))) (nntp-accept-response) (while (progn ! (set-buffer buf) ! (goto-char last-point) ;; Count replies. (while (nntp-next-result-arrived-p) (aset map received (cons (aref map received) (point))) + (setq last-point (point)) (incf received)) (< received count)) ;; If number of headers is greater than 100, give ;; informative messages. *************** *** 522,533 **** (nntp-accept-response)))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (nnheader-message 6 "NNTP: Receiving headers...done")) ! ;; Now we have all the responses. We go through the results, ;; washes it and copies it over to the server buffer. (set-buffer nntp-server-buffer) (erase-buffer) (mapcar (lambda (entry) (narrow-to-region --- 524,536 ---- (nntp-accept-response)))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (nnheader-message 6 "NNTP: Receiving articles...done")) ! ;; Now we have all the responses. We go through the results, ;; washes it and copies it over to the server buffer. (set-buffer nntp-server-buffer) (erase-buffer) + (setq last-point (point-min)) (mapcar (lambda (entry) (narrow-to-region *************** *** 535,559 **** (progn (insert-buffer-substring buf last-point (cdr entry)) (point-max))) (nntp-decode-text) (widen) (cons (car entry) point)) map)))) - (defun nntp-next-result-arrived-p () - (let ((point (point))) - (cond - ((looking-at "2") - (if (re-search-forward "\n.\r?\n" nil t) - t - (goto-char point) - nil)) - ((looking-at "[34]") - (forward-line 1) - t) - (t - nil)))) - (defun nntp-try-list-active (group) (nntp-list-active-group group) (save-excursion --- 538,549 ---- (progn (insert-buffer-substring buf last-point (cdr entry)) (point-max))) + (setq last-point (cdr entry)) (nntp-decode-text) (widen) (cons (car entry) point)) map)))) (defun nntp-try-list-active (group) (nntp-list-active-group group) (save-excursion *************** *** 634,640 **** (while (setq process (car (pop nntp-connection-alist))) (when (memq (process-status process) '(open run)) (set-process-sentinel process nil) ! (nntp-send-string process "QUIT")) (when (buffer-name (process-buffer process)) (kill-buffer (process-buffer process)))) (nnoo-close-server 'nntp))) --- 624,631 ---- (while (setq process (car (pop nntp-connection-alist))) (when (memq (process-status process) '(open run)) (set-process-sentinel process nil) ! (ignore-errors ! (nntp-send-string process "QUIT"))) (when (buffer-name (process-buffer process)) (kill-buffer (process-buffer process)))) (nnoo-close-server 'nntp))) *** pub/qgnus/lisp/nnvirtual.el Sat Sep 13 15:43:23 1997 --- qgnus/lisp/nnvirtual.el Sat Sep 13 21:56:53 1997 *************** *** 560,586 **** (defun nnvirtual-reverse-map-article (group article) "Return the virtual article number corresponding to the given component GROUP and ARTICLE." ! (let ((table nnvirtual-mapping-table) ! (group-pos 0) ! entry) ! (while (not (string= group (car (aref nnvirtual-mapping-offsets group-pos)))) ! (setq group-pos (1+ group-pos))) ! (setq article (- article (cdr (aref nnvirtual-mapping-offsets ! group-pos)))) ! (while (and table ! (> article (aref (car table) 0))) ! (setq table (cdr table))) ! (setq entry (car table)) ! (when (and entry ! (> article 0) ! (< group-pos (aref entry 2))) ; article not out of range below ! (+ (aref entry 4) ! group-pos ! (* (- article (aref entry 1)) ! (aref entry 2)) ! 1)) ! )) (defsubst nnvirtual-reverse-map-sequence (group articles) --- 560,587 ---- (defun nnvirtual-reverse-map-article (group article) "Return the virtual article number corresponding to the given component GROUP and ARTICLE." ! (when (numberp article) ! (let ((table nnvirtual-mapping-table) ! (group-pos 0) ! entry) ! (while (not (string= group (car (aref nnvirtual-mapping-offsets ! group-pos)))) ! (setq group-pos (1+ group-pos))) ! (setq article (- article (cdr (aref nnvirtual-mapping-offsets group-pos)))) ! (while (and table ! (> article (aref (car table) 0))) ! (setq table (cdr table))) ! (setq entry (car table)) ! (when (and entry ! (> article 0) ! (< group-pos (aref entry 2))) ; article not out of range below ! (+ (aref entry 4) ! group-pos ! (* (- article (aref entry 1)) ! (aref entry 2)) ! 1)) ! ))) (defsubst nnvirtual-reverse-map-sequence (group articles) *** pub/qgnus/texi/gnus.texi Tue Sep 9 04:18:18 1997 --- qgnus/texi/gnus.texi Sat Sep 13 21:56:57 1997 *************** *** 984,996 **** normally be run just once in each Emacs session, no matter how many times you start Gnus. @item gnus-startup-hook @vindex gnus-startup-hook ! A hook run after starting up Gnus successfully. @item gnus-started-hook @vindex gnus-started-hook ! A hook run as the very last thing after starting up Gnus successfully. @item gnus-check-bogus-newsgroups --- 984,1000 ---- normally be run just once in each Emacs session, no matter how many times you start Gnus. + @item gnus-before-startup-hook + @vindex gnus-before-startup-hook + A hook run after starting up Gnus successfully. + @item gnus-startup-hook @vindex gnus-startup-hook ! A hook run as the very last thing after starting up Gnus @item gnus-started-hook @vindex gnus-started-hook ! A hook that is run as the very last thing after starting up Gnus successfully. @item gnus-check-bogus-newsgroups *************** *** 1629,1635 **** (default 3) and @code{gnus-level-default-unsubscribed} (default 6), which are the levels that new groups will be put on if they are (un)subscribed. These two variables should, of course, be inside the ! relevant legal ranges. @vindex gnus-keep-same-level If @code{gnus-keep-same-level} is non-@code{nil}, some movement commands --- 1633,1639 ---- (default 3) and @code{gnus-level-default-unsubscribed} (default 6), which are the levels that new groups will be put on if they are (un)subscribed. These two variables should, of course, be inside the ! relevant valid ranges. @vindex gnus-keep-same-level If @code{gnus-keep-same-level} is non-@code{nil}, some movement commands *************** *** 1776,1782 **** @findex gnus-group-rename-group @cindex renaming groups Rename the current group to something else ! (@code{gnus-group-rename-group}). This is legal only on some groups---mail groups mostly. This command might very well be quite slow on some backends. --- 1780,1786 ---- @findex gnus-group-rename-group @cindex renaming groups Rename the current group to something else ! (@code{gnus-group-rename-group}). This is valid only on some groups---mail groups mostly. This command might very well be quite slow on some backends. *************** *** 1871,1877 **** Make an ephemeral group based on a web search (@code{gnus-group-make-web-group}). If you give a prefix to this command, make a solid group instead. You will be prompted for the ! search engine type and the search string. Legal search engine types include @code{dejanews}, @code{altavista} and @code{reference}. @xref{Web Searches}. --- 1875,1881 ---- Make an ephemeral group based on a web search (@code{gnus-group-make-web-group}). If you give a prefix to this command, make a solid group instead. You will be prompted for the ! search engine type and the search string. Valid search engine types include @code{dejanews}, @code{altavista} and @code{reference}. @xref{Web Searches}. *************** *** 2004,2017 **** @item score-file @cindex score file group parameter Elements that look like @code{(score-file . "file")} will make ! @file{file} into the current score file for the group in question. This ! means that all score commands you issue will end up in that file. @item adapt-file @cindex adapt file group parameter Elements that look like @code{(adapt-file . "file")} will make ! @file{file} into the current adaptive score file for the group in ! question. All adaptive score entries will be put into this file. @item admin-address When unsubscribing from a mailing list you should never send the --- 2008,2021 ---- @item score-file @cindex score file group parameter Elements that look like @code{(score-file . "file")} will make ! @file{file} into the current adaptive score file for the group in ! question. All adaptive score entries will be put into this file. @item adapt-file @cindex adapt file group parameter Elements that look like @code{(adapt-file . "file")} will make ! @file{file} into the current adaptive file for the group in question. ! All adaptive score entries will be put into this file. @item admin-address When unsubscribing from a mailing list you should never send the *************** *** 2021,2027 **** @item display Elements that look like @code{(display . MODE)} say which articles to ! display on entering the group. Legal values are: @table @code @item all --- 2025,2031 ---- @item display Elements that look like @code{(display . MODE)} say which articles to ! display on entering the group. Valid values are: @table @code @item all *************** *** 2524,2530 **** @vindex gnus-topic-line-format The topic lines themselves are created according to the @code{gnus-topic-line-format} variable (@pxref{Formatting Variables}). ! Legal elements are: @table @samp @item i --- 2528,2534 ---- @vindex gnus-topic-line-format The topic lines themselves are created according to the @code{gnus-topic-line-format} variable (@pxref{Formatting Variables}). ! Valid elements are: @table @samp @item i *************** *** 2781,2787 **** @cindex topic parameters All groups in a topic will inherit group parameters from the parent (and ! ancestor) topic parameters. All legal group parameters are legal topic parameters (@pxref{Group Parameters}). Group parameters (of course) override topic parameters, and topic --- 2785,2791 ---- @cindex topic parameters All groups in a topic will inherit group parameters from the parent (and ! ancestor) topic parameters. All valid group parameters are valid topic parameters (@pxref{Group Parameters}). Group parameters (of course) override topic parameters, and topic *************** *** 3233,3238 **** --- 3237,3244 ---- article has any children. @item P The line number. + @item O + Download mark. @item u User defined specifier. The next character in the format string should be a letter. Gnus will call the function *************** *** 3245,3251 **** The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and ``hard-code'' ! that. This means that it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. --- 3251,3257 ---- The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and ``hard-code'' ! that. This means that it is invalid to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. *************** *** 3518,3525 **** @findex gnus-summary-goto-last-article Go to the previous article read (@code{gnus-summary-goto-last-article}). ! @item G p ! @kindex G p (Summary) @findex gnus-summary-pop-article Pop an article off the summary history and go to this article (@code{gnus-summary-pop-article}). This command differs from the --- 3524,3531 ---- @findex gnus-summary-goto-last-article Go to the previous article read (@code{gnus-summary-goto-last-article}). ! @item G o ! @kindex G o (Summary) @findex gnus-summary-pop-article Pop an article off the summary history and go to this article (@code{gnus-summary-pop-article}). This command differs from the *************** *** 5388,5393 **** --- 5394,5400 ---- * Uuencoded Articles:: Uudecode articles. * Shared Articles:: Unshar articles. * PostScript Files:: Split PostScript. + * Other Files:: Plain save and binhex. * Decoding Variables:: Variables for a happy decoding. * Viewing Files:: You want to look at the result of the decoding? @end menu *************** *** 5439,5445 **** @kindex X v U (Summary) @findex gnus-uu-decode-uu-and-save-view Uudecodes, views and saves the current series ! (@code{gnus-uu-decode-uu-and-save-view}). @end table Remember that these all react to the presence of articles marked with --- 5446,5453 ---- @kindex X v U (Summary) @findex gnus-uu-decode-uu-and-save-view Uudecodes, views and saves the current series ! (@code{gnus-uu-decode-uu-and-save-view}). ! @end table Remember that these all react to the presence of articles marked with *************** *** 5524,5529 **** --- 5532,5555 ---- @end table + @node Other Files + @subsection Other Files + + @table @kbd + @item X o + @kindex X o (Summary) + @findex gnus-uu-decode-save + Save the current series + (@code{gnus-uu-decode-save}). + + @item X b + @kindex X b (Summary) + @findex gnus-uu-decode-binhex + Unbinhex the current series (@code{gnus-uu-decode-binhex}). This + doesn't really work yet. + @end table + + @node Decoding Variables @subsection Decoding Variables *************** *** 5993,5999 **** Gnus adds buttons to show where the cited text has been hidden, and to allow toggle hiding the text. The format of the variable is specified by this format-like variable (@pxref{Formatting Variables}). These ! specs are legal: @table @samp @item b --- 6019,6025 ---- Gnus adds buttons to show where the cited text has been hidden, and to allow toggle hiding the text. The format of the variable is specified by this format-like variable (@pxref{Formatting Variables}). These ! specs are valid: @table @samp @item b *************** *** 6653,6659 **** @item gnus-tree-mode-line-format @vindex gnus-tree-mode-line-format A format string for the mode bar in the tree mode buffers. The default ! is @samp{Gnus: %%b [%A] %Z}. For a list of legal specs, @pxref{Summary Buffer Mode Line}. @item gnus-selected-tree-face --- 6679,6685 ---- @item gnus-tree-mode-line-format @vindex gnus-tree-mode-line-format A format string for the mode bar in the tree mode buffers. The default ! is @samp{Gnus: %%b [%A] %Z}. For a list of valid specs, @pxref{Summary Buffer Mode Line}. @item gnus-selected-tree-face *************** *** 6669,6675 **** the name of the poster. It is vital that all nodes are of the same length, so you @emph{must} use @samp{%4,4n}-like specifiers. ! Legal specs are: @table @samp @item n --- 6695,6701 ---- the name of the poster. It is vital that all nodes are of the same length, so you @emph{must} use @samp{%4,4n}-like specifiers. ! Valid specs are: @table @samp @item n *************** *** 6777,6783 **** @cindex mail group commands Some commands only make sense in mail groups. If these commands are ! illegal in the current group, they will raise hell and let you know. All these commands (except the expiry and edit commands) use the process/prefix convention (@pxref{Process/Prefix}). --- 6803,6809 ---- @cindex mail group commands Some commands only make sense in mail groups. If these commands are ! invalid in the current group, they will raise a hell and let you know. All these commands (except the expiry and edit commands) use the process/prefix convention (@pxref{Process/Prefix}). *************** *** 10014,10020 **** @item nndoc-post-type @vindex nndoc-post-type This variable says whether Gnus is to consider the group a news group or ! a mail group. There are two legal values: @code{mail} (the default) and @code{news}. @end table --- 10040,10046 ---- @item nndoc-post-type @vindex nndoc-post-type This variable says whether Gnus is to consider the group a news group or ! a mail group. There are two valid values: @code{mail} (the default) and @code{news}. @end table *************** *** 10142,10148 **** @code{nil} if the document is not of the correct type; @code{t} if it is of the correct type; and a number if the document might be of the correct type. A high number means high probability; a low number means ! low probability with @samp{0} being the lowest legal number. @node SOUP --- 10168,10174 ---- @code{nil} if the document is not of the correct type; @code{t} if it is of the correct type; and a number if the document might be of the correct type. A high number means high probability; a low number means ! low probability with @samp{0} being the lowest valid number. @node SOUP *************** *** 10883,10889 **** @end table @item ! The third key is the match type. Which match types are legal depends on what headers you are scoring on. @table @code --- 10909,10915 ---- @end table @item ! The third key is the match type. Which match types are valid depends on what headers you are scoring on. @table @code *************** *** 11165,11171 **** Even though this looks much like lisp code, nothing here is actually @code{eval}ed. The lisp reader is used to read this form, though, so it ! has to be legal syntactically, if not semantically. Six keys are supported by this alist: --- 11191,11197 ---- Even though this looks much like lisp code, nothing here is actually @code{eval}ed. The lisp reader is used to read this form, though, so it ! has to be valid syntactically, if not semantically. Six keys are supported by this alist: *************** *** 12098,12104 **** to see your predictions displayed. The display of predictions is controlled by the @code{grouplens-prediction-display} variable. ! The following are legal values for that variable. @table @code @item prediction-spot --- 12124,12130 ---- to see your predictions displayed. The display of predictions is controlled by the @code{grouplens-prediction-display} variable. ! The following are valid values for that variable. @table @code @item prediction-spot *************** *** 12551,12557 **** be achieved by using @dfn{tilde modifiers}. A typical tilde spec might look like @samp{%~(cut 3)~(ignore "0")y}. ! These are the legal modifiers: @table @code @item pad --- 12577,12583 ---- be achieved by using @dfn{tilde modifiers}. A typical tilde spec might look like @samp{%~(cut 3)~(ignore "0")y}. ! These are the valid modifiers: @table @code @item pad *************** *** 12759,12765 **** The splitting is never accurate, and this buffer will eat any leftover lines from the splits. ! To be slightly more formal, here's a definition of what a legal split may look like: @example --- 12785,12791 ---- The splitting is never accurate, and this buffer will eat any leftover lines from the splits. ! To be slightly more formal, here's a definition of what a valid split may look like: @example *************** *** 12972,12978 **** file. This variable can be a list of visual properties that are enabled. The ! following elements are legal, and are all included by default: @table @code @item group-highlight --- 12998,13004 ---- file. This variable can be a list of visual properties that are enabled. The ! following elements are valid, and are all included by default: @table @code @item group-highlight *************** *** 13621,13627 **** @end table - @node Smileys @subsection Smileys @cindex smileys --- 13647,13652 ---- *************** *** 13766,13771 **** --- 13791,13798 ---- @end table + + @node Fuzzy Matching @section Fuzzy Matching @cindex fuzzy matching *************** *** 13813,13819 **** The way to deal with this is having Gnus split out all spam into a @samp{spam} mail group (@pxref{Splitting Mail}). ! First, pick one (1) legal mail address that you can be reached at, and put it in your @code{From} header of all your news articles. (I've chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form @samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your --- 13840,13846 ---- The way to deal with this is having Gnus split out all spam into a @samp{spam} mail group (@pxref{Splitting Mail}). ! First, pick one (1) valid mail address that you can be reached at, and put it in your @code{From} header of all your news articles. (I've chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form @samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your *************** *** 13934,13943 **** @item nnheader-file-name-translation-alist @vindex nnheader-file-name-translation-alist @cindex file names ! @cindex illegal characters in file names @cindex characters in file names This is an alist that says how to translate characters in file names. ! For instance, if @samp{:} is illegal as a file character in file names on your system (you OS/2 user you), you could say something like: @lisp --- 13961,13970 ---- @item nnheader-file-name-translation-alist @vindex nnheader-file-name-translation-alist @cindex file names ! @cindex invalid characters in file names @cindex characters in file names This is an alist that says how to translate characters in file names. ! For instance, if @samp{:} is invalid as a file character in file names on your system (you OS/2 user you), you could say something like: @lisp *************** *** 15191,15197 **** @item select method @cindex select method A structure that specifies the backend, the server and the virtual ! server parameters. @item virtual server @cindex virtual server --- 15218,15224 ---- @item select method @cindex select method A structure that specifies the backend, the server and the virtual ! server settings. @item virtual server @cindex virtual server *************** *** 16478,16484 **** @end example is a perfectly valid range, although a pretty long-winded one. This is ! also legal: @example (1 . 5) --- 16505,16511 ---- @end example is a perfectly valid range, although a pretty long-winded one. This is ! also valid: @example (1 . 5) *** pub/qgnus/texi/dir Wed Jun 18 00:54:19 1997 --- qgnus/texi/dir Sat Jul 12 19:54:27 1997 *************** *** 0 **** --- 1,11 ---- + -*- Text -*- + The Gnus-related top node. +  + File: dir Node: Top This is the Gnus Info tree + + * Menu: + + * Gnus: (gnus). The news reader Gnus. + * Message: (message). The Message sending thingamabob. + * Widget: (widget). The Widget library. + * Custom: (custom). The Custom library.