*** pub/rgnus/lisp/article.el Wed Jul 31 20:58:42 1996 --- rgnus/lisp/article.el Fri Aug 2 18:50:08 1996 *************** *** 54,69 **** Possible values in this list are `empty', `newsgroups', `followup-to', `reply-to', and `date'.") ! (defvar gnus-signature-separator "^-- *$" ! "Regexp matching signature separator.") (defvar gnus-signature-limit nil "Provide a limit to what is considered a signature. If it is a number, no signature may not be longer (in characters) than ! that number. If it is a function, the function will be called without ! any parameters, and if it returns nil, there is no signature in the ! buffer. If it is a string, it will be used as a regexp. If it ! matches, the text in question is not a signature.") (defvar gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text.") --- 54,73 ---- Possible values in this list are `empty', `newsgroups', `followup-to', `reply-to', and `date'.") ! (defvar gnus-signature-separator '("^-- $" "^-- *$") ! "Regexp matching signature separator. ! This can also be a list of regexps. In that case, it will be checked ! from head to tail looking for a separator. Searches will be done from ! the end of the buffer.") (defvar gnus-signature-limit nil "Provide a limit to what is considered a signature. If it is a number, no signature may not be longer (in characters) than ! that number. If it is a floating point number, no signature may be ! longer (in lines) than that number. If it is a function, the function ! will be called without any parameters, and if it returns nil, there is ! no signature in the buffer. If it is a string, it will be used as a ! regexp. If it matches, the text in question is not a signature.") (defvar gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text.") *************** *** 540,565 **** (defun article-narrow-to-signature () "Narrow to the signature." (widen) ! (if (and (boundp 'mime::preview/content-list) ! mime::preview/content-list) ! (let ((pcinfo (car (last mime::preview/content-list)))) ! (condition-case () ! (narrow-to-region ! (funcall (intern "mime::preview-content-info/point-min") pcinfo) ! (point-max)) ! (error nil)))) ! (goto-char (point-max)) ! (when (re-search-backward gnus-signature-separator nil t) (forward-line 1) ! (when (or (null gnus-signature-limit) ! (and (numberp gnus-signature-limit) ! (< (- (point-max) (point)) gnus-signature-limit)) ! (and (gnus-functionp gnus-signature-limit) ! (funcall gnus-signature-limit)) ! (and (stringp gnus-signature-limit) ! (not (re-search-forward gnus-signature-limit nil t)))) ! (narrow-to-region (point) (point-max)) ! t))) (defun article-hidden-arg () "Return the current prefix arg as a number, or 0 if no prefix." --- 544,597 ---- (defun article-narrow-to-signature () "Narrow to the signature." (widen) ! (when (and (boundp 'mime::preview/content-list) ! mime::preview/content-list) ! ;; We have a MIMEish article, so we use the MIME data to narrow. ! (let ((pcinfo (car (last mime::preview/content-list)))) ! (condition-case () ! (narrow-to-region ! (funcall (intern "mime::preview-content-info/point-min") pcinfo) ! (point-max)) ! (error nil)))) ! ! (when (article-search-signature) (forward-line 1) ! ;; Check whether we have some limits to what we consider ! ;; to be a signature. ! (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit ! (list gnus-signature-limit))) ! limit limited) ! (while (setq limit (pop limits)) ! (if (or (and (integerp limit) ! (< (- (point-max) (point)) limit)) ! (and (floatp limit) ! (< (count-lines (point) (point-max)) limit)) ! (and (gnus-functionp limit) ! (funcall limit)) ! (and (stringp limit) ! (not (re-search-forward limit nil t)))) ! () ; This limit did not succeed. ! (setq limited t ! limits nil))) ! (unless limited ! (narrow-to-region (point) (point-max)) ! t)))) ! ! (defun article-search-signature () ! "Search the current buffer for the signature separator. ! Put point at the beginning of the signature separator." ! (let ((cur (point))) ! (goto-char (point-max)) ! (if (if (stringp gnus-signature-separator) ! (re-search-backward gnus-signature-separator nil t) ! (let ((seps gnus-signature-separator)) ! (while (and seps ! (not (re-search-backward (car seps) nil t))) ! (pop seps)) ! seps)) ! t ! (goto-char cur) ! nil))) (defun article-hidden-arg () "Return the current prefix arg as a number, or 0 if no prefix." *** pub/rgnus/lisp/gnus-async.el Tue Jul 30 23:28:12 1996 --- rgnus/lisp/gnus-async.el Fri Aug 2 20:04:55 1996 *************** *** 41,51 **** that all articles belonging to a group are removed on exit from that group.") ;;; Internal variables. (defvar gnus-async-article-alist nil) ! (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") ;;; Utility functions. --- 41,56 ---- that all articles belonging to a group are removed on exit from that group.") + (defvar gnus-use-header-prefetch nil + "*If non-nil, prefetch the headers to the next group.") + ;;; Internal variables. + (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") (defvar gnus-async-article-alist nil) ! (defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") ! (defvar gnus-asynch-header-prefetched nil) ;;; Utility functions. *************** *** 53,71 **** "Say whether GROUP is fetched from a server that supports asynchronocity." (gnus-asynchronous-p (gnus-find-method-for-group group))) ;;; Article prefetch (gnus-add-shutdown 'gnus-async-close 'gnus) (defun gnus-async-close () (gnus-kill-buffer gnus-async-prefetch-article-buffer) ! (setq gnus-async-article-alist nil)) ! ! (defun gnus-async-set-prefetch-buffer () ! (if (get-buffer gnus-async-prefetch-article-buffer) ! (set-buffer gnus-async-prefetch-article-buffer) ! (set-buffer (get-buffer-create gnus-async-prefetch-article-buffer)) ! (buffer-disable-undo (current-buffer)) ! (gnus-add-current-to-buffer-list))) (defun gnus-async-prefetch-next (group article summary) "Possibly prefetch several articles starting with the article after ARTICLE." --- 58,73 ---- "Say whether GROUP is fetched from a server that supports asynchronocity." (gnus-asynchronous-p (gnus-find-method-for-group group))) + ;;; ;;; Article prefetch + ;;; (gnus-add-shutdown 'gnus-async-close 'gnus) (defun gnus-async-close () (gnus-kill-buffer gnus-async-prefetch-article-buffer) ! (gnus-kill-buffer gnus-async-prefetch-headers-buffer) ! (setq gnus-async-article-alist nil ! gnus-asynch-header-prefetched nil)) (defun gnus-async-prefetch-next (group article summary) "Possibly prefetch several articles starting with the article after ARTICLE." *************** *** 94,106 **** (set-buffer summary) (let ((next (caadr (gnus-data-find-list article))) mark) ! (gnus-async-set-prefetch-buffer) (goto-char (point-max)) (setq mark (point-marker)) (let ((nnheader-callback-function `(lambda (arg) (save-excursion ! (gnus-async-set-prefetch-buffer) (push (list ',(intern (format "%s-%d" group article)) ,mark (set-marker (make-marker) (point-max)) ,group ,article) --- 96,109 ---- (set-buffer summary) (let ((next (caadr (gnus-data-find-list article))) mark) ! (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) (goto-char (point-max)) (setq mark (point-marker)) (let ((nnheader-callback-function `(lambda (arg) (save-excursion ! (nnheader-set-temp-buffer ! gnus-async-prefetch-article-buffer t) (push (list ',(intern (format "%s-%d" group article)) ,mark (set-marker (make-marker) (point-max)) ,group ,article) *************** *** 117,137 **** (defun gnus-async-request-fetched-article (group article buffer) "See whether we have ARTICLE from GROUP and put it in BUFFER." ! (let ((entry (gnus-async-prefetched-article-entry group article))) ! (when entry ! (save-excursion ! (gnus-async-set-prefetch-buffer) ! (copy-to-buffer buffer (cadr entry) (caddr entry)) ! ;; Remove the read article from the prefetch buffer. ! (when (memq 'read gnus-prefetched-article-deletion-strategy) ! (gnus-asynch-delete-prefected-entry entry)) ! ;; Decode the article. Perhaps this shouldn't be done ! ;; here? ! (set-buffer buffer) ! (nntp-decode-text) ! (goto-char (point-min)) ! (gnus-delete-line) ! t)))) (defun gnus-asynch-delete-prefected-entry (entry) "Delete ENTRY from buffer and alist." --- 120,141 ---- (defun gnus-async-request-fetched-article (group article buffer) "See whether we have ARTICLE from GROUP and put it in BUFFER." ! (when (numberp article) ! (let ((entry (gnus-async-prefetched-article-entry group article))) ! (when entry ! (save-excursion ! (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) ! (copy-to-buffer buffer (cadr entry) (caddr entry)) ! ;; Remove the read article from the prefetch buffer. ! (when (memq 'read gnus-prefetched-article-deletion-strategy) ! (gnus-asynch-delete-prefected-entry entry)) ! ;; Decode the article. Perhaps this shouldn't be done ! ;; here? ! (set-buffer buffer) ! (nntp-decode-text) ! (goto-char (point-min)) ! (gnus-delete-line) ! t))))) (defun gnus-asynch-delete-prefected-entry (entry) "Delete ENTRY from buffer and alist." *************** *** 147,153 **** (memq 'exit gnus-prefetched-article-deletion-strategy)) (let ((alist gnus-async-article-alist)) (save-excursion ! (gnus-async-set-prefetch-buffer) (while alist (when (equal group (nth 3 (car alist))) (gnus-asynch-delete-prefected-entry (car alist))) --- 151,157 ---- (memq 'exit gnus-prefetched-article-deletion-strategy)) (let ((alist gnus-async-article-alist)) (save-excursion ! (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) (while alist (when (equal group (nth 3 (car alist))) (gnus-asynch-delete-prefected-entry (car alist))) *************** *** 158,163 **** --- 162,205 ---- (assq (intern (format "%s-%d" group article)) gnus-async-article-alist)) + ;;; + ;;; Header prefetch + ;;; + + (defun gnus-async-prefetch-headers (group) + "Prefetch the headers for group GROUP." + (save-excursion + (let (unread) + (when (and gnus-use-header-prefetch + (gnus-group-asynchronous-p group) + (listp gnus-asynch-header-prefetched) + (setq unread (gnus-list-of-unread-articles group))) + ;; Mark that a fetch is in progress. + (setq gnus-asynch-header-prefetched t) + (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) + (erase-buffer) + (let ((nntp-server-buffer (current-buffer)) + (nnheader-callback-function + `(lambda (arg) + (setq gnus-asynch-header-prefetched + ,(cons group unread))))) + (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) + + (defun gnus-asynch-retrieve-fetched-headers (articles group) + "See whether we have prefetched headers." + (when (and gnus-use-header-prefetch + (gnus-group-asynchronous-p group) + (listp gnus-asynch-header-prefetched) + (equal group (car gnus-asynch-header-prefetched)) + (equal articles (cdr gnus-asynch-header-prefetched))) + (save-excursion + (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) + (nntp-decode-text) + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (erase-buffer) + (setq gnus-asynch-header-prefetched nil) + t))) + (provide 'gnus-async) ;;; gnus-async.el ends here *** pub/rgnus/lisp/gnus-cache.el Sun Jul 28 23:11:50 1996 --- rgnus/lisp/gnus-cache.el Fri Aug 2 18:50:08 1996 *************** *** 28,33 **** --- 28,35 ---- (require 'gnus-load) (require 'gnus-int) (require 'gnus-range) + (require 'gnus-sum) + (require 'gnus-start) (require 'gnus) (defvar gnus-cache-directory *** pub/rgnus/lisp/gnus-cite.el Wed Jul 31 21:06:10 1996 --- rgnus/lisp/gnus-cite.el Fri Aug 2 18:50:09 1996 *************** *** 245,251 **** (search-forward "\n\n" nil t) (push (cons (point-marker) "") marks) (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) (push (cons (point-marker) "") marks) (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) (let* ((omarks marks)) --- 245,251 ---- (search-forward "\n\n" nil t) (push (cons (point-marker) "") marks) (goto-char (point-max)) ! (article-search-signature) (push (cons (point-marker) "") marks) (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) (let* ((omarks marks)) *************** *** 375,381 **** (hiden 0) total) (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdar atts) --- 375,381 ---- (hiden 0) total) (goto-char (point-max)) ! (article-search-signature) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdar atts) *************** *** 441,447 **** (case-fold-search t) (max (save-excursion (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. --- 441,447 ---- (case-fold-search t) (max (save-excursion (goto-char (point-max)) ! (article-search-signature) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. *** pub/rgnus/lisp/gnus-dup.el Fri Aug 2 22:35:02 1996 --- rgnus/lisp/gnus-dup.el Fri Aug 2 21:48:10 1996 *************** *** 0 **** --- 1,130 ---- + ;;; gnus-dup.el --- suppression of duplicate articles in Gnus + ;; Copyright (C) 1996 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: + + ;; This package tries to mark articles as read the second time the + ;; user reads a copy. This is useful if the server doesn't support + ;; Xref properly, or if the user reads the same group from several + ;; servers. + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-art) + (require 'gnus) + + (defvar gnus-save-duplicate-list nil + "*If non-nil, save the duplicate list when shutting down Gnus. + If nil, duplicate suppression will only work on duplicates + seen in the same session.") + + (defvar gnus-duplicate-list-length 10000 + "*The number of Message-IDs to keep in the duplicate suppression list.") + + (defvar gnus-duplicate-file (nnheader-concat gnus-directory "suppression") + "*The name of the file to store the duplicate suppression list.") + + ;;; Internal variables + + (defvar gnus-dup-list nil) + (defvar gnus-dup-hashtb nil) + + ;;; + ;;; Starting and stopping + ;;; + + (gnus-add-shutdown 'gnus-dup-close 'gnus) + + (defun gnus-dup-close () + "Possibly save the duplicate suppression list and shut down the subsystem." + (when gnus-save-duplicate-list + (gnus-dup-save)) + (setq gnus-dup-list nil + gnus-dup-hashtb nil)) + + (defun gnus-dup-open () + "Possibly read the duplicate suppression list and start the subsystem." + (if gnus-save-duplicate-list + (gnus-dup-read) + (setq gnus-dup-list nil)) + (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) + ;; Enter all Message-IDs into the hash table. + (let ((list gnus-dup-list) + (obarray gnus-dup-hashtb)) + (while list + (intern (pop list))))) + + (defun gnus-dup-read () + "Read the duplicate suppression list." + (setq gnus-dup-list nil) + (when (file-exists-p gnus-duplicate-file) + (load gnus-duplicate-file t t t))) + + (defun gnus-dup-save () + "Save the duplicate suppression list." + (nnheader-temp-write gnus-duplicate-file + (prin1 `(setq gnus-duplicate-file ',gnus-duplicate-file) + (current-buffer)))) + + ;;; + ;;; Interface functions + ;;; + + (defun gnus-dup-enter-articles () + "Enter articles from the current group for future duplicate suppression." + (unless gnus-dup-list + (gnus-dup-open)) + (let ((data gnus-newsgroup-data) + id) + ;; Enter the Message-IDs of all read articles into the list + ;; and hash table. + (while data + (when (gnus-data-read-p (car data)) + (intern (car (push (mail-header-id (gnus-data-header (car data))) + gnus-dup-list)) + gnus-dup-hashtb)) + (pop data)) + ;; Chop off excess Message-IDs from the list. + (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) + (when end + (setcdr end nil))))) + + (defun gnus-dup-suppress-articles () + "Mark duplicate articles as read." + (unless gnus-dup-list + (gnus-dup-open)) + (let ((headers gnus-newsgroup-headers) + number) + (while headers + (when (intern-soft (mail-header-id (car headers)) gnus-dup-hashtb) + (setq gnus-newsgroup-unreads + (delq (setq number (mail-header-number (car headers))) + gnus-newsgroup-unreads)) + (push (cons number gnus-duplicate-mark) + gnus-newsgroup-reads)) + (pop headers)))) + + (provide 'gnus-dup) + + ;;; gnus-dup.el ends here *** pub/rgnus/lisp/gnus-eform.el Fri Aug 2 22:35:03 1996 --- rgnus/lisp/gnus-eform.el Fri Aug 2 18:50:09 1996 *************** *** 0 **** --- 1,124 ---- + ;;; gnus-eform.el --- a mode for editing forms for Gnus + ;; Copyright (C) 1996 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: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-win) + (require 'gnus) + + ;;; + ;;; Editing forms + ;;; + + (defvar gnus-edit-form-mode-hook nil + "Hook run in `gnus-edit-form-mode' buffers.") + + (defvar gnus-edit-form-menu-hook nil + "Hook run when creating menus in `gnus-edit-form-mode' buffers.") + + ;;; Internal variables + + (defvar gnus-edit-form-done-function nil) + (defvar gnus-edit-form-buffer "*Gnus edit form*") + + (defvar gnus-edit-form-mode-map nil) + (unless gnus-edit-form-mode-map + (set gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map)) + (gnus-define-keys gnus-edit-form-mode-map + "\C-c\C-c" gnus-edit-form-done + "\C-c\C-k" gnus-edit-form-exit)) + + (defun gnus-edit-form-make-menu-bar () + (unless (boundp 'gnus-edit-form-menu) + (easy-menu-define + gnus-edit-form-menu gnus-edit-form-mode-map "" + '("Edit Form" + ["Exit and save changes" gnus-edit-form-done t] + ["Exit" gnus-edit-form-exit t])) + (run-hooks 'gnus-edit-form-menu-hook))) + + (defun gnus-edit-form-mode () + "Major mode for editing forms. + It is a slightly enhanced emacs-lisp-mode. + + \\{gnus-edit-form-mode-map}" + (interactive) + (when (and menu-bar-mode + (gnus-visual-p 'group-menu 'menu)) + (gnus-edit-form-make-menu-bar)) + (kill-all-local-variables) + (setq major-mode 'gnus-edit-form-mode) + (setq mode-name "Edit Form") + (use-local-map gnus-edit-form-mode-map) + (make-local-variable 'gnus-edit-form-done-function) + (make-local-variable 'gnus-prev-winconf) + (run-hooks 'gnus-edit-form-mode-hook)) + + (defun gnus-edit-form (form documentation exit-func) + "Edit FORM in a new buffer. + Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning + of the buffer." + (let ((winconf (current-window-configuration))) + (set-buffer (setq gnus-edit-form-buffer + (get-buffer-create gnus-edit-form-buffer))) + (gnus-configure-windows 'edit-form) + (gnus-add-current-to-buffer-list) + (gnus-edit-form-mode) + (setq gnus-prev-winconf winconf) + (setq gnus-edit-form-done-function exit-func) + (erase-buffer) + (insert documentation) + (unless (bolp) + (insert "\n")) + (goto-char (point-min)) + (while (not (eobp)) + (insert ";;; ") + (forward-line 1)) + (insert ";; Type `C-c C-c' after you've finished editing.\n") + (insert "\n") + (let ((p (point))) + (pp form (current-buffer)) + (insert "\n") + (goto-char p)))) + + (defun gnus-edit-form-done () + "Update changes and kill the current buffer." + (interactive) + (goto-char (point-min)) + (let ((form (read (current-buffer)))) + (gnus-edit-form-exit) + (funcall gnus-edit-form-done-function form))) + + (defun gnus-edit-form-exit () + "Kill the current buffer." + (interactive) + (let ((winconf gnus-prev-winconf)) + (kill-buffer (current-buffer)) + (set-window-configuration winconf))) + + (provide 'gnus-eform) + + ;;; gnus-eform.el ends here *** pub/rgnus/lisp/gnus-gl.el Sun Jul 28 13:49:15 1996 --- rgnus/lisp/gnus-gl.el Fri Aug 2 18:50:09 1996 *************** *** 855,861 **** (setq gnus-summary-line-format gnus-summary-grouplens-line-format) (make-local-variable 'gnus-summary-line-format-spec) ! (setq gnus-summary-line-format-spec nil) ;; Set up the menu. (when (and menu-bar-mode --- 855,863 ---- (setq gnus-summary-line-format gnus-summary-grouplens-line-format) (make-local-variable 'gnus-summary-line-format-spec) ! (setq gnus-summary-line-format nil) ! (gnus-update-format-specifications nil 'summary) ! (gnus-update-summary-mark-positions) ;; Set up the menu. (when (and menu-bar-mode *** pub/rgnus/lisp/gnus-group.el Wed Jul 31 22:11:13 1996 --- rgnus/lisp/gnus-group.el Fri Aug 2 22:16:35 1996 *************** *** 77,85 **** "*Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil.") - (defvar gnus-group-use-permanent-levels nil - "*If non-nil, once you set a level, Gnus will use this level.") - (defvar gnus-group-list-inactive-groups t "*If non-nil, inactive groups will be listed.") --- 77,82 ---- *************** *** 200,205 **** --- 197,203 ---- "Function to override finding the next group after listing groups.") (defvar gnus-group-edit-buffer nil) + (defvar gnus-edit-form-buffer nil) (defvar gnus-group-line-format-alist `((?M gnus-tmp-marked-mark ?c) *************** *** 1048,1055 **** (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) ! (zerop (+ number (length (cdr (assq 'tick marked))) ! (length (cdr (assq 'dormant marked))))))) no-article))) (defun gnus-group-select-group (&optional all) --- 1046,1055 ---- (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) ! (zerop (+ number (gnus-range-length ! (cdr (assq 'tick marked))) ! (gnus-range-length ! (cdr (assq 'dormant marked))))))) no-article))) (defun gnus-group-select-group (&optional all) *************** *** 1146,1163 **** (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (when group - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. (beginning-of-line) ! (if (eq (get-text-property (point) 'gnus-group) ! (gnus-intern-safe group gnus-active-hashtb)) ! (point) ;; Search through the entire buffer. ! (let ((b (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) ! (when b ! (goto-char b)))))) (defun gnus-group-next-group (n &optional silent) "Go to next N'th newsgroup. --- 1146,1177 ---- (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (when group (beginning-of-line) ! (cond ! ;; It's quite likely that we are on the right line, so ! ;; we check the current line first. ! ((eq (get-text-property (point) 'gnus-group) ! (gnus-intern-safe group gnus-active-hashtb)) ! (point)) ! ;; Previous and next line are also likely, so we check them as well. ! ((save-excursion ! (forward-line -1) ! (eq (get-text-property (point) 'gnus-group) ! (gnus-intern-safe group gnus-active-hashtb))) ! (forward-line -1) ! (point)) ! ((save-excursion ! (forward-line 1) ! (eq (get-text-property (point) 'gnus-group) ! (gnus-intern-safe group gnus-active-hashtb))) ! (forward-line 1) ! (point)) ! (t ;; Search through the entire buffer. ! (gnus-goto-char ! (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))) (defun gnus-group-next-group (n &optional silent) "Go to next N'th newsgroup. *************** *** 1269,1293 **** The user will be prompted for a NAME, for a select METHOD, and an ADDRESS." (interactive ! (cons (read-string "Group name: ") ! (let ((method ! (completing-read ! "Method: " (append gnus-valid-select-methods gnus-server-alist) ! nil t nil 'gnus-method-history))) ! (cond ! ((equal method "") ! (setq method gnus-select-method)) ! ((assoc method gnus-valid-select-methods) ! (list method ! (if (memq 'prompt-address ! (assoc method gnus-valid-select-methods)) ! (read-string "Address: ") ! ""))) ! ((assoc method gnus-server-alist) ! (list method)) ! (t ! (list method "")))))) (let* ((meth (when (and method (not (gnus-server-equal method gnus-select-method))) --- 1283,1291 ---- The user will be prompted for a NAME, for a select METHOD, and an ADDRESS." (interactive ! (list (read-string "Group name: ") ! (gnus-read-server "From method: "))) (let* ((meth (when (and method (not (gnus-server-equal method gnus-select-method))) *************** *** 1405,1448 **** (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let* ((part (or part 'info)) ! (done-func `(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done ',part ,group))) ! (winconf (current-window-configuration)) ! info) ! (or group (error "No group on current line")) ! (or (setq info (gnus-get-info group)) ! (error "Killed group; can't be edited")) ! (set-buffer (setq gnus-group-edit-buffer ! (get-buffer-create ! (format "*Gnus edit %s*" group)))) ! (gnus-configure-windows 'edit-group) ! (gnus-add-current-to-buffer-list) ! (emacs-lisp-mode) ! ;; Suggested by Hallvard B Furuseth . ! (use-local-map (copy-keymap emacs-lisp-mode-map)) ! (local-set-key "\C-c\C-c" done-func) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (erase-buffer) ! (insert ! (cond ! ((eq part 'method) ! ";; Type `C-c C-c' after editing the select method.\n\n") ! ((eq part 'params) ! ";; Type `C-c C-c' after editing the group parameters.\n\n") ! ((eq part 'info) ! ";; Type `C-c C-c' after editing the group info.\n\n"))) ! (insert ! (pp-to-string ! (cond ((eq part 'method) ! (or (gnus-info-method info) "native")) ! ((eq part 'params) ! (gnus-info-params info)) ! (t info))) ! "\n"))) (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." --- 1403,1430 ---- (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((part (or part 'info)) ! info) ! (unless group ! (error "No group on current line")) ! (unless (setq info (gnus-get-info group)) ! (error "Killed group; can't be edited")) ! (gnus-edit-form ! ;; Find the proper form to edit. ! (cond ((eq part 'method) ! (or (gnus-info-method info) "native")) ! ((eq part 'params) ! (gnus-info-params info)) ! (t info)) ! ;; The proper documentation. ! (format ! "Editing the %s." ! (cond ! ((eq part 'method) "select method") ! ((eq part 'params) "group parameters") ! (t "group info"))) ! `(lambda (form) ! (gnus-group-edit-group-done ',part ,group form))))) (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." *************** *** 1454,1504 **** (interactive (list (gnus-group-group-name))) (gnus-group-edit-group group 'params)) ! (defun gnus-group-edit-group-done (part group) ! "Get info from buffer, update variables and jump to the group buffer." ! (when (and gnus-group-edit-buffer ! (buffer-name gnus-group-edit-buffer)) ! (set-buffer gnus-group-edit-buffer) ! (goto-char (point-min)) ! (let* ((form (read (current-buffer))) ! (winconf gnus-prev-winconf) ! (method (cond ((eq part 'info) (nth 4 form)) ! ((eq part 'method) form) ! (t nil))) ! (info (cond ((eq part 'info) form) ! ((eq part 'method) (gnus-get-info group)) (t nil))) ! (new-group (if info ! (if (or (not method) ! (gnus-server-equal ! gnus-select-method method)) ! (gnus-group-real-name (car info)) ! (gnus-group-prefixed-name ! (gnus-group-real-name (car info)) method)) ! nil))) ! (when (and new-group ! (not (equal new-group group))) ! (when (gnus-group-goto-group group) ! (gnus-group-kill-group 1)) ! (gnus-activate-group new-group)) ! ;; Set the info. ! (if (and info new-group) ! (progn ! (setq info (gnus-copy-sequence info)) ! (setcar info new-group) ! (unless (gnus-server-equal method "native") ! (unless (nthcdr 3 info) ! (nconc info (list nil nil))) ! (unless (nthcdr 4 info) ! (nconc info (list nil))) ! (gnus-info-set-method info method)) ! (gnus-group-set-info info)) ! (gnus-group-set-info form (or new-group group) part)) ! (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) ! (set-buffer gnus-group-buffer) ! (gnus-group-update-group (or new-group group)) ! (gnus-group-position-point)))) (defun gnus-group-make-help-group () "Create the Gnus documentation group." --- 1436,1476 ---- (interactive (list (gnus-group-group-name))) (gnus-group-edit-group group 'params)) ! (defun gnus-group-edit-group-done (part group form) ! "Update variables." ! (let* ((method (cond ((eq part 'info) (nth 4 form)) ! ((eq part 'method) form) (t nil))) ! (info (cond ((eq part 'info) form) ! ((eq part 'method) (gnus-get-info group)) ! (t nil))) ! (new-group (if info ! (if (or (not method) ! (gnus-server-equal ! gnus-select-method method)) ! (gnus-group-real-name (car info)) ! (gnus-group-prefixed-name ! (gnus-group-real-name (car info)) method)) ! nil))) ! (when (and new-group ! (not (equal new-group group))) ! (when (gnus-group-goto-group group) ! (gnus-group-kill-group 1)) ! (gnus-activate-group new-group)) ! ;; Set the info. ! (if (not (and info new-group)) ! (gnus-group-set-info form (or new-group group) part) ! (setq info (gnus-copy-sequence info)) ! (setcar info new-group) ! (unless (gnus-server-equal method "native") ! (unless (nthcdr 3 info) ! (nconc info (list nil nil))) ! (unless (nthcdr 4 info) ! (nconc info (list nil))) ! (gnus-info-set-method info method)) ! (gnus-group-set-info info)) ! (gnus-group-update-group (or new-group group)) ! (gnus-group-position-point))) (defun gnus-group-make-help-group () "Create the Gnus documentation group." *************** *** 2609,2614 **** --- 2581,2654 ---- (defun gnus-group-set-params-info (group params) (gnus-group-set-info params group 'params)) + + (defun gnus-add-marked-articles (group type articles &optional info force) + ;; Add ARTICLES of TYPE to the info of GROUP. + ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't + ;; add, but replace marked articles of TYPE with ARTICLES. + (let ((info (or info (gnus-get-info group))) + (uncompressed '(score bookmark killed)) + marked m) + (or (not info) + (and (not (setq marked (nthcdr 3 info))) + (or (null articles) + (setcdr (nthcdr 2 info) + (list (list (cons type (gnus-compress-sequence + articles t))))))) + (and (not (setq m (assq type (car marked)))) + (or (null articles) + (setcar marked + (cons (cons type (gnus-compress-sequence articles t) ) + (car marked))))) + (if force + (if (null articles) + (setcar (nthcdr 3 info) + (delq (assq type (car marked)) (car marked))) + (setcdr m (gnus-compress-sequence articles t))) + (setcdr m (gnus-compress-sequence + (sort (nconc (gnus-uncompress-range (cdr m)) + (copy-sequence articles)) '<) t)))))) + + (defun gnus-update-read-articles (group unread) + "Update the list of read and ticked articles in GROUP using the + UNREAD and TICKED lists. + Note: UNSELECTED has to be sorted over `<'. + Returns whether the updating was successful." + (let* ((active (or gnus-newsgroup-active (gnus-active group))) + (entry (gnus-gethash group gnus-newsrc-hashtb)) + (info (nth 2 entry)) + (prev 1) + (unread (sort (copy-sequence unread) '<)) + read) + (if (or (not info) (not active)) + ;; There is no info on this group if it was, in fact, + ;; killed. Gnus stores no information on killed groups, so + ;; there's nothing to be done. + ;; One could store the information somewhere temporarily, + ;; perhaps... Hmmm... + () + ;; Remove any negative articles numbers. + (while (and unread (< (car unread) 0)) + (setq unread (cdr unread))) + ;; Remove any expired article numbers + (while (and unread (< (car unread) (car active))) + (setq unread (cdr unread))) + ;; Compute the ranges of read articles by looking at the list of + ;; unread articles. + (while unread + (if (/= (car unread) prev) + (setq read (cons (if (= prev (1- (car unread))) prev + (cons prev (1- (car unread)))) read))) + (setq prev (1+ (car unread))) + (setq unread (cdr unread))) + (when (<= prev (cdr active)) + (setq read (cons (cons prev (cdr active)) read))) + ;; Enter this list into the group info. + (gnus-info-set-read + info (if (> (length read) 1) (nreverse read) read)) + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (gnus-get-unread-articles-in-group info (gnus-active group)) + t))) (provide 'gnus-group) *** pub/rgnus/lisp/gnus-int.el Tue Jul 30 22:08:06 1996 --- rgnus/lisp/gnus-int.el Fri Aug 2 18:50:10 1996 *************** *** 43,86 **** ;; Stream is already opened. nil ;; Open NNTP server. ! (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) ! (if confirm ! (progn ! ;; Read server name with completion. ! (setq gnus-nntp-server ! (completing-read "NNTP server: " ! (mapcar (lambda (server) (list server)) ! (cons (list gnus-nntp-server) ! gnus-secondary-servers)) ! nil nil gnus-nntp-server)))) ! (if (and gnus-nntp-server ! (stringp gnus-nntp-server) ! (not (string= gnus-nntp-server ""))) ! (setq gnus-select-method ! (cond ((or (string= gnus-nntp-server "") ! (string= gnus-nntp-server "::")) ! (list 'nnspool (system-name))) ! ((string-match "^:" gnus-nntp-server) ! (list 'nnmh gnus-nntp-server ! (list 'nnmh-directory ! (file-name-as-directory ! (expand-file-name ! (concat "~/" (substring ! gnus-nntp-server 1))))) ! (list 'nnmh-get-new-mail nil))) ! (t ! (list 'nntp gnus-nntp-server))))) (setq how (car gnus-select-method)) ! (cond ((eq how 'nnspool) ! (require 'nnspool) ! (gnus-message 5 "Looking up local news spool...")) ! ((eq how 'nnmh) ! (require 'nnmh) ! (gnus-message 5 "Looking up mh spool...")) ! (t ! (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) (or --- 43,87 ---- ;; Stream is already opened. nil ;; Open NNTP server. ! (unless gnus-nntp-service ! (setq gnus-nntp-server nil)) ! (when confirm ! ;; Read server name with completion. ! (setq gnus-nntp-server ! (completing-read "NNTP server: " ! (mapcar (lambda (server) (list server)) ! (cons (list gnus-nntp-server) ! gnus-secondary-servers)) ! nil nil gnus-nntp-server))) ! (when (and gnus-nntp-server ! (stringp gnus-nntp-server) ! (not (string= gnus-nntp-server ""))) ! (setq gnus-select-method ! (cond ((or (string= gnus-nntp-server "") ! (string= gnus-nntp-server "::")) ! (list 'nnspool (system-name))) ! ((string-match "^:" gnus-nntp-server) ! (list 'nnmh gnus-nntp-server ! (list 'nnmh-directory ! (file-name-as-directory ! (expand-file-name ! (concat "~/" (substring ! gnus-nntp-server 1))))) ! (list 'nnmh-get-new-mail nil))) ! (t ! (list 'nntp gnus-nntp-server))))) (setq how (car gnus-select-method)) ! (cond ! ((eq how 'nnspool) ! (require 'nnspool) ! (gnus-message 5 "Looking up local news spool...")) ! ((eq how 'nnmh) ! (require 'nnmh) ! (gnus-message 5 "Looking up mh spool...")) ! (t ! (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) (or *** pub/rgnus/lisp/gnus-load.el Wed Jul 31 22:34:17 1996 --- rgnus/lisp/gnus-load.el Fri Aug 2 21:27:24 1996 *************** *** 137,142 **** --- 137,152 ---- that case, just return a fully prefixed name of the group -- \"nnml+private:mail.misc\", for instance.") + (defvar gnus-secondary-servers nil + "*List of NNTP servers that the user can choose between interactively. + To make Gnus query you for a server, you have to give `gnus' a + non-numeric prefix - `C-u M-x gnus', in short.") + + (defvar gnus-nntp-server nil + "*The name of the host running the NNTP server. + This variable is semi-obsolete. Use the `gnus-select-method' + variable instead.") + (defvar gnus-secondary-select-methods nil "*A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see *************** *** 278,283 **** --- 288,296 ---- (defvar gnus-use-nocem nil "*If non-nil, Gnus will read NoCeM cancel messages.") + (defvar gnus-suppress-duplicates nil + "*If non-nil, Gnus will mark duplicate copies of the same article as read.") + (defvar gnus-use-demon nil "If non-nil, Gnus might use some demons.") *************** *** 371,376 **** --- 384,392 ---- (defvar gnus-group-uncollapsed-levels 1 "Number of group name elements to leave alone when making a short group name.") + (defvar gnus-group-use-permanent-levels nil + "*If non-nil, once you set a level, Gnus will use this level.") + ;; Hooks. (defvar gnus-load-hook nil *************** *** 537,543 **** ("pp" pp pp-to-string pp-eval-expression) ("mail-extr" mail-extract-address-components) ("nnmail" nnmail-split-fancy nnmail-article-group) ! ("nnvirtual" nnvirtual-catchup-group) ("timezone" timezone-make-date-arpa-standard timezone-fix-time timezone-make-sortable-date timezone-make-time-string) ("rmailout" rmail-output) --- 553,559 ---- ("pp" pp pp-to-string pp-eval-expression) ("mail-extr" mail-extract-address-components) ("nnmail" nnmail-split-fancy nnmail-article-group) ! ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) ("timezone" timezone-make-date-arpa-standard timezone-fix-time timezone-make-sortable-date timezone-make-time-string) ("rmailout" rmail-output) *************** *** 645,651 **** ("gnus-group" gnus-group-insert-group-line gnus-group-quit gnus-group-list-groups gnus-group-first-unread-group gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc ! gnus-group-setup-buffer gnus-group-get-new-news) ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article gnus-backlog-remove-article) ("gnus-art" gnus-article-read-summary-keys gnus-article-save --- 661,668 ---- ("gnus-group" gnus-group-insert-group-line gnus-group-quit gnus-group-list-groups gnus-group-first-unread-group gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc ! gnus-group-setup-buffer gnus-group-get-new-news ! gnus-group-make-help-group gnus-group-update-group) ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article gnus-backlog-remove-article) ("gnus-art" gnus-article-read-summary-keys gnus-article-save *************** *** 662,677 **** gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed ! gnus-decode-rfc1522 gnus-article-show-all-headers) ("gnus-int" gnus-request-type) ! ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1) ("gnus-range" gnus-copy-sequence) ("gnus-vm" gnus-vm-mail-setup) ("gnus-logic" gnus-score-advanced) ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm)))) ;;; ;;; Skeleton keymaps --- 679,761 ---- gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed ! gnus-decode-rfc1522 gnus-article-show-all-headers ! gnus-article-edit-mode) ("gnus-int" gnus-request-type) ! ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 ! gnus-dribble-enter) ! ("gnus-dup" gnus-dup-suppress-articles gnus-dup-enter-articles) ("gnus-range" gnus-copy-sequence) ("gnus-vm" gnus-vm-mail-setup) + ("gnus-eform" gnus-edit-form) + ("gnus-move" :interactive t + gnus-group-move-group-to-server gnus-change-server) ("gnus-logic" gnus-score-advanced) ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm)))) + + ;;; gnus-sum.el thingies + + + (defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + "*The format specification of the lines in the summary buffer. + + It works along the same lines as a normal formatting string, + with some simple extensions. + + %N Article number, left padded with spaces (string) + %S Subject (string) + %s Subject if it is at the root of a thread, and \"\" otherwise (string) + %n Name of the poster (string) + %a Extracted name of the poster (string) + %A Extracted address of the poster (string) + %F Contents of the From: header (string) + %x Contents of the Xref: header (string) + %D Date of the article (string) + %d Date of the article (string) in DD-MMM format + %M Message-id of the article (string) + %r References of the article (string) + %c Number of characters in the article (integer) + %L Number of lines in the article (integer) + %I Indentation based on thread level (a string of spaces) + %T A string with two possible values: 80 spaces if the article + is on thread level two or larger and 0 spaces on level one + %R \"A\" if this article has been replied to, \" \" otherwise (character) + %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") + %[ Opening bracket (character, \"[\" or \"<\") + %] Closing bracket (character, \"]\" or \">\") + %> Spaces of length thread-level (string) + %< Spaces of length (- 20 thread-level) (string) + %i Article score (number) + %z Article zcore (character) + %t Number of articles under the current thread (number). + %e Whether the thread is empty or not (character). + %l GroupLens score (string). + %P The line number (number). + %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 + current header as argument. The function should return a string, which + will be inserted into the summary just like information from any other + summary specifier. + + Text between %( and %) will be highlighted with `gnus-mouse-face' + when the mouse point is placed inside the area. There can only be one + such area. + + The %U (status), %R (replied) and %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. + + The smart choice is to have these specs as for to the left as + possible. + + This restriction may disappear in later versions of Gnus.") ;;; ;;; Skeleton keymaps *** pub/rgnus/lisp/gnus-move.el Fri Aug 2 22:35:05 1996 --- rgnus/lisp/gnus-move.el Fri Aug 2 18:50:11 1996 *************** *** 0 **** --- 1,172 ---- + ;;; gnus-move.el --- commands for moving Gnus from one server to another + ;; Copyright (C) 1996 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: + + ;;; Code: + + (require 'gnus-load) + (require 'gnus-start) + (require 'gnus-int) + (require 'gnus-range) + (require 'gnus) + + ;;; + ;;; Moving by comparing Message-ID's. + ;;; + + ;;;###autoload + (defun gnus-change-server (from-server to-server) + "Move from FROM-SERVER to TO-SERVER. + Update the .newsrc.eld file to reflect the change of nntp server." + (interactive + (list gnus-select-method (gnus-read-server "Move to method: "))) + + ;; First start Gnus. + (let ((gnus-activate-level 0) + (nnmail-spool-file nil)) + (gnus)) + + (save-excursion + ;; Go through all groups and translate. + (let ((newsrc gnus-newsrc-alist) + (nntp-nov-gap nil) + info) + (while (setq info (pop newsrc)) + (when (gnus-group-native-p (gnus-info-group info)) + (gnus-move-group-to-server info from-server to-server)))))) + + (defun gnus-move-group-to-server (info from-server to-server) + "Move group INFO from FROM-SERVER to TO-SERVER." + (let ((group (gnus-info-group info)) + to-active hashtb type mark marks + to-article to-reads to-marks article) + (gnus-message 7 "Translating %s..." group) + (when (gnus-request-group group nil to-server) + (setq to-active (gnus-parse-active) + hashtb (make-vector 1023 0)) + ;; Fetch the headers from the `to-server'. + (when (setq type (gnus-retrieve-headers + (car to-active) (cdr to-active))) + ;; Convert HEAD headers. I don't care. + (when (eq type 'headers) + (nnvirtual-convert-headers)) + ;; Create a mapping from Message-ID to article number. + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (while (looking-at + "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t" + nil t) + (gnus-sethash + (buffer-substring (match-beginning 1) (match-end 1)) + (read (current-buffer)) + hashtb) + (forward-line 1)) + ;; Then we read the headers from the `from-server'. + (when (and (gnus-request-group group nil from-server) + (gnus-active group) + (setq type (gnus-retrieve-headers + (car (gnus-active group)) + (cdr (gnus-active group))))) + ;; Make it easier to map marks. + (let ((mark-lists (gnus-info-marks info)) + ms type m) + (while mark-lists + (setq type (caar mark-lists) + ms (gnus-uncompress-range (cdr (pop mark-lists)))) + (while ms + (if (setq m (assq (car ms) marks)) + (setcdr m (cons type (cdr m))) + (push (list (car ms) type) marks)) + (pop ms)))) + ;; Convert. + (when (eq type 'headers) + (nnvirtual-convert-headers)) + ;; Go through the headers and map away. + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (while (looking-at + "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t" + nil t) + (setq to-article + (gnus-gethash + (buffer-substring (match-beginning 1) (match-end 1)) + hashtb)) + ;; Add this article to the list of read articles. + (push to-article to-reads) + ;; See if there are any marks and then add them. + (when (setq mark (assq (read (current-buffer)) marks)) + (setq marks (delq mark marks)) + (setcar mark to-article) + (push mark to-marks)) + (forward-line 1)) + ;; Now we know what the read articles are and what the + ;; article marks are. We transform the information + ;; into the Gnus info format. + (setq to-reads + (gnus-range-add + (gnus-compress-sequence (sort to-reads '<) t) + (cons 1 (1- (car to-active))))) + (gnus-info-set-read info to-reads) + ;; Do the marks. I'm sure y'all understand what's + ;; going on down below, so I won't bother with any + ;; further comments. + (let ((mlists gnus-article-mark-lists) + lists ms a) + (while mlists + (push (list (cdr (pop mlists))) lists)) + (while (setq ms (pop marks)) + (setq article (pop ms)) + (while ms + (setcdr (setq a (assq (pop ms) lists)) + (cons article (cdr a))))) + (setq a lists) + (while a + (setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<))) + (pop a)) + (gnus-info-set-marks info lists))))) + (gnus-message 7 "Translating %s...done" group))) + + (defun gnus-group-move-group-to-server (info from-server to-server) + "Move the group on the current line from FROM-SERVER to TO-SERVER." + (interactive + (let ((info (gnus-get-info (gnus-group-group-name)))) + (list info (gnus-find-method-for-group (gnus-info-group info)) + (gnus-read-server (format "Move group %s to method: " + (gnus-info-group info)))))) + (save-excursion + (gnus-move-group-to-server info from-server to-server) + ;; We have to update the group info to point use the right server. + (gnus-info-set-method info to-server t) + ;; We also have to change the name of the group and stuff. + (let* ((group (gnus-info-group info)) + (new-name (gnus-group-prefixed-name + (gnus-group-real-name group) to-server))) + (gnus-info-set-group info new-name) + (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) + gnus-newsrc-hashtb) + (gnus-sethash group nil gnus-newsrc-hashtb)))) + + (provide 'gnus-move) + + ;;; gnus-move.el ends here *** pub/rgnus/lisp/gnus-msg.el Sun Jul 28 14:34:44 1996 --- rgnus/lisp/gnus-msg.el Fri Aug 2 18:50:11 1996 *************** *** 710,717 **** "Attemps to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path." (interactive) ! (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el" ! "message.el")) file dirs expr olist sym) (gnus-message 4 "Please wait while we snoop your variables...") (sit-for 0) --- 710,719 ---- "Attemps to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path." (interactive) ! (let ((files '("gnus-sum.el" "gnus-group.el" ! "gnus-art.el" "gnus-start.el" ! "gnus-msg.el" "gnus-score.el" ! "nnmail.el" "message.el")) file dirs expr olist sym) (gnus-message 4 "Please wait while we snoop your variables...") (sit-for 0) *** pub/rgnus/lisp/gnus-range.el Sun Jul 28 10:13:28 1996 --- rgnus/lisp/gnus-range.el Fri Aug 2 18:50:11 1996 *************** *** 265,270 **** --- 265,285 ---- sublist nil))) sublistp)) + (defun gnus-range-add (range1 range2) + "Add RANGE2 to RANGE1 destructively." + (cond + ;; If either are nil, then the job is quite easy. + ((or (null range1) (null range2)) + (or range1 range2)) + (t + ;; I don't like thinking. + (gnus-compress-sequence + (sort + (nconc + (gnus-uncompress-range range1) + (gnus-uncompress-range range2)) + '<))))) + (provide 'gnus-range) ;;; gnus-range.el ends here *** pub/rgnus/lisp/gnus-salt.el Sun Jul 28 14:34:43 1996 --- rgnus/lisp/gnus-salt.el Fri Aug 2 18:52:03 1996 *************** *** 40,45 **** --- 40,53 ---- (defvar gnus-pick-mode-hook nil "Hook run in summary pick mode buffers.") + (defvar gnus-mark-unpicked-articles-as-read nil + "*If non-nil, mark all unpicked articles as read.") + + (defvar gnus-summary-pick-line-format + "%-5p %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + "*The format specification of the lines in pick buffers. + It accepts the same format specs that `gnus-summary-line-format' does.") + ;;; Internal variables. (defvar gnus-pick-mode-map nil) *************** *** 51,57 **** gnus-pick-mode-map "t" gnus-uu-mark-thread "T" gnus-uu-unmark-thread ! " " gnus-summary-mark-as-processable "u" gnus-summary-unmark-as-processable "U" gnus-summary-unmark-all-processable "v" gnus-uu-mark-over --- 59,65 ---- 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 *************** *** 61,66 **** --- 69,75 ---- "E" gnus-uu-mark-by-regexp "b" gnus-uu-mark-buffer "B" gnus-uu-unmark-buffer + "." gnus-pick-article "\r" gnus-pick-start-reading)) (defun gnus-pick-make-menu-bar () *************** *** 97,102 **** --- 106,119 ---- ;; Make sure that we don't select any articles upon group entry. (make-local-variable 'gnus-auto-select-first) (setq gnus-auto-select-first nil) + ;; Change line format. + (make-local-variable 'gnus-summary-line-format) + (setq gnus-summary-line-format + gnus-summary-pick-line-format) + (make-local-variable 'gnus-summary-line-format-spec) + (setq gnus-summary-line-format nil) + (gnus-update-format-specifications nil 'summary) + (gnus-update-summary-mark-positions) ;; Set up the menu. (when (and menu-bar-mode (gnus-visual-p 'pick-menu 'menu)) *************** *** 108,113 **** --- 125,137 ---- minor-mode-map-alist)) (run-hooks 'gnus-pick-mode-hook)))) + (defvar gnus-pick-line-number 1) + (defun gnus-pick-line-number () + "Return the current line number." + (if (bobp) + (setq gnus-pick-line-number 1) + (incf gnus-pick-line-number))) + (defun gnus-pick-start-reading (&optional catch-up) "Start reading the picked articles. If given a prefix, mark all unpicked articles as read." *************** *** 115,125 **** (unless gnus-newsgroup-processable (error "No articles have been picked")) (gnus-summary-limit-to-articles nil) ! (when catch-up (gnus-summary-limit-mark-excluded-as-read)) (gnus-summary-first-unread-article) (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) ;;; ;;; gnus-binary-mode --- 139,170 ---- (unless gnus-newsgroup-processable (error "No articles have been picked")) (gnus-summary-limit-to-articles nil) ! (when (or catch-up gnus-mark-unpicked-articles-as-read) (gnus-summary-limit-mark-excluded-as-read)) (gnus-summary-first-unread-article) (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) + (defun gnus-pick-article (&optional arg) + "Pick the article on the current line. + If ARG, pick the article on that line instead." + (interactive "P") + (when arg + (let (pos) + (save-excursion + (goto-char (point-min)) + (when (zerop (forward-line (1- (prefix-numeric-value arg)))) + (setq pos (point)))) + (if (not pos) + (gnus-error 2 "No such line: %s" arg) + (goto-char pos)))) + (gnus-summary-mark-as-processable 1)) + + (defun gnus-pick-next-page () + "Go to the next page. If at the end of the buffer, start reading articles." + (interactive) + (condition-case () + (scroll-up) + (gnus-pick-start-reading))) ;;; ;;; gnus-binary-mode *** pub/rgnus/lisp/gnus-score.el Mon Jul 29 12:43:29 1996 --- rgnus/lisp/gnus-score.el Fri Aug 2 20:04:57 1996 *************** *** 554,571 **** (let ((score (gnus-score-default score)) (header (format "%s" (downcase header))) new) ! (and prompt (setq match (read-string ! (format "Match %s on %s, %s: " ! (cond ((eq date 'now) ! "now") ! ((stringp date) ! "temp") ! (t "permanent")) ! header ! (if (< score 0) "lower" "raise")) ! (if (numberp match) ! (int-to-string match) ! match)))) ;; Get rid of string props. (setq match (format "%s" match)) --- 554,572 ---- (let ((score (gnus-score-default score)) (header (format "%s" (downcase header))) new) ! (when prompt ! (setq match (read-string ! (format "Match %s on %s, %s: " ! (cond ((eq date 'now) ! "now") ! ((stringp date) ! "temp") ! (t "permanent")) ! header ! (if (< score 0) "lower" "raise")) ! (if (numberp match) ! (int-to-string match) ! match)))) ;; Get rid of string props. (setq match (format "%s" match)) *************** *** 1062,1109 **** (defun gnus-score-save () ;; Save all score information. ! (let ((cache gnus-score-cache)) (save-excursion (setq gnus-score-alist nil) ! (set-buffer (get-buffer-create "*Score*")) ! (buffer-disable-undo (current-buffer)) ! (let (entry score file) ! (while cache ! (setq entry (car cache) ! cache (cdr cache) ! file (car entry) ! score (cdr entry)) ! (if (or (not (equal (gnus-score-get 'touched score) '(t))) ! (gnus-score-get 'read-only score) ! (and (file-exists-p file) ! (not (file-writable-p file)))) ! () ! (setq score (setcdr entry (delq (assq 'touched score) score))) ! (erase-buffer) ! (let (emacs-lisp-mode-hook) ! (if (string-match ! (concat (regexp-quote gnus-adaptive-file-suffix) ! "$") file) ! ;; This is an adaptive score file, so we do not run ! ;; it through `pp'. These files can get huge, and ! ;; are not meant to be edited by human hands. ! (prin1 score (current-buffer)) ! ;; This is a normal score file, so we print it very ! ;; prettily. ! (pp score (current-buffer)))) ! (if (not (make-directory (file-name-directory file) t)) ! () ! ;; If the score file is empty, we delete it. ! (if (zerop (buffer-size)) ! (delete-file file) ! ;; There are scores, so we write the file. ! (when (file-writable-p file) ! (write-region (point-min) (point-max) file nil 'silent) ! (and gnus-score-after-write-file-function ! (funcall gnus-score-after-write-file-function file))))) ! (and gnus-score-uncacheable-files ! (string-match gnus-score-uncacheable-files file) ! (gnus-score-remove-from-cache file))))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) --- 1063,1111 ---- (defun gnus-score-save () ;; Save all score information. ! (let ((cache gnus-score-cache) ! entry score file) (save-excursion (setq gnus-score-alist nil) ! (nnheader-set-temp-buffer "*Score*") ! (while cache ! (current-buffer) ! (setq entry (pop cache) ! file (car entry) ! score (cdr entry)) ! (if (or (not (equal (gnus-score-get 'touched score) '(t))) ! (gnus-score-get 'read-only score) ! (and (file-exists-p file) ! (not (file-writable-p file)))) ! () ! (setq score (setcdr entry (delq (assq 'touched score) score))) ! (erase-buffer) ! (let (emacs-lisp-mode-hook) ! (if (string-match ! (concat (regexp-quote gnus-adaptive-file-suffix) ! "$") file) ! ;; This is an adaptive score file, so we do not run ! ;; it through `pp'. These files can get huge, and ! ;; are not meant to be edited by human hands. ! (prin1 score (current-buffer)) ! ;; This is a normal score file, so we print it very ! ;; prettily. ! (pp score (current-buffer)))) ! (if (and (not (file-exists-p (file-name-directory file))) ! (make-directory (file-name-directory file) t)) ! (gnus-error 1 "Can't create directory %s" ! (file-name-directory file)) ! ;; If the score file is empty, we delete it. ! (if (zerop (buffer-size)) ! (delete-file file) ! ;; There are scores, so we write the file. ! (when (file-writable-p file) ! (write-region (point-min) (point-max) file nil 'silent) ! (when gnus-score-after-write-file-function ! (funcall gnus-score-after-write-file-function file))))) ! (and gnus-score-uncacheable-files ! (string-match gnus-score-uncacheable-files file) ! (gnus-score-remove-from-cache file)))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) *** pub/rgnus/lisp/gnus-srvr.el Sun Jul 28 19:39:44 1996 --- rgnus/lisp/gnus-srvr.el Fri Aug 2 18:57:13 1996 *************** *** 417,455 **** (error "No server on current line")) (unless (assoc server gnus-server-alist) (error "This server can't be edited")) ! (let ((winconf (current-window-configuration)) ! (info (cdr (assoc server gnus-server-alist)))) (gnus-close-server info) ! (get-buffer-create gnus-server-edit-buffer) ! (gnus-configure-windows 'edit-server) ! (gnus-add-current-to-buffer-list) ! (emacs-lisp-mode) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (use-local-map (copy-keymap (current-local-map))) ! (let ((done-func '(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-server-edit-server-done 'group)))) ! (setcar (cdr (nth 4 done-func)) server) ! (local-set-key "\C-c\C-c" done-func)) ! (erase-buffer) ! (insert ";; Type `C-c C-c' after you have edited the server.\n\n") ! (insert (pp-to-string info)))) ! ! (defun gnus-server-edit-server-done (server) ! (interactive) ! (set-buffer (get-buffer-create gnus-server-edit-buffer)) ! (goto-char (point-min)) ! (let ((form (read (current-buffer))) ! (winconf gnus-prev-winconf)) ! (gnus-server-set-info server form) ! (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) ! (set-buffer gnus-server-buffer) ! (gnus-server-update-server server) ! (gnus-server-list-servers) ! (gnus-server-position-point))) (defun gnus-server-read-server (server) "Browse a server." --- 417,430 ---- (error "No server on current line")) (unless (assoc server gnus-server-alist) (error "This server can't be edited")) ! (let ((info (cdr (assoc server gnus-server-alist)))) (gnus-close-server info) ! (gnus-edit-form ! info "Editing the server." ! `(lambda (form) ! (gnus-server-set-info ,server form) ! (gnus-server-list-servers) ! (gnus-server-position-point))))) (defun gnus-server-read-server (server) "Browse a server." *** pub/rgnus/lisp/gnus-start.el Wed Jul 31 15:49:36 1996 --- rgnus/lisp/gnus-start.el Fri Aug 2 21:27:23 1996 *************** *** 33,48 **** (require 'gnus-range) (require 'message) - (defvar gnus-secondary-servers nil - "*List of NNTP servers that the user can choose between interactively. - To make Gnus query you for a server, you have to give `gnus' a - non-numeric prefix - `C-u M-x gnus', in short.") - - (defvar gnus-nntp-server nil - "*The name of the host running the NNTP server. - This variable is semi-obsolete. Use the `gnus-select-method' - variable instead.") - (defvar gnus-startup-file "~/.newsrc" "*Your `.newsrc' file. `.newsrc-SERVER' will be used instead if that exists.") --- 33,38 ---- *************** *** 1347,1407 **** t) (condition-case () (gnus-request-group group dont-check method) ! ; (error nil) (quit nil)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! ;; Parse the result we got from `gnus-request-group'. ! (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") ! (progn ! (goto-char (match-beginning 1)) ! (gnus-set-active ! group (setq active (cons (read (current-buffer)) ! (read (current-buffer))))) ! ;; Return the new active info. ! active)))))) ! ! (defun gnus-update-read-articles (group unread) ! "Update the list of read and ticked articles in GROUP using the ! UNREAD and TICKED lists. ! Note: UNSELECTED has to be sorted over `<'. ! Returns whether the updating was successful." ! (let* ((active (or gnus-newsgroup-active (gnus-active group))) ! (entry (gnus-gethash group gnus-newsrc-hashtb)) ! (info (nth 2 entry)) ! (prev 1) ! (unread (sort (copy-sequence unread) '<)) ! read) ! (if (or (not info) (not active)) ! ;; There is no info on this group if it was, in fact, ! ;; killed. Gnus stores no information on killed groups, so ! ;; there's nothing to be done. ! ;; One could store the information somewhere temporarily, ! ;; perhaps... Hmmm... ! () ! ;; Remove any negative articles numbers. ! (while (and unread (< (car unread) 0)) ! (setq unread (cdr unread))) ! ;; Remove any expired article numbers ! (while (and unread (< (car unread) (car active))) ! (setq unread (cdr unread))) ! ;; Compute the ranges of read articles by looking at the list of ! ;; unread articles. ! (while unread ! (if (/= (car unread) prev) ! (setq read (cons (if (= prev (1- (car unread))) prev ! (cons prev (1- (car unread)))) read))) ! (setq prev (1+ (car unread))) ! (setq unread (cdr unread))) ! (when (<= prev (cdr active)) ! (setq read (cons (cons prev (cdr active)) read))) ! ;; Enter this list into the group info. ! (gnus-info-set-read ! info (if (> (length read) 1) (nreverse read) read)) ! ;; Set the number of unread articles in gnus-newsrc-hashtb. ! (gnus-get-unread-articles-in-group info (gnus-active group)) ! t))) (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." --- 1337,1358 ---- t) (condition-case () (gnus-request-group group dont-check method) ! ; (error nil) (quit nil)) ! (gnus-set-active group (setq active (gnus-parse-active))) ! ;; Return the new active info. ! active))) ! ! (defun gnus-parse-active () ! "Parse active info in the nntp server buffer." ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! ;; Parse the result we got from `gnus-request-group'. ! (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") ! (goto-char (match-beginning 1)) ! (cons (read (current-buffer)) ! (read (current-buffer)))))) (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." *** pub/rgnus/lisp/gnus-sum.el Wed Jul 31 22:31:32 1996 --- rgnus/lisp/gnus-sum.el Fri Aug 2 21:48:10 1996 *************** *** 258,263 **** --- 258,265 ---- "*Mark used for sparsely reffed articles.") (defvar gnus-canceled-mark ?G "*Mark used for canceled articles.") + (defvar gnus-duplicate-mark ?M + "*Mark used for duplicate articles.") (defvar gnus-score-over-mark ?+ "*Score mark used for articles with high scores.") (defvar gnus-score-below-mark ?- *************** *** 283,345 **** (defvar gnus-insert-pseudo-articles t "*If non-nil, insert pseudo-articles when decoding articles.") - (defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" - "*The format specification of the lines in the summary buffer. - - It works along the same lines as a normal formatting string, - with some simple extensions. - - %N Article number, left padded with spaces (string) - %S Subject (string) - %s Subject if it is at the root of a thread, and \"\" otherwise (string) - %n Name of the poster (string) - %a Extracted name of the poster (string) - %A Extracted address of the poster (string) - %F Contents of the From: header (string) - %x Contents of the Xref: header (string) - %D Date of the article (string) - %d Date of the article (string) in DD-MMM format - %M Message-id of the article (string) - %r References of the article (string) - %c Number of characters in the article (integer) - %L Number of lines in the article (integer) - %I Indentation based on thread level (a string of spaces) - %T A string with two possible values: 80 spaces if the article - is on thread level two or larger and 0 spaces on level one - %R \"A\" if this article has been replied to, \" \" otherwise (character) - %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") - %[ Opening bracket (character, \"[\" or \"<\") - %] Closing bracket (character, \"]\" or \">\") - %> Spaces of length thread-level (string) - %< Spaces of length (- 20 thread-level) (string) - %i Article score (number) - %z Article zcore (character) - %t Number of articles under the current thread (number). - %e Whether the thread is empty or not (character). - %l GroupLens score (string). - %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 - current header as argument. The function should return a string, which - will be inserted into the summary just like information from any other - summary specifier. - - Text between %( and %) will be highlighted with `gnus-mouse-face' - when the mouse point is placed inside the area. There can only be one - such area. - - The %U (status), %R (replied) and %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. - - The smart choice is to have these specs as for to the left as - possible. - - This restriction may disappear in later versions of Gnus.") - (defvar gnus-summary-dummy-line-format "* %(: :%) %S\n" "*The format specification for the dummy roots in the summary buffer. --- 285,290 ---- *************** *** 556,562 **** (?e (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level t) ?c) ! (?u gnus-tmp-user-defined ?s)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") --- 501,508 ---- (?e (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level t) ?c) ! (?u gnus-tmp-user-defined ?s) ! (?P (gnus-pick-line-number) ?d)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") *************** *** 1235,1240 **** --- 1181,1189 ---- (defmacro gnus-data-unread-p (data) `(= (nth 1 ,data) gnus-unread-mark)) + (defmacro gnus-data-read-p (data) + `(/= (nth 1 ,data) gnus-unread-mark)) + (defmacro gnus-data-pseudo-p (data) `(consp (nth 3 ,data))) *************** *** 2809,2814 **** --- 2758,2767 ---- (when cached (setq gnus-newsgroup-cached cached)) + ;; Suppress duplicates? + (when gnus-suppress-duplicates + (gnus-dup-suppress-articles)) + ;; Set the initial limit. (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. *************** *** 3009,3041 **** (when (nthcdr (decf i) info) (setcdr (nthcdr i info) nil))))))) - (defun gnus-add-marked-articles (group type articles &optional info force) - ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't - ;; add, but replace marked articles of TYPE with ARTICLES. - (let ((info (or info (gnus-get-info group))) - (uncompressed '(score bookmark killed)) - marked m) - (or (not info) - (and (not (setq marked (nthcdr 3 info))) - (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) - (and (not (setq m (assq type (car marked)))) - (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) - (if force - (if (null articles) - (setcar (nthcdr 3 info) - (delq (assq type (car marked)) (car marked))) - (setcdr m (gnus-compress-sequence articles t))) - (setcdr m (gnus-compress-sequence - (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) - (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." --- 2962,2967 ---- *************** *** 3848,3854 **** (gnus-summary-reselect-current-group all t)) (defun gnus-summary-update-info () ! (let* ((group gnus-newsgroup-name)) (when gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence --- 3774,3780 ---- (gnus-summary-reselect-current-group all t)) (defun gnus-summary-update-info () ! (let ((group gnus-newsgroup-name)) (when gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence *************** *** 3902,3907 **** --- 3828,3835 ---- (gnus-cache-possibly-remove-articles) (gnus-cache-save-buffers)) (gnus-async-prefetch-remove-group group) + (when gnus-suppress-duplicates + (gnus-dup-enter-articles)) (when gnus-use-trees (gnus-tree-close group)) ;; Make all changes in this group permanent. *************** *** 4687,4693 **** (list gnus-del-mark gnus-read-mark gnus-ancient-mark gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark ! gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) 'reverse))) (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) --- 4615,4622 ---- (list gnus-del-mark gnus-read-mark gnus-ancient-mark gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark ! gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark ! gnus-duplicate-mark) 'reverse))) (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) *************** *** 6095,6101 **** (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-ancient-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark))) (setq mark gnus-expirable-mark) (push article gnus-newsgroup-expirable)) ;; Set the mark in the buffer. --- 6024,6031 ---- (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-ancient-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark) ! (= mark gnus-duplicate-mark))) (setq mark gnus-expirable-mark) (push article gnus-newsgroup-expirable)) ;; Set the mark in the buffer. *************** *** 6152,6158 **** (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark)))) (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) --- 6082,6089 ---- (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark) ! (= mark gnus-duplicate-mark)))) (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) *************** *** 6199,6218 **** t) (defun gnus-summary-update-mark (mark type) - (beginning-of-line) (let ((forward (cdr (assq type gnus-summary-mark-positions))) ! (buffer-read-only nil)) (when (and forward ! (<= (+ forward (point)) (point-max))) ;; Go to the right position on the line. (goto-char (+ forward (point))) ;; Replace the old mark with the new mark. (subst-char-in-region (point) (1+ (point)) (following-char) mark) ;; Optionally update the marks by some user rule. (when (eq type 'unread) ! (gnus-data-set-mark ! (gnus-data-find (gnus-summary-article-number)) mark) ! (gnus-summary-update-line (eq mark gnus-unread-mark)))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." --- 6130,6150 ---- t) (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) ! (buffer-read-only nil)) ! (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) ! (and (looking-at "\r") (setq forward (1+ forward))) (when (and forward ! (<= (+ forward (point)) (point-max))) ;; Go to the right position on the line. (goto-char (+ forward (point))) ;; Replace the old mark with the new mark. (subst-char-in-region (point) (1+ (point)) (following-char) mark) ;; Optionally update the marks by some user rule. (when (eq type 'unread) ! (gnus-data-set-mark ! (gnus-data-find (gnus-summary-article-number)) mark) ! (gnus-summary-update-line (eq mark gnus-unread-mark)))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." *** pub/rgnus/lisp/gnus-topic.el Mon Jul 29 13:50:52 1996 --- rgnus/lisp/gnus-topic.el Fri Aug 2 18:57:13 1996 *************** *** 76,82 **** (defvar gnus-topic-line-format-spec nil) ! ;; Functions. (defun gnus-group-topic-name () "The name of the topic on the current line." --- 76,82 ---- (defvar gnus-topic-line-format-spec nil) ! ;;; Utility functions (defun gnus-group-topic-name () "The name of the topic on the current line." *************** *** 98,116 **** (gnus-group-topic-unread))) 0)) ! (defun gnus-topic-init-alist () ! "Initialize the topic structures." ! (setq gnus-topic-topology ! (cons (list "Gnus" 'visible) ! (mapcar (lambda (topic) ! (list (list (car topic) 'visible))) ! '(("misc"))))) ! (setq gnus-topic-alist ! (list (cons "misc" ! (mapcar (lambda (info) (gnus-info-group info)) ! (cdr gnus-newsrc-alist))) ! (list "Gnus"))) ! (gnus-topic-enter-dribble)) (defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) "List all newsgroups with unread articles of level LEVEL or lower, and --- 98,325 ---- (gnus-group-topic-unread))) 0)) ! (defun gnus-group-topic-p () ! "Return non-nil if the current line is a topic." ! (gnus-group-topic-name)) ! ! (defun gnus-topic-visible-p () ! "Return non-nil if the current topic is visible." ! (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) ! ! (defun gnus-topic-articles-in-topic (entries) ! (let ((total 0) ! number) ! (while entries ! (when (numberp (setq number (car (pop entries)))) ! (incf total number))) ! total)) ! ! (defun gnus-group-topic (group) ! "Return the topic GROUP is a member of." ! (let ((alist gnus-topic-alist) ! out) ! (while alist ! (when (member group (cdar alist)) ! (setq out (caar alist) ! alist nil)) ! (setq alist (cdr alist))) ! out)) ! ! (defun gnus-group-parent-topic (group) ! "Return the topic GROUP is member of by looking at the group buffer." ! (save-excursion ! (set-buffer gnus-group-buffer) ! (if (gnus-group-goto-group group) ! (gnus-current-topic) ! (gnus-group-topic group)))) ! ! (defun gnus-topic-goto-topic (topic) ! "Go to TOPIC." ! (when topic ! (gnus-goto-char (text-property-any (point-min) (point-max) ! 'gnus-topic (intern topic))))) ! ! (defun gnus-current-topic () ! "Return the name of the current topic." ! (let ((result ! (or (get-text-property (point) 'gnus-topic) ! (save-excursion ! (and (gnus-goto-char (previous-single-property-change ! (point) 'gnus-topic)) ! (get-text-property (max (1- (point)) (point-min)) ! 'gnus-topic)))))) ! (when result ! (symbol-name result)))) ! ! (defun gnus-current-topics () ! "Return a list of all current topics, lowest in hierarchy first." ! (let ((topic (gnus-current-topic)) ! topics) ! (while topic ! (push topic topics) ! (setq topic (gnus-topic-parent-topic topic))) ! (nreverse topics))) ! ! (defun gnus-group-active-topic-p () ! "Say whether the current topic comes from the active topics." ! (save-excursion ! (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. ! (while groups ! (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb) ! info (nth 2 entry) ! params (gnus-info-params info) ! active (gnus-active group) ! unread (or (car entry) ! (and (not (equal group "dummy.group")) ! active ! (- (1+ (cdr active)) (car active)))) ! clevel (or (gnus-info-level info) ! (if (member group gnus-zombie-list) 8 9))) ! (and ! unread ; nil means that the group is dead. ! (<= clevel level) ! (>= clevel lowest) ; Is inside the level we want. ! (or all ! (if (eq unread t) ! gnus-group-list-inactive-groups ! (> unread 0)) ! (and gnus-list-groups-with-ticked-articles ! (cdr (assq 'tick (gnus-info-marks info)))) ! ; Has right readedness. ! ;; Check for permanent visibility. ! (and gnus-permanently-visible-groups ! (string-match gnus-permanently-visible-groups group)) ! (memq 'visible params) ! (cdr (assq 'visible params))) ! ;; Add this group to the list of visible groups. ! (push (or entry group) visible-groups))) ! (nreverse visible-groups))) ! ! (defun gnus-topic-previous-topic (topic) ! "Return the previous topic on the same level as TOPIC." ! (let ((top (cddr (gnus-topic-find-topology ! (gnus-topic-parent-topic topic))))) ! (unless (equal topic (caaar top)) ! (while (and top (not (equal (caaadr top) topic))) ! (setq top (cdr top))) ! (caaar top)))) ! ! (defun gnus-topic-parent-topic (topic &optional topology) ! "Return the parent of TOPIC." ! (unless topology ! (setq topology gnus-topic-topology)) ! (let ((parent (car (pop topology))) ! result found) ! (while (and topology ! (not (setq found (equal (caaar topology) topic))) ! (not (setq result (gnus-topic-parent-topic topic ! (car topology))))) ! (setq topology (cdr topology))) ! (or result (and found parent)))) ! ! (defun gnus-topic-next-topic (topic &optional previous) ! "Return the next sibling of TOPIC." ! (let ((parentt (cddr (gnus-topic-find-topology ! (gnus-topic-parent-topic topic)))) ! prev) ! (while (and parentt ! (not (equal (caaar parentt) topic))) ! (setq prev (caaar parentt) ! parentt (cdr parentt))) ! (if previous ! prev ! (caaadr parentt)))) ! ! (defun gnus-topic-find-topology (topic &optional topology level remove) ! "Return the topology of TOPIC." ! (unless topology ! (setq topology gnus-topic-topology) ! (setq level 0)) ! (let ((top topology) ! result) ! (if (equal (caar topology) topic) ! (progn ! (when remove ! (delq topology remove)) ! (cons level topology)) ! (setq topology (cdr topology)) ! (while (and topology ! (not (setq result (gnus-topic-find-topology ! topic (car topology) (1+ level) ! (and remove top))))) ! (setq topology (cdr topology))) ! result))) ! ! (defvar gnus-tmp-topics nil) ! (defun gnus-topic-list (&optional topology) ! "Return a list of all topics in the topology." ! (unless topology ! (setq topology gnus-topic-topology ! gnus-tmp-topics nil)) ! (push (caar topology) gnus-tmp-topics) ! (mapcar 'gnus-topic-list (cdr topology)) ! gnus-tmp-topics) ! ! ;;; Topic parameter jazz ! ! (defun gnus-topic-parameters (topic) ! "Return the parameters for TOPIC." ! (let ((top (gnus-topic-find-topology topic))) ! (unless top ! (error "No such topic: %s" topic)) ! (nth 2 (car top)))) ! ! (defun gnus-topic-set-parameters (topic parameters) ! "Set the topic parameters of TOPIC to PARAMETERS." ! (let ((top (gnus-topic-find-topology topic))) ! (unless top ! (error "No such topic: %s" topic)) ! ;; We may have to extend if there is no parameters here ! ;; to begin with. ! (unless (nthcdr 2 (car top)) ! (nconc (car top) (list nil))) ! (setcar (nthcdr 2 (car top)) parameters))) ! ! (defun gnus-group-topic-parameters (group) ! "Compute the group parameters for GROUP taking into account inheretance from topics." ! (let ((params-list (list (gnus-group-get-parameter group))) ! topics params param out) ! (save-excursion ! (gnus-group-goto-group group) ! (setq topics (gnus-current-topics)) ! (while topics ! (push (gnus-topic-parameters (pop topics)) params-list)) ! ;; We probably have lots of nil elements here, so ! ;; we remove them. Probably faster than doing this "properly". ! (setq params-list (delq nil params-list)) ! ;; Now we have all the parameters, so we go through them ! ;; and do inheretance in the obvious way. ! (while (setq params (pop params-list)) ! (while (setq param (pop params)) ! (when (atom param) ! (setq param (cons param t))) ! ;; Override any old versions of this param. ! (setq out (delq (assq (car param) out) out)) ! (push param out))) ! ;; Return the resulting parameter list. ! out))) ! ! ;;; General utility funtions ! ! (defun gnus-topic-enter-dribble () ! (gnus-dribble-enter ! (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) ! ! ;;; Generating group buffers (defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) "List all newsgroups with unread articles of level LEVEL or lower, and *************** *** 211,254 **** (goto-char end) unread)) - (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. - (while groups - (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb) - info (nth 2 entry) - params (gnus-info-params info) - active (gnus-active group) - unread (or (car entry) - (and (not (equal group "dummy.group")) - active - (- (1+ (cdr active)) (car active)))) - clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) 8 9))) - (and - unread ; nil means that the group is dead. - (<= clevel level) - (>= clevel lowest) ; Is inside the level we want. - (or all - (if (eq unread t) - gnus-group-list-inactive-groups - (> unread 0)) - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; Has right readedness. - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups group)) - (memq 'visible params) - (cdr (assq 'visible params))) - ;; Add this group to the list of visible groups. - (push (or entry group) visible-groups))) - (nreverse visible-groups))) - (defun gnus-topic-remove-topic (&optional insert total-remove hide in-level) "Remove the current topic." (let ((topic (gnus-group-topic-name)) --- 420,425 ---- *************** *** 287,300 **** (gnus-topic-remove-topic (or insert (not (gnus-topic-visible-p))) nil nil 9))))))) - (defun gnus-group-topic-p () - "Return non-nil if the current line is a topic." - (gnus-group-topic-name)) - - (defun gnus-topic-visible-p () - "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) - (defun gnus-topic-insert-topic-line (name visiblep shownp level entries &optional unread) (let* ((visible (if visiblep "" "...")) --- 458,463 ---- *************** *** 315,375 **** 'gnus-active active-topic 'gnus-topic-visible visiblep)))) ! (defun gnus-topic-previous-topic (topic) ! "Return the previous topic on the same level as TOPIC." ! (let ((top (cddr (gnus-topic-find-topology ! (gnus-topic-parent-topic topic))))) ! (unless (equal topic (caaar top)) ! (while (and top (not (equal (caaadr top) topic))) ! (setq top (cdr top))) ! (caaar top)))) ! (defun gnus-topic-parent-topic (topic &optional topology) ! "Return the parent of TOPIC." ! (unless topology ! (setq topology gnus-topic-topology)) ! (let ((parent (car (pop topology))) ! result found) ! (while (and topology ! (not (setq found (equal (caaar topology) topic))) ! (not (setq result (gnus-topic-parent-topic topic ! (car topology))))) ! (setq topology (cdr topology))) ! (or result (and found parent)))) ! (defun gnus-topic-next-topic (topic &optional previous) ! "Return the next sibling of TOPIC." ! (let ((topology gnus-topic-topology) ! (parentt (cddr (gnus-topic-find-topology ! (gnus-topic-parent-topic topic)))) ! prev) ! (while (and parentt ! (not (equal (caaar parentt) topic))) ! (setq prev (caaar parentt) ! parentt (cdr parentt))) ! (if previous ! prev ! (caaadr parentt)))) ! (defun gnus-topic-find-topology (topic &optional topology level remove) ! "Return the topology of TOPIC." ! (unless topology ! (setq topology gnus-topic-topology) ! (setq level 0)) ! (let ((top topology) ! result) ! (if (equal (caar topology) topic) ! (progn ! (when remove ! (delq topology remove)) ! (cons level topology)) ! (setq topology (cdr topology)) ! (while (and topology ! (not (setq result (gnus-topic-find-topology ! topic (car topology) (1+ level) ! (and remove top))))) ! (setq topology (cdr topology))) ! result))) (gnus-add-shutdown 'gnus-topic-close 'gnus) --- 478,556 ---- 'gnus-active active-topic 'gnus-topic-visible visiblep)))) ! (defun gnus-topic-update-topic () ! "Update all parent topics to the current group." ! (when (and (eq major-mode 'gnus-group-mode) ! gnus-topic-mode) ! (let ((group (gnus-group-group-name)) ! (buffer-read-only nil)) ! (when (and group (gnus-get-info group) ! (gnus-topic-goto-topic (gnus-current-topic))) ! (gnus-topic-update-topic-line (gnus-group-topic-name)) ! (gnus-group-goto-group group) ! (gnus-group-position-point))))) ! (defun gnus-topic-goto-missing-group (group) ! "Place point where GROUP is supposed to be inserted." ! (let* ((topic (gnus-group-topic group)) ! (groups (cdr (assoc topic gnus-topic-alist))) ! (g (cdr (member group groups))) ! (unfound t)) ! (while (and g unfound) ! (when (gnus-group-goto-group (pop g)) ! (beginning-of-line) ! (setq unfound nil))) ! (when unfound ! (setq g (cdr (member group (reverse groups)))) ! (while (and g unfound) ! (when (gnus-group-goto-group (pop g)) ! (forward-line 1) ! (setq unfound nil))) ! (when unfound ! (gnus-topic-goto-topic topic) ! (forward-line 1))))) ! (defun gnus-topic-update-topic-line (topic-name &optional reads) ! (let* ((top (gnus-topic-find-topology topic-name)) ! (type (cadr top)) ! (children (cddr top)) ! (entries (gnus-topic-find-groups ! (car type) (car gnus-group-list-mode) ! (cdr gnus-group-list-mode))) ! (parent (gnus-topic-parent-topic topic-name)) ! (all-entries entries) ! (unread 0) ! old-unread entry) ! (when (gnus-topic-goto-topic (car type)) ! ;; Tally all the groups that belong in this topic. ! (if reads ! (setq unread (- (gnus-group-topic-unread) reads)) ! (while children ! (incf unread (gnus-topic-unread (caar (pop children))))) ! (while (setq entry (pop entries)) ! (when (numberp (car entry)) ! (incf unread (car entry))))) ! (setq old-unread (gnus-group-topic-unread)) ! ;; Insert the topic line. ! (gnus-topic-insert-topic-line ! (car type) (gnus-topic-visible-p) ! (not (eq (nth 2 type) 'hidden)) ! (gnus-group-topic-level) all-entries unread) ! (gnus-delete-line)) ! (when parent ! (forward-line -1) ! (gnus-topic-update-topic-line ! parent (- old-unread (gnus-group-topic-unread)))) ! unread)) ! (defun gnus-topic-group-indentation () ! (make-string ! (* gnus-topic-indent-level ! (or (save-excursion ! (gnus-topic-goto-topic (gnus-current-topic)) ! (gnus-group-topic-level)) 0)) ? )) ! ! ;;; Initialization (gnus-add-shutdown 'gnus-topic-close 'gnus) *************** *** 425,545 **** (setq topic (cdr topic)) (setcdr topic (cddr topic))))))) ! (defvar gnus-tmp-topics nil) ! (defun gnus-topic-list (&optional topology) ! "Return a list of all topics in the topology." ! (unless topology ! (setq topology gnus-topic-topology ! gnus-tmp-topics nil)) ! (push (caar topology) gnus-tmp-topics) ! (mapcar 'gnus-topic-list (cdr topology)) ! gnus-tmp-topics) ! ! (defun gnus-topic-enter-dribble () ! (gnus-dribble-enter ! (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) ! ! (defun gnus-topic-articles-in-topic (entries) ! (let ((total 0) ! number) ! (while entries ! (when (numberp (setq number (car (pop entries)))) ! (incf total number))) ! total)) ! (defun gnus-group-topic (group) ! "Return the topic GROUP is a member of." ! (let ((alist gnus-topic-alist) ! out) ! (while alist ! (when (member group (cdar alist)) ! (setq out (caar alist) ! alist nil)) ! (setq alist (cdr alist))) ! out)) ! (defun gnus-topic-goto-topic (topic) ! "Go to TOPIC." ! (when topic ! (gnus-goto-char (text-property-any (point-min) (point-max) ! 'gnus-topic (intern topic))))) ! (defun gnus-group-parent-topic () ! "Return the name of the current topic." ! (let ((result ! (or (get-text-property (point) 'gnus-topic) ! (save-excursion ! (and (gnus-goto-char (previous-single-property-change ! (point) 'gnus-topic)) ! (get-text-property (max (1- (point)) (point-min)) ! 'gnus-topic)))))) ! (when result ! (symbol-name result)))) ! ! (defun gnus-topic-update-topic () ! "Update all parent topics to the current group." ! (when (and (eq major-mode 'gnus-group-mode) ! gnus-topic-mode) ! (let ((group (gnus-group-group-name)) ! (buffer-read-only nil)) ! (when (and group (gnus-get-info group) ! (gnus-topic-goto-topic (gnus-group-parent-topic))) ! (gnus-topic-update-topic-line (gnus-group-topic-name)) ! (gnus-group-goto-group group) ! (gnus-group-position-point))))) ! (defun gnus-topic-goto-missing-group (group) ! "Place point where GROUP is supposed to be inserted." ! (let* ((topic (gnus-group-topic group)) ! (groups (cdr (assoc topic gnus-topic-alist))) ! (g (cdr (member group groups))) ! (unfound t)) ! (while (and g unfound) ! (when (gnus-group-goto-group (pop g)) ! (beginning-of-line) ! (setq unfound nil))) ! (when unfound ! (setq g (cdr (member group (reverse groups)))) ! (while (and g unfound) ! (when (gnus-group-goto-group (pop g)) ! (forward-line 1) ! (setq unfound nil))) ! (when unfound ! (gnus-topic-goto-topic topic) ! (forward-line 1))))) ! (defun gnus-topic-update-topic-line (topic-name &optional reads) ! (let* ((top (gnus-topic-find-topology topic-name)) ! (type (cadr top)) ! (children (cddr top)) ! (entries (gnus-topic-find-groups ! (car type) (car gnus-group-list-mode) ! (cdr gnus-group-list-mode))) ! (parent (gnus-topic-parent-topic topic-name)) ! (all-entries entries) ! (unread 0) ! old-unread entry) ! (when (gnus-topic-goto-topic (car type)) ! ;; Tally all the groups that belong in this topic. ! (if reads ! (setq unread (- (gnus-group-topic-unread) reads)) ! (while children ! (incf unread (gnus-topic-unread (caar (pop children))))) ! (while (setq entry (pop entries)) ! (when (numberp (car entry)) ! (incf unread (car entry))))) ! (setq old-unread (gnus-group-topic-unread)) ! ;; Insert the topic line. ! (gnus-topic-insert-topic-line ! (car type) (gnus-topic-visible-p) ! (not (eq (nth 2 type) 'hidden)) ! (gnus-group-topic-level) all-entries unread) ! (gnus-delete-line)) ! (when parent ! (forward-line -1) ! (gnus-topic-update-topic-line ! parent (- old-unread (gnus-group-topic-unread)))) ! unread)) (defun gnus-topic-grok-active (&optional force) "Parse all active groups and create topic structures for them." --- 606,720 ---- (setq topic (cdr topic)) (setcdr topic (cddr topic))))))) ! (defun gnus-topic-init-alist () ! "Initialize the topic structures." ! (setq gnus-topic-topology ! (cons (list "Gnus" 'visible) ! (mapcar (lambda (topic) ! (list (list (car topic) 'visible))) ! '(("misc"))))) ! (setq gnus-topic-alist ! (list (cons "misc" ! (mapcar (lambda (info) (gnus-info-group info)) ! (cdr gnus-newsrc-alist))) ! (list "Gnus"))) ! (gnus-topic-enter-dribble)) ! ;;; Maintenance ! (defun gnus-topic-clean-alist () ! "Remove bogus groups from the topic alist." ! (let ((topic-alist gnus-topic-alist) ! result topic) ! (unless gnus-killed-hashtb ! (gnus-make-hashtable-from-killed)) ! (while (setq topic (pop topic-alist)) ! (let ((topic-name (pop topic)) ! group filtered-topic) ! (while (setq group (pop topic)) ! (if (and (gnus-gethash group gnus-active-hashtb) ! (not (gnus-gethash group gnus-killed-hashtb))) ! (push group filtered-topic))) ! (push (cons topic-name (nreverse filtered-topic)) result))) ! (setq gnus-topic-alist (nreverse result)))) ! (defun gnus-topic-change-level (group level oldlevel) ! "Run when changing levels to enter/remove groups from topics." ! (save-excursion ! (set-buffer gnus-group-buffer) ! (when (and gnus-topic-mode ! gnus-topic-alist ! (not gnus-topic-inhibit-change-level)) ! ;; Remove the group from the topics. ! (when (and (< oldlevel gnus-level-zombie) ! (>= level gnus-level-zombie)) ! (let (alist) ! (forward-line -1) ! (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist)) ! (setcdr alist (gnus-delete-first group (cdr alist)))))) ! ;; If the group is subscribed. then we enter it into the topics. ! (when (and (< level gnus-level-zombie) ! (>= oldlevel gnus-level-zombie)) ! (let* ((prev (gnus-group-group-name)) ! (gnus-topic-inhibit-change-level t) ! (gnus-group-indentation ! (make-string ! (* gnus-topic-indent-level ! (or (save-excursion ! (gnus-topic-goto-topic (gnus-current-topic)) ! (gnus-group-topic-level)) 0)) ? )) ! (yanked (list group)) ! alist talist end) ! ;; Then we enter the yanked groups into the topics they belong ! ;; to. ! (when (setq alist (assoc (save-excursion ! (forward-line -1) ! (or ! (gnus-current-topic) ! (caar gnus-topic-topology))) ! gnus-topic-alist)) ! (setq talist alist) ! (when (stringp yanked) ! (setq yanked (list yanked))) ! (if (not prev) ! (nconc alist yanked) ! (if (not (cdr alist)) ! (setcdr alist (nconc yanked (cdr alist))) ! (while (and (not end) (cdr alist)) ! (when (equal (cadr alist) prev) ! (setcdr alist (nconc yanked (cdr alist))) ! (setq end t)) ! (setq alist (cdr alist))) ! (unless end ! (nconc talist yanked)))))) ! (gnus-topic-update-topic))))) ! (defun gnus-topic-goto-next-group (group props) ! "Go to group or the next group after group." ! (if (null group) ! (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))) ! (if (gnus-group-goto-group group) ! t ! ;; The group is no longer visible. ! (let* ((list (assoc (gnus-current-topic) gnus-topic-alist)) ! (after (cdr (member group (cdr list))))) ! ;; First try to put point on a group after the current one. ! (while (and after ! (not (gnus-group-goto-group (car after)))) ! (setq after (cdr after))) ! ;; Then try to put point on a group before point. ! (unless after ! (setq after (cdr (member group (reverse (cdr list))))) ! (while (and after ! (not (gnus-group-goto-group (car after)))) ! (setq after (cdr after)))) ! ;; Finally, just put point on the topic. ! (unless after ! (gnus-topic-goto-topic (car list)) ! (setq after nil)) ! t)))) ! ;;; Topic-active functions (defun gnus-topic-grok-active (&optional force) "Parse all active groups and create topic structures for them." *************** *** 591,602 **** ;; to this topic. groups)) - (defun gnus-group-active-topic-p () - "Return whether the current active comes from the active topics." - (save-excursion - (beginning-of-line) - (get-text-property (point) 'gnus-active))) - ;;; Topic mode, commands and keymap. (defvar gnus-topic-mode-map nil) --- 766,771 ---- *************** *** 615,620 **** --- 784,790 ---- "\C-y" gnus-topic-yank-group "\M-g" gnus-topic-get-new-news-this-topic "AT" gnus-topic-list-active + "Gp" gnus-topic-edit-parameters gnus-mouse-2 gnus-mouse-pick-topic) ;; Define a new submap. *************** *** 748,754 **** (interactive (list (read-string "New topic: ") ! (gnus-group-parent-topic))) ;; Check whether this topic already exists. (when (gnus-topic-find-topology topic) (error "Topic aleady exists")) --- 918,924 ---- (interactive (list (read-string "New topic: ") ! (gnus-current-topic))) ;; Check whether this topic already exists. (when (gnus-topic-find-topology topic) (error "Topic aleady exists")) *************** *** 783,789 **** (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and ! (setq entry (assoc (gnus-group-parent-topic) gnus-topic-alist)) (not copyp)) (setcdr entry (gnus-delete-first g (cdr entry)))) --- 953,959 ---- (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and ! (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) (not copyp)) (setcdr entry (gnus-delete-first g (cdr entry)))) *************** *** 796,802 **** (defun gnus-topic-remove-group () "Remove the current group from the topic." (interactive) ! (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist)) (group (gnus-group-group-name)) (buffer-read-only nil)) (when (and topicl group) --- 966,972 ---- (defun gnus-topic-remove-group () "Remove the current group from the topic." (interactive) ! (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) (group (gnus-group-group-name)) (buffer-read-only nil)) (when (and topicl group) *************** *** 811,915 **** (completing-read "Copy to topic: " gnus-topic-alist nil t))) (gnus-topic-move-group n topic t)) - (defun gnus-topic-group-indentation () - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-group-parent-topic)) - (gnus-group-topic-level)) 0)) ? )) - - (defun gnus-topic-clean-alist () - "Remove bogus groups from the topic alist." - (let ((topic-alist gnus-topic-alist) - result topic) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - (while (setq topic (pop topic-alist)) - (let ((topic-name (pop topic)) - group filtered-topic) - (while (setq group (pop topic)) - (if (and (gnus-gethash group gnus-active-hashtb) - (not (gnus-gethash group gnus-killed-hashtb))) - (push group filtered-topic))) - (push (cons topic-name (nreverse filtered-topic)) result))) - (setq gnus-topic-alist (nreverse result)))) - - (defun gnus-topic-change-level (group level oldlevel) - "Run when changing levels to enter/remove groups from topics." - (save-excursion - (set-buffer gnus-group-buffer) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) - ;; Remove the group from the topics. - (when (and (< oldlevel gnus-level-zombie) - (>= level gnus-level-zombie)) - (let (alist) - (forward-line -1) - (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist)) - (setcdr alist (gnus-delete-first group (cdr alist)))))) - ;; If the group is subscribed. then we enter it into the topics. - (when (and (< level gnus-level-zombie) - (>= oldlevel gnus-level-zombie)) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-group-parent-topic)) - (gnus-group-topic-level)) 0)) ? )) - (yanked (list group)) - alist talist end) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (when (setq alist (assoc (save-excursion - (forward-line -1) - (or - (gnus-group-parent-topic) - (caar gnus-topic-topology))) - gnus-topic-alist)) - (setq talist alist) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (and (not end) (cdr alist)) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq end t)) - (setq alist (cdr alist))) - (unless end - (nconc talist yanked)))))) - (gnus-topic-update-topic))))) - - (defun gnus-topic-goto-next-group (group props) - "Go to group or the next group after group." - (if (null group) - (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))) - (if (gnus-group-goto-group group) - t - ;; The group is no longer visible. - (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist)) - (after (cdr (member group (cdr list))))) - ;; First try to put point on a group after the current one. - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after))) - ;; Then try to put point on a group before point. - (unless after - (setq after (cdr (member group (reverse (cdr list))))) - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after)))) - ;; Finally, just put point on the topic. - (unless after - (gnus-topic-goto-topic (car list)) - (setq after nil)) - t)))) - (defun gnus-topic-kill-group (&optional n discard) "Kill the next N groups." (interactive "P") --- 981,986 ---- *************** *** 927,933 **** (if gnus-topic-killed-topics (let ((previous (or (gnus-group-topic-name) ! (gnus-topic-next-topic (gnus-group-parent-topic)))) (item (cdr (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic (caar item) (gnus-topic-parent-topic previous) previous --- 998,1004 ---- (if gnus-topic-killed-topics (let ((previous (or (gnus-group-topic-name) ! (gnus-topic-next-topic (gnus-current-topic)))) (item (cdr (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic (caar item) (gnus-topic-parent-topic previous) previous *************** *** 939,945 **** (make-string (* gnus-topic-indent-level (or (save-excursion ! (gnus-topic-goto-topic (gnus-group-parent-topic)) (gnus-group-topic-level)) 0)) ? )) yanked alist) ;; We first yank the groups the normal way... --- 1010,1016 ---- (make-string (* gnus-topic-indent-level (or (save-excursion ! (gnus-topic-goto-topic (gnus-current-topic)) (gnus-group-topic-level)) 0)) ? )) yanked alist) ;; We first yank the groups the normal way... *************** *** 948,954 **** ;; to. (setq alist (assoc (save-excursion (forward-line -1) ! (gnus-group-parent-topic)) gnus-topic-alist)) (when (stringp yanked) (setq yanked (list yanked))) --- 1019,1025 ---- ;; to. (setq alist (assoc (save-excursion (forward-line -1) ! (gnus-current-topic)) gnus-topic-alist)) (when (stringp yanked) (setq yanked (list yanked))) *************** *** 966,973 **** (defun gnus-topic-hide-topic () "Hide the current topic." (interactive) ! (when (gnus-group-parent-topic) ! (gnus-topic-goto-topic (gnus-group-parent-topic)) (gnus-topic-remove-topic nil nil 'hidden))) (defun gnus-topic-show-topic () --- 1037,1044 ---- (defun gnus-topic-hide-topic () "Hide the current topic." (interactive) ! (when (gnus-current-topic) ! (gnus-topic-goto-topic (gnus-current-topic)) (gnus-topic-remove-topic nil nil 'hidden))) (defun gnus-topic-show-topic () *************** *** 978,984 **** (defun gnus-topic-mark-topic (topic &optional unmark) "Mark all groups in the topic with the process mark." ! (interactive (list (gnus-group-parent-topic))) (save-excursion (let ((groups (gnus-topic-find-groups topic 9 t))) (while groups --- 1049,1055 ---- (defun gnus-topic-mark-topic (topic &optional unmark) "Mark all groups in the topic with the process mark." ! (interactive (list (gnus-current-topic))) (save-excursion (let ((groups (gnus-topic-find-groups topic 9 t))) (while groups *************** *** 987,993 **** (defun gnus-topic-unmark-topic (topic &optional unmark) "Remove the process mark from all groups in the topic." ! (interactive (list (gnus-group-parent-topic))) (gnus-topic-mark-topic topic t)) (defun gnus-topic-get-new-news-this-topic (&optional n) --- 1058,1064 ---- (defun gnus-topic-unmark-topic (topic &optional unmark) "Remove the process mark from all groups in the topic." ! (interactive (list (gnus-current-topic))) (gnus-topic-mark-topic topic t)) (defun gnus-topic-get-new-news-this-topic (&optional n) *************** *** 1039,1045 **** (defun gnus-topic-rename (old-name new-name) "Rename a topic." (interactive ! (let ((topic (gnus-group-parent-topic))) (list topic (read-string (format "Rename %s to: " topic))))) (let ((top (gnus-topic-find-topology old-name)) --- 1110,1116 ---- (defun gnus-topic-rename (old-name new-name) "Rename a topic." (interactive ! (let ((topic (gnus-current-topic))) (list topic (read-string (format "Rename %s to: " topic))))) (let ((top (gnus-topic-find-topology old-name)) *************** *** 1057,1063 **** (interactive "P") (if unindent (gnus-topic-unindent) ! (let* ((topic (gnus-group-parent-topic)) (parent (gnus-topic-previous-topic topic))) (unless parent (error "Nothing to indent %s into" topic)) --- 1128,1134 ---- (interactive "P") (if unindent (gnus-topic-unindent) ! (let* ((topic (gnus-current-topic)) (parent (gnus-topic-previous-topic topic))) (unless parent (error "Nothing to indent %s into" topic)) *************** *** 1072,1078 **** (defun gnus-topic-unindent () "Unindent a topic." (interactive) ! (let* ((topic (gnus-group-parent-topic)) (parent (gnus-topic-parent-topic topic)) (grandparent (gnus-topic-parent-topic parent))) (unless grandparent --- 1143,1149 ---- (defun gnus-topic-unindent () "Unindent a topic." (interactive) ! (let* ((topic (gnus-current-topic)) (parent (gnus-topic-parent-topic topic)) (grandparent (gnus-topic-parent-topic parent))) (unless grandparent *************** *** 1096,1101 **** --- 1167,1187 ---- (gnus-topic-alist gnus-topic-active-alist) gnus-killed-list gnus-zombie-list) (gnus-group-list-groups 9 nil 1))) + + (defun gnus-topic-edit-parameters (group) + "Edit the group parameters of GROUP. + If performed on a topic, edit the topic parameters instead." + (interactive (list (gnus-group-group-name))) + (if group + (gnus-group-edit-group-parameters group) + (if (not (gnus-group-topic-p)) + (error "Nothing to edit on the current line.") + (let ((topic (gnus-group-topic-name))) + (gnus-edit-form + (gnus-topic-parameters topic) + "Editing the topic parameters." + `(lambda (form) + (gnus-topic-set-parameters ,topic form))))))) (provide 'gnus-topic) *** pub/rgnus/lisp/gnus-util.el Wed Jul 31 21:20:49 1996 --- rgnus/lisp/gnus-util.el Fri Aug 2 18:50:17 1996 *************** *** 506,512 **** (and (not (,(car funs) t2 t1)) ,(gnus-make-sort-function (cdr funs)))) `(,(car funs) t1 t2))) ! (provide 'gnus-util) ;;; gnus-util.el ends here --- 506,512 ---- (and (not (,(car funs) t2 t1)) ,(gnus-make-sort-function (cdr funs)))) `(,(car funs) t1 t2))) ! (provide 'gnus-util) ;;; gnus-util.el ends here *** pub/rgnus/lisp/gnus-uu.el Sun Jul 28 20:31:12 1996 --- rgnus/lisp/gnus-uu.el Fri Aug 2 21:27:25 1996 *************** *** 29,34 **** --- 29,35 ---- (require 'gnus-load) (require 'gnus-art) (require 'message) + (require 'gnus-msg) ;; Default viewing action rules *** pub/rgnus/lisp/gnus-vis.el Wed Jul 31 21:06:09 1996 --- rgnus/lisp/gnus-vis.el Fri Aug 2 21:42:23 1996 *************** *** 1361,1367 **** (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 'face gnus-signature-face) (widen) ! (re-search-backward gnus-signature-separator nil t) (let ((start (match-beginning 0)) (end (set-marker (make-marker) (1+ (match-end 0))))) (gnus-article-add-button start (1- end) 'gnus-signature-toggle --- 1361,1367 ---- (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 'face gnus-signature-face) (widen) ! (article-search-signature) (let ((start (match-beginning 0)) (end (set-marker (make-marker) (1+ (match-end 0))))) (gnus-article-add-button start (1- end) 'gnus-signature-toggle *************** *** 1522,1528 **** (defun gnus-button-url (address) "Browse ADDRESS." ! (funcall browse-url-browser-function address)) ;;; Next/prev buttons in the article buffer. --- 1522,1528 ---- (defun gnus-button-url (address) "Browse ADDRESS." ! (funcall browse-url-browser-function address browse-url-new-window-p)) ;;; Next/prev buttons in the article buffer. *** pub/rgnus/lisp/gnus-win.el Sun Jul 28 13:48:36 1996 --- rgnus/lisp/gnus-win.el Fri Aug 2 18:50:17 1996 *************** *** 91,104 **** (vertical 1.0 (summary 0.25) (faq 1.0 point))) ! (edit-group (vertical 1.0 (group 0.5) ! (edit-group 1.0 point))) ! (edit-server ! (vertical 1.0 ! (server 0.5) ! (edit-server 1.0 point))) (edit-score (vertical 1.0 (summary 0.25) --- 91,100 ---- (vertical 1.0 (summary 0.25) (faq 1.0 point))) ! (edit-form (vertical 1.0 (group 0.5) ! (edit-form 1.0 point))) (edit-score (vertical 1.0 (summary 0.25) *************** *** 158,163 **** --- 154,160 ---- (server . gnus-server-buffer) (browse . "*Gnus Browse Server*") (edit-group . gnus-group-edit-buffer) + (edit-group . gnus-edit-form-buffer) (edit-server . gnus-server-edit-buffer) (group-carpal . gnus-carpal-group-buffer) (summary-carpal . gnus-carpal-summary-buffer) *** pub/rgnus/lisp/gnus-xmas.el Wed Jul 31 21:34:30 1996 --- rgnus/lisp/gnus-xmas.el Fri Aug 2 22:15:54 1996 *************** *** 498,503 **** --- 498,504 ---- (when (and (<= emacs-major-version 19) (<= emacs-minor-version 13)) + (setq gnus-article-x-face-too-ugly (if (eq (device-type) 'tty) ".")) (fset 'gnus-highlight-selected-summary 'gnus-xmas-highlight-selected-summary) (fset 'gnus-group-remove-excess-properties *** pub/rgnus/lisp/gnus.el Wed Jul 31 23:03:00 1996 --- rgnus/lisp/gnus.el Fri Aug 2 21:32:29 1996 *************** *** 28,34 **** (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.3" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) --- 28,34 ---- (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.4" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) *************** *** 150,156 **** (defun gnus-alive-p () "Say whether Gnus is running or not." (and gnus-group-buffer ! (get-buffer gnus-group-buffer))) ;; Info access macros. --- 150,159 ---- (defun gnus-alive-p () "Say whether Gnus is running or not." (and gnus-group-buffer ! (get-buffer gnus-group-buffer) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (eq major-mode 'gnus-group-mode)))) ;; Info access macros. *************** *** 182,193 **** `(setcar (nthcdr 1 ,info) ,rank)) (defmacro gnus-info-set-read (info read) `(setcar (nthcdr 2 ,info) ,read)) ! (defmacro gnus-info-set-marks (info marks) ! `(setcar (nthcdr 3 ,info) ,marks)) ! (defmacro gnus-info-set-method (info method) ! `(setcar (nthcdr 4 ,info) ,method)) ! (defmacro gnus-info-set-params (info params) ! `(setcar (nthcdr 5 ,info) ,params)) (defmacro gnus-info-set-level (info level) `(let ((rank (cdr ,info))) --- 185,209 ---- `(setcar (nthcdr 1 ,info) ,rank)) (defmacro gnus-info-set-read (info read) `(setcar (nthcdr 2 ,info) ,read)) ! (defmacro gnus-info-set-marks (info marks &optional extend) ! (if extend ! `(gnus-info-set-entry ,info ,marks 3) ! `(setcar (nthcdr 3 ,info) ,marks))) ! (defmacro gnus-info-set-method (info method &optional extend) ! (if extend ! `(gnus-info-set-entry ,info ,method 4) ! `(setcar (nthcdr 4 ,info) ,method))) ! (defmacro gnus-info-set-params (info params &optional extend) ! (if extend ! `(gnus-info-set-entry ,info ,params 5) ! `(setcar (nthcdr 5 ,info) ,params))) ! ! (defun gnus-info-set-entry (info entry number) ! ;; Extend the info until we have enough elements. ! (while (< (length info) number) ! (nconc info (list nil))) ! ;; Set the entry. ! (setcar (nthcdr number info) entry)) (defmacro gnus-info-set-level (info level) `(let ((rank (cdr ,info))) *************** *** 203,208 **** --- 219,226 ---- (defmacro gnus-get-info (group) `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) + ;; Byte-compiler warning. + (defvar gnus-visual) ;; Find out whether the gnus-visual TYPE is wanted. (defun gnus-visual-p (&optional type class) (and gnus-visual ; Has to be non-nil, at least. *************** *** 732,737 **** --- 750,776 ---- (setq outs (cons (car valids) outs))) (setq valids (cdr valids))) outs)) + + (defun gnus-read-method (prompt) + "Prompt the user for a method. + Allow completion over sensible values." + (let ((method + (completing-read + prompt (append gnus-valid-select-methods gnus-server-alist) + nil t nil 'gnus-method-history))) + (cond + ((equal method "") + (setq method gnus-select-method)) + ((assoc method gnus-valid-select-methods) + (list method + (if (memq 'prompt-address + (assoc method gnus-valid-select-methods)) + (read-string "Address: ") + ""))) + ((assoc method gnus-server-alist) + (list method)) + (t + (list method ""))))) ;;; User-level commands. *** pub/rgnus/lisp/md5.el Fri Aug 2 22:35:12 1996 --- rgnus/lisp/md5.el Thu Aug 1 20:51:45 1996 *************** *** 0 **** --- 1,409 ---- + ;;; md5.el -- MD5 Message Digest Algorithm + ;;; Gareth Rees + + ;; LCD Archive Entry: + ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| + ;; MD5 cryptographic message digest algorithm| + ;; 13-Nov-95|1.0|~/misc/md5.el.Z| + + ;;; Details: ------------------------------------------------------------------ + + ;; This is a direct translation into Emacs LISP of the reference C + ;; implementation of the MD5 Message-Digest Algorithm written by RSA + ;; Data Security, Inc. + ;; + ;; The algorithm takes a message (that is, a string of bytes) and + ;; computes a 16-byte checksum or "digest" for the message. This digest + ;; is supposed to be cryptographically strong in the sense that if you + ;; are given a 16-byte digest D, then there is no easier way to + ;; construct a message whose digest is D than to exhaustively search the + ;; space of messages. However, the robustness of the algorithm has not + ;; been proven, and a similar algorithm (MD4) was shown to be unsound, + ;; so treat with caution! + ;; + ;; The C algorithm uses 32-bit integers; because GNU Emacs + ;; implementations provide 28-bit integers (with 24-bit integers on + ;; versions prior to 19.29), the code represents a 32-bit integer as the + ;; cons of two 16-bit integers. The most significant word is stored in + ;; the car and the least significant in the cdr. The algorithm requires + ;; at least 17 bits of integer representation in order to represent the + ;; carry from a 16-bit addition. + + ;;; Usage: -------------------------------------------------------------------- + + ;; To compute the MD5 Message Digest for a message M (represented as a + ;; string or as a vector of bytes), call + ;; + ;; (md5-encode M) + ;; + ;; which returns the message digest as a vector of 16 bytes. If you + ;; need to supply the message in pieces M1, M2, ... Mn, then call + ;; + ;; (md5-init) + ;; (md5-update M1) + ;; (md5-update M2) + ;; ... + ;; (md5-update Mn) + ;; (md5-final) + + ;;; Copyright and licence: ---------------------------------------------------- + + ;; Copyright (C) 1995 by Gareth Rees + ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm + ;; + ;; md5.el 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. + ;; + ;; md5.el 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. + ;; + ;; The original copyright notice is given below, as required by the + ;; licence for the original code. This code is distributed under *both* + ;; RSA's original licence and the GNU General Public Licence. (There + ;; should be no problems, as the former is more liberal than the + ;; latter). + + ;;; Original copyright notice: ------------------------------------------------ + + ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. + ;; + ;; License to copy and use this software is granted provided that it is + ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest + ;; Algorithm" in all material mentioning or referencing this software or + ;; this function. + ;; + ;; License is also granted to make and use derivative works provided + ;; that such works are identified as "derived from the RSA Data + ;; Security, Inc. MD5 Message-Digest Algorithm" in all material + ;; mentioning or referencing the derived work. + ;; + ;; RSA Data Security, Inc. makes no representations concerning either + ;; the merchantability of this software or the suitability of this + ;; software for any particular purpose. It is provided "as is" without + ;; express or implied warranty of any kind. + ;; + ;; These notices must be retained in any copies of any part of this + ;; documentation and/or software. + + ;;; Code: --------------------------------------------------------------------- + + (defvar md5-program "md5" + "*Program that reads a message on its standard input and writes an + MD5 digest on its output.") + + (defvar md5-maximum-internal-length 4096 + "*The maximum size of a piece of data that should use the MD5 routines + written in lisp. If a message exceeds this, it will be run through an + external filter for processing. Also see the `md5-program' variable. + This variable has no effect if you call the md5-init|update|final + functions - only used by the `md5' function's simpler interface.") + + (defvar md5-bits (make-vector 4 0) + "Number of bits handled, modulo 2^64. + Represented as four 16-bit numbers, least significant first.") + (defvar md5-buffer (make-vector 4 '(0 . 0)) + "Scratch buffer (four 32-bit integers).") + (defvar md5-input (make-vector 64 0) + "Input buffer (64 bytes).") + + (defun md5-unhex (x) + (if (> x ?9) + (if (>= x ?a) + (+ 10 (- x ?a)) + (+ 10 (- x ?A))) + (- x ?0))) + + (defun md5-encode (message) + "Encodes MESSAGE using the MD5 message digest algorithm. + MESSAGE must be a string or an array of bytes. + Returns a vector of 16 bytes containing the message digest." + (if (<= (length message) md5-maximum-internal-length) + (progn + (md5-init) + (md5-update message) + (md5-final)) + (save-excursion + (set-buffer (get-buffer-create " *md5-work*")) + (erase-buffer) + (insert message) + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t (current-buffer) nil + "-c" md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (let ((data (buffer-substring (point-min) (+ (point-min) 32))) + (vec (make-vector 16 0)) + (ctr 0)) + (while (< ctr 16) + (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) + (md5-unhex (aref data (1+ (* ctr 2)))))) + (setq ctr (1+ ctr))))))) + + (defsubst md5-add (x y) + "Return 32-bit sum of 32-bit integers X and Y." + (let ((m (+ (car x) (car y))) + (l (+ (cdr x) (cdr y)))) + (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) + + ;; FF, GG, HH and II are basic MD5 functions, providing transformations + ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this + ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x + ;; by y bits to the left): + ;; + ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b + ;; + ;; so we use the macro `md5-make-step' to construct each one. The + ;; helper functions F, G, H and I operate on 16-bit numbers; the full + ;; operation splits its inputs, operates on the halves separately and + ;; then puts the results together. + + (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) + (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) + (defsubst md5-H (x y z) (logxor x y z)) + (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) + + (defmacro md5-make-step (name func) + (` + (defun (, name) (a b c d x s ac) + (let* + ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) + (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) + (m2 (logand 65535 (+ m1 (lsh l1 -16)))) + (l2 (logand 65535 l1)) + (m3 (logand 65535 (if (> s 15) + (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) + (+ (lsh m2 s) (lsh l2 (- s 16)))))) + (l3 (logand 65535 (if (> s 15) + (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) + (+ (lsh l2 s) (lsh m2 (- s 16))))))) + (md5-add (cons m3 l3) b))))) + + (md5-make-step md5-FF md5-F) + (md5-make-step md5-GG md5-G) + (md5-make-step md5-HH md5-H) + (md5-make-step md5-II md5-I) + + (defun md5-init () + "Initialise the state of the message-digest routines." + (aset md5-bits 0 0) + (aset md5-bits 1 0) + (aset md5-bits 2 0) + (aset md5-bits 3 0) + (aset md5-buffer 0 '(26437 . 8961)) + (aset md5-buffer 1 '(61389 . 43913)) + (aset md5-buffer 2 '(39098 . 56574)) + (aset md5-buffer 3 '( 4146 . 21622))) + + (defun md5-update (string) + "Update the current MD5 state with STRING (an array of bytes)." + (let ((len (length string)) + (i 0) + (j 0)) + (while (< i len) + ;; Compute number of bytes modulo 64 + (setq j (% (/ (aref md5-bits 0) 8) 64)) + + ;; Store this byte (truncating to 8 bits to be sure) + (aset md5-input j (logand 255 (aref string i))) + + ;; Update number of bits by 8 (modulo 2^64) + (let ((c 8) (k 0)) + (while (and (> c 0) (< k 4)) + (let ((b (aref md5-bits k))) + (aset md5-bits k (logand 65535 (+ b c))) + (setq c (if (> b (- 65535 c)) 1 0) + k (1+ k))))) + + ;; Increment number of bytes processed + (setq i (1+ i)) + + ;; When 64 bytes accumulated, pack them into sixteen 32-bit + ;; integers in the array `in' and then tranform them. + (if (= j 63) + (let ((in (make-vector 16 (cons 0 0))) + (k 0) + (kk 0)) + (while (< k 16) + (aset in k (md5-pack md5-input kk)) + (setq k (+ k 1) kk (+ kk 4))) + (md5-transform in)))))) + + (defun md5-pack (array i) + "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." + (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) + (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) + + (defun md5-byte (array n b) + "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." + (let ((e (aref array n))) + (cond ((eq b 0) (logand 255 (cdr e))) + ((eq b 1) (lsh (cdr e) -8)) + ((eq b 2) (logand 255 (car e))) + ((eq b 3) (lsh (car e) -8))))) + + (defun md5-final () + (let ((in (make-vector 16 (cons 0 0))) + (j 0) + (digest (make-vector 16 0)) + (padding)) + + ;; Save the number of bits in the message + (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) + (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) + + ;; Compute number of bytes modulo 64 + (setq j (% (/ (aref md5-bits 0) 8) 64)) + + ;; Pad out computation to 56 bytes modulo 64 + (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) + (aset padding 0 128) + (md5-update padding) + + ;; Append length in bits and transform + (let ((k 0) (kk 0)) + (while (< k 14) + (aset in k (md5-pack md5-input kk)) + (setq k (+ k 1) kk (+ kk 4)))) + (md5-transform in) + + ;; Store the results in the digest + (let ((k 0) (kk 0)) + (while (< k 4) + (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) + (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) + (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) + (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) + (setq k (+ k 1) kk (+ kk 4)))) + + ;; Return digest + digest)) + + ;; It says in the RSA source, "Note that if the Mysterious Constants are + ;; arranged backwards in little-endian order and decrypted with the DES + ;; they produce OCCULT MESSAGES!" Security through obscurity? + + (defun md5-transform (in) + "Basic MD5 step. Transform md5-buffer based on array IN." + (let ((a (aref md5-buffer 0)) + (b (aref md5-buffer 1)) + (c (aref md5-buffer 2)) + (d (aref md5-buffer 3))) + (setq + a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) + d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) + c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) + b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) + a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) + d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) + c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) + b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) + a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) + d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) + c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) + b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) + a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) + d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) + c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) + b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) + a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) + d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) + c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) + b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) + a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) + d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) + c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) + b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) + a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) + d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) + c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) + b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) + a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) + d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) + c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) + b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) + a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) + d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) + c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) + b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) + a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) + d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) + c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) + b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) + a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) + d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) + c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) + b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) + a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) + d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) + c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) + b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) + a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) + d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) + c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) + b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) + a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) + d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) + c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) + b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) + a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) + d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) + c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) + b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) + a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) + d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) + c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) + b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) + + (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) + (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) + (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) + (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;; Here begins the merger with the XEmacs API and the md5.el from the URL + ;;; package. Courtesy wmperry@spry.com + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun md5 (object &optional start end) + "Return the MD5 (a secure message digest algorithm) of an object. + OBJECT is either a string or a buffer. + Optional arguments START and END denote buffer positions for computing the + hash of a portion of OBJECT." + (let ((buffer nil)) + (unwind-protect + (save-excursion + (setq buffer (generate-new-buffer " *md5-work*")) + (set-buffer buffer) + (cond + ((bufferp object) + (insert-buffer-substring object start end)) + ((stringp object) + (insert (if (or start end) + (substring object start end) + object))) + (t nil)) + (prog1 + (if (<= (point-max) md5-maximum-internal-length) + (mapconcat + (function (lambda (node) (format "%02x" node))) + (md5-encode (buffer-string)) + "") + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t buffer nil + "-c" md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (buffer-substring (point-min) (+ (point-min) 32))) + (kill-buffer buffer))) + (and buffer (kill-buffer buffer) nil)))) + + (provide 'md5) + + ;;; md5.el ends here ---------------------------------------------------------- *** pub/rgnus/lisp/message.el Wed Jul 31 14:22:26 1996 --- rgnus/lisp/message.el Fri Aug 2 21:32:29 1996 *************** *** 415,420 **** --- 415,423 ---- (defvar message-buffer-list nil) + ;; Byte-compiler warning + (defvar gnus-active-hashtb) + ;;; Regexp matching the delimiter of messages in UNIX mail format ;;; (UNIX From lines), minus the initial ^. (defvar message-unix-mail-delimiter *** pub/rgnus/lisp/nnheader.el Mon Jul 29 21:03:15 1996 --- rgnus/lisp/nnheader.el Fri Aug 2 21:34:44 1996 *************** *** 38,44 **** ;;; Code: (require 'mail-utils) - (eval-when-compile (require 'cl)) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") --- 38,43 ---- *************** *** 50,55 **** --- 49,59 ---- \(setq nnheader-file-name-translation-alist '((?: . ?_)))") + (eval-and-compile + (autoload 'nnmail-message-id "nnmail") + (autoload 'mail-position-on-field "sendmail") + (autoload 'message-remove-header "message")) + ;;; Header access macros. (defmacro mail-header-number (header) *************** *** 359,369 **** (point-max))) (goto-char (point-min))) ! (defun nnheader-set-temp-buffer (name) "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." (set-buffer (get-buffer-create name)) (buffer-disable-undo (current-buffer)) ! (erase-buffer) (current-buffer)) (defmacro nnheader-temp-write (file &rest forms) --- 363,374 ---- (point-max))) (goto-char (point-min))) ! (defun nnheader-set-temp-buffer (name &optional noerase) "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." (set-buffer (get-buffer-create name)) (buffer-disable-undo (current-buffer)) ! (unless noerase ! (erase-buffer)) (current-buffer)) (defmacro nnheader-temp-write (file &rest forms) *** pub/rgnus/lisp/nnoo.el Wed Jun 26 22:58:06 1996 --- rgnus/lisp/nnoo.el Fri Aug 2 21:32:27 1996 *************** *** 25,30 **** --- 25,31 ---- ;;; Code: + (require 'nnheader) (eval-when-compile (require 'cl)) (defvar nnoo-definition-alist nil) *** pub/rgnus/lisp/nntp.el Wed Jul 31 23:04:36 1996 --- rgnus/lisp/nntp.el Fri Aug 2 21:32:26 1996 *************** *** 150,155 **** --- 150,158 ---- (defvoo nntp-server-xover 'try) (defvoo nntp-server-list-active-group 'try) + (eval-and-compile + (autoload 'nnmail-read-passwd "nnmail")) + ;;; Interface functions. *************** *** 286,298 **** (deffoo nntp-request-list (&optional server) (nntp-possibly-change-group nil server) ! (prog1 (nntp-send-command "\r\n\\.\r\n" "LIST") ! (nntp-decode-text t))) (deffoo nntp-request-list-newsgroups (&optional server) (nntp-possibly-change-group nil server) ! (prog1 (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS") ! (nntp-decode-text t))) (deffoo nntp-request-newgroups (date &optional server) (nntp-possibly-change-group nil server) --- 289,299 ---- (deffoo nntp-request-list (&optional server) (nntp-possibly-change-group nil server) ! (nntp-send-command-and-decode "\r\n\\.\r\n" "LIST")) (deffoo nntp-request-list-newsgroups (&optional server) (nntp-possibly-change-group nil server) ! (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS")) (deffoo nntp-request-newgroups (date &optional server) (nntp-possibly-change-group nil server) *************** *** 475,480 **** --- 476,482 ---- (nntp-process-filter proc string)))) (defun nntp-process-filter (proc string) + "Process filter used for waiting a calling back." (let ((old-buffer (current-buffer))) (unwind-protect (let (point) *************** *** 495,500 **** --- 497,503 ---- (if (buffer-name (get-buffer nntp-tmp-buffer)) (save-excursion (set-buffer (get-buffer nntp-tmp-buffer)) + (goto-char (point-max)) (insert-buffer-substring (process-buffer proc)))) (set-process-filter proc nil) (erase-buffer) *************** *** 714,720 **** (defun nntp-send-xover-command (beg end &optional wait-for-reply) "Send the XOVER command to the server." (let ((range (format "%d-%d" beg end)) - (curbuf (current-buffer)) (nntp-inhibit-erase t)) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this --- 717,722 ---- *** pub/rgnus/lisp/nnvirtual.el Sat Jun 15 04:20:16 1996 --- rgnus/lisp/nnvirtual.el Fri Aug 2 21:32:26 1996 *************** *** 34,39 **** --- 34,42 ---- (require 'nnheader) (require 'gnus) (require 'nnoo) + (require 'gnus-util) + (require 'gnus-start) + (require 'gnus-sum) (eval-when-compile (require 'cl)) (nnoo-declare nnvirtual) *** pub/rgnus/lisp/pop3.el Fri Aug 2 22:35:16 1996 --- rgnus/lisp/pop3.el Thu Aug 1 20:52:12 1996 *************** *** 0 **** --- 1,422 ---- + ;;; pop3.el --- Post Office Protocol (RFC 1460) interface + + ;; Copyright (C) 1996, Free Software Foundation, Inc. + + ;; Author: Richard L. Pieri + ;; Keywords: mail, pop3 + ;; Version: 1.2 + + ;; 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: + + ;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands + ;; are implemented. The LIST command has not been implemented due to lack + ;; of actual usefulness. + ;; The optional POP3 command TOP has not been implemented. + + ;; This program was inspired by Kyle E. Jones's vm-pop program. + + ;;; Code: + + (require 'mail-utils) + (provide 'pop3) + + (defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) + "*POP3 maildrop.") + (defvar pop3-mailhost (or (getenv "MAILHOST") nil) + "*POP3 mailhost.") + (defvar pop3-port 110 + "*POP3 port.") + + (defvar pop3-password-required t + "*Non-nil if a password is required when connecting to POP server.") + (defvar pop3-password nil + "*Password to use when connecting to POP server.") + + (defvar pop3-authentication-scheme 'pass + "*POP3 authentication scheme. Defaults to 'pass, for the standard + USER/PASS authentication. Other valid values are 'apop.") + + (defvar pop3-timestamp nil + "Timestamp returned when initially connected to the POP server. + Used for APOP authentication.") + + (defvar pop3-read-point nil) + (defvar pop3-debug nil) + + (defun pop3-movemail (&optional crashbox) + "Transfer contents of a maildrop to the specified CRASHBOX." + (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) + (let* ((process (pop3-open-server pop3-mailhost pop3-port)) + (crashbuf (get-buffer-create " *pop3-retr*")) + (n 1) + message-count) + ;; for debugging only + (if pop3-debug (switch-to-buffer (process-buffer process))) + (cond ((equal 'apop pop3-authentication-scheme) + (pop3-apop process pop3-maildrop)) + ((equal 'pass pop3-authentication-scheme) + (pop3-user process pop3-maildrop) + (pop3-pass process)) + (t (error "Invalid POP3 authentication scheme."))) + (setq message-count (car (pop3-stat process))) + (while (<= n message-count) + (message (format "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost)) + (sit-for 0) + (pop3-retr process n crashbuf) + (save-excursion + (set-buffer crashbuf) + (append-to-file (point-min) (point-max) crashbox)) + (pop3-dele process n) + (setq n (+ 1 n))) + (pop3-quit process) + (kill-buffer crashbuf) + ) + (sit-for 0) + ) + + (defun pop3-open-server (mailhost port) + "Open TCP connection to MAILHOST. + Returns the process associated with the connection." + (let ((process-buffer + (get-buffer-create (format "trace of POP session to %s" mailhost))) + (process)) + (save-excursion + (set-buffer process-buffer) + (erase-buffer)) + (setq process + (open-network-stream "POP" process-buffer mailhost port)) + (setq pop3-read-point (point-min)) + (let ((response (pop3-read-response process t))) + (setq pop3-timestamp + (substring response (or (string-match "<" response) 0) + (+ 1 (or (string-match ">" response) -1))))) + process + )) + + ;; Support functions + + (defun pop3-process-filter (process output) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert output))) + + (defun pop3-send-command (process command) + (set-buffer (process-buffer process)) + (goto-char (point-max)) + ;; (if (= (aref command 0) ?P) + ;; (insert "PASS \r\n") + ;; (insert command "\r\n")) + (setq pop3-read-point (point)) + (goto-char (point-max)) + (process-send-string process command) + (process-send-string process "\r\n") + ) + + (defun pop3-read-response (process &optional return) + "Read the response from the server. + Return the response string if optional second argument is non-nil." + (let ((case-fold-search nil) + match-end) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char pop3-read-point) + (while (not (search-forward "\r\n" nil t)) + (accept-process-output process) + (goto-char pop3-read-point)) + (setq match-end (point)) + (goto-char pop3-read-point) + (if (looking-at "-ERR") + (error (buffer-substring (point) (- match-end 2))) + (if (not (looking-at "+OK")) + (progn (setq pop3-read-point match-end) nil) + (setq pop3-read-point match-end) + (if return + (buffer-substring (point) match-end) + t) + ))))) + + (defun pop3-string-to-list (string &optional regexp) + "Chop up a string into a list." + (let ((list) + (regexp (or regexp " ")) + (string (if (string-match "\r" string) + (substring string 0 (match-beginning 0)) + string))) + (store-match-data nil) + (while string + (if (string-match regexp string) + (setq list (cons (substring string 0 (- (match-end 0) 1)) list) + string (substring string (match-end 0))) + (setq list (cons string list) + string nil))) + (nreverse list))) + + (defvar pop3-read-passwd nil) + (defun pop3-read-passwd (prompt) + (if (not pop3-read-passwd) + (if (load "passwd" t) + (setq pop3-read-passwd 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (setq pop3-read-passwd 'ange-ftp-read-passwd))) + (funcall pop3-read-passwd prompt)) + + (defun pop3-clean-region (start end) + (setq end (set-marker (make-marker) end)) + (save-excursion + (goto-char start) + (while (and (< (point) end) (search-forward "\r\n" end t)) + (replace-match "\n" t t)) + (goto-char start) + (while (and (< (point) end) (re-search-forward "^\\." end t)) + (replace-match "" t t) + (forward-char))) + (set-marker end nil)) + + (defun pop3-munge-message-separator (start end) + "Check to see if a message separator exists. If not, generate one." + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (if (not (or (looking-at "From .?") ; Unix mail + (looking-at "\001\001\001\001\n") ; MMDF + (looking-at "BABYL OPTIONS:") ; Babyl + )) + (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) + (date (pop3-string-to-list (mail-fetch-field "Date"))) + (From_)) + ;; sample date formats I have seen + ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) + ;; Date: 08 Jul 1996 23:22:24 -0400 + ;; should be + ;; Tue Jul 9 09:04:21 1996 + (setq date + (cond ((string-match "[A-Z]" (nth 0 date)) + (format "%s %s %s %s %s" + (nth 0 date) (nth 2 date) (nth 1 date) + (nth 4 date) (nth 3 date))) + (t + ;; this really needs to be better but I don't feel + ;; like writing a date to day converter. + (format "Sun %s %s %s %s" + (nth 1 date) (nth 0 date) + (nth 3 date) (nth 2 date))) + )) + (setq From_ (format "From %s %s\n" from date)) + (while (string-match "," From_) + (setq From_ (concat (substring From_ 0 (match-beginning 0)) + (substring From_ (match-end 0))))) + (goto-char (point-min)) + (insert From_)))))) + + ;; The Command Set + + ;; AUTHORIZATION STATE + + (defun pop3-user (process user) + "Send USER information to POP3 server." + (pop3-send-command process (format "USER %s" user)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (error (format "USER %s not valid." user))))) + + (defun pop3-pass (process) + "Send authentication information to the server." + (let ((pass pop3-password)) + (if (and pop3-password-required (not pass)) + (setq pass + (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (if pass + (progn + (pop3-send-command process (format "PASS %s" pass)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (pop3-quit process))))) + )) + + (defun pop3-apop (process user) + "Send alternate authentication information to the server." + (if (not (fboundp 'md5)) (autoload 'md5 "md5")) + (let ((pass pop3-password)) + (if (and pop3-password-required (not pass)) + (setq pass + (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (if pass + (let ((hash (md5 (concat pop3-timestamp pass)))) + (pop3-send-command process (format "APOP %s %s" user hash)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (pop3-quit process))))) + )) + + ;; TRANSACTION STATE + + (defun pop3-stat (process) + "Return a list of the number of messages in the maildrop and the size + of the maildrop." + (pop3-send-command process "STAT") + (let ((response (pop3-read-response process t))) + (list (string-to-int (nth 1 (pop3-string-to-list response))) + (string-to-int (nth 2 (pop3-string-to-list response)))) + )) + + (defun pop3-list (process &optional msg) + "Scan listing of available messages. + This function currently does nothing.") + + (defun pop3-retr (process msg crashbuf) + "Retrieve message-id MSG from the server and place the contents in + buffer CRASHBUF." + (pop3-send-command process (format "RETR %s" msg)) + (pop3-read-response process) + (let ((start pop3-read-point) end) + (save-excursion + (set-buffer (process-buffer process)) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (accept-process-output process) + (goto-char start)) + (setq pop3-read-point (point-marker)) + (goto-char (match-beginning 0)) + (setq end (point-marker)) + (pop3-clean-region start end) + (pop3-munge-message-separator start end) + (save-excursion + (set-buffer crashbuf) + (erase-buffer)) + (copy-to-buffer crashbuf start end) + (delete-region start end) + ))) + + (defun pop3-dele (process msg) + "Mark message-id MSG as deleted." + (pop3-send-command process (format "DELE %s" msg)) + (pop3-read-response process)) + + (defun pop3-noop (process msg) + "No-operation." + (pop3-send-command process "NOOP") + (pop3-read-response process)) + + (defun pop3-last (process) + "Return highest accessed message-id number for the session." + (pop3-send-command process "LAST") + (let ((response (pop3-read-response process t))) + (string-to-int (nth 1 (pop3-string-to-list response))) + )) + + (defun pop3-rset (process) + "Remove all delete marks from current maildrop." + (pop3-send-command process "RSET") + (pop3-read-response process)) + + ;; UPDATE + + (defun pop3-quit (process) + "Tell server to remove all messages marked as deleted, unlock the + maildrop, and close the connection." + (pop3-send-command process "QUIT") + (pop3-read-response process t) + (if process + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (delete-process process)))) + + ;; Summary of POP3 (Post Office Protocol version 3) commands and responses + + ;;; AUTHORIZATION STATE + + ;; Initial TCP connection + ;; Arguments: none + ;; Restrictions: none + ;; Possible responses: + ;; +OK [POP3 server ready] + + ;; USER name + ;; Arguments: a server specific user-id (required) + ;; Restrictions: authorization state [after unsuccessful USER or PASS + ;; Possible responses: + ;; +OK [valid user-id] + ;; -ERR [invalid user-id] + + ;; PASS string + ;; Arguments: a server/user-id specific password (required) + ;; Restrictions: authorization state, after successful USER + ;; Possible responses: + ;; +OK [maildrop locked and ready] + ;; -ERR [invalid password] + ;; -ERR [unable to lock maildrop] + + ;;; TRANSACTION STATE + + ;; STAT + ;; Arguments: none + ;; Restrictions: transaction state + ;; Possible responses: + ;; +OK nn mm [# of messages, size of maildrop] + + ;; LIST [msg] + ;; Arguments: a message-id (optional) + ;; Restrictions: transaction state; msg must not be deleted + ;; Possible responses: + ;; +OK [scan listing follows] + ;; -ERR [no such message] + + ;; RETR msg + ;; Arguments: a message-id (required) + ;; Restrictions: transaction state; msg must not be deleted + ;; Possible responses: + ;; +OK [message contents follow] + ;; -ERR [no such message] + + ;; DELE msg + ;; Arguments: a message-id (required) + ;; Restrictions: transaction state; msg must not be deleted + ;; Possible responses: + ;; +OK [message deleted] + ;; -ERR [no such message] + + ;; NOOP + ;; Arguments: none + ;; Restrictions: transaction state + ;; Possible responses: + ;; +OK + + ;; LAST + ;; Arguments: none + ;; Restrictions: transaction state + ;; Possible responses: + ;; +OK nn [highest numbered message accessed] + + ;; RSET + ;; Arguments: none + ;; Restrictions: transaction state + ;; Possible responses: + ;; +OK [all delete marks removed] + + ;;; UPDATE STATE + + ;; QUIT + ;; Arguments: none + ;; Restrictions: none + ;; Possible responses: + ;; +OK [TCP connection closed] *** pub/rgnus/lisp/ChangeLog Wed Jul 31 23:03:00 1996 --- rgnus/lisp/ChangeLog Fri Aug 2 22:17:55 1996 *************** *** 1,3 **** --- 1,137 ---- + Wed Jul 31 15:23:54 1996 Ken Olstad + + * gnus-xmas.el (gnus-xmas-redefine): Disbale XFace when running + under tty. + + Wed Jul 31 14:21:38 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-read-group): Use `gnus-range-length' instead + of `length'. + + Fri Aug 2 21:48:17 1996 Lars Magne Ingebrigtsen + + * gnus-dup.el (gnus-dup-suppress-articles): Wouldn't mark articles + properly. + + Fri Aug 2 21:40:33 1996 Glenn Coombs + + * gnus-vis.el (gnus-button-url): New definition. + + Fri Aug 2 19:08:55 1996 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-update-read-articles): Moved here. + + * gnus-sum.el (gnus-update-read-articles): Moved here. + + * gnus-async.el (gnus-async-request-fetched-article): Would bug + out on Message-IDs. + + * gnus-score.el (gnus-score-save): Would kill wrong buffer. + + * nntp.el (nntp-process-filter): Insert at point-max. + + * nnheader.el (nnheader-set-temp-buffer): Accept a noerase param. + + Fri Aug 2 00:14:16 1996 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-edit-parameters): New command. + (gnus-group-topic-parameters): New function. + (gnus-topic-set-parameters): New function. + (gnus-topic-parameters): New function. + + * gnus-group.el (gnus-group-edit-group-done): Newish definition. + + * gnus-srvr.el (gnus-server-edit-server): Use new edit function. + (gnus-server-edit-server-done): Removed. + + * gnus-group.el: Use new edit function. + + * gnus-eform.el (gnus-eform): New file. + + * gnus-group.el (gnus-group-goto-group): Tippy-toe around some + more to find the most likely instance of the group. + (gnus-edit-form): New function. + (gnus-edit-form-mode): New command. + (gnus-edit-form-make-menu-bar): New function. + (gnus-edit-form-mode-hook): New variable. + (gnus-edit-form-exit): New command and keystroke. + (gnus-edit-form-done): Ditto. + + * gnus-topic.el: Moved functions around. + (gnus-current-topic): Renamed. + (gnus-current-topics): New function. + (gnus-group-parent-topic): New function. + + * article.el (gnus-signature-separator): New default. + (gnus-signature-limit): Extended value. + (article-narrow-to-signature): Use it. + + * gnus-cite.el (gnus-cite-parse): Use new signature functions. + + * article.el (article-search-signature): New function. + (gnus-signature-separator): Allow wider syntax. + + * gnus-async.el (gnus-use-header-prefetch): New variable. + (gnus-async-set-article-buffer): Removed. + (gnus-async-prefetch-headers): New function. + (gnus-asynch-retrieve-fetched-headers): New function. + (gnus-async-prefetch-header-buffer): New variable. + + * gnus-salt.el (gnus-summary-pick-line-format): New variable. + (gnus-pick-mode): Use it. + (gnus-pick-line-number): New function. + (gnus-pick-article): New command and keystroke. + (gnus-pick-mode-map): Changed " " to `gnus-pick-next-page'. + (gnus-pick-next-page): New command and keystroke. + (gnus-mark-unpicked-articles-as-read): New variable. + (gnus-pick-start-reading): Use it. + + * gnus-sum.el (gnus-summary-line-format-alist): Add pick line + number. + + Thu Aug 1 23:32:15 1996 Lars Magne Ingebrigtsen + + * nntp.el (nntp-request-list): Decode. + (nntp-request-list-newsgroups): Ditto. + + * gnus-gl.el (gnus-grouplens-mode): Update summary line specs. + + * gnus-msg.el (gnus-debug): Would bug out. + + Thu Aug 1 23:24:48 1996 Glenn Coombs + + * gnus-sum.el (gnus-summary-update-mark): Work on hidden threads. + + Thu Aug 1 00:00:16 1996 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-save): Wouldn't save scores. + + * gnus-load.el (gnus-summary-line-format): Moved here. + + * gnus.el (gnus-alive-p): More thorough definition. + (gnus-info-set-entry): New macro. + + * gnus-move.el: New file. + (gnus-move-group-to-server): New function. + (gnus-change-server): New command. + (gnus-group-move-group-to-server): New command. + + * gnus-start.el (gnus-parse-active): New function. + + * gnus.el (gnus-read-method): Mew function. + * gnus-group.el: Use it. + + * gnus-load.el (gnus-suppress-duplicates): New variable. + + * gnus-dup.el: New file. + + * gnus-sum.el (gnus-data-read-p): New macro. + (gnus-duplicate-mark): New variable. + + Wed Jul 31 23:09:35 1996 Lars Magne Ingebrigtsen + + * gnus.el: Red Gnus v0.3 is released. + Wed Jul 31 21:38:08 1996 Lars Magne Ingebrigtsen * nntp.el (nntp-retrieve-headers-with-xover): Didn't work. *** pub/rgnus/texi/gnus.texi Wed Jul 31 21:08:08 1996 --- rgnus/texi/gnus.texi Fri Aug 2 22:17:12 1996 *************** *** 339,344 **** --- 339,345 ---- * Startup Files:: Those pesky startup files---@file{.newsrc}. * Auto Save:: Recovering from a crash. * The Active File:: Reading the active file over a slow line Takes Time. + * Changing Servers:: You may want to move from one server to another. * Startup Variables:: Other variables you might change. @end menu *************** *** 649,654 **** --- 650,693 ---- Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss. + @node Changing Servers + @section Changing Servers + + Sometimes it is necessary to move from one @sc{nntp} server to another. + This happens very rarely, but perhaps you change jobs, or one server is + very flake and you want to use another. + + Changing the server is pretty easy, right? You just change + @code{gnus-select-method} to point to the new server? + + @emph{Wrong!} + + Article numbers are not (in any way) kept synchronized between different + @sc{nntp} servers, and the only way Gnus keeps track of what articles + you have read is by keeping track of article numbers. So when you + change @code{gnus-select-method}, your @file{.newsrc} file becomes + worthless. + + Gnus provides a few functions to attempt to translate a @file{.newsrc} + file from one server to another. They all have one thing in + common---they take a looong time to run. You don't want to use these + functions more than absolutely necessary. + + @kindex M-x gnus-change-server + @findex gnus-change-server + If you have access to both servers, Gnus can request the headers for all + the articles you have read and compare @code{Message-ID}s and map + reads and article marks. The @kbd{M-x gnus-change-server} command will + do this for all your native groups. It will prompt for the method you + want to move to. + + @kindex M-x gnus-group-move-group-to-server + @findex gnus-group-move-group-to-server + You can also move individual groups with the @kbd{M-x + gnus-group-move-group-to-server} command. This is useful if you want to + move a (foreign) group from one server to another. + + @node Startup Files @section Startup Files @cindex startup files *************** *** 2156,2213 **** @table @kbd @item T n ! @kindex T n (Group) @findex gnus-topic-create-topic Prompt for a new topic name and create it (@code{gnus-topic-create-topic}). @item T m ! @kindex T m (Group) @findex gnus-topic-move-group Move the current group to some other topic (@code{gnus-topic-move-group}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item T c ! @kindex T c (Group) @findex gnus-topic-copy-group Copy the current group to some other topic (@code{gnus-topic-copy-group}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item T D ! @kindex T D (Group) @findex gnus-topic-remove-group Remove a group from the current topic (@code{gnus-topic-remove-group}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item T M ! @kindex T M (Group) @findex gnus-topic-move-matching Move all groups that match some regular expression to a topic (@code{gnus-topic-move-matching}). @item T C ! @kindex T C (Group) @findex gnus-topic-copy-matching Copy all groups that match some regular expression to a topic (@code{gnus-topic-copy-matching}). @item T # ! @kindex T # (Group) @findex gnus-topic-mark-topic Mark all groups in the current topic with the process mark (@code{gnus-topic-mark-topic}). @item T M-# ! @kindex T M-# (Group) @findex gnus-topic-unmark-topic Remove the process mark from all groups in the current topic (@code{gnus-topic-unmark-topic}). @item RET ! @kindex RET (Group) @findex gnus-topic-select-group @itemx SPACE Either select a group or fold a topic (@code{gnus-topic-select-group}). --- 2195,2252 ---- @table @kbd @item T n ! @kindex T n (Topic) @findex gnus-topic-create-topic Prompt for a new topic name and create it (@code{gnus-topic-create-topic}). @item T m ! @kindex T m (Topic) @findex gnus-topic-move-group Move the current group to some other topic (@code{gnus-topic-move-group}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item T c ! @kindex T c (Topic) @findex gnus-topic-copy-group Copy the current group to some other topic (@code{gnus-topic-copy-group}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item T D ! @kindex T D (Topic) @findex gnus-topic-remove-group Remove a group from the current topic (@code{gnus-topic-remove-group}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item T M ! @kindex T M (Topic) @findex gnus-topic-move-matching Move all groups that match some regular expression to a topic (@code{gnus-topic-move-matching}). @item T C ! @kindex T C (Topic) @findex gnus-topic-copy-matching Copy all groups that match some regular expression to a topic (@code{gnus-topic-copy-matching}). @item T # ! @kindex T # (Topic) @findex gnus-topic-mark-topic Mark all groups in the current topic with the process mark (@code{gnus-topic-mark-topic}). @item T M-# ! @kindex T M-# (Topic) @findex gnus-topic-unmark-topic Remove the process mark from all groups in the current topic (@code{gnus-topic-unmark-topic}). @item RET ! @kindex RET (Topic) @findex gnus-topic-select-group @itemx SPACE Either select a group or fold a topic (@code{gnus-topic-select-group}). *************** *** 2218,2256 **** prefix, group on that level (and lower) will be displayed. @item T TAB ! @kindex T TAB (Group) @findex gnus-topic-indent ``Indent'' the current topic so that it becomes a sub-topic of the previous topic (@code{gnus-topic-indent}). If given a prefix, ``un-indent'' the topic instead. @item C-k ! @kindex C-k (Group) @findex gnus-topic-kill-group Kill a group or topic (@code{gnus-topic-kill-group}). @item C-y ! @kindex C-y (Group) @findex gnus-topic-yank-group Yank the previously killed group or topic (@code{gnus-topic-yank-group}). Note that all topics will be yanked before all groups. @item T r ! @kindex T r (Group) @findex gnus-topic-rename Rename a topic (@code{gnus-topic-rename}). @item T DEL ! @kindex T DEL (Group) @findex gnus-topic-delete Delete an empty topic (@code{gnus-topic-delete}). @item A T ! @kindex A T (Group) @findex gnus-topic-list-active List all groups that Gnus knows about in a topics-ified way (@code{gnus-topic-list-active}). @end table --- 2257,2307 ---- prefix, group on that level (and lower) will be displayed. @item T TAB ! @kindex T TAB (Topic) @findex gnus-topic-indent ``Indent'' the current topic so that it becomes a sub-topic of the previous topic (@code{gnus-topic-indent}). If given a prefix, ``un-indent'' the topic instead. @item C-k ! @kindex C-k (Topic) @findex gnus-topic-kill-group Kill a group or topic (@code{gnus-topic-kill-group}). @item C-y ! @kindex C-y (Topic) @findex gnus-topic-yank-group Yank the previously killed group or topic (@code{gnus-topic-yank-group}). Note that all topics will be yanked before all groups. @item T r ! @kindex T r (Topic) @findex gnus-topic-rename Rename a topic (@code{gnus-topic-rename}). @item T DEL ! @kindex T DEL (Topic) @findex gnus-topic-delete Delete an empty topic (@code{gnus-topic-delete}). @item A T ! @kindex A T (Topic) @findex gnus-topic-list-active List all groups that Gnus knows about in a topics-ified way (@code{gnus-topic-list-active}). + @item G p + @kindex G p (Topic) + @findex gnus-topic-edit-parameters + @cindex group parameters + @cindex topic parameters + @cindex parameters + Edit the topic parameters (@code{gnus-topic-edit-parameters}). All + groups in the topic will inherit group parameters from the parent (and + ancestor) topic parameters. Group parameters (of course) override topic + parameters, and topic parameters in sub-topics override topic parameters + in super-topics. You know. Normal inheretance rules. + @end table *************** *** 2511,2516 **** --- 2562,2569 ---- * Mail Group Commands:: Some commands can only be used in mail groups. * Various Summary Stuff:: What didn't fit anywhere else. * Exiting the Summary Buffer:: Returning to the Group buffer. + * Crosspost Handling:: How crossposted articles are dealt with. + * Duplicate Suppression:: An alternative when crosspost handling fails. @end menu *************** *** 2619,2624 **** --- 2672,2679 ---- down summary buffer generation somewhat. @item e A single character will be displayed if the article has any children. + @item P + The line number. @item u User defined specifier. The next character in the format string should be a letter. @sc{gnus} will call the function *************** *** 4927,4932 **** --- 4982,4988 ---- * Article Washing:: Lots of way-neat functions to make life better. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Date:: Grumble, UT! + * Article Signature:: What is a signature? @end menu *************** *** 5021,5029 **** @vindex gnus-signature-face @findex gnus-article-highlight-signature Highlight the signature (@code{gnus-article-highlight-signature}). ! Everything after @code{gnus-signature-separator} in an article will be ! considered a signature and will be highlighted with ! @code{gnus-signature-face}, which is @code{italic} by default. @end table --- 5077,5086 ---- @vindex gnus-signature-face @findex gnus-article-highlight-signature Highlight the signature (@code{gnus-article-highlight-signature}). ! Everything after @code{gnus-signature-separator} (@pxref{Article ! Signature}) in an article will be considered a signature and will be ! highlighted with @code{gnus-signature-face}, which is @code{italic} by ! default. @end table *************** *** 5057,5063 **** @item W W s @kindex W W s (Summary) @findex gnus-article-hide-signature ! Hide signature (@code{gnus-article-hide-signature}). @item W W p @kindex W W p (Summary) --- 5114,5121 ---- @item W W s @kindex W W s (Summary) @findex gnus-article-hide-signature ! Hide signature (@code{gnus-article-hide-signature}). @xref{Article ! Signature}. @item W W p @kindex W W p (Summary) *************** *** 5126,5139 **** Also @pxref{Article Highlighting} for further variables for citation customization. - @vindex gnus-signature-limit - @code{gnus-signature-limit} provides a limit to what is considered a - signature. If it is a number, no signature may not be longer (in - characters) than that number. If it is a function, the function will be - called without any parameters, and if it returns @code{nil}, there is no - signature in the buffer. If it is a string, it will be used as a - regexp. If it matches, the text in question is not a signature. - @node Article Washing @subsection Article Washing --- 5184,5189 ---- *************** *** 5365,5370 **** --- 5415,5472 ---- @end table + @node Article Signature + @subsection Article Signature + @cindex signatures + @cindex article signature + + @vindex gnus-signature-separator + Each article is divided into two parts---the head and the body. The + body can be divided into a signature part and a text part. The variable + that says what is to be considered a signature is + @code{gnus-signature-separator}. This is normally the standard + @samp{"^-- $"} as mandated by son-of-RFC 1036. However, many people use + non-standard signature separators, so this variable can also be a list + of regular expressions to be tested, one by one. (Searches are done + from the end of the body towards the beginning.) One likely value is: + + @lisp + (setq gnus-signature-separator + '("^-- $" ; The standard + "^-- *$" ; A common mangling + "^-------*$" ; Many people just use a looong + ; line of dashes. Shame! + "^ *--------*$" ; Double-shame! + "^________*$" ; Underscores are also popular + "^========*$")) ; Pervert! + @end lisp + + The more permissive you are, the more likely it is that you'll get false + positives. + + @vindex gnus-signature-limit + @code{gnus-signature-limit} provides a limit to what is considered a + signature. + + @enumerate + @item + If it is an integer, no signature may be longer (in characters) than + that integer. + @item + If it is a floating point number, no signature may be longer (in lines) + than that number. + @item + If it is a function, the function will be called without any parameters, + and if it returns @code{nil}, there is no signature in the buffer. + @item + If it is a string, it will be used as a regexp. If it matches, the text + in question is not a signature. + @end enumerate + + This variable can also be a list where the elements may be of the types + listed above. + + @node Summary Sorting @section Summary Sorting @cindex summary sorting *************** *** 5487,5496 **** Here are the available keystrokes when using pick mode: @table @kbd @item SPACE @kindex SPACE (Pick) ! @findex gnus-summary-mark-as-processable ! Pick the article (@code{gnus-summary-mark-as-processable}). @item u @kindex u (Pick) --- 5589,5607 ---- Here are the available keystrokes when using pick mode: @table @kbd + @item . + @kindex . (Pick) + @findex gnus-summary-mark-as-processable + Pick the article on the current line + (@code{gnus-summary-mark-as-processable}). If given a numerical prefix, + go to the article on that line and pick that article. (The line number + is normally displayed on the beginning of the summary pick lines.) + @item SPACE @kindex SPACE (Pick) ! @findex gnus-pick-next-page ! Scroll the summary buffer up one page (@code{gnus-pick-next-page}). If ! at the end of the buffer, start reading the picked articles. @item u @kindex u (Pick) *************** *** 5562,5567 **** --- 5673,5690 ---- @vindex gnus-pick-mode-hook @code{gnus-pick-mode-hook} is run in pick minor mode buffers. + @vindex gnus-mark-unpicked-articles-as-read + If @code{gnus-mark-unpicked-articles-as-read} is non-@code{nil}, mark + all unpicked articles as read. The default is @code{nil}. + + @vindex gnus-summary-pick-line-format + The summary line format in pick mode is slightly different than the + standard format. At the beginning of each line the line number is + displayed. The pick mode line format is controlled by the + @code{gnus-summary-pick-line-format} variable (@pxref{Formatting + Variables}). It accepts the same format specs that + @code{gnus-summary-line-format} does (@pxref{Summary Buffer Lines}). + @node Binary Groups @subsection Binary Groups *************** *** 6034,6040 **** this group and are marked as read, will also be marked as read in the other subscribed groups they were cross-posted to. If this variable is neither @code{nil} nor @code{t}, the article will be marked as read in ! both subscribed and unsubscribed groups. @cindex velveeta @cindex spamming --- 6157,6167 ---- this group and are marked as read, will also be marked as read in the other subscribed groups they were cross-posted to. If this variable is neither @code{nil} nor @code{t}, the article will be marked as read in ! both subscribed and unsubscribed groups (@pxref{Crosspost Handling}). ! ! ! @node Crosspost Handling ! @section Crosspost Handling @cindex velveeta @cindex spamming *************** *** 6043,6053 **** posted it to several groups separately. Posting the same article to several groups (not cross-posting) is called @dfn{spamming}, and you are by law required to send nasty-grams to anyone who perpetrates such a ! heinous crime. Remember: Cross-posting is kinda ok, but posting the same article separately to several groups is not. Massive cross-posting (aka. ! @dfn{velveeta}) is to be avoided. @cindex cross-posting @cindex Xref --- 6170,6181 ---- posted it to several groups separately. Posting the same article to several groups (not cross-posting) is called @dfn{spamming}, and you are by law required to send nasty-grams to anyone who perpetrates such a ! heinous crime. You may want to try NoCeM handling to filter out spam ! (@pxref{NoCeM}). Remember: Cross-posting is kinda ok, but posting the same article separately to several groups is not. Massive cross-posting (aka. ! @dfn{velveeta}) is to be avoided at all costs. @cindex cross-posting @cindex Xref *************** *** 6080,6085 **** --- 6208,6285 ---- C'est la vie. + For an alternative approach, @xref{Duplicate Suppression}. + + + @node Duplicate Suppression + @section Duplicate Suppression + + By default, Gnus tries to make sure that you don't have to read the same + article more than once by utilizing the crossposing mechanism + (@pxref{Crosspost Handling}). However, that simple and efficient + approach may not work satisfactorily for some users for various + reasons. + + @enumerate + @item + The @sc{nntp} server may fail to generate the @code{Xref} header. This + is evil and not very common. + + @item + The @sc{nntp} server may fail to include the @code{Xref} header in the + @file{.overview} data bases. This is evil and all too common, alas. + + @item + You may be reading the same group (or several related groups) from + different @sc{nntp} servers. + + @item + You may be getting mail that duplicates articles posted to groups. + @end enumerate + + I'm sure there are other situations that @code{Xref} handling fails as + well, but these four are the most common situations. + + If, and only if, @code{Xref} handling fails for you, then you may + consider switching on @dfn{duplicate suppression}. If you do so, Gnus + will remember the @code{Message-ID}s of all articles you have read or + otherwise marked as read, and then, as if by magic, mark them as read + all subsequent times you see them---in @emph{all} groups. Using this + mechanism is quite likely to be somewhat inefficient, but not overly + so. It's certainly preferrable to reading the same articles more than + once. + + @table @code + @item gnus-suppress-duplicates + @vindex gnus-suppress-duplicates + If non-@code{nil}, suppress duplicates. + + @item gnus-save-duplicate-list + @vindex gnus-save-duplicate-list + If non-@code{nil}, save the list of duplicates to a file. This will + make startup and shutdown take longer, so the default is @code{nil}. + However, this means that only duplicate articles that is read in a + single Gnus session are suppressed. + + @item gnus-duplicate-list-length + @vindex gnus-duplicate-list-length + This variables says how many @code{Message-ID}s to keep in the duplicate + suppression list. The default is 10000. + + @item gnus-duplicate-file + @vindex gnus-duplicate-file + The name of the file to store the duplicate suppression list. The + default is @file{~/News/suppression}. + @end table + + If you have a tendency to stop and start Gnus often, setting + @code{gnus-save-duplicate-list} to @code{t} is probably a good idea. If + you leave Gnus running for weeks on end, you may have it @code{nil}. On + the other hand, saving the list makes startup and shutdown much slower, + so that means that if you stop and start Gnus often, you should set + @code{gnus-save-duplicate-list} to @code{nil}. Uhm. I'll leave this up + to you to figure out, I think. + @node The Article Buffer @chapter The Article Buffer *************** *** 7637,7643 **** @cindex incoming mail files @cindex deleting incoming files If non-@code{nil}, the mail backends will delete the temporary incoming ! file after splitting mail into the proper groups. This is @code{nil} by default for reasons of security. @item nnmail-use-long-file-names --- 7837,7843 ---- @cindex incoming mail files @cindex deleting incoming files If non-@code{nil}, the mail backends will delete the temporary incoming ! file after splitting mail into the proper groups. This is @code{t} by default for reasons of security. @item nnmail-use-long-file-names *************** *** 10504,10510 **** @code{gnus-group-mode-line-format}, @code{gnus-summary-mode-line-format}, @code{gnus-article-mode-line-format}, ! @code{gnus-server-mode-line-format}. Note that the @samp{%(} specs (and friends) do not make any sense on the mode-line variables. --- 10704,10711 ---- @code{gnus-group-mode-line-format}, @code{gnus-summary-mode-line-format}, @code{gnus-article-mode-line-format}, ! @code{gnus-server-mode-line-format}, and ! @code{gnus-summary-pick-line-format}. Note that the @samp{%(} specs (and friends) do not make any sense on the mode-line variables. *************** *** 10700,10709 **** @code{gnus-buffer-configuration}: @code{group}, @code{summary}, @code{article}, @code{server}, ! @code{browse}, @code{group-mail}, @code{summary-mail}, ! @code{summary-reply}, @code{info}, @code{summary-faq}, ! @code{edit-group}, @code{edit-server}, @code{reply}, @code{reply-yank}, ! @code{followup}, @code{followup-yank}, @code{edit-score}. @findex gnus-add-configuration Since the @code{gnus-buffer-configuration} variable is so long and --- 10901,10925 ---- @code{gnus-buffer-configuration}: @code{group}, @code{summary}, @code{article}, @code{server}, ! @code{browse}, @code{message}, @code{pick}, @code{info}, ! @code{summary-faq}, @code{edit-group}, @code{edit-server}, ! @code{edit-score}, @code{post}, @code{reply}, @code{forward}, ! @code{reply-yank}, @code{mail-bounce}, @code{draft}, ! @code{pipe}, @code{bug}, @code{compose-bounce}. ! ! Note that the @code{message} key is used for both ! @code{gnus-group-mail} and @code{gnus-summary-mail-other-window}. If ! it is desireable to distinguish between the two, something like this ! might be used: ! ! @lisp ! (message (horizontal 1.0 ! (vertical 1.0 (message 1.0 point)) ! (vertical 0.24 ! (if (buffer-live-p gnus-summary-buffer) ! '(summary 0.5)) ! (group 1.0))))) ! @end lisp @findex gnus-add-configuration Since the @code{gnus-buffer-configuration} variable is so long and *** pub/rgnus/texi/message.texi Tue Jul 16 23:10:03 1996 --- rgnus/texi/message.texi Fri Aug 2 18:50:20 1996 *************** *** 169,175 **** @findex message-wide-reply The @code{message-wide-reply} pops up a message buffer that's a wide ! reply to the message in the current buffer. @vindex message-wide-reply-to-function Message uses the normal methods to determine where wide replies are to go, --- 169,177 ---- @findex message-wide-reply The @code{message-wide-reply} pops up a message buffer that's a wide ! reply to the message in the current buffer. A @dfn{wide reply} is a ! reply that goes out to all people listed in the @code{To}, @code{From} ! and @code{Cc} headers. @vindex message-wide-reply-to-function Message uses the normal methods to determine where wide replies are to go, *************** *** 277,283 **** @findex message-bounce The @code{message-bounce} command will, if the current buffer contains a bounced mail message, pop up a message buffer stripped of the bounce ! information. @vindex message-ignored-bounced-headers Headers that match the @code{message-ignored-bounced-headers} regexp --- 279,287 ---- @findex message-bounce The @code{message-bounce} command will, if the current buffer contains a bounced mail message, pop up a message buffer stripped of the bounce ! information. A @dfn{bounced message} is typically a mail you've sent ! out that has been returned by some @code{mailer-daemon} as ! undeliverable. @vindex message-ignored-bounced-headers Headers that match the @code{message-ignored-bounced-headers} regexp *** pub/rgnus/texi/ChangeLog Wed Jul 31 15:40:46 1996 --- rgnus/texi/ChangeLog Fri Aug 2 22:16:56 1996 *************** *** 1,3 **** --- 1,27 ---- + Wed Jul 31 15:34:12 1996 Lars Magne Ingebrigtsen + + * gnus.texi (are): Fix. + + Wed Jul 31 15:32:57 1996 David S. Goldberg + + * gnus.texi (buffer-name): Addition. + + Fri Aug 2 00:32:39 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Pick and Read): Addition. + (Article Hiding): Addition. + (Article Signature): Made into own node. + + Thu Aug 1 00:25:41 1996 Lars Magne Ingebrigtsen + + * message.texi (Wide Reply): Addition. + (Bouncing): Addition. + + * gnus.texi (Crosspost Handling): Made into own node. + (Duplicate Suppression): New. + (Document Server Internals): New. + (Changing Servers): New. + Wed Jul 31 15:37:44 1996 Lars Magne Ingebrigtsen * gnus.texi: Fix