*** pub/dgnus/lisp/auc-menu.el Sun Jul 2 17:31:33 1995 --- dgnus/lisp/auc-menu.el Sat Jul 1 21:47:12 1995 *************** *** 0 **** --- 1,313 ---- + ;;; auc-menu.el - Easy menu support for GNU Emacs 19 and XEmacs. + ;; + ;; $Id: auc-menu.el,v 5.7 1994/11/28 01:41:22 amanda Exp $ + ;; + ;; LCD Archive Entry: + ;; auc-menu|Per Abrahamsen|abraham@iesd.auc.dk| + ;; Easy menu support for GNU Emacs 19 and XEmacs| + ;; $Date: 1994/11/28 01:41:22 $|$Revision: 5.7 $|~/misc/auc-menu.el.gz| + + ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. + ;; Copyright (C) 1994 Per Abrahamsen + ;; + ;; This program is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + ;; + ;; This program is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + ;; + ;; You should have received a copy of the GNU General Public License + ;; along with this program; if not, write to the Free Software + ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; Commentary: + ;; + ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs. + ;; The advantages of using easymenu are: + ;; + ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax. + ;; + ;; - Common interface for Emacs 18, Emacs 19, and XEmacs. + ;; (The code does nothing when run under Emacs 18). + ;; + ;; The public functions are: + ;; + ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU + ;; SYMBOL is both the name of the variable that holds the menu and + ;; the name of a function that will present a the menu. + ;; MAPS is a list of keymaps where the menu should appear in the menubar. + ;; DOC is the documentation string for the variable. + ;; MENU is an XEmacs style menu description. + ;; + ;; See the documentation for easy-menu-define for details. + ;; + ;; - Function: easy-menu-change PATH NAME ITEMS + ;; Change an existing menu. + ;; The menu must already exist an be visible on the menu bar. + ;; PATH is a list of strings used for locating the menu on the menu bar. + ;; NAME is the name of the menu. + ;; ITEMS is a list of menu items, as defined in `easy-menu-define'. + ;; + ;; - Function: easy-menu-add MENU [ MAP ] + ;; Add MENU to the current menubar in MAP. + ;; + ;; - Function: easy-menu-remove MENU + ;; Remove MENU from the current menubar. + ;; + ;; GNU Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', + ;; menus automatically appear and disappear when the keymaps + ;; specified by the MAPS argument to `easy-menu-define' are + ;; activated. + ;; + ;; XEmacs will bind the map to button3 in each MAPS, but you must + ;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and + ;; remove menus from the menu bar. + + ;; auc-menu.el define the easymenu API included in Emacs 19.29 and + ;; later. In fact, the Emacs 19 specific code should be identical. + + ;;; Code: + + ;;;###autoload + (defmacro easy-menu-define (symbol maps doc menu) + "Define a menu bar submenu in maps MAPS, according to MENU. + The arguments SYMBOL and DOC are ignored; they are present for + compatibility only. SYMBOL is not evaluated. In other Emacs versions + these arguments may be used as a variable to hold the menu data, and a + doc string for that variable. + + The first element of MENU must be a string. It is the menu bar item name. + The rest of the elements are menu items. + + A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] + + NAME is a string--the menu item name. + + CALLBACK is a command to run when the item is chosen, + or a list to evaluate when the item is chosen. + + ENABLE is an expression; the item is enabled for selection + whenever this expression's value is non-nil. + + Alternatively, a menu item may have the form: + + [ NAME CALLBACK [ KEYWORD ARG ] ... ] + + Where KEYWORD is one of the symbol defined below. + + :keys KEYS + + KEYS is a string; a complex keyboard equivalent to this menu item. + + :active ENABLE + + ENABLE is an expression; the item is enabled for selection + whenever this expression's value is non-nil. + + :suffix NAME + + NAME is a string; the name of an argument to CALLBACK. + + :style STYLE + + STYLE is a symbol describing the type of menu item. The following are + defined: + + toggle: A checkbox. + Currently just prepend the name with the string \"Toggle \". + radio: A radio button. + nil: An ordinary menu item. + + :selected SELECTED + + SELECTED is an expression; the checkbox or radio button is selected + whenever this expression's value is non-nil. + Currently just disable radio buttons, no effect on checkboxes. + + A menu item can be a string. Then that string appears in the menu as + unselectable text. A string consisting solely of hyphens is displayed + as a solid horizontal line. + + A menu item can be a list. It is treated as a submenu. + The first element should be the submenu name. That's used as the + menu item in the top-level menu. The cdr of the submenu list + is a list of menu items, as above." + (` (progn + (defvar (, symbol) nil (, doc)) + (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu))))) + + (cond + + ;;; Emacs 18 + + ((< (string-to-int emacs-version) 19) + + (defun easy-menu-do-define (symbol maps doc menu) + (fset symbol (symbol-function 'ignore))) + + (defun easy-menu-remove (menu)) + + (defun easy-menu-add (menu &optional map)) + + (defun easy-menu-change (path name items)) + + ) ;Emacs 18 + + ;;; XEmacs + + ((string-match "XEmacs\\|Lucid" emacs-version) + + (defun easy-menu-do-define (symbol maps doc menu) + (set symbol menu) + (fset symbol (list 'lambda '(e) + doc + '(interactive "@e") + '(run-hooks 'activate-menubar-hook) + '(setq zmacs-region-stays 't) + (list 'popup-menu symbol))) + (mapcar (function (lambda (map) (define-key map 'button3 symbol))) + (if (keymapp maps) (list maps) maps))) + + (fset 'easy-menu-change (symbol-function 'add-menu)) + + (defun easy-menu-add (menu &optional map) + "Add MENU to the current menu bar." + (cond ((null current-menubar) + ;; Don't add it to a non-existing menubar. + nil) + ((assoc (car menu) current-menubar) + ;; Already present. + nil) + ((equal current-menubar '(nil)) + ;; Set at left if only contains right marker. + (set-buffer-menubar (list menu nil))) + (t + ;; Add at right. + (set-buffer-menubar (copy-sequence current-menubar)) + (add-menu nil (car menu) (cdr menu))))) + + (defun easy-menu-remove (menu) + "Remove MENU from the current menu bar." + (and current-menubar + (assoc (car menu) current-menubar) + (delete-menu-item (list (car menu))))) + + ) ;XEmacs + + ;;; GNU Emacs 19 + + (t + + (defun easy-menu-do-define (symbol maps doc menu) + ;; We can't do anything that might differ between Emacs dialects in + ;; `easy-menu-define' in order to make byte compiled files + ;; compatible. Therefore everything interesting is done in this + ;; function. + (set symbol (easy-menu-create-keymaps (car menu) (cdr menu))) + (fset symbol (` (lambda (event) (, doc) (interactive "@e") + (easy-popup-menu event (, symbol))))) + (mapcar (function (lambda (map) + (define-key map (vector 'menu-bar (intern (car menu))) + (cons (car menu) (symbol-value symbol))))) + (if (keymapp maps) (list maps) maps))) + + (defvar easy-menu-item-count 0) + + ;; Return a menu keymap corresponding to a XEmacs style menu list + ;; MENU-ITEMS, and with name MENU-NAME. + (defun easy-menu-create-keymaps (menu-name menu-items) + (let ((menu (make-sparse-keymap menu-name))) + ;; Process items in reverse order, + ;; since the define-key loop reverses them again. + (setq menu-items (reverse menu-items)) + (while menu-items + (let* ((item (car menu-items)) + (callback (if (vectorp item) (aref item 1))) + command enabler name) + (cond ((stringp item) + (setq command nil) + (setq name (if (string-match "^-+$" item) "" item))) + ((consp item) + (setq command (easy-menu-create-keymaps (car item) (cdr item))) + (setq name (car item))) + ((vectorp item) + (setq command (make-symbol (format "menu-function-%d" + easy-menu-item-count))) + (setq easy-menu-item-count (1+ easy-menu-item-count)) + (setq name (aref item 0)) + (let ((keyword (aref item 2))) + (if (and (symbolp keyword) + (= ?: (aref (symbol-name keyword) 0))) + (let ((count 2) + style selected active keys + arg) + (while (> (length item) count) + (setq keyword (aref item count)) + (setq arg (aref item (1+ count))) + (setq count (+ 2 count)) + (cond ((eq keyword ':keys) + (setq keys arg)) + ((eq keyword ':active) + (setq active arg)) + ((eq keyword ':suffix) + (setq name (concat name " " arg))) + ((eq keyword ':style) + (setq style arg)) + ((eq keyword ':selected) + (setq selected arg)))) + (if keys + (setq name (concat name " (" keys ")"))) + (if (eq style 'toggle) + ;; Simulate checkboxes. + (setq name (concat "Toggle " name))) + (if active + (put command 'menu-enable active) + (and (eq style 'radio) + selected + ;; Simulate radio buttons with menu-enable. + (put command 'menu-enable + (list 'not selected))))))) + (if (keymapp callback) + (setq name (concat name " ..."))) + (if (symbolp callback) + (fset command callback) + (fset command (list 'lambda () '(interactive) callback))))) + (if (null command) + ;; Handle inactive strings specially--allow any number + ;; of identical ones. + (setcdr menu (cons (list nil name) (cdr menu))) + (if name + (define-key menu (vector (intern name)) (cons name command))))) + (setq menu-items (cdr menu-items))) + menu)) + + (defun easy-menu-change (path name items) + "Change menu found at PATH as item NAME to contain ITEMS. + PATH is a list of strings for locating the menu containing NAME in the + menu bar. ITEMS is a list of menu items, as in `easy-menu-define'. + These items entirely replace the previous items in that map. + + Call this from `activate-menubar-hook' to implement dynamic menus." + (let ((map (key-binding (apply 'vector + 'menu-bar + (mapcar 'intern (append path (list name))))))) + (if (keymapp map) + (setcdr map (cdr (easy-menu-create-keymaps name items))) + (error "Malformed menu in `easy-menu-change'")))) + + (defun easy-menu-remove (menu)) + + (defun easy-menu-add (menu &optional map)) + + ) ;GNU Emacs 19 + + ) ;cond + + (provide 'easymenu) + (provide 'auc-menu) + + ;;; auc-menu.el ends here *** pub/dgnus/lisp/gnus-cache.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-cache.el Sun Jul 2 12:00:58 1995 *************** *** 265,272 **** (kill-buffer cache-buf))) (defun gnus-cache-braid-heads (group cached) ! (let ((cache-buf (get-buffer-create " *gnus-cache*")) ! beg end) (save-excursion (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) --- 265,271 ---- (kill-buffer cache-buf))) (defun gnus-cache-braid-heads (group cached) ! (let ((cache-buf (get-buffer-create " *gnus-cache*"))) (save-excursion (set-buffer cache-buf) (buffer-disable-undo (current-buffer)) *** pub/dgnus/lisp/gnus-cite.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-cite.el Sun Jul 2 12:50:22 1995 *************** *** 149,155 **** (alist gnus-cite-prefix-alist) (faces gnus-cite-face-list) (inhibit-point-motion-hooks t) ! face entry prefix skip numbers number face-alist end) ;; Loop through citation prefixes. (while alist (setq entry (car alist) --- 149,155 ---- (alist gnus-cite-prefix-alist) (faces gnus-cite-face-list) (inhibit-point-motion-hooks t) ! face entry prefix skip numbers number face-alist) ;; Loop through citation prefixes. (while alist (setq entry (car alist) *************** *** 282,288 **** (goto-char (point-max)) (re-search-backward gnus-signature-separator nil t) (point))) ! alist entry prefix start begin end numbers) ;; Get all potential prefixes in `alist'. (while (< (point) max) ;; Each line. --- 282,288 ---- (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'. (while (< (point) max) ;; Each line. *************** *** 399,405 **** (concat "\\`" (regexp-quote prefix) ".+"))) ;; Remove loose prefixes with too few lines. (let ((alist gnus-cite-loose-prefix-alist) ! entry prefix) (while alist (setq entry (car alist) alist (cdr alist)) --- 399,405 ---- (concat "\\`" (regexp-quote prefix) ".+"))) ;; Remove loose prefixes with too few lines. (let ((alist gnus-cite-loose-prefix-alist) ! entry) (while alist (setq entry (car alist) alist (cdr alist)) *************** *** 435,441 **** ;; TAG is the SuperCite tag on the attribution line. (let ((atts gnus-cite-loose-attribution-alist) (case-fold-search t) ! att wrote in prefix tag regexp limit smallest best size aprefix) (while atts (setq att (car atts) atts (cdr atts) --- 435,441 ---- ;; TAG is the SuperCite tag on the attribution line. (let ((atts gnus-cite-loose-attribution-alist) (case-fold-search t) ! att wrote in prefix tag regexp limit smallest best size) (while atts (setq att (car atts) atts (cdr atts) *************** *** 494,500 **** (defun gnus-cite-find-loose (prefix) ;; Return a list of loose attribution lines prefixed by PREFIX. (let* ((atts gnus-cite-loose-attribution-alist) ! att line lines candidate) (while atts (setq att (car atts) line (car att) --- 494,500 ---- (defun gnus-cite-find-loose (prefix) ;; Return a list of loose attribution lines prefixed by PREFIX. (let* ((atts gnus-cite-loose-attribution-alist) ! att line lines) (while atts (setq att (car atts) line (car att) *** pub/dgnus/lisp/gnus-ems.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-ems.el Sun Jul 2 17:11:31 1995 *************** *** 66,72 **** () (setq gnus-group-mode-hook (cons ! (lambda () (easy-menu-add gnus-group-reading-menu) (easy-menu-add gnus-group-group-menu) (easy-menu-add gnus-group-post-menu) --- 66,72 ---- () (setq gnus-group-mode-hook (cons ! '(lambda () (easy-menu-add gnus-group-reading-menu) (easy-menu-add gnus-group-group-menu) (easy-menu-add gnus-group-post-menu) *************** *** 75,81 **** gnus-group-mode-hook)) (setq gnus-summary-mode-hook (cons ! (lambda () (easy-menu-add gnus-summary-mark-menu) (easy-menu-add gnus-summary-move-menu) (easy-menu-add gnus-summary-article-menu) --- 75,81 ---- gnus-group-mode-hook)) (setq gnus-summary-mode-hook (cons ! '(lambda () (easy-menu-add gnus-summary-mark-menu) (easy-menu-add gnus-summary-move-menu) (easy-menu-add gnus-summary-article-menu) *************** *** 87,93 **** gnus-summary-mode-hook)) (setq gnus-article-mode-hook (cons ! (lambda () (easy-menu-add gnus-article-article-menu) (easy-menu-add gnus-article-treatment-menu)) gnus-article-mode-hook))) --- 87,93 ---- gnus-summary-mode-hook)) (setq gnus-article-mode-hook (cons ! '(lambda () (easy-menu-add gnus-article-article-menu) (easy-menu-add gnus-article-treatment-menu)) gnus-article-mode-hook))) *************** *** 133,140 **** ;; XEmacs definitions. (fset 'gnus-set-mouse-face (lambda (string) string)) ! (defun gnus-summary-make-display-table () ! ) (defun gnus-highlight-selected-summary () ;; Added by Per Abrahamsen . --- 133,142 ---- ;; XEmacs definitions. (fset 'gnus-set-mouse-face (lambda (string) string)) ! (fset 'gnus-summary-make-display-table (lambda () nil)) ! ! (provide 'gnus) ! (require 'gnus-vis) (defun gnus-highlight-selected-summary () ;; Added by Per Abrahamsen . *************** *** 152,164 **** (setq from beg) (setq to end))) (if gnus-newsgroup-selected-overlay ! (delete-extent gnus-newsgroup-selected-overlay)) ! (setq gnus-newsgroup-selected-overlay ! (make-extent from to)) ! (set-extent-face gnus-newsgroup-selected-overlay ! gnus-summary-selected-face))))) ) ((boundp 'MULE) ;; Mule definitions (if (not (fboundp 'truncate-string)) --- 154,295 ---- (setq from beg) (setq to end))) (if gnus-newsgroup-selected-overlay ! (delete-extent gnus-newsgroup-selected-overlay)) ! (setq gnus-newsgroup-selected-overlay ! (make-extent from to)) ! (set-extent-face gnus-newsgroup-selected-overlay ! gnus-summary-selected-face))))) ! ! ! (defun gnus-summary-recenter () ! (let* ((top (cond ((< (window-height) 4) 0) ! ((< (window-height) 7) 1) ! (t 2))) ! (height (- (window-height) 2)) ! (bottom (save-excursion (goto-char (point-max)) ! (forward-line (- height)) ! (point))) ! (window (get-buffer-window (current-buffer)))) ! (and ! ;; The user has to want it, ! gnus-auto-center-summary ! ;; the article buffer must be displayed, ! (get-buffer-window gnus-article-buffer) ! ;; Set the window start to either `bottom', which is the biggest ! ;; possible valid number, or the second line from the top, ! ;; whichever is the least. ! (set-window-start ! window (min bottom (save-excursion (forward-line (- top)) ! (point))))))) ! ! (defun gnus-group-insert-group-line-info (group) ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) ! (beg (point)) ! active info) ! (if entry ! (progn ! (setq info (nth 2 entry)) ! (gnus-group-insert-group-line ! nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) ! (setq active (gnus-gethash group gnus-active-hashtb)) ! ! (gnus-group-insert-group-line ! nil group (if (member group gnus-zombie-list) gnus-level-zombie ! gnus-level-killed) ! nil (if active (- (1+ (cdr active)) (car active)) 0) nil)) ! (save-excursion ! (goto-char beg) ! (remove-text-properties ! (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) ! '(gnus-group nil))))) ! ! (defun gnus-copy-article-buffer (&optional article-buffer) ! (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) ! (buffer-disable-undo gnus-article-copy) ! (or (memq gnus-article-copy gnus-buffer-list) ! (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) ! (let ((article-buffer (or article-buffer gnus-article-buffer)) ! buf) ! (if (and (get-buffer article-buffer) ! (buffer-name (get-buffer article-buffer))) ! (save-excursion ! (set-buffer article-buffer) ! (widen) ! (setq buf (buffer-substring (point-min) (point-max))) ! (set-buffer gnus-article-copy) ! (erase-buffer) ! (insert (format "%s" buf)))))) ! ! (defun gnus-summary-refer-article (message-id) ! "Refer article specified by MESSAGE-ID. ! NOTE: This command only works with newsgroups that use real or simulated NNTP." ! (interactive "sMessage-ID: ") ! (if (or (not (stringp message-id)) ! (zerop (length message-id))) ! () ! ;; Construct the correct Message-ID if necessary. ! ;; Suggested by tale@pawl.rpi.edu. ! (or (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (or (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) ! (let ((header (car (gnus-gethash (downcase message-id) ! gnus-newsgroup-dependencies)))) ! (if header ! (or (gnus-summary-goto-article (header-number header)) ! ;; The header has been read, but the article had been ! ;; expunged, so we insert it again. ! (let ((beg (point))) ! (gnus-summary-insert-line ! nil header 0 nil gnus-read-mark nil nil ! (header-subject header)) ! (save-excursion ! (goto-char beg) ! (remove-text-properties ! (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) ! '(gnus-number nil gnus-mark nil gnus-level nil))) ! (forward-line -1) ! (header-number header))) ! (let ((gnus-override-method gnus-refer-article-method) ! (gnus-ancient-mark gnus-read-mark) ! (tmp-buf (get-buffer-create " *gnus refer")) ! (tmp-point (window-start ! (get-buffer-window gnus-article-buffer))) ! number) ! (and gnus-refer-article-method ! (or (gnus-server-opened gnus-refer-article-method) ! (gnus-open-server gnus-refer-article-method))) ! ;; Save the old article buffer. ! (save-excursion ! (set-buffer tmp-buf) ! (buffer-disable-undo (current-buffer)) ! (insert-buffer-substring gnus-article-buffer)) ! (prog1 ! (if (gnus-article-prepare ! message-id nil (gnus-read-header message-id)) ! (progn ! (setq number (header-number gnus-current-headers)) ! (gnus-rebuild-thread message-id) ! (gnus-summary-goto-subject number) ! (gnus-summary-recenter) ! (gnus-article-set-window-start ! (cdr (assq number gnus-newsgroup-bookmarks))) ! message-id) ! ;; We restore the old article buffer. ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (insert-buffer-substring tmp-buf) ! (and tmp-point ! (set-window-start (get-buffer-window (current-buffer)) ! tmp-point)))) ! nil) ! (kill-buffer tmp-buf))))))) ! ! ) + ((boundp 'MULE) ;; Mule definitions (if (not (fboundp 'truncate-string)) *************** *** 180,193 **** ) (defalias 'gnus-truncate-string 'truncate-string) ! (defun gnus-format-max-width (form length) ! (let* ((val (eval form)) ! (valstr (if (numberp val) (int-to-string val) val))) ! (if (> (length valstr) length) ! (truncate-string valstr length) ! valstr))) ! (defun gnus-summary-make-display-table ()) ) )) --- 311,326 ---- ) (defalias 'gnus-truncate-string 'truncate-string) ! (fset ! 'gnus-format-max-width ! (lambda (form length) ! (let* ((val (eval form)) ! (valstr (if (numberp val) (int-to-string val) val))) ! (if (> (length valstr) length) ! (truncate-string valstr length) ! valstr)))) ! (fset 'gnus-summary-make-display-table (lambda () nil)) ) )) *** pub/dgnus/lisp/gnus-kill.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-kill.el Sun Jul 2 12:50:22 1995 *************** *** 328,336 **** (gnus-newsgroup-kill-file gnus-newsgroup-name))) (unreads (length gnus-newsgroup-unreads)) (gnus-summary-inhibit-highlight t) ! (mark-below (or gnus-summary-mark-below gnus-summary-default-score 0)) ! (expunge-below gnus-summary-expunge-below) ! form beg) (setq gnus-newsgroup-kill-headers nil) (or gnus-newsgroup-headers-hashtb-by-number (gnus-make-headers-hashtable-by-number)) --- 328,334 ---- (gnus-newsgroup-kill-file gnus-newsgroup-name))) (unreads (length gnus-newsgroup-unreads)) (gnus-summary-inhibit-highlight t) ! beg) (setq gnus-newsgroup-kill-headers nil) (or gnus-newsgroup-headers-hashtb-by-number (gnus-make-headers-hashtable-by-number)) *************** *** 586,592 **** marked as read or ticked are ignored." (save-excursion (let ((killed-no 0) ! function header article) (if (or (null field) (string-equal field "")) (setq function nil) ;; Get access function of header filed. --- 584,590 ---- marked as read or ticked are ignored." (save-excursion (let ((killed-no 0) ! function article) (if (or (null field) (string-equal field "")) (setq function nil) ;; Get access function of header filed. *** pub/dgnus/lisp/gnus-msg.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-msg.el Sun Jul 2 16:23:33 1995 *************** *** 419,425 **** (cons (current-buffer) gnus-current-article)))) (from (and header (header-from header))) (winconf (current-window-configuration)) ! follow-to real-group) (and gnus-interactive-post (not gnus-expert-user) post (not group) --- 419,425 ---- (cons (current-buffer) gnus-current-article)))) (from (and header (header-from header))) (winconf (current-window-configuration)) ! real-group) (and gnus-interactive-post (not gnus-expert-user) post (not group) *************** *** 443,452 **** (if (and (boundp 'gnus-followup-to-function) gnus-followup-to-function gnus-article-copy) ! (setq follow-to ! (save-excursion ! (set-buffer gnus-article-copy) ! (funcall gnus-followup-to-function group))))) gnus-use-followup-to)) (if post (gnus-configure-windows 'post) --- 443,451 ---- (if (and (boundp 'gnus-followup-to-function) gnus-followup-to-function gnus-article-copy) ! (save-excursion ! (set-buffer gnus-article-copy) ! (funcall gnus-followup-to-function group)))) gnus-use-followup-to)) (if post (gnus-configure-windows 'post) *************** *** 1077,1084 **** (let ((signature (or (and gnus-signature-function (funcall gnus-signature-function gnus-newsgroup-name)) ! gnus-signature-file)) ! b) (if (and signature (or (file-exists-p signature) (string-match " " signature) --- 1076,1082 ---- (let ((signature (or (and gnus-signature-function (funcall gnus-signature-function gnus-newsgroup-name)) ! gnus-signature-file))) (if (and signature (or (file-exists-p signature) (string-match " " signature) *************** *** 1382,1393 **** (defun gnus-mail-reply-using-mail (&optional yank to-address) (save-excursion (set-buffer gnus-summary-buffer) ! (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb))) ! (group (gnus-group-real-name gnus-newsgroup-name)) (cur (cons (current-buffer) (cdr gnus-article-current))) (winconf (current-window-configuration)) ! from subject date to reply-to message-of ! references message-id sender follow-to cc sendto elt) (set-buffer (get-buffer-create gnus-mail-buffer)) (mail-mode) (make-local-variable 'gnus-article-reply) --- 1380,1390 ---- (defun gnus-mail-reply-using-mail (&optional yank to-address) (save-excursion (set-buffer gnus-summary-buffer) ! (let ((group (gnus-group-real-name gnus-newsgroup-name)) (cur (cons (current-buffer) (cdr gnus-article-current))) (winconf (current-window-configuration)) ! from subject date reply-to message-of ! references message-id sender follow-to sendto elt) (set-buffer (get-buffer-create gnus-mail-buffer)) (mail-mode) (make-local-variable 'gnus-article-reply) *************** *** 1422,1428 **** "Re: none")) (or (string-match "^[Rr][Ee]:" subject) (setq subject (concat "Re: " subject))) - (setq cc (mail-fetch-field "cc")) (setq reply-to (mail-fetch-field "reply-to")) (setq references (mail-fetch-field "references")) (setq message-id (mail-fetch-field "message-id")) --- 1419,1424 ---- *** pub/dgnus/lisp/gnus-score.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-score.el Sun Jul 2 13:02:09 1995 *************** *** 552,558 **** (let ((mark (car (gnus-score-get 'mark alist))) (expunge (car (gnus-score-get 'expunge alist))) (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) - (read-only (gnus-score-get 'read-only alist)) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) (orphan (car (gnus-score-get 'orphan alist))) --- 552,557 ---- *************** *** 834,840 **** ;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). (defun gnus-score-orphans (score) (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) - (index (nth 1 (assoc "references" gnus-header-index))) alike articles art arts this last this-id) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) --- 833,838 ---- *************** *** 891,897 **** (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ! alike last this art entries alist articles) ;; Find matches. (while scores --- 889,895 ---- (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ! entries alist) ;; Find matches. (while scores *************** *** 910,917 **** (eq type '>=) (eq type '=)) type (error "Illegal match type: %s" type))) ! (articles gnus-scores-articles) ! arts art) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few --- 908,914 ---- (eq type '>=) (eq type '=)) type (error "Illegal match type: %s" type))) ! (articles gnus-scores-articles)) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few *************** *** 941,947 **** (defun gnus-score-date (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ! alike last this art entries alist articles) ;; Find matches. (while scores --- 938,944 ---- (defun gnus-score-date (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ! entries alist) ;; Find matches. (while scores *************** *** 962,968 **** ((eq type 'at) 'string=) (t (error "Illegal match type: %s" type)))) (articles gnus-scores-articles) ! arts art l) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few --- 959,965 ---- ((eq type 'at) 'string=) (t (error "Illegal match type: %s" type)))) (articles gnus-scores-articles) ! l) ;; Instead of doing all the clever stuff that ;; `gnus-score-string' does to minimize searches and stuff, ;; I will assume that people generally will put so few *************** *** 1003,1009 **** ((string= "body" (downcase header)) 'gnus-request-body) (t 'gnus-request-article))) ! alike this art entries alist ofunc article) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. (or (gnus-check-backend-function request-func gnus-newsgroup-name) --- 1000,1006 ---- ((string= "body" (downcase header)) 'gnus-request-body) (t 'gnus-request-article))) ! entries alist ofunc article) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. (or (gnus-check-backend-function request-func gnus-newsgroup-name) *************** *** 1054,1061 **** (eq type 'string) (eq type 'String)) 'search-forward) (t ! (error "Illegal match type: %s" type)))) ! arts art) (goto-char (point-min)) (if (funcall search-func match nil t) ;; Found a match, update scores. --- 1051,1057 ---- (eq type 'string) (eq type 'String)) 'search-forward) (t ! (error "Illegal match type: %s" type))))) (goto-char (point-min)) (if (funcall search-func match nil t) ;; Found a match, update scores. *** pub/dgnus/lisp/gnus-uu.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-uu.el Sun Jul 2 13:02:09 1995 *************** *** 429,435 **** (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (concat gnus-uu-tmp-dir "forward"))) - (winconf (current-window-configuration)) buf) (gnus-uu-decode-save n file) (gnus-uu-add-file file) --- 429,434 ---- *************** *** 841,847 **** ;; my experience, should get most postings of a series. (let ((count 2) (vernum "v[0-9]+[a-z][0-9]+:") ! reg beg) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) --- 840,846 ---- ;; my experience, should get most postings of a series. (let ((count 2) (vernum "v[0-9]+[a-z][0-9]+:") ! beg) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) *************** *** 887,893 **** ;; returned. ;; Failing that, articles that have subjects that are part of the ;; same "series" as the current will be returned. ! (let (articles process) (cond (n (let ((backward (< n 0)) --- 886,892 ---- ;; returned. ;; Failing that, articles that have subjects that are part of the ;; same "series" as the current will be returned. ! (let (articles) (cond (n (let ((backward (< n 0)) *************** *** 915,921 **** ;; non-nil, article names are not equalized before sorting. (let ((subject (or subject (gnus-uu-reginize-string (gnus-summary-subject-string)))) ! beg end list-of-subjects) (save-excursion (if (not subject) () --- 914,920 ---- ;; non-nil, article names are not equalized before sorting. (let ((subject (or subject (gnus-uu-reginize-string (gnus-summary-subject-string)))) ! list-of-subjects) (save-excursion (if (not subject) () *************** *** 951,957 **** ;; sorting to find out what sequence the articles are supposed to be ;; decoded in. Returns the list of expanded strings. (let ((out-list string-list) ! string pos num) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) --- 950,956 ---- ;; sorting to find out what sequence the articles are supposed to be ;; decoded in. Returns the list of expanded strings. (let ((out-list string-list) ! string) (save-excursion (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) *************** *** 1029,1038 **** (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) (let ((state 'first) ! (wrong-type t) ! has-been-begin has-been-end ! article result-file result-files process-state article-buffer ! begin-article) (if (not (gnus-server-opened gnus-current-select-method)) (progn --- 1028,1035 ---- (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) (let ((state 'first) ! has-been-begin article result-file result-files process-state ! article-buffer) (if (not (gnus-server-opened gnus-current-select-method)) (progn *************** *** 1089,1097 **** (delete-file result-file))) (if (memq 'begin process-state) (setq result-file (car process-state))) ! (setq begin-article article) ! (setq has-been-begin t) ! (setq has-been-end nil))) (if (memq 'end process-state) (progn --- 1086,1092 ---- (delete-file result-file))) (if (memq 'begin process-state) (setq result-file (car process-state))) ! (setq has-been-begin t))) (if (memq 'end process-state) (progn *************** *** 1099,1105 **** (setq result-files (cons (list (cons 'name result-file) (cons 'article article)) result-files)) - (setq has-been-end t) (setq has-been-begin nil) (and limit (= (length result-files) limit) (setq articles nil)))) --- 1094,1099 ---- *************** *** 1110,1121 **** (delete-file result-file))) (if (not (memq 'wrong-type process-state)) ! (setq wrong-type nil) (if gnus-uu-unmark-articles-not-decoded (gnus-summary-tick-article article t))) - (if sloppy (setq wrong-type nil)) - (if (and (not has-been-begin) (not sloppy) (or (memq 'end process-state) --- 1104,1113 ---- (delete-file result-file))) (if (not (memq 'wrong-type process-state)) ! () (if gnus-uu-unmark-articles-not-decoded (gnus-summary-tick-article article t))) (if (and (not has-been-begin) (not sloppy) (or (memq 'end process-state) *************** *** 1253,1259 **** nil t) (forward-line 1))) ! (condition-case err (process-send-region gnus-uu-uudecode-process start-char (point)) (error --- 1245,1251 ---- nil t) (forward-line 1))) ! (condition-case nil (process-send-region gnus-uu-uudecode-process start-char (point)) (error *************** *** 1328,1334 **** (defun gnus-uu-treat-archive (file-path) ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) ! action command files file file-name dir) (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules --- 1320,1326 ---- (defun gnus-uu-treat-archive (file-path) ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) ! action command dir) (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules *************** *** 1338,1344 **** (if (not action) (error "No unpackers for the file %s" file-path)) (string-match "/[^/]*$" file-path) - (setq file-name (substring file-path (1+ (match-beginning 0)))) (setq dir (substring file-path 0 (match-beginning 0))) (if (member action gnus-uu-destructive-archivers) --- 1330,1335 ---- *************** *** 1429,1435 **** out)) (defun gnus-uu-check-correct-stripped-uucode (start end) ! (let (found beg length short) (if (not gnus-uu-correct-stripped-uucode) () (goto-char start) --- 1420,1426 ---- out)) (defun gnus-uu-check-correct-stripped-uucode (start end) ! (let (found beg length) (if (not gnus-uu-correct-stripped-uucode) () (goto-char start) *************** *** 1686,1692 **** (if (memq 'Message-ID gnus-required-headers) gnus-required-headers (cons 'Message-ID gnus-required-headers))) ! gnus-inews-article-hook elem) (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) gnus-inews-article-hook --- 1677,1683 ---- (if (memq 'Message-ID gnus-required-headers) gnus-required-headers (cons 'Message-ID gnus-required-headers))) ! gnus-inews-article-hook) (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) gnus-inews-article-hook *************** *** 1712,1718 **** ;; the current buffer. Returns the file name the user gave. (defun gnus-uu-post-insert-binary () (let ((uuencode-buffer-name "*uuencode buffer*") ! file-path post-buf uubuf file-name) (setq file-path (read-file-name "What file do you want to encode? ")) --- 1703,1709 ---- ;; the current buffer. Returns the file name the user gave. (defun gnus-uu-post-insert-binary () (let ((uuencode-buffer-name "*uuencode buffer*") ! file-path uubuf file-name) (setq file-path (read-file-name "What file do you want to encode? ")) *************** *** 1745,1751 **** (encoded-buffer-name "*encoded buffer*") (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") (separator (concat mail-header-separator "\n\n")) ! file uubuf length parts header i end beg beg-line minlen buf post-buf whole-len beg-binary end-binary) (setq post-buf (current-buffer)) --- 1736,1742 ---- (encoded-buffer-name "*encoded buffer*") (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") (separator (concat mail-header-separator "\n\n")) ! uubuf length parts header i end beg beg-line minlen buf post-buf whole-len beg-binary end-binary) (setq post-buf (current-buffer)) *** pub/dgnus/lisp/gnus-vis.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus-vis.el Sun Jul 2 12:50:19 1995 *************** *** 879,886 **** (entry (gnus-button-entry)) (start (and entry (match-beginning (nth 1 entry)))) (end (and entry (match-end (nth 1 entry)))) ! (form (nth 2 entry)) ! marker) (if (not entry) () (goto-char (match-end 0)) --- 879,885 ---- (entry (gnus-button-entry)) (start (and entry (match-beginning (nth 1 entry)))) (end (and entry (match-end (nth 1 entry)))) ! (form (nth 2 entry))) (if (not entry) () (goto-char (match-end 0)) *** pub/dgnus/lisp/gnus.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/gnus.el Sun Jul 2 17:11:31 1995 *************** *** 1291,1297 **** (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "(ding) Gnus v0.90" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1291,1297 ---- (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "(ding) Gnus v0.91" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1845,1851 **** (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) - (thread nil) pos) (gnus-set-work-buffer) (gnus-summary-insert-line --- 1845,1850 ---- *************** *** 1902,1908 **** ;; specification string, and a list of forms depending on the ;; SPEC-ALIST. (let ((max-width 0) ! spec flist fstring b newspec max-width elem beg) (save-excursion (gnus-set-work-buffer) (insert format) --- 1901,1907 ---- ;; specification string, and a list of forms depending on the ;; SPEC-ALIST. (let ((max-width 0) ! spec flist fstring newspec elem beg) (save-excursion (gnus-set-work-buffer) (insert format) *************** *** 2036,2042 **** (defun gnus-subscribe-hierarchical-interactive (groups) (let ((groups (sort groups 'string<)) ! prefixes prefix start rest ans group starts) (while groups (setq prefixes (list "^")) (while (and groups prefixes) --- 2035,2041 ---- (defun gnus-subscribe-hierarchical-interactive (groups) (let ((groups (sort groups 'string<)) ! prefixes prefix start ans group starts) (while groups (setq prefixes (list "^")) (while (and groups prefixes) *************** *** 2372,2378 **** (cdr (assq setting gnus-buffer-configuration)) setting)) (in-buf (current-buffer)) ! rule val window w height hor ohor heights sub jump-buffer rel total to-buf) (or r (error "No such setting: %s" setting)) --- 2371,2377 ---- (cdr (assq setting gnus-buffer-configuration)) setting)) (in-buf (current-buffer)) ! rule val w height hor ohor heights sub jump-buffer rel total to-buf) (or r (error "No such setting: %s" setting)) *************** *** 3951,3957 **** (defun gnus-group-make-help-group () "Create the (ding) Gnus documentation group." (interactive) ! (let ((path load-path)) (and (gnus-gethash (setq name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) gnus-newsrc-hashtb) --- 3950,3957 ---- (defun gnus-group-make-help-group () "Create the (ding) Gnus documentation group." (interactive) ! (let ((path load-path) ! name) (and (gnus-gethash (setq name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) gnus-newsrc-hashtb) *************** *** 3979,3985 **** (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ((= char ?b) 'babyl) ((= char ?d) 'digest) ! (t (setq mess "%c unknown. " char) nil)))) found))) (let* ((file (expand-file-name file)) --- 3979,3985 ---- (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ((= char ?b) 'babyl) ((= char ?d) 'digest) ! (t (setq err "%c unknown. " char) nil)))) found))) (let* ((file (expand-file-name file)) *************** *** 4085,4092 **** (leaf (gnus-group-prefixed-name (file-name-nondirectory (directory-file-name dir)) method)) ! (name (gnus-generate-new-group-name leaf)) ! (num 0)) (let ((nneething-read-only t)) (or (gnus-group-read-ephemeral-group name method t --- 4085,4091 ---- (leaf (gnus-group-prefixed-name (file-name-nondirectory (directory-file-name dir)) method)) ! (name (gnus-generate-new-group-name leaf))) (let ((nneething-read-only t)) (or (gnus-group-read-ephemeral-group name method t *************** *** 4165,4172 **** or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (num (car entry)) ! (marked (nth 3 (nth 2 entry))) ! ticked) (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up; non-active group") ;; Do the updating only if the newsgroup isn't killed. --- 4164,4170 ---- or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (num (car entry)) ! (marked (nth 3 (nth 2 entry)))) (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up; non-active group") ;; Do the updating only if the newsgroup isn't killed. *************** *** 4430,4436 **** (interactive "P") (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) - (w-p (window-start)) group) (while groups (setq group (car groups) --- 4428,4433 ---- *************** *** 4517,4523 **** (interactive "sGnus apropos (regexp): ") (let ((prev "") (obuf (current-buffer)) ! groups des prev) ;; Go through all newsgroups that are known to Gnus. (mapatoms (lambda (group) --- 4514,4520 ---- (interactive "sGnus apropos (regexp): ") (let ((prev "") (obuf (current-buffer)) ! groups des) ;; Go through all newsgroups that are known to Gnus. (mapatoms (lambda (group) *************** *** 5506,5513 **** If NO-ARTICLE is non-nil, no article is selected initially." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) ! (did-select (and new-group (gnus-select-newsgroup group show-all))) ! (method (car (gnus-find-method-for-group group)))) (cond ((not new-group) (gnus-set-global-variables) --- 5503,5509 ---- If NO-ARTICLE is non-nil, no article is selected initially." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) ! (did-select (and new-group (gnus-select-newsgroup group show-all)))) (cond ((not new-group) (gnus-set-global-variables) *************** *** 5650,5656 **** (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) (result threads) ! thread subject hthread whole-subject) (while threads (setq whole-subject (setq subject (header-subject (car (car threads))))) --- 5646,5652 ---- (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) (result threads) ! subject hthread whole-subject) (while threads (setq whole-subject (setq subject (header-subject (car (car threads))))) *************** *** 5788,5794 **** ;; It was not expunged, but we look at expunged children. (let* ((prev (symbol-value refs)) (headers (cdr prev)) ! article id) (while headers (setq article (header-number (car headers))) (if (not (< (or (cdr (assq article gnus-newsgroup-scored)) --- 5784,5790 ---- ;; It was not expunged, but we look at expunged children. (let* ((prev (symbol-value refs)) (headers (cdr prev)) ! article) (while headers (setq article (header-number (car headers))) (if (not (< (or (cdr (assq article gnus-newsgroup-scored)) *************** *** 6105,6111 **** If READ-ALL is non-nil, all articles in the group are selected." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! articles header-marks) (gnus-check-news-server (setq gnus-current-select-method (gnus-find-method-for-group group))) --- 6101,6107 ---- If READ-ALL is non-nil, all articles in the group are selected." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! articles) (gnus-check-news-server (setq gnus-current-select-method (gnus-find-method-for-group group))) *************** *** 6244,6251 **** (if (string-match "^[ \t]*$" input) number input))) (t number)) ! (quit nil))))) ! total-articles) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select --- 6240,6246 ---- (if (string-match "^[ \t]*$" input) number input))) (t number)) ! (quit nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select *************** *** 6255,6262 **** (setq number (length articles))) (setq articles (copy-sequence articles))) - (setq total-articles articles) - (if (< (abs select) number) (if (< select 0) ;; Select the N oldest articles. --- 6250,6255 ---- *************** *** 6281,6287 **** "Remove all marked articles that are no longer legal." (let ((marked-lists (nth 3 info)) (active (or active (gnus-gethash (car info) gnus-active-hashtb))) ! marked m prev) ;; There are many types of marked articles. (while marked-lists (setq m (cdr (setq prev (car marked-lists)))) --- 6274,6280 ---- "Remove all marked articles that are no longer legal." (let ((marked-lists (nth 3 info)) (active (or active (gnus-gethash (car info) gnus-active-hashtb))) ! m prev) ;; There are many types of marked articles. (while marked-lists (setq m (cdr (setq prev (car marked-lists)))) *************** *** 6472,6478 **** (assoc (symbol-name (car (gnus-find-method-for-group from-newsgroup))) gnus-valid-select-methods))) ! name entry read info xref-hashtb idlist active num range exps method nth4) (save-excursion (set-buffer gnus-group-buffer) --- 6465,6471 ---- (assoc (symbol-name (car (gnus-find-method-for-group from-newsgroup))) gnus-valid-select-methods))) ! name entry info xref-hashtb idlist method nth4) (save-excursion (set-buffer gnus-group-buffer) *************** *** 6512,6518 **** (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! (active (gnus-gethash name gnus-active-hashtb)) exps expirable range) ;; First peel off all illegal article numbers. (if active --- 6505,6511 ---- (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! (active (gnus-gethash group gnus-active-hashtb)) exps expirable range) ;; First peel off all illegal article numbers. (if active *************** *** 6568,6574 **** (length (cdr (assq 'dormant (nth 3 info))))))) ;; Update the group buffer. ! (gnus-group-update-group name t))))) (defun gnus-methods-equal-p (m1 m2) (let ((m1 (or m1 gnus-select-method)) --- 6561,6567 ---- (length (cdr (assq 'dormant (nth 3 info))))))) ;; Update the group buffer. ! (gnus-group-update-group group t))))) (defun gnus-methods-equal-p (m1 m2) (let ((m1 (or m1 gnus-select-method)) *************** *** 6588,6594 **** (setq gnus-article-internal-prepare-hook nil) (let ((cur nntp-server-buffer) (dependencies gnus-newsgroup-dependencies) ! headers char article id dep end) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) --- 6581,6587 ---- (setq gnus-article-internal-prepare-hook nil) (let ((cur nntp-server-buffer) (dependencies gnus-newsgroup-dependencies) ! headers id dep end ref) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) *************** *** 6596,6611 **** ;; do not begin with 2 or 3. (while (re-search-forward "^[23][0-9]+ " nil t) (let ((header (make-vector 9 nil)) - (c (following-char)) (case-fold-search t) (p (point)) ! from subject in-reply-to references ref) (setq id nil ! ref nil ! references nil ! subject nil ! from nil) ! (header-set-number header (setq article (read cur))) ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually --- 6589,6600 ---- ;; do not begin with 2 or 3. (while (re-search-forward "^[23][0-9]+ " nil t) (let ((header (make-vector 9 nil)) (case-fold-search t) (p (point)) ! in-reply-to) (setq id nil ! ref nil) ! (header-set-number header (read cur)) ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually *************** *** 6728,6734 **** (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) (let ((cur nntp-server-buffer) (dependencies gnus-newsgroup-dependencies) - (none 0) number headers header) (save-excursion (set-buffer nntp-server-buffer) --- 6717,6722 ---- *************** *** 7121,7127 **** (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) (active (gnus-gethash group gnus-active-hashtb)) (last (cdr active)) ! unread first nlast unread) ;; If none are read, then all are unread. (if (not read) (setq first (car active)) --- 7109,7115 ---- (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) (active (gnus-gethash group gnus-active-hashtb)) (last (cdr active)) ! first nlast unread) ;; If none are read, then all are unread. (if (not read) (setq first (car active)) *************** *** 7166,7172 **** (interactive) (gnus-set-global-variables) (let ((articles (reverse gnus-newsgroup-processable)) ! key func) (or articles (error "No articles marked")) (or (setq func (key-binding (read-key-sequence "C-c C-u"))) (error "Undefined key")) --- 7154,7160 ---- (interactive) (gnus-set-global-variables) (let ((articles (reverse gnus-newsgroup-processable)) ! func) (or articles (error "No articles marked")) (or (setq func (key-binding (read-key-sequence "C-c C-u"))) (error "Undefined key")) *************** *** 7216,7223 **** (gnus-group-read-group all))) (defun gnus-summary-update-info () ! (let* ((group gnus-newsgroup-name) ! (method (car (gnus-find-method-for-group group)))) (if gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence --- 7204,7210 ---- (gnus-group-read-group all))) (defun gnus-summary-update-info () ! (let* ((group gnus-newsgroup-name)) (if gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence *************** *** 7230,7237 **** (sort gnus-newsgroup-unreads '<))) t))) (or (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) ! (let ((updated nil) ! (headers gnus-newsgroup-headers)) (gnus-close-group group) (run-hooks 'gnus-exit-group-hook) (gnus-update-read-articles --- 7217,7223 ---- (sort gnus-newsgroup-unreads '<))) t))) (or (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) ! (let ((headers gnus-newsgroup-headers)) (gnus-close-group group) (run-hooks 'gnus-exit-group-hook) (gnus-update-read-articles *************** *** 7265,7271 **** (quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group gnus-newsgroup-name)))) (mode major-mode) - (method (car (gnus-find-method-for-group group))) (buf (current-buffer))) (gnus-summary-update-info) ; Make all changes in this group permanent. ;; Make sure where I was, and go to next newsgroup. --- 7251,7256 ---- *************** *** 7578,7586 **** If BACKWARD, the previous article is selected instead of the next." (interactive "P") (gnus-set-global-variables) ! (let ((opoint (point)) ! (method (car (gnus-find-method-for-group gnus-newsgroup-name))) ! header) (cond ;; Is there such an article? ((gnus-summary-display-article --- 7563,7569 ---- If BACKWARD, the previous article is selected instead of the next." (interactive "P") (gnus-set-global-variables) ! (let (header) (cond ;; Is there such an article? ((gnus-summary-display-article *************** *** 8234,8241 **** (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) ! (article (car articles)) ! (marked (nth 3 info))) (gnus-summary-goto-subject article) (beginning-of-line) (delete-region (point) --- 8217,8223 ---- (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) ! (article (car articles))) (gnus-summary-goto-subject article) (beginning-of-line) (delete-region (point) *************** *** 8359,8366 **** (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) ! (article (car articles)) ! (marked (nth 3 info))) (if (not (memq article gnus-newsgroup-unreads)) (setcar (cdr (cdr info)) (gnus-add-to-range (nth 2 info) --- 8341,8347 ---- (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) ! (article (car articles))) (if (not (memq article gnus-newsgroup-unreads)) (setcar (cdr (cdr info)) (gnus-add-to-range (nth 2 info) *************** *** 9968,9974 **** (if (get-buffer gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) ! (buffer-disable-undo) (setq buffer-read-only t) (gnus-add-current-to-buffer-list) (or (eq major-mode 'gnus-article-mode) --- 9949,9955 ---- (if (get-buffer gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) ! (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) (gnus-add-current-to-buffer-list) (or (eq major-mode 'gnus-article-mode) *************** *** 10207,10213 **** (save-restriction (let ((sorted gnus-sorted-header-list) (buffer-read-only nil) ! want want-list beg want-l) ;; First we narrow to just the headers. (widen) (goto-char (point-min)) --- 10188,10194 ---- (save-restriction (let ((sorted gnus-sorted-header-list) (buffer-read-only nil) ! want-list beg want-l) ;; First we narrow to just the headers. (widen) (goto-char (point-min)) *************** *** 10687,10702 **** (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func) (set-buffer obuf) ! (let ((npoint (point))) ! (set-window-configuration owin) ! (set-window-start (get-buffer-window (current-buffer)) (point))))) (defun gnus-article-summary-command-nosave () "Execute the last keystroke in the summary buffer." (interactive) ! (let ((obuf (current-buffer)) ! (owin (current-window-configuration)) ! func) (switch-to-buffer gnus-summary-buffer 'norecord) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) --- 10668,10680 ---- (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func) (set-buffer obuf) ! (set-window-configuration owin) ! (set-window-start (get-buffer-window (current-buffer)) (point)))) (defun gnus-article-summary-command-nosave () "Execute the last keystroke in the summary buffer." (interactive) ! (let (func) (switch-to-buffer gnus-summary-buffer 'norecord) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) *************** *** 10781,10787 **** (gnus-use-dribble-file nil) (yes (car yes-and-no)) (no (cdr yes-and-no)) ! group subscribed newsrc entry ;; Disable verbose message. gnus-novice-user gnus-large-newsgroup) ;; Eat all arguments. --- 10759,10765 ---- (gnus-use-dribble-file nil) (yes (car yes-and-no)) (no (cdr yes-and-no)) ! group newsrc entry ;; Disable verbose message. gnus-novice-user gnus-large-newsgroup) ;; Eat all arguments. *************** *** 10900,10906 **** "Auto-save file exists. Do you want to read it? ") (progn (gnus-message 5 "Reading %s..." dribble-file) ! (eval-current-buffer) (gnus-message 5 "Reading %s...done" dribble-file))))))))) (defun gnus-dribble-delete-file () --- 10878,10884 ---- "Auto-save file exists. Do you want to read it? ") (progn (gnus-message 5 "Reading %s..." dribble-file) ! (eval-buffer (current-buffer)) (gnus-message 5 "Reading %s...done" dribble-file))))))))) (defun gnus-dribble-delete-file () *************** *** 11063,11069 **** (defun gnus-start-news-server (&optional confirm) "Open a method for getting news. If CONFIRM is non-nil, the user will be asked for an NNTP server." ! (let (how where) (if gnus-current-select-method ;; Stream is already opened. nil --- 11041,11047 ---- (defun gnus-start-news-server (&optional confirm) "Open a method for getting news. If CONFIRM is non-nil, the user will be asked for an NNTP server." ! (let (how) (if gnus-current-select-method ;; Stream is already opened. nil *************** *** 11098,11104 **** (list 'nntp gnus-nntp-server))))) (setq how (car gnus-select-method)) - (setq where (car (cdr gnus-select-method))) (cond ((eq how 'nnspool) (require 'nnspool) (gnus-message 5 "Looking up local news spool...")) --- 11076,11081 ---- *************** *** 11595,11602 **** ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) ! (let ((pinfo entry) ! group info active num) ;; Glean what info we can from the arguments (if (consp entry) (if fromkilled (setq group (nth 1 entry)) --- 11572,11578 ---- ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) ! (let (group info active num) ;; Glean what info we can from the arguments (if (consp entry) (if fromkilled (setq group (nth 1 entry)) *************** *** 11753,11759 **** ;; and compute how many unread articles there are in each group. (defun gnus-get-unread-articles (&optional level) (let* ((newsrc (cdr gnus-newsrc-alist)) - (conditional level) (level (or level (1+ gnus-level-subscribed))) (foreign-level (min --- 11729,11734 ---- *************** *** 11857,11864 **** (defun gnus-get-unread-articles-in-group (info active) (let* ((range (nth 2 info)) (num 0) ! (marked (nth 3 info)) ! srange lowest group highest) ;; If a cache is present, we may have to alter the active info. (and gnus-use-cache (gnus-cache-possibly-alter-active (car info) active)) --- 11832,11838 ---- (defun gnus-get-unread-articles-in-group (info active) (let* ((range (nth 2 info)) (num 0) ! (marked (nth 3 info))) ;; If a cache is present, we may have to alter the active info. (and gnus-use-cache (gnus-cache-possibly-alter-active (car info) active)) *************** *** 11977,11988 **** (let* ((active (or gnus-newsgroup-active (gnus-gethash group gnus-active-hashtb))) (entry (gnus-gethash group gnus-newsrc-hashtb)) - (number (car entry)) (info (nth 2 entry)) (marked (nth 3 info)) (prev 1) (unread (sort (copy-sequence unread) (function <))) ! last 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 --- 11951,11961 ---- (let* ((active (or gnus-newsgroup-active (gnus-gethash group gnus-active-hashtb))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (marked (nth 3 info)) (prev 1) (unread (sort (copy-sequence unread) (function <))) ! 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 *************** *** 12048,12054 **** ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (if (gnus-server-opened gnus-select-method) ;; The native server is available. (cons gnus-select-method gnus-secondary-select-methods) ;; The native server is down, so we just do the --- 12021,12028 ---- ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (if (or (gnus-server-opened gnus-select-method) ! (gnus-open-server gnus-select-method)) ;; The native server is available. (cons gnus-select-method gnus-secondary-select-methods) ;; The native server is down, so we just do the *************** *** 12139,12145 **** ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) ! group max mod min) (while (not (eobp)) (condition-case nil (progn --- 12113,12119 ---- ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) ! group max min) (while (not (eobp)) (condition-case nil (progn *************** *** 12211,12217 **** (set (let ((obarray hashtb)) (read cur)) (cons min max)) (forward-line 1))) ! (let (min max opoint) (while (not (eobp)) (if (= (following-char) ?2) (progn --- 12185,12191 ---- (set (let ((obarray hashtb)) (read cur)) (cons min max)) (forward-line 1))) ! (let (min max) (while (not (eobp)) (if (= (following-char) ?2) (progn *************** *** 12283,12289 **** ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) ! (let (newsrc killed marked group g m len info) (prog1 (let ((gnus-killed-assoc nil) gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) --- 12257,12263 ---- ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) ! (let (newsrc killed marked group m) (prog1 (let ((gnus-killed-assoc nil) gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) *************** *** 12373,12379 **** (setq gnus-active-hashtb (make-vector 4095 0))) (let ((buf (current-buffer)) (already-read (> (length gnus-newsrc-alist) 1)) ! group level subscribed info options-symbol newsrc symbol reads num1) (goto-char (point-min)) ;; We intern the symbol `options' in the active hashtb so that we --- 12347,12353 ---- (setq gnus-active-hashtb (make-vector 4095 0))) (let ((buf (current-buffer)) (already-read (> (length gnus-newsrc-alist) 1)) ! group subscribed options-symbol newsrc symbol reads num1) (goto-char (point-min)) ;; We intern the symbol `options' in the active hashtb so that we *************** *** 12862,12869 **** (setq b (point)) ;; Insert the text. (insert (eval sformat)) ! (add-text-properties ! b (1+ b) (list 'gnus-server (intern name))))) (defun gnus-server-setup-buffer () (if (get-buffer gnus-server-buffer) --- 12836,12842 ---- (setq b (point)) ;; Insert the text. (insert (eval sformat)) ! (add-text-properties b (1+ b) (list 'gnus-server (intern name))))) (defun gnus-server-setup-buffer () (if (get-buffer gnus-server-buffer) *************** *** 13307,13313 **** (defun gnus-possibly-score-headers (&optional trace) (let ((func gnus-score-find-score-files-function) ! score-files scores) (and func (not (listp func)) (setq func (list func))) ;; Go through all the functions for finding score files (or actual --- 13280,13286 ---- (defun gnus-possibly-score-headers (&optional trace) (let ((func gnus-score-find-score-files-function) ! score-files) (and func (not (listp func)) (setq func (list func))) ;; Go through all the functions for finding score files (or actual *** pub/dgnus/lisp/nnbabyl.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnbabyl.el Sun Jul 2 12:50:15 1995 *************** *** 77,84 **** (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((file nil) ! (number (length sequence)) (count 0) article art-string start stop) (nnbabyl-possibly-change-newsgroup newsgroup) --- 77,83 ---- (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((number (length sequence)) (count 0) article art-string start stop) (nnbabyl-possibly-change-newsgroup newsgroup) *************** *** 229,235 **** (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) ! article rest) (save-excursion (set-buffer nnbabyl-mbox-buffer) (while articles --- 228,234 ---- (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) ! rest) (save-excursion (set-buffer nnbabyl-mbox-buffer) (while articles *************** *** 497,503 **** (defun nnbabyl-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) - (all-spools spools) (group-in group) incoming incomings) (nnbabyl-read-mbox) --- 496,501 ---- *** pub/dgnus/lisp/nndoc.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nndoc.el Sun Jul 2 13:02:04 1995 *************** *** 91,97 **** (set-buffer nntp-server-buffer) (erase-buffer) (let ((prev 2) ! article p beg end lines) (nndoc-possibly-change-buffer newsgroup server) (if (stringp (car sequence)) 'headers --- 91,97 ---- (set-buffer nntp-server-buffer) (erase-buffer) (let ((prev 2) ! article p beg lines) (nndoc-possibly-change-buffer newsgroup server) (if (stringp (car sequence)) 'headers *************** *** 119,125 **** (and (re-search-forward nndoc-article-end nil t) (goto-char (match-beginning 0))) (goto-char (point-max))))) - (setq end (point)) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) --- 119,124 ---- *** pub/dgnus/lisp/nneething.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nneething.el Sun Jul 2 12:50:14 1995 *************** *** 80,86 **** (count 0) (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) ! beg article file) (if (stringp (car sequence)) 'headers --- 80,86 ---- (count 0) (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) ! article file) (if (stringp (car sequence)) 'headers *************** *** 209,215 **** ;; Read nneething-active and nneething-map (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) - (dir (file-name-as-directory nneething-directory)) touched) (if (file-exists-p map-file) (condition-case nil --- 209,214 ---- *** pub/dgnus/lisp/nnfolder.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnfolder.el Sun Jul 2 13:02:04 1995 *************** *** 112,121 **** (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((file nil) ! (number (length sequence)) ! (delim-string (concat "^" rmail-unix-mail-delimiter)) ! beg article art-string start stop) (nnfolder-possibly-change-group newsgroup) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) --- 112,119 ---- (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) ! article art-string start stop) (nnfolder-possibly-change-group newsgroup) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) *************** *** 138,144 **** (setq stop (1- (point))) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) (insert-buffer-substring nnfolder-current-buffer start stop) (goto-char (point-max)) (insert ".\n"))) --- 136,141 ---- *************** *** 270,279 **** (nnfolder-request-list) (setq nnfolder-group-alist (nnmail-get-active)) (or (assoc group nnfolder-group-alist) ! (let (active) (setq nnfolder-group-alist ! (cons (list group (setq active (cons 0 0))) ! nnfolder-group-alist)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) t) --- 267,275 ---- (nnfolder-request-list) (setq nnfolder-group-alist (nnmail-get-active)) (or (assoc group nnfolder-group-alist) ! (progn (setq nnfolder-group-alist ! (cons (list group (cons 0 0)) nnfolder-group-alist)) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) t) *************** *** 304,310 **** (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) ! article rest) (save-excursion (set-buffer nnfolder-current-buffer) (while articles --- 300,306 ---- (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) ! rest) (save-excursion (set-buffer nnfolder-current-buffer) (while articles *************** *** 374,380 **** (defun nnfolder-request-accept-article (group &optional last) (nnfolder-possibly-change-group group) (let ((buf (current-buffer)) ! result beg) (goto-char (point-min)) (if (looking-at "X-From-Line: ") (replace-match "From ") --- 370,376 ---- (defun nnfolder-request-accept-article (group &optional last) (nnfolder-possibly-change-group group) (let ((buf (current-buffer)) ! result) (goto-char (point-min)) (if (looking-at "X-From-Line: ") (replace-match "From ") *************** *** 634,640 **** (defun nnfolder-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) - (all-spools spools) (group-in group) incomings incoming) (if (or (not nnfolder-get-new-mail) (not nnmail-spool-file)) --- 630,635 ---- *** pub/dgnus/lisp/nnheader.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnheader.el Sun Jul 2 12:50:13 1995 *************** *** 188,195 **** ;; Read the head of an article. (defun nnheader-insert-head (file) (let ((beg 0) ! (chop 1024) ! found) (while (and (eq chop (nth 1 (insert-file-contents file nil beg (setq beg (+ chop beg))))) (prog1 (not (search-backward "\n\n" nil t)) --- 188,194 ---- ;; Read the head of an article. (defun nnheader-insert-head (file) (let ((beg 0) ! (chop 1024)) (while (and (eq chop (nth 1 (insert-file-contents file nil beg (setq beg (+ chop beg))))) (prog1 (not (search-backward "\n\n" nil t)) *** pub/dgnus/lisp/nnkiboze.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnkiboze.el Sun Jul 2 12:05:26 1995 *************** *** 225,230 **** --- 225,231 ---- (gnus-score-find-score-files-function 'nnkiboze-score-file) gnus-select-group-hook gnus-summary-prepare-hook gnus-thread-sort-functions gnus-show-threads + gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active ginfo lowest) (setq nnkiboze-current-score-group group) *** pub/dgnus/lisp/nnmail.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnmail.el Sun Jul 2 12:50:12 1995 *************** *** 538,544 **** (let ((methods nnmail-split-methods) (obuf (current-buffer)) (beg (point-min)) ! end found group-art) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. --- 538,544 ---- (let ((methods nnmail-split-methods) (obuf (current-buffer)) (beg (point-min)) ! end group-art) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. *** pub/dgnus/lisp/nnmbox.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnmbox.el Sun Jul 2 14:45:51 1995 *************** *** 79,88 **** (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((file nil) ! (number (length sequence)) (count 0) ! beg article art-string start stop) (nnmbox-possibly-change-newsgroup newsgroup) (if (stringp (car sequence)) 'headers --- 79,87 ---- (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((number (length sequence)) (count 0) ! article art-string start stop) (nnmbox-possibly-change-newsgroup newsgroup) (if (stringp (car sequence)) 'headers *************** *** 103,109 **** (setq stop (1- (point))) (set-buffer nntp-server-buffer) (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) (insert-buffer-substring nnmbox-mbox-buffer start stop) (goto-char (point-max)) (insert ".\n"))) --- 102,107 ---- *************** *** 233,239 **** (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) ! article rest) (save-excursion (set-buffer nnmbox-mbox-buffer) (while articles --- 231,237 ---- (let* ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function newsgroup)) nnmail-expiry-wait)) ! rest) (save-excursion (set-buffer nnmbox-mbox-buffer) (while articles *************** *** 294,300 **** (defun nnmbox-request-accept-article (group &optional last) (let ((buf (current-buffer)) ! result beg) (goto-char (point-min)) (if (looking-at "X-From-Line: ") (replace-match "From ") --- 292,298 ---- (defun nnmbox-request-accept-article (group &optional last) (let ((buf (current-buffer)) ! result) (goto-char (point-min)) (if (looking-at "X-From-Line: ") (replace-match "From ") *************** *** 450,456 **** (defun nnmbox-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) - (all-spools spools) (group-in group) incoming incomings) (nnmbox-read-mbox) --- 448,453 ---- *** pub/dgnus/lisp/nnmh.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnmh.el Sun Jul 2 15:17:09 1995 *************** *** 260,265 **** --- 260,266 ---- (if (and (or (not nnmail-keep-last-article) (not max-article) (not (= (car articles) max-article))) + (not (equal mod-time '(0 0))) (or force (> (nnmail-days-between (current-time-string) *************** *** 349,357 **** (defun nnmh-save-mail () "Called narrowed to an article." ! (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number))) ! chars nov-line lines hbeg hend) ! (setq chars (nnmail-insert-lines)) (nnmail-insert-xref group-art) (run-hooks 'nnmh-prepare-save-mail-hook) (goto-char (point-min)) --- 350,357 ---- (defun nnmh-save-mail () "Called narrowed to an article." ! (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))) ! (nnmail-insert-lines) (nnmail-insert-xref group-art) (run-hooks 'nnmh-prepare-save-mail-hook) (goto-char (point-min)) *************** *** 379,390 **** "Compute the next article number in GROUP." (let ((active (car (cdr (assoc group nnmh-group-alist))))) (setcdr active (1+ (cdr active))) ! (let (file) ! (while (file-exists-p ! (setq file (concat (nnmh-article-pathname ! group nnmh-directory) ! (int-to-string (cdr active))))) ! (setcdr active (1+ (cdr active))))) (cdr active))) (defun nnmh-article-pathname (group mail-dir) --- 379,388 ---- "Compute the next article number in GROUP." (let ((active (car (cdr (assoc group nnmh-group-alist))))) (setcdr active (1+ (cdr active))) ! (while (file-exists-p ! (concat (nnmh-article-pathname group nnmh-directory) ! (int-to-string (cdr active)))) ! (setcdr active (1+ (cdr active)))) (cdr active))) (defun nnmh-article-pathname (group mail-dir) *************** *** 397,403 **** (defun nnmh-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) - (all-spools spools) (group-in group) incoming incomings) (if (or (not nnmh-get-new-mail) (not nnmail-spool-file)) --- 395,400 ---- *** pub/dgnus/lisp/nnml.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnml.el Sun Jul 2 15:17:08 1995 *************** *** 277,282 **** --- 277,283 ---- (if (and (or (not nnmail-keep-last-article) (not max-article) (not (= (car articles) max-article))) + (not (equal mod-time '(0 0))) (or force (> (nnmail-days-between (current-time-string) *************** *** 469,486 **** (setq active (cons 1 0)) (setq nnml-group-alist (cons (list group active) nnml-group-alist)))) (setcdr active (1+ (cdr active))) ! (let (file) ! (while (file-exists-p ! (setq file (concat (nnmail-article-pathname ! group nnml-directory) ! (int-to-string (cdr active))))) ! (setcdr active (1+ (cdr active))))) (cdr active))) (defun nnml-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) - (all-spools spools) (group-in group) incoming incomings) (if (or (not nnml-get-new-mail) (not nnmail-spool-file)) --- 470,484 ---- (setq active (cons 1 0)) (setq nnml-group-alist (cons (list group active) nnml-group-alist)))) (setcdr active (1+ (cdr active))) ! (while (file-exists-p ! (concat (nnmail-article-pathname group nnml-directory) ! (int-to-string (cdr active)))) ! (setcdr active (1+ (cdr active)))) (cdr active))) (defun nnml-get-new-mail (&optional group) "Read new incoming mail." (let* ((spools (nnmail-get-spool-files group)) (group-in group) incoming incomings) (if (or (not nnml-get-new-mail) (not nnmail-spool-file)) *** pub/dgnus/lisp/nnsoup.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnsoup.el Sun Jul 2 12:52:56 1995 *************** *** 94,104 **** (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((count 0) ! (areas (cdr (assoc nnsoup-current-group nnsoup-group-alist))) (articles sequence) (use-nov t) ! beg article useful-areas this-area-seq) (if (stringp (car sequence)) 'headers ;; We go through all the areas and find which files the --- 94,103 ---- (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((areas (cdr (assoc nnsoup-current-group nnsoup-group-alist))) (articles sequence) (use-nov t) ! useful-areas this-area-seq) (if (stringp (car sequence)) 'headers ;; We go through all the areas and find which files the *************** *** 489,496 **** (let ((tembuf (generate-new-buffer " sendmail temp")) (case-fold-search nil) (mailbuf (current-buffer)) ! delimline ! prefix) (save-excursion (set-buffer tembuf) (erase-buffer) --- 488,494 ---- (let ((tembuf (generate-new-buffer " sendmail temp")) (case-fold-search nil) (mailbuf (current-buffer)) ! delimline) (save-excursion (set-buffer tembuf) (erase-buffer) *************** *** 506,513 **** (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) ! (if mail-aliases ! (expand-mail-aliases (point-min) delimline)) (goto-char (point-min)) ;; ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) --- 504,510 ---- (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) ! (if mail-aliases (expand-mail-aliases (point-min) delimline)) (goto-char (point-min)) ;; ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) *** pub/dgnus/lisp/nnvirtual.el Sat Jul 1 21:28:26 1995 --- dgnus/lisp/nnvirtual.el Sun Jul 2 17:11:26 1995 *************** *** 301,310 **** (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual ""))) (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (groups nnvirtual-current-groups) - (i 1) - (total 0) (offset 0) ! reads unread igroup itotal itreads ireads) ;; The virtual group doesn't exist. (?) (or info (error "No such group: %s" group)) (setq nnvirtual-current-mapping nil) --- 301,308 ---- (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual ""))) (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (groups nnvirtual-current-groups) (offset 0) ! reads unread igroup itotal ireads) ;; The virtual group doesn't exist. (?) (or info (error "No such group: %s" group)) (setq nnvirtual-current-mapping nil) *************** *** 452,459 **** (nnvirtual-possibly-change-newsgroups group server) (let ((gnus-group-marked nnvirtual-current-groups) (gnus-expert-user t)) ! (set-buffer gnus-group-buffer) ! (gnus-group-catchup-current nil all))) (provide 'nnvirtual) --- 450,458 ---- (nnvirtual-possibly-change-newsgroups group server) (let ((gnus-group-marked nnvirtual-current-groups) (gnus-expert-user t)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-catchup-current nil all)))) (provide 'nnvirtual) *** pub/dgnus/lisp/ChangeLog Sat Jul 1 21:28:27 1995 --- dgnus/lisp/ChangeLog Sun Jul 2 17:11:27 1995 *************** *** 1,4 **** --- 1,36 ---- + Sun Jul 2 14:11:14 1995 Lars Magne Ingebrigtsen + + * nnvirtual.el (nnvirtual-catchup-group): Would kill the group + buffer. + + * gnus-ems.el (gnus-ems-redefine): Redefine insertion of group + lines to avoid that awfol front-stickyness of extents. + (gnus-ems-redefine): Redefine gnus-copy-article-buffer. + (gnus-ems-redefine): Redefine gnus-summary-refer-article. + + * nnml.el (nnml-request-expire-articles): Would delete everything + over ange-ftp. + + * gnus-ems.el (gnus-ems-redefine): Really redefine + gnus-highlight-selected-summary. + + * gnus-ems.el (gnus-ems-redefine): Redefine gnus-summary-recenter. + + Sun Jul 2 13:02:19 1995 Lars Magne Ingebrigtsen + + * gnus.el: Removed tons of unreferenced local variables from all + files. + (gnus-read-active-file): When using several nntp servers, the + native nntp server often would not be consulted for an active + file. + + Sun Jul 2 12:03:18 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-make-articles-read): name instead of group. + Sat Jul 1 16:04:13 1995 Lars Magne Ingebrigtsen + + * gnus.el: 0.90 is released. * gnus.el (gnus-summary-edit-article-done): No arguments to buffer-disable-undo.