*** pub/sgnus/lisp/gnus-gl.el Wed Apr 3 22:50:14 1996 --- sgnus/lisp/gnus-gl.el Thu Apr 4 15:36:25 1996 *************** *** 1,3 **** --- 1,28 ---- + ;;; gnus-gl.el --- an interface to GroupLens for Gnus + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Brad Miller + ;; Keywords: news, score + + ;; 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: + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GroupLens software and documentation is copyright (c) 1995 by Paul ;; Resnick (Massachusetts Institute of Technology); Brad Miller, John *************** *** 116,121 **** --- 141,148 ---- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; + ;;; Code: + (require 'gnus-score) (eval-and-compile (require 'cl)) *************** *** 132,139 **** "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" ! "User's pseudonym. This pseudonym is obtained during the registration ! process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" "Host where the bbbd is running" ) --- 159,165 ---- "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" ! "User's pseudonym. This pseudonym is obtained during the registration process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" "Host where the bbbd is running" ) *************** *** 176,186 **** The scale factor is applied after the offset.") (defvar gnus-grouplens-override-scoring t ! "Tell Grouplens to override the normal Gnus scoring mechanism. If ! this variable is non-nill than Grouplens will completely override ! the normal scoring mechanism of Gnus. When nil, Grouplens will not ! override the normal scoring mechanism so both can be used at once.") ! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Program global variables --- 202,211 ---- The scale factor is applied after the offset.") (defvar gnus-grouplens-override-scoring t ! "Tell Grouplens to override the normal Gnus scoring mechanism. ! If this variable is non-nill than Grouplens will completely override ! the normal scoring mechanism of Gnus. When nil, Grouplens will not ! override the normal scoring mechanism so both can be used at once.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Program global variables *************** *** 457,472 **** (defconst grplens-minrating 1) (defconst grplens-predstringsize 12) - (defalias 'bbb-grouplens-score 'gnus-user-format-function-G) - (defvar gnus-tmp-score) ! (defun gnus-user-format-function-G (header) (let* ((rate-string (make-string 12 ? )) (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) (hashent (gethash mid grouplens-current-hashtable)) ! (iscore (if (string-match "September" gnus-version) ! gnus-tmp-score ! score)) (low (car (cdr hashent))) (high (car (cdr (cdr hashent))))) (aset rate-string 0 ?|) --- 482,493 ---- (defconst grplens-minrating 1) (defconst grplens-predstringsize 12) (defvar gnus-tmp-score) ! (defun bbb-grouplens-score (header) (let* ((rate-string (make-string 12 ? )) (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) (hashent (gethash mid grouplens-current-hashtable)) ! (iscore gnus-tmp-score) (low (car (cdr hashent))) (high (car (cdr (cdr hashent))))) (aset rate-string 0 ?|) *************** *** 718,730 **** (nth 1 (assoc "message-id" gnus-header-index))) (gnus-message 3 "You must select an article before you rate it"))) - (defvar gnus-tmp-group) - (defun gnus-user-format-function-I (header) - (let ((gname (if (string-match "September" gnus-version) - gnus-tmp-group - group))) - (if (member gname grouplens-newsgroups) " (GroupLens Enhanced)" ""))) - (defun bbb-grouplens-group-p (group) "Say whether GROUP is a GroupLens group." (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) --- 739,744 ---- *************** *** 864,867 **** (provide 'gnus-gl) ! ;;; end gnus-gl.el --- 878,881 ---- (provide 'gnus-gl) ! ;;; gnus-gl.el ends here *** pub/sgnus/lisp/gnus-kill.el Wed Apr 3 22:50:15 1996 --- sgnus/lisp/gnus-kill.el Thu Apr 4 03:19:15 1996 *************** *** 331,336 **** --- 331,350 ---- (set-buffer gnus-summary-buffer) (gnus-summary-limit-to-marks marks 'reverse))) + (defun gnus-apply-kill-file-unless-scored () + "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." + (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) + ;; Ignores global KILL. + (if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) + (message "Note: Ignoring %s.KILL; preferring .SCORE" + gnus-newsgroup-name)) + 0) + ((or (file-exists-p (gnus-newsgroup-kill-file nil)) + (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) + (gnus-apply-kill-file-internal)) + (t + 0))) + (defun gnus-apply-kill-file-internal () "Apply a kill file to the current newsgroup. Returns the number of articles marked as read." *** pub/sgnus/lisp/gnus-mh.el Wed Apr 3 22:50:15 1996 --- sgnus/lisp/gnus-mh.el Fri Apr 5 23:26:41 1996 *************** *** 91,97 **** (insert "In-Reply-To: " in-reply-to "\n"))) (setq mh-sent-from-folder gnus-original-article-buffer) (setq mh-sent-from-msg 1) ! (setq gnus-mail-buffer (buffer-name (current-buffer))) (setq mail-reply-buffer replybuffer) (save-excursion (set-buffer mh-sent-from-folder) --- 91,97 ---- (insert "In-Reply-To: " in-reply-to "\n"))) (setq mh-sent-from-folder gnus-original-article-buffer) (setq mh-sent-from-msg 1) ! (setq gnus-message-buffer (buffer-name (current-buffer))) (setq mail-reply-buffer replybuffer) (save-excursion (set-buffer mh-sent-from-folder) *************** *** 104,122 **** (defun gnus-mh-mail-send-and-exit (&optional dont-send) "Send the current mail and return to Gnus." (interactive) ! (let* ((reply gnus-article-reply) ! (winconf gnus-prev-winconf) ! (address-group gnus-add-to-address) ! (to-address (and address-group ! (mail-fetch-field "to")))) ! (setq gnus-add-to-address nil) (or dont-send (mh-send-letter)) (bury-buffer) - ;; This mail group doesn't have a `to-address', so we add one - ;; here. Magic! - (and to-address - (gnus-group-add-parameter - address-group (cons 'to-address to-address))) (if (get-buffer gnus-group-buffer) (progn (if (gnus-buffer-exists-p (car-safe reply)) --- 104,113 ---- (defun gnus-mh-mail-send-and-exit (&optional dont-send) "Send the current mail and return to Gnus." (interactive) ! (let ((reply gnus-article-reply) ! (winconf gnus-prev-winconf)) (or dont-send (mh-send-letter)) (bury-buffer) (if (get-buffer gnus-group-buffer) (progn (if (gnus-buffer-exists-p (car-safe reply)) *** pub/sgnus/lisp/gnus-msg.el Wed Apr 3 22:50:15 1996 --- sgnus/lisp/gnus-msg.el Fri Apr 5 22:55:24 1996 *************** *** 796,804 **** (save-excursion (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) ! (unless (condition-case () ! (gnus-request-accept-article group t method) ! (error nil)) (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) --- 796,807 ---- (save-excursion (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) ! (goto-char (point-min)) ! (when (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$") ! nil t) ! (replace-match "" t t )) ! (unless (gnus-request-accept-article group method t) (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) *** pub/sgnus/lisp/gnus-picon.el Wed Apr 3 22:50:15 1996 --- sgnus/lisp/gnus-picon.el Thu Apr 4 15:47:19 1996 *************** *** 1,8 **** ! ;;; gnus-picons.el: Icon hacks for displaying pretty icons in Gnus. ! ;; Copyright (C) 1996 Wes Hardaker ! ;; Author: Wes Hardaker ! ;; Keywords: gnus xpm annotation glyph faces ;;; Commentary: --- 1,25 ---- ! ;;; gnus-picon.el --- displaying pretty icons in Gnus ! ;; Copyright (C) 1996 Free Software Foundation, Inc. ! ;; Author: Wes Hardaker ! ;; Keywords: news xpm annotation glyph faces ! ! ;; 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: *** pub/sgnus/lisp/gnus-scomo.el Sat Apr 6 00:14:02 1996 --- sgnus/lisp/gnus-scomo.el Tue Apr 2 23:05:12 1996 *************** *** 0 **** --- 1,110 ---- + ;;; gnus-scomo.el --- mode for editing Gnus score files + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news, mail + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'easymenu) + (require 'timezone) + (eval-when-compile (require 'cl)) + + (defvar gnus-score-mode-hook nil + "*Hook run in score mode buffers.") + + (defvar gnus-score-menu-hook nil + "*Hook run after creating the score mode menu.") + + (defvar gnus-score-edit-exit-function nil + "Function run on exit from the score buffer.") + + (defvar gnus-score-mode-map nil) + (unless gnus-score-mode-map + (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) + (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) + (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) + (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) + + ;;;###autoload + (defun gnus-score-mode () + "Mode for editing Gnus score files. + This mode is an extended emacs-lisp mode. + + \\{gnus-score-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map gnus-score-mode-map) + (when menu-bar-mode + (gnus-score-make-menu-bar)) + (set-syntax-table emacs-lisp-mode-syntax-table) + (setq major-mode 'gnus-score-mode) + (setq mode-name "Score") + (lisp-mode-variables nil) + (make-local-variable 'gnus-score-edit-exit-function) + (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) + + (defun gnus-score-make-menu-bar () + (unless (boundp 'gnus-score-menu) + (easy-menu-define + gnus-score-menu gnus-score-mode-map "" + '("Score" + ["Exit" gnus-score-edit-done t] + ["Insert date" gnus-score-edit-insert-date t] + ["Format" gnus-score-pretty-print t])) + (run-hooks 'gnus-score-menu-hook))) + + (defun gnus-score-edit-insert-date () + "Insert date in numerical format." + (interactive) + (princ (gnus-score-day-number (current-time)) (current-buffer))) + + (defun gnus-score-pretty-print () + "Format the current score file." + (interactive) + (goto-char (point-min)) + (let ((form (read (current-buffer)))) + (erase-buffer) + (pp form (current-buffer))) + (goto-char (point-min))) + + (defun gnus-score-edit-exit () + "Stop editing the score file." + (interactive) + (unless (file-exists-p (file-name-directory (buffer-file-name))) + (make-directory (file-name-directory (buffer-file-name)) t)) + (save-buffer) + (bury-buffer (current-buffer)) + (let ((buf (current-buffer))) + (when gnus-score-edit-exit-function + (funcall gnus-score-edit-exit-function)) + (when (eq buf (current-buffer)) + (switch-to-buffer (other-buffer (current-buffer)))))) + + (defun gnus-score-day-number (time) + (let ((dat (decode-time time))) + (timezone-absolute-from-gregorian + (nth 4 dat) (nth 3 dat) (nth 5 dat)))) + + (provide 'gnus-scomo) + + ;;; gnus-scomo.el ends here *** pub/sgnus/lisp/gnus-score.el Wed Apr 3 22:50:16 1996 --- sgnus/lisp/gnus-score.el Fri Apr 5 23:28:44 1996 *************** *** 730,735 **** --- 730,736 ---- (gnus-score-load-file file) (gnus-set-mode-line 'summary)) + (defvar gnus-score-edit-exit-function) (defun gnus-score-edit-current-scores (file) "Edit the current score alist." (interactive (list gnus-current-score-file)) *************** *** 739,744 **** --- 740,746 ---- (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) + (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message *************** *** 755,760 **** --- 757,763 ---- (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) + (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message *************** *** 1794,1868 **** (setq elem (cdr elem))))) (setq data (cdr data)))))) - ;;; - ;;; Score mode. - ;;; - - (defvar gnus-score-mode-hook nil - "*Hook run in score mode buffers.") - - (defvar gnus-score-menu-hook nil - "*Hook run after creating the score mode menu.") - - (defvar gnus-score-mode-map nil) - (unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) - (gnus-define-keys - gnus-score-mode-map - "\C-c\C-c" gnus-score-edit-done - "\C-c\C-d" gnus-score-edit-insert-date - "\C-c\C-p" gnus-score-pretty-print)) - - (defun gnus-score-mode () - "Mode for editing score files. - This mode is an extended emacs-lisp mode. - - \\{gnus-score-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-score-mode-map) - (when (and menu-bar-mode - (gnus-visual-p 'score-menu 'menu)) - (gnus-score-make-menu-bar)) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-score-mode) - (setq mode-name "Score") - (lisp-mode-variables nil) - (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) - - (defun gnus-score-make-menu-bar () - (unless (boundp 'gnus-score-menu) - (easy-menu-define - gnus-score-menu gnus-score-mode-map "" - '("Score" - ["Exit" gnus-score-edit-done t] - ["Insert date" gnus-score-edit-insert-date t] - ["Format" gnus-score-pretty-print t] - )) - (run-hooks 'gnus-score-menu-hook))) - - (defun gnus-score-edit-insert-date () - "Insert date in numerical format." - (interactive) - (princ (gnus-day-number (current-time-string)) (current-buffer))) - - (defun gnus-score-pretty-print () - "Format the current score file." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (erase-buffer) - (pp form (current-buffer))) - (goto-char (point-min))) - (defun gnus-score-edit-done () - "Save the score file and return to the summary buffer." - (interactive) (let ((bufnam (buffer-file-name (current-buffer))) (winconf gnus-prev-winconf)) - (gnus-make-directory (file-name-directory (buffer-file-name))) - (save-buffer) - (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (gnus-score-remove-from-cache bufnam) (gnus-score-load-file bufnam))) --- 1797,1805 ---- *************** *** 1907,1912 **** --- 1844,1851 ---- (gnus-add-shutdown 'gnus-score-close 'gnus) + (defvar gnus-score-file-alist-cache nil) + (defun gnus-score-close () "Clear all internal score variables." (setq gnus-score-cache nil *************** *** 2082,2091 **** (search-forward "+") (forward-char -1) (insert "\\"))) - ;; Kludge to deal with "++" groups. - (while (search-forward "++" nil t) - (replace-match "\\+\\+" t t)) - (goto-char (point-min)) ;; Translate "all" to ".*". (while (search-forward "all" nil t) (replace-match ".*" t t)) --- 2021,2026 ---- *************** *** 2135,2142 **** (gnus-score-file-name newsgroup gnus-adaptive-file-suffix)) (setq all (nreverse all))) (mapcar 'gnus-score-file-name all)))) - - (defvar gnus-score-file-alist-cache nil) (defun gnus-score-find-alist (group) "Return list of score files for GROUP. --- 2070,2075 ---- *** pub/sgnus/lisp/gnus-uu.el Wed Apr 3 22:50:18 1996 --- sgnus/lisp/gnus-uu.el Fri Apr 5 23:27:28 1996 *************** *** 1720,1727 **** "Inserts an encoded file in the buffer. The user will be asked for a file name." (interactive) - (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) - (error "Not in post-news buffer")) (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) --- 1720,1725 ---- *************** *** 1757,1763 **** file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction ! (set-buffer gnus-post-news-buffer) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line -1) --- 1755,1761 ---- file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction ! (set-buffer gnus-message-buffer) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line -1) *************** *** 1778,1785 **** "Posts the composed news article and encoded file. If no file has been included, the user will be asked for a file." (interactive) - (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) - (error "Not in post news buffer")) (let (file-name) --- 1776,1781 ---- *************** *** 1788,1797 **** (setq file-name (gnus-uu-post-insert-binary))) (if gnus-uu-post-threaded ! (let ((gnus-required-headers ! (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) --- 1784,1793 ---- (setq file-name (gnus-uu-post-insert-binary))) (if gnus-uu-post-threaded ! (let ((message-required-news-headers ! (if (memq 'Message-ID message-required-news-headers) ! message-required-news-headers ! (cons 'Message-ID message-required-news-headers))) gnus-inews-article-hook) (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) *** pub/sgnus/lisp/gnus-vis.el Wed Apr 3 22:50:19 1996 --- sgnus/lisp/gnus-vis.el Fri Apr 5 23:10:40 1996 *************** *** 319,339 **** (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" '("Group" ! ["Read" gnus-group-read-group t] ! ["Select" gnus-group-select-group t] ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC"] ! ["Catch up" gnus-group-catchup-current t] ! ["Catch up all articles" gnus-group-catchup-current-all t] ! ["Check for new articles" gnus-group-get-new-news-this-group t] ! ["Toggle subscription" gnus-group-unsubscribe-current-group t] ! ["Kill" gnus-group-kill-group t] ! ["Yank" gnus-group-yank-group t] ! ["Describe" gnus-group-describe-group t] ! ["Fetch FAQ" gnus-group-fetch-faq t] ! ["Edit kill file" gnus-group-edit-local-kill t] ! ["Expire articles" gnus-group-expire-articles t] ! ["Set group level" gnus-group-set-current-level t] ! ["Select quick" gnus-group-quick-select-group t] )) (easy-menu-define --- 319,345 ---- (easy-menu-define gnus-group-reading-menu gnus-group-mode-map "" '("Group" ! ["Read" gnus-group-read-group (gnus-group-group-name)] ! ["Select" gnus-group-select-group (gnus-group-group-name)] ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC"] ! ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] ! ["Catch up all articles" gnus-group-catchup-current-all ! (gnus-group-group-name)] ! ["Check for new articles" gnus-group-get-new-news-this-group ! (gnus-group-group-name)] ! ["Toggle subscription" gnus-group-unsubscribe-current-group ! (gnus-group-group-name)] ! ["Kill" gnus-group-kill-group (gnus-group-group-name)] ! ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] ! ["Describe" gnus-group-describe-group (gnus-group-group-name)] ! ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] ! ["Edit kill file" gnus-group-edit-local-kill ! (gnus-group-group-name)] ! ["Expire articles" gnus-group-expire-articles ! (gnus-group-group-name)] ! ["Set group level" gnus-group-set-current-level ! (gnus-group-group-name)] ! ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] )) (easy-menu-define *************** *** 342,350 **** ("Listing" ["List subscribed groups" gnus-group-list-groups t] ["List all groups" gnus-group-list-all-groups t] ! ["List groups matching..." gnus-group-list-matching t] ! ["List killed groups" gnus-group-list-killed t] ! ["List zombie groups" gnus-group-list-zombies t] ["List level" gnus-group-list-level t] ["Describe all groups" gnus-group-describe-all-groups t] ["Group apropos" gnus-group-apropos t] --- 348,355 ---- ("Listing" ["List subscribed groups" gnus-group-list-groups t] ["List all groups" gnus-group-list-all-groups t] ! ["List killed groups" gnus-group-list-killed gnus-killed-list] ! ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] ["List level" gnus-group-list-level t] ["Describe all groups" gnus-group-describe-all-groups t] ["Group apropos" gnus-group-apropos t] *************** *** 361,368 **** ["Sort by unread" gnus-group-sort-groups-by-unread t] ["Sort by name" gnus-group-sort-groups-by-alphabet t]) ("Mark" ! ["Mark group" gnus-group-mark-group t] ! ["Unmark group" gnus-group-unmark-group t] ["Unmark all" gnus-group-unmark-all-groups t] ["Mark regexp" gnus-group-mark-regexp t] ["Mark region" gnus-group-mark-region t] --- 366,373 ---- ["Sort by unread" gnus-group-sort-groups-by-unread t] ["Sort by name" gnus-group-sort-groups-by-alphabet t]) ("Mark" ! ["Mark group" gnus-group-mark-group (gnus-group-group-name)] ! ["Unmark group" gnus-group-unmark-group (gnus-group-group-name)] ["Unmark all" gnus-group-unmark-all-groups t] ["Mark regexp" gnus-group-mark-regexp t] ["Mark region" gnus-group-mark-region t] *************** *** 371,377 **** ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ! ["Kill all zombie groups" gnus-group-kill-all-zombies t] ["Kill all groups on level..." gnus-group-kill-level t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] --- 376,383 ---- ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ! ["Kill all zombie groups" gnus-group-kill-all-zombies ! gnus-zombie-list] ["Kill all groups on level..." gnus-group-kill-level t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] *************** *** 385,393 **** ["Rename group" gnus-group-rename-group t] ["Delete group" gnus-group-delete-group t]) ("Editing groups" ! ["Parameters" gnus-group-edit-group-parameters t] ! ["Select method" gnus-group-edit-group-method t] ! ["Info" gnus-group-edit-group t]) ("Score file" ["Flush cache" gnus-score-flush-cache t]) ("Move" --- 391,401 ---- ["Rename group" gnus-group-rename-group t] ["Delete group" gnus-group-delete-group t]) ("Editing groups" ! ["Parameters" gnus-group-edit-group-parameters ! (gnus-group-group-name)] ! ["Select method" gnus-group-edit-group-method ! (gnus-group-group-name)] ! ["Info" gnus-group-edit-group (gnus-group-group-name)]) ("Score file" ["Flush cache" gnus-score-flush-cache t]) ("Move" *************** *** 401,407 **** ["Jump to group" gnus-group-jump-to-group t] ["First unread group" gnus-group-first-unread-group t] ["Best unread group" gnus-group-best-unread-group t]) ! ["Transpose" gnus-group-transpose-groups t] ["Read a directory as a group" gnus-group-enter-directory t] )) --- 409,416 ---- ["Jump to group" gnus-group-jump-to-group t] ["First unread group" gnus-group-first-unread-group t] ["Best unread group" gnus-group-best-unread-group t]) ! ["Transpose" gnus-group-transpose-groups ! (gnus-group-group-name)] ["Read a directory as a group" gnus-group-enter-directory t] )) *** pub/sgnus/lisp/gnus-vm.el Wed Apr 3 22:50:19 1996 --- sgnus/lisp/gnus-vm.el Thu Apr 4 15:20:52 1996 *************** *** 106,112 **** (setq gnus-newsgroup-last-mail folder))) (defun gnus-vm-mail-setup (to subject in-reply-to cc replybuffer actions) ! (gnus-sendmail-mail-setup to subject in-reply-to cc replybuffer actions) ) (defun gnus-mail-forward-using-vm (&optional buffer) --- 106,112 ---- (setq gnus-newsgroup-last-mail folder))) (defun gnus-vm-mail-setup (to subject in-reply-to cc replybuffer actions) ! ;; ) (defun gnus-mail-forward-using-vm (&optional buffer) *** pub/sgnus/lisp/gnus.el Wed Apr 3 22:50:21 1996 --- sgnus/lisp/gnus.el Fri Apr 5 23:06:14 1996 *************** *** 177,189 **** (defvar gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" ! "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" "/ftp@ftp.sunet.se:/pub/usenet/" "/ftp@nctuccca.edu.tw:/USENET/FAQ/" ! "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/" "/ftp@ftp.hk.super.net:/mirror/faqs/") "*Directory where the group FAQs are stored. This will most commonly be on a remote machine, and the file will be --- 177,190 ---- (defvar gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" + "/ftp@sunsite.auc.dk:/pub/usenet/" "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" ! "/ftp@rtfm.mit.edu:/pub/usenet/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" "/ftp@ftp.sunet.se:/pub/usenet/" "/ftp@nctuccca.edu.tw:/USENET/FAQ/" ! "/ftp@hwarang.postech.ac.kr:/pub/usenet/" "/ftp@ftp.hk.super.net:/mirror/faqs/") "*Directory where the group FAQs are stored. This will most commonly be on a remote machine, and the file will be *************** *** 201,212 **** North America: mirrors.aol.com /pub/rtfm/usenet ftp.seas.gwu.edu /pub/rtfm ! rtfm.mit.edu /pub/usenet/news.answers Europe: ftp.uni-paderborn.de /pub/FAQ src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet/news.answers ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory --- 202,214 ---- North America: mirrors.aol.com /pub/rtfm/usenet ftp.seas.gwu.edu /pub/rtfm ! rtfm.mit.edu /pub/usenet Europe: ftp.uni-paderborn.de /pub/FAQ src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet + sunsite.auc.dk /pub/usenet Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory *************** *** 1693,1699 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.63" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1695,1701 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.64" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 4179,4187 **** (defun gnus-group-default-level (&optional level number-or-nil) (cond (gnus-group-use-permanent-levels ! (setq gnus-group-default-list-level ! (or level gnus-group-default-list-level)) ! (or gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t --- 4181,4189 ---- (defun gnus-group-default-level (&optional level number-or-nil) (cond (gnus-group-use-permanent-levels ! ; (setq gnus-group-default-list-level ! ; (or level gnus-group-default-list-level)) ! (or level gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t *************** *** 4543,4548 **** --- 4545,4552 ---- ;; select method, and return a select method. (cond ((stringp method) (gnus-server-to-method method)) + ((equal method gnus-select-method) + gnus-select-method) ((and (stringp (car method)) group) (gnus-server-extend-method group method)) ((and method (not group) *************** *** 4588,4593 **** --- 4592,4607 ---- (t m2)))) (gnus-method-equal m1 m2))) + (defun gnus-servers-using-backend (backend) + "Return a list of known servers using BACKEND." + (let ((opened gnus-opened-servers) + out) + (while opened + (when (eq backend (caaar opened)) + (push (caar opened) out)) + (pop opened)) + out)) + (defun gnus-group-prefixed-name (group method) "Return the whole name from GROUP and METHOD." (and (stringp method) (setq method (gnus-server-to-method method))) *************** *** 7605,7613 **** (not no-display) gnus-newsgroup-unreads gnus-auto-select-first) ! (if (eq gnus-auto-select-first 'best) ! (gnus-summary-best-unread-article) ! (gnus-summary-first-unread-article)) ;; Don't select any articles, just move point to the first ;; article in the group. (goto-char (point-min)) --- 7619,7628 ---- (not no-display) gnus-newsgroup-unreads gnus-auto-select-first) ! (unless (if (eq gnus-auto-select-first 'best) ! (gnus-summary-best-unread-article) ! (gnus-summary-first-unread-article)) ! (gnus-configure-windows 'summary)) ;; Don't select any articles, just move point to the first ;; article in the group. (goto-char (point-min)) *************** *** 10347,10356 **** (setq best score article (gnus-data-number (car data)))) (setq data (cdr data))) ! (if article ! (gnus-summary-goto-article article) ! (error "No unread articles")) ! (gnus-summary-position-point))) (defun gnus-summary-last-subject () "Go to the last displayed subject line in the group." --- 10362,10372 ---- (setq best score article (gnus-data-number (car data)))) (setq data (cdr data))) ! (prog1 ! (if article ! (gnus-summary-goto-article article) ! (error "No unread articles")) ! (gnus-summary-position-point)))) (defun gnus-summary-last-subject () "Go to the last displayed subject line in the group." *************** *** 11147,11153 **** If N is nil and any articles have been marked with the process mark, move those articles instead. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. For this function to work, both the current newsgroup and the --- 11163,11169 ---- If N is nil and any articles have been marked with the process mark, move those articles instead. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method. For this function to work, both the current newsgroup and the *************** *** 11183,11192 **** (cadr (assq action names)) gnus-current-move-group articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) ! (setq to-method (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) ! ;;(when (equal to-newsgroup gnus-newsgroup-name) ! ;;(error "Can't %s to the same group you're already in" action)) ;; Check the method we are to move this article to... (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) --- 11199,11206 ---- (cadr (assq action names)) gnus-current-move-group articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) ! (setq to-method (or select-method ! (gnus-find-method-for-group to-newsgroup))) ;; Check the method we are to move this article to... (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) *************** *** 11194,11200 **** (error "Can't open server %s" (car to-method))) (gnus-message 6 "%s to %s: %s..." (caddr (assq action names)) ! (or select-method to-newsgroup) articles) (while articles (setq article (pop articles)) (setq --- 11208,11214 ---- (error "Can't open server %s" (car to-method))) (gnus-message 6 "%s to %s: %s..." (caddr (assq action names)) ! (or (car select-method) to-newsgroup) articles) (while articles (setq article (pop articles)) (setq *************** *** 11208,11216 **** (nth 1 (gnus-find-method-for-group gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article ! (if select-method ! (list 'quote select-method) ! to-newsgroup) (not articles)) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. --- 11222,11228 ---- (nth 1 (gnus-find-method-for-group gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article ! to-newsgroup (list 'quote select-method) (not articles)) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. *************** *** 11219,11226 **** (set-buffer copy-buf) (gnus-request-article-this-buffer article gnus-newsgroup-name) (gnus-request-accept-article ! (if select-method select-method to-newsgroup) ! (not articles)))) ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (mail-header-xref (gnus-summary-article-header article)))) --- 11231,11237 ---- (set-buffer copy-buf) (gnus-request-article-this-buffer article gnus-newsgroup-name) (gnus-request-accept-article ! to-newsgroup select-method (not articles)))) ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (mail-header-xref (gnus-summary-article-header article)))) *************** *** 11236,11243 **** (gnus-request-article-this-buffer article gnus-newsgroup-name) (nnheader-replace-header "xref" new-xref) (gnus-request-accept-article ! (if select-method select-method to-newsgroup) ! (not articles))))))) (if (not art-group) (gnus-message 1 "Couldn't %s article %s" (cadr (assq action names)) article) --- 11247,11253 ---- (gnus-request-article-this-buffer article gnus-newsgroup-name) (nnheader-replace-header "xref" new-xref) (gnus-request-accept-article ! to-newsgroup select-method (not articles))))))) (if (not art-group) (gnus-message 1 "Couldn't %s article %s" (cadr (assq action names)) article) *************** *** 11247,11254 **** (gnus-gethash (gnus-group-prefixed-name (car art-group) ! (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) (to-group (gnus-info-group info))) --- 11257,11264 ---- (gnus-gethash (gnus-group-prefixed-name (car art-group) ! (or select-method ! (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) (to-group (gnus-info-group info))) *************** *** 11324,11330 **** (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method." (interactive "P") (gnus-summary-move-article n nil select-method 'copy)) --- 11334,11340 ---- (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method." (interactive "P") (gnus-summary-move-article n nil select-method 'copy)) *************** *** 11334,11340 **** (interactive "P") (gnus-summary-move-article n nil nil 'crosspost)) ! (defun gnus-summary-respool-article (&optional n respool-method) "Respool the current article. The article will be squeezed through the mail spooling process again, which means that it will be put in some mail newsgroup or other --- 11344,11350 ---- (interactive "P") (gnus-summary-move-article n nil nil 'crosspost)) ! (defun gnus-summary-respool-article (&optional n method) "Respool the current article. The article will be squeezed through the mail spooling process again, which means that it will be put in some mail newsgroup or other *************** *** 11348,11369 **** In the former case, the articles in question will be moved from the current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." ! (interactive "P") (gnus-set-global-variables) ! (let ((respool-methods (gnus-methods-using 'respool)) ! (methname ! (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))))) ! (unless respool-method ! (setq respool-method ! (completing-read ! "What method do you want to use when respooling? " ! respool-methods nil t (cons methname 0)))) ! (unless (string= respool-method "") ! (if (assoc (symbol-name ! (car (gnus-find-method-for-group gnus-newsgroup-name))) ! respool-methods) ! (gnus-summary-move-article n nil (intern respool-method)) ! (gnus-summary-copy-article n nil (intern respool-method)))))) (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." --- 11358,11391 ---- In the former case, the articles in question will be moved from the current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." ! (interactive ! (list current-prefix-arg ! (let* ((methods (gnus-methods-using 'respool)) ! (methname ! (symbol-name (car (gnus-find-method-for-group ! gnus-newsgroup-name)))) ! (method ! (completing-read ! "What backend do you want to use when respooling? " ! methods nil t (cons methname 0))) ! ms) ! (cond ! ((zerop (length (setq ms (gnus-servers-using-backend method)))) ! (list (intern method) "")) ! ((= 1 (length ms)) ! (car ms)) ! (t ! (cdr (completing-read ! "Server name: " ! (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) (gnus-set-global-variables) ! (unless method ! (error "No method given for respooling")) ! (if (assoc (symbol-name ! (car (gnus-find-method-for-group gnus-newsgroup-name))) ! (gnus-methods-using 'respool)) ! (gnus-summary-move-article n nil method) ! (gnus-summary-copy-article n nil method))) (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." *************** *** 11396,11402 **** "Message-ID: " (gnus-inews-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) ! (gnus-request-accept-article group t) (kill-buffer (current-buffer))))) (defun gnus-summary-expire-articles () --- 11418,11424 ---- "Message-ID: " (gnus-inews-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) ! (gnus-request-accept-article group nil t) (kill-buffer (current-buffer))))) (defun gnus-summary-expire-articles () *************** *** 14020,14026 **** (date (and (vectorp header) (mail-header-date header))) (date-regexp "^Date: \\|^X-Sent: ") (now (current-time)) ! (inhibit-point-motion-hooks t)) (when (and date (not (string= date ""))) (save-excursion (set-buffer gnus-article-buffer) --- 14042,14049 ---- (date (and (vectorp header) (mail-header-date header))) (date-regexp "^Date: \\|^X-Sent: ") (now (current-time)) ! (inhibit-point-motion-hooks t) ! bface eface) (when (and date (not (string= date ""))) (save-excursion (set-buffer gnus-article-buffer) *************** *** 14028,14035 **** (nnheader-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. ! (if (zerop (message-remove-header date-regexp t)) ! (beginning-of-line) (goto-char (point-max))) (insert (cond --- 14051,14062 ---- (nnheader-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. ! (if (re-search-forward date-regexp nil t) ! (progn ! (setq bface (get-text-property (gnus-point-at-bol) 'face) ! eface (get-text-property (gnus-point-at-eol) 'face)) ! (message-remove-header date-regexp t) ! (beginning-of-line)) (goto-char (point-max))) (insert (cond *************** *** 14103,14110 **** (t (error "Unknown conversion type: %s" type))))) ;; Do highlighting. ! (when (and highlight (gnus-visual-p 'article-highlight 'highlight)) ! (gnus-article-highlight-headers))))))) (defun gnus-article-date-local (&optional highlight) "Convert the current article date to the local timezone." --- 14130,14142 ---- (t (error "Unknown conversion type: %s" type))))) ;; Do highlighting. ! (beginning-of-line) ! (when (and highlight (gnus-visual-p 'article-highlight 'highlight) ! (looking-at "\\([^:]\\): *\\(.*\\)$")) ! (put-text-property (match-beginning 1) (match-end 1) ! 'face bface) ! (put-text-property (match-beginning 2) (match-end 2) ! 'face eface))))))) (defun gnus-article-date-local (&optional highlight) "Convert the current article date to the local timezone." *************** *** 14882,14888 **** article (gnus-group-real-name group) (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group &optional last method) ;; Make sure there's a newline at the end of the article. (when (stringp method) (setq method (gnus-server-to-method method))) --- 14914,14920 ---- article (gnus-group-real-name group) (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group method &optional last) ;; Make sure there's a newline at the end of the article. (when (stringp method) (setq method (gnus-server-to-method method))) *************** *** 14892,14899 **** (goto-char (point-max)) (unless (bolp) (insert "\n")) ! (let ((func (if (symbolp group) group ! (car (or method (gnus-find-method-for-group group)))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) (cadr method) --- 14924,14930 ---- (goto-char (point-max)) (unless (bolp) (insert "\n")) ! (let ((func (car (or method (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) (cadr method) *** pub/sgnus/lisp/mail-header.el Wed Apr 3 22:50:21 1996 --- sgnus/lisp/mail-header.el Fri Apr 5 23:26:39 1996 *************** *** 46,51 **** --- 46,54 ---- ;;; Code: + ;; Make the byte-compiler shut up. + (defvar headers) + (defun mail-header-extract () "Extract headers from current buffer after point. Returns a header alist, where each element is a cons cell (name . value), *** pub/sgnus/lisp/message.el Wed Apr 3 22:50:22 1996 --- sgnus/lisp/message.el Fri Apr 5 23:53:24 1996 *************** *** 27,72 **** ;; consists mainly of large chunks of code from the sendmail.el, ;; gnus-msg.el and rnewspost.el files. - ;;; underline.el - - ;; This code should be moved to underline.el (from which it is stolen). - - ;;;###autoload - (defun bold-region (start end) - "Bold all nonblank characters in the region. - Works by overstriking characters. - Called from program, takes two arguments START and END - which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (< (point) end1) - (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) - (forward-char 1))))) - - ;;;###autoload - (defun unbold-region (start end) - "Remove all boldness (overstruck characters) in the region. - Called from program, takes two arguments START and END - which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) - (delete-char -2)))))) - ;;; Code: (eval-when-compile (require 'cl)) (require 'mail-header) (require 'nnheader) ;;;###autoload (defvar message-fcc-handler-function 'rmail-output --- 27,39 ---- ;; consists mainly of large chunks of code from the sendmail.el, ;; gnus-msg.el and rnewspost.el files. ;;; Code: (eval-when-compile (require 'cl)) (require 'mail-header) (require 'nnheader) + (require 'timezone) ;;;###autoload (defvar message-fcc-handler-function 'rmail-output *************** *** 761,771 **** (search-forward (concat "\n" mail-header-separator "\n") nil t)) (defun message-goto-signature () ! "Move point to the beginning of the message signature, ! or the line sollowing `message-signature-separator'." (interactive) (goto-char (point-min)) ! (search-forward (concat "\n" message-signature-separator "\n") nil t)) --- 728,738 ---- (search-forward (concat "\n" mail-header-separator "\n") nil t)) (defun message-goto-signature () ! "Move point to the beginning of the message signature." (interactive) (goto-char (point-min)) ! (or (re-search-forward message-signature-separator nil t) ! (goto-char (point-max)))) *************** *** 1012,1021 **** "Send message like `message-send', then, if no errors, exit from mail buffer." (interactive) (let ((buf (current-buffer))) ! (message-send) ! (bury-buffer buf) ! (when (eq buf (current-buffer)) ! (message-bury buf)))) (defun message-dont-send () "Don't send the message you have been editing." --- 979,988 ---- "Send message like `message-send', then, if no errors, exit from mail buffer." (interactive) (let ((buf (current-buffer))) ! (when (message-send) ! (bury-buffer buf) ! (when (eq buf (current-buffer)) ! (message-bury buf))))) (defun message-dont-send () "Don't send the message you have been editing." *************** *** 1073,1079 **** (condition-case nil (apply (caar actions) (cdar actions)) (error)) ! (pop actions)))))) (defun message-send-mail (&optional arg) (require 'mail-utils) --- 1040,1048 ---- (condition-case nil (apply (caar actions) (cdar actions)) (error)) ! (pop actions))) ! ;; Return success. ! t))) (defun message-send-mail (&optional arg) (require 'mail-utils) *************** *** 1118,1126 **** (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) - (sendmail-synch-aliases) - (when message-aliases - (expand-mail-aliases (point-min) delimline)) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) --- 1087,1092 ---- *************** *** 1325,1330 **** --- 1291,1301 ---- (message "Denied posting -- the From looks strange: \"%s\"." from) nil) + ((string-match "@[^@]*@" from) + (message + "Denied posting -- two \"@\"'s in the From header: %s." + from) + nil) ((string-match "(.*).*(.*)" from) (message "Denied posting -- the From header looks strange: \"%s\"." *************** *** 1830,1841 **** (defun message-fill-header (header value) (let ((begin (point)) (fill-column 78) ! (fill-prefix "\t")) (insert (capitalize (symbol-name header)) ": " (if (consp value) (car value) value) "\n") ! (fill-region-as-paragraph begin (point)))) (defun sendmail-synch-aliases () (let ((modtime (nth 5 (file-attributes message-personal-alias-file)))) --- 1801,1824 ---- (defun message-fill-header (header value) (let ((begin (point)) (fill-column 78) ! (fill-prefix "\t") ! end) (insert (capitalize (symbol-name header)) ": " (if (consp value) (car value) value) "\n") ! (save-restriction ! (narrow-to-region begin (point)) ! (fill-region-as-paragraph begin (point)) ! ;; Tapdance around looong Message-IDs. ! (forward-line -1) ! (when (eolp) ! (message-delete-line)) ! (goto-char begin) ! (re-search-forward ":" nil t) ! (when (looking-at "\n[ \t]+") ! (replace-match " " t t)) ! (goto-char (point-max))))) (defun sendmail-synch-aliases () (let ((modtime (nth 5 (file-attributes message-personal-alias-file)))) *************** *** 1894,1899 **** --- 1877,1884 ---- (forward-line -1) (when message-default-headers (insert message-default-headers)) + (insert mail-header-separator "\n") + (forward-line -1) (when (and (message-news-p) message-default-news-headers) (when message-generate-headers-first *************** *** 1904,1910 **** (when message-generate-headers-first (message-generate-headers message-required-mail-headers)) (insert message-default-mail-headers)) - (insert mail-header-separator "\n") (message-insert-signature) (message-set-auto-save-file-name) (save-restriction --- 1889,1894 ---- *************** *** 2372,2377 **** --- 2356,2395 ---- (message-pop-to-buffer "*news message*")) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) + + ;;; underline.el + + ;; This code should be moved to underline.el (from which it is stolen). + + ;;;###autoload + (defun bold-region (start end) + "Bold all nonblank characters in the region. + Works by overstriking characters. + Called from program, takes two arguments START and END + which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (< (point) end1) + (or (looking-at "[_\^@- ]") + (insert (following-char) "\b")) + (forward-char 1))))) + + ;;;###autoload + (defun unbold-region (start end) + "Remove all boldness (overstruck characters) in the region. + Called from program, takes two arguments START and END + which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (re-search-forward "\b" end1 t) + (if (eq (following-char) (char-after (- (point) 2))) + (delete-char -2)))))) (provide 'message) *** pub/sgnus/lisp/nndir.el Wed Apr 3 22:50:22 1996 --- sgnus/lisp/nndir.el Fri Apr 5 22:55:26 1996 *************** *** 143,148 **** --- 143,152 ---- ;;; Low-Level Interface (defun nndir-execute-nnmh-command (command) + (unless (nnmh-server-opened nndir-current-server) + (nnmh-open-server nndir-current-server + `((nnmh-directory ,nnml-directory) + (nnmh-get-new-mail nil)))) (let ((dir (file-name-as-directory (expand-file-name nndir-directory)))) (if (and (not (file-directory-p nndir-group)) (or (file-directory-p (concat dir nndir-group)) *************** *** 160,165 **** --- 164,174 ---- (eval command)))))) (defun nndir-execute-nnml-command (command) + (unless (nnml-server-opened nndir-current-server) + (nnml-open-server nndir-current-server + `((nnml-directory ,nnml-directory) + (nnml-nov-is-evil ,nnml-nov-is-evil) + (nnml-get-new-mail nil)))) (let ((dir (file-name-as-directory (expand-file-name nndir-directory)))) (if (and (not (file-directory-p nndir-group)) (or (file-directory-p (concat dir nndir-group)) *************** *** 175,186 **** (let* ((nndir-group (substring dir (1+ (match-beginning 0)))) (nnml-directory (substring dir 0 (1+ (match-beginning 0)))) (nnml-nov-is-evil nndir-nov-is-evil) ! (nnml-get-new-mail nil) ! (defs `((nnml-directory ,nnml-directory) ! (nnml-nov-is-evil ,nnml-nov-is-evil) ! (nnml-get-new-mail)))) ! (unless (nnml-server-opened nndir-current-server) ! (nnml-open-server nndir-current-server defs)) (eval command)))))) (provide 'nndir) --- 184,190 ---- (let* ((nndir-group (substring dir (1+ (match-beginning 0)))) (nnml-directory (substring dir 0 (1+ (match-beginning 0)))) (nnml-nov-is-evil nndir-nov-is-evil) ! (nnml-get-new-mail nil)) (eval command)))))) (provide 'nndir) *** pub/sgnus/lisp/nnfolder.el Wed Apr 3 22:50:22 1996 --- sgnus/lisp/nnfolder.el Fri Apr 5 23:32:36 1996 *************** *** 615,635 **** (nnmail-activate 'nnfolder))) (defun nnfolder-active-number (group) ! (save-excursion ! ;; Find the next article number in GROUP. ! (prog1 ! (let ((active (cadr (assoc group nnfolder-group-alist)))) ! (if active ! (setcdr active (1+ (cdr active))) ! ;; This group is new, so we create a new entry for it. ! ;; This might be a bit naughty... creating groups on the drop of ! ;; a hat, but I don't know... ! (setq nnfolder-group-alist ! (cons (list group (setq active (cons 1 1))) ! nnfolder-group-alist))) ! (cdr active)) ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! (nnfolder-possibly-activate-groups group)))) ;; This method has a problem if you've accidentally let the active list get --- 615,636 ---- (nnmail-activate 'nnfolder))) (defun nnfolder-active-number (group) ! (when group ! (save-excursion ! ;; Find the next article number in GROUP. ! (prog1 ! (let ((active (cadr (assoc group nnfolder-group-alist)))) ! (if active ! (setcdr active (1+ (cdr active))) ! ;; This group is new, so we create a new entry for it. ! ;; This might be a bit naughty... creating groups on the drop of ! ;; a hat, but I don't know... ! (setq nnfolder-group-alist ! (cons (list group (setq active (cons 1 1))) ! nnfolder-group-alist))) ! (cdr active)) ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! (nnfolder-possibly-activate-groups group))))) ;; This method has a problem if you've accidentally let the active list get *** pub/sgnus/lisp/nnmail.el Wed Apr 3 22:50:23 1996 --- sgnus/lisp/nnmail.el Thu Apr 4 20:58:31 1996 *************** *** 514,522 **** ;; Go to the beginning of the next article - or to the end ;; of the buffer. (if do-search ! (if (re-search-forward "\n" nil t) ! (goto-char (+ 1 (match-beginning 0))) ! (goto-char (- (point-max) 1)))) (delete-char 1) ; delete ^_ (save-excursion (save-restriction --- 514,522 ---- ;; Go to the beginning of the next article - or to the end ;; of the buffer. (if do-search ! (if (re-search-forward "^" nil t) ! (goto-char (match-beginning 0)) ! (goto-char (1- (point-max))))) (delete-char 1) ; delete ^_ (save-excursion (save-restriction *** pub/sgnus/lisp/nnsoup.el Wed Apr 3 22:50:23 1996 --- sgnus/lisp/nnsoup.el Thu Apr 4 21:27:40 1996 *************** *** 248,261 **** (defun nnsoup-request-article (id &optional newsgroup server buffer) (nnsoup-possibly-change-group newsgroup) ! (let ((buffer (or buffer nntp-server-buffer))) (save-excursion ! (set-buffer buffer) (erase-buffer) ! (if (stringp id) ! () ! (insert-buffer-substring ! (nnsoup-narrow-to-article id)) t)))) (defun nnsoup-request-group (group &optional server dont-check) --- 248,260 ---- (defun nnsoup-request-article (id &optional newsgroup server buffer) (nnsoup-possibly-change-group newsgroup) ! (let (buf) (save-excursion ! (set-buffer (or buffer nntp-server-buffer)) (erase-buffer) ! (when (and (not (stringp id)) ! (setq buf (nnsoup-narrow-to-article id))) ! (insert-buffer-substring buf) t)))) (defun nnsoup-request-group (group &optional server dont-check) *************** *** 515,575 **** (defun nnsoup-narrow-to-article (article &optional area head) (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) ! (prefix (gnus-soup-area-prefix (nth 1 area))) ! (msg-buf (nnsoup-index-buffer prefix 'msg)) beg end) ! (save-excursion ! (cond ! ;; There is no MSG file. ! ((null msg-buf) ! nil) ! ;; We use the index file to find out where the article begins and ends. ! ((and (= (gnus-soup-encoding-index ! (gnus-soup-area-encoding (nth 1 area))) ! ?c) ! (file-exists-p (nnsoup-file prefix))) ! (set-buffer (nnsoup-index-buffer prefix)) ! (widen) ! (goto-char (point-min)) ! (forward-line (- article (caar area))) ! (setq beg (read (current-buffer))) ! (forward-line 1) ! (if (looking-at "[0-9]+") ! (progn ! (setq end (read (current-buffer))) ! (set-buffer msg-buf) ! (widen) ! (let ((format (gnus-soup-encoding-format ! (gnus-soup-area-encoding (nth 1 area))))) ! (goto-char end) ! (if (or (= format ?n) (= format ?m)) ! (setq end (progn (forward-line -1) (point)))))) ! (set-buffer msg-buf)) ! (widen) ! (narrow-to-region beg (or end (point-max)))) ! (t ! (set-buffer msg-buf) ! (widen) (goto-char (point-min)) ! (let ((header (nnsoup-header ! (gnus-soup-encoding-format ! (gnus-soup-area-encoding (nth 1 area)))))) ! (re-search-forward header nil t (- article (caar area))) (narrow-to-region ! (match-beginning 0) ! (if (re-search-forward header nil t) ! (match-beginning 0) ! (point-max)))))) ! (goto-char (point-min)) ! (if (not head) ! () ! (narrow-to-region ! (point-min) ! (if (search-forward "\n\n" nil t) ! (1- (point)) ! (point-max)))) ! msg-buf))) (defun nnsoup-header (format) (cond --- 514,575 ---- (defun nnsoup-narrow-to-article (article &optional area head) (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) ! (prefix (and area (gnus-soup-area-prefix (nth 1 area)))) ! (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg))) beg end) ! (when area ! (save-excursion ! (cond ! ;; There is no MSG file. ! ((null msg-buf) ! nil) ! ;; We use the index file to find out where the article begins and ends. ! ((and (= (gnus-soup-encoding-index ! (gnus-soup-area-encoding (nth 1 area))) ! ?c) ! (file-exists-p (nnsoup-file prefix))) ! (set-buffer (nnsoup-index-buffer prefix)) ! (widen) ! (goto-char (point-min)) ! (forward-line (- article (caar area))) ! (setq beg (read (current-buffer))) ! (forward-line 1) ! (if (looking-at "[0-9]+") ! (progn ! (setq end (read (current-buffer))) ! (set-buffer msg-buf) ! (widen) ! (let ((format (gnus-soup-encoding-format ! (gnus-soup-area-encoding (nth 1 area))))) ! (goto-char end) ! (if (or (= format ?n) (= format ?m)) ! (setq end (progn (forward-line -1) (point)))))) ! (set-buffer msg-buf)) ! (widen) ! (narrow-to-region beg (or end (point-max)))) ! (t ! (set-buffer msg-buf) ! (widen) ! (goto-char (point-min)) ! (let ((header (nnsoup-header ! (gnus-soup-encoding-format ! (gnus-soup-area-encoding (nth 1 area)))))) ! (re-search-forward header nil t (- article (caar area))) ! (narrow-to-region ! (match-beginning 0) ! (if (re-search-forward header nil t) ! (match-beginning 0) ! (point-max)))))) (goto-char (point-min)) ! (if (not head) ! () (narrow-to-region ! (point-min) ! (if (search-forward "\n\n" nil t) ! (1- (point)) ! (point-max)))) ! msg-buf)))) (defun nnsoup-header (format) (cond *************** *** 626,695 **** (setq message-send-news-function (cadr nnsoup-old-functions))) (defun nnsoup-store-reply (kind) ! ;; Mostly stolen from `sendmail.el'. ! (let ((tembuf (generate-new-buffer " sendmail temp")) (case-fold-search nil) ! (mailbuf (current-buffer)) ! delimline) ! (save-excursion ! (set-buffer tembuf) ! (erase-buffer) ! (insert-buffer-substring mailbuf) ! (goto-char (point-max)) ! ;; require one newline at the end. ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! ;; Change header-delimiter to be what sendmail expects. ! (goto-char (point-min)) ! (if (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "\n") nil t) ! (replace-match "\n") ! (search-forward "\n\n" nil t)) ! (backward-char 1) ! (setq delimline (point-marker)) ! (if (and mail-aliases (fboundp 'expand-mail-aliases)) ! (expand-mail-aliases (point-min) delimline)) ! (goto-char (point-min)) ! ;; ignore any blank lines in the header ! (while (and (re-search-forward "\n\n\n*" delimline t) ! (< (point) delimline)) ! (replace-match "\n")) ! (let ((case-fold-search t)) ! (goto-char (point-min)) ! ;; Find and handle any FCC fields. ! (goto-char (point-min)) ! (if (re-search-forward "^FCC:" delimline t) ! (mail-do-fcc delimline)) ! (goto-char (point-min)) ! ;; "S:" is an abbreviation for "Subject:". ! (goto-char (point-min)) ! (if (re-search-forward "^S:" delimline t) ! (replace-match "Subject:")) ! ;; Don't send out a blank subject line ! (goto-char (point-min)) ! (if (re-search-forward "^Subject:[ \t]*\n" delimline t) ! (replace-match "")) ! ;; Insert an extra newline if we need it to work around ! ;; Sun's bug that swallows newlines. ! (goto-char (1+ delimline)) ! (if (and (boundp 'mail-mailer-swallows-blank-line) ! (eval mail-mailer-swallows-blank-line)) ! (newline))) ! (let ((msg-buf ! (gnus-soup-store ! nnsoup-replies-directory ! (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type ! nnsoup-replies-index-type)) ! (num 0)) ! (when (and msg-buf (bufferp msg-buf)) ! (save-excursion ! (set-buffer msg-buf) (goto-char (point-min)) ! (while (re-search-forward "^#! *rnews" nil t) ! (incf num))) ! (message "Stored %d messages" num))) ! (nnsoup-write-replies) ! (kill-buffer tembuf)))) (defun nnsoup-kind-to-prefix (kind) (unless nnsoup-replies-list --- 626,686 ---- (setq message-send-news-function (cadr nnsoup-old-functions))) (defun nnsoup-store-reply (kind) ! ;; Mostly stolen from `message.el'. ! (require 'mail-utils) ! (let ((tembuf (generate-new-buffer " message temp")) (case-fold-search nil) ! (news (message-news-p)) ! (resend-to-addresses (mail-fetch-field "resent-to")) ! delimline ! (mailbuf (current-buffer))) ! (unwind-protect ! (save-excursion ! (set-buffer tembuf) ! (erase-buffer) ! (insert-buffer-substring mailbuf) ! ;; Remove some headers. ! (save-restriction ! (message-narrow-to-headers) ! ;; Remove some headers. ! (message-remove-header message-ignored-mail-headers t)) ! (goto-char (point-max)) ! ;; require one newline at the end. ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! (when (and news ! (equal kind "mail") ! (or (mail-fetch-field "cc") ! (mail-fetch-field "to"))) ! (message-insert-courtesy-copy)) ! (let ((case-fold-search t)) ! ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "\n")) ! (replace-match "\n") ! (backward-char 1) ! (setq delimline (point-marker)) ! ;; Insert an extra newline if we need it to work around ! ;; Sun's bug that swallows newlines. ! (goto-char (1+ delimline)) ! (when (eval message-mailer-swallows-blank-line) ! (newline)) ! (let ((msg-buf ! (gnus-soup-store ! nnsoup-replies-directory ! (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type ! nnsoup-replies-index-type)) ! (num 0)) ! (when (and msg-buf (bufferp msg-buf)) ! (save-excursion ! (set-buffer msg-buf) ! (goto-char (point-min)) ! (while (re-search-forward "^#! *rnews" nil t) ! (incf num))) ! (message "Stored %d messages" num))) ! (nnsoup-write-replies) ! (kill-buffer tembuf)))))) (defun nnsoup-kind-to-prefix (kind) (unless nnsoup-replies-list *** pub/sgnus/lisp/nnspool.el Wed Apr 3 22:50:23 1996 --- sgnus/lisp/nnspool.el Thu Apr 4 21:53:49 1996 *************** *** 35,41 **** "Program to post news. This is most commonly `inews' or `injnews'.") ! (defvar nnspool-inews-switches '("-h -S") "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") --- 35,41 ---- "Program to post news. This is most commonly `inews' or `injnews'.") ! (defvar nnspool-inews-switches '("-h") "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") *** pub/sgnus/lisp/nnvirtual.el Wed Apr 3 22:50:23 1996 --- sgnus/lisp/nnvirtual.el Fri Apr 5 23:26:39 1996 *************** *** 224,229 **** --- 224,231 ---- (defun nnvirtual-close-group (group &optional server) (when (nnvirtual-possibly-change-group group server t) + ;; Copy (un)read articles. + (nnvirtual-update-reads) ;; We copy the marks from this group to the component ;; groups here. (nnvirtual-update-marked) *************** *** 249,266 **** (let ((map nnvirtual-mapping) (marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists)) reads mr m op) (while map ! (setq m (pop map)) ! (unless (nth 3 m) (push (car m) reads)) (when (setq mr (nth 4 m)) (while mr (setcdr (setq op (assq (pop mr) marks)) (cons (car m) (cdr op)))))) (setq mr marks) (while mr ! (setcdr (car mr) (gnus-compress-sequence (sort (cdar mr) '<))) ! (setq mr (cdr mr))) (setcar (cddr info) (gnus-compress-sequence (nreverse reads))) ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) --- 251,278 ---- (let ((map nnvirtual-mapping) (marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists)) reads mr m op) + ;; Go through the mapping. (while map ! (unless (nth 3 (setq m (pop map))) ! ;; Read article. (push (car m) reads)) + ;; Copy marks. (when (setq mr (nth 4 m)) (while mr (setcdr (setq op (assq (pop mr) marks)) (cons (car m) (cdr op)))))) + ;; Compress the marks and the reads. (setq mr marks) (while mr ! (setcdr (car mr) (gnus-compress-sequence (sort (cdr (pop mr)) '<)))) (setcar (cddr info) (gnus-compress-sequence (nreverse reads))) + ;; Remove empty marks lists. + (while (and marks (not (cdar marks))) + (setq marks (cdr marks))) + (setq mr marks) + (while (cdr mr) + (if (cdadr mr) + (setq mr (cdr mr)) + (setcdr mr (cddr mr)))) ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) *************** *** 339,345 **** (and (string-match regexp (caar newsrc)) (not (string= (caar newsrc) virt-group)) (setq nnvirtual-component-groups ! (cons (caar newsrc) nnvirtual-component-groups))) (setq newsrc (cdr newsrc)))) (if nnvirtual-component-groups (progn --- 351,359 ---- (and (string-match regexp (caar newsrc)) (not (string= (caar newsrc) virt-group)) (setq nnvirtual-component-groups ! (cons (caar newsrc) ! (delete (caar newsrc) ! nnvirtual-component-groups)))) (setq newsrc (cdr newsrc)))) (if nnvirtual-component-groups (progn *************** *** 354,368 **** (defun nnvirtual-update-marked () "Copy marks from the virtual group to the component groups." (let ((mark-lists gnus-article-mark-lists) type list mart cgroups) ! (when (and gnus-summary-buffer ! (get-buffer gnus-summary-buffer) ! (buffer-name (get-buffer gnus-summary-buffer))) ! (set-buffer gnus-summary-buffer)) ! (while mark-lists ! (setq type (cdar mark-lists)) ! (setq list (symbol-value (intern (format "gnus-newsgroup-%s" ! (car (pop mark-lists)))))) (setq cgroups (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) (while list --- 368,379 ---- (defun nnvirtual-update-marked () "Copy marks from the virtual group to the component groups." (let ((mark-lists gnus-article-mark-lists) + (marks (gnus-info-marks (gnus-get-info + (concat "nnvirtual:" + nnvirtual-current-group)))) type list mart cgroups) ! (while (setq type (cdr (pop mark-lists))) ! (setq list (gnus-uncompress-range (cdr (assq type marks)))) (setq cgroups (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) (while list *************** *** 374,379 **** --- 385,402 ---- (caar cgroups) type (cdar cgroups) nil t) (gnus-group-update-group (car (pop cgroups)) t))))) + (defun nnvirtual-update-reads () + "Copy (un)reads from the current group to the component groups." + (let ((groups (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) + (articles (gnus-list-of-unread-articles + (concat "nnvirtual:" nnvirtual-current-group))) + m) + (while articles + (setq m (assq (pop articles) nnvirtual-mapping)) + (nconc (assoc (nth 1 m) groups) (list (nth 2 m)))) + (while groups + (gnus-update-read-articles (caar groups) (cdr (pop groups)))))) + (defsubst nnvirtual-marks (article marks) "Return a list of mark types for ARTICLE." (let (out) *************** *** 385,433 **** (defun nnvirtual-create-mapping () "Create an article mapping for the current group." ! (let* (div m marks list article (map (sort (apply 'nconc (mapcar (lambda (g) ! (let* ((active (or (gnus-active g) (gnus-activate-group g))) ! (unreads (and active (gnus-list-of-unread-articles ! g))) ! (marks (gnus-uncompress-marks ! (gnus-info-marks (gnus-get-info g))))) ! (when active ! (when gnus-use-cache ! (push (cons 'cache (gnus-cache-articles-in-group g)) ! marks)) ! (when active ! (setq div (/ (float (car active)) ! (if (zerop (cdr active)) ! 1 (cdr active)) )) ! (mapcar (lambda (n) ! (list (* div (- n (car active))) ! g n (and (memq n unreads) t) ! (nnvirtual-marks n marks))) ! (gnus-uncompress-range active)))))) ! nnvirtual-component-groups)) (lambda (m1 m2) (< (car m1) (car m2))))) (i 0)) (setq nnvirtual-mapping map) ! ;; Nix out any old marks. ! (let ((marks gnus-article-mark-lists)) ! (set (intern (format "gnus-newsgroup-%s" (car (pop marks)))) nil)) ! ;; Copy in all marks from the component groups. (while (setq m (pop map)) ! (setcar m (setq article (incf i))) ! (when (setq marks (nth 4 m)) ! (while marks ! (set (setq list ! (intern (concat "gnus-newsgroup-" ! (symbol-name ! (car (rassq (pop marks) ! gnus-article-mark-lists)))))) ! (cons article (symbol-value list)))))))) (provide 'nnvirtual) --- 408,444 ---- (defun nnvirtual-create-mapping () "Create an article mapping for the current group." ! (let* ((div nil) ! m marks list article unreads marks active (map (sort (apply 'nconc (mapcar (lambda (g) ! (when (setq active (or (gnus-active g) ! (gnus-activate-group g))) ! (setq unreads (gnus-list-of-unread-articles g) ! marks (gnus-uncompress-marks ! (gnus-info-marks (gnus-get-info g)))) ! (when gnus-use-cache ! (push (cons 'cache (gnus-cache-articles-in-group g)) ! marks)) ! (setq div (/ (float (car active)) ! (if (zerop (cdr active)) ! 1 (cdr active)) )) ! (mapcar (lambda (n) ! (list (* div (- n (car active))) ! g n (and (memq n unreads) t) ! (inline (nnvirtual-marks n marks)))) ! (gnus-uncompress-range active)))) ! nnvirtual-component-groups)) (lambda (m1 m2) (< (car m1) (car m2))))) (i 0)) (setq nnvirtual-mapping map) ! ;; Set the virtual article numbers. (while (setq m (pop map)) ! (setcar m (setq article (incf i)))))) (provide 'nnvirtual) *** pub/sgnus/lisp/ChangeLog Wed Apr 3 22:50:31 1996 --- sgnus/lisp/ChangeLog Fri Apr 5 23:53:26 1996 *************** *** 1,4 **** --- 1,84 ---- + Fri Apr 5 23:51:17 1996 Lars Magne Ingebrigtsen + + * message.el (message-send-and-exit): Don't bury buffer on + unsucessful sending. + + Fri Apr 5 21:10:55 1996 Jens Lautenbacher + + * gnus-vis.el (gnus-group-make-menu-bar): Grey out certain items. + + Fri Apr 5 20:05:19 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-default-level): Would set + `gnus-group-default-list-level'. + + * gnus-score.el: Don't require gnus-scomo. + + * gnus-msg.el (gnus-inews-do-gcc): Remove mail header separator. + + * nndir.el (nndir-execute-nnml-command): Would set nnml + directory. + + * nnvirtual.el (nnvirtual-request-update-info): Would infloop. + + Fri Apr 5 17:53:08 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-best-unread-article): Return a proper + value. + (gnus-summary-read-group): Wouldn't configure windows properly + when the first article was canceled. + + * nnvirtual.el (nnvirtual-create-mapping): Inline function. + (nnvirtual-create-mapping): Don't set the marks lists. + (nnvirtual-possibly-change-group): Would add groups twice, + possibly. + (nnvirtual-update-reads): New function. + + Thu Apr 4 21:07:53 1996 Lars Magne Ingebrigtsen + + * nnspool.el (nnspool-inews-switches): Changed default back. + + * nnsoup.el (nnsoup-narrow-to-article): Would choke on fetching + non-existent articles. + (nnsoup-store-reply): Handle courtesy copies. + + Thu Apr 4 21:01:53 1996 Greg Stark + + * nnmail.el (nnmail-process-babyl-mail-format): Would parse empty + mails badly. + + Thu Apr 4 03:37:56 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-servers-using-backend): New function. + (gnus-summary-respool-article): Use real methods instead of + backend names. + (gnus-summary-move-article): Use the method. + + * message.el (timezone): Require timezone. + (message-setup): Insert the separator before generating headers. + (message-goto-signature): Goto point-max if there is no signature + separator. + + * gnus.el (gnus-article-date-ut): Don't call + `gnus-article-highlight-headers'. + (gnus-server-get-method): Return the native select method when + needed. + + Thu Apr 4 03:12:04 1996 Richard Mlynarik + + * gnus-kill.el (gnus-apply-kill-file-unless-scored): New + function. + + Thu Apr 4 01:59:18 1996 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Don't do the mailalias thing. + (message-fill-header): Would fill long Message-IDs badly. + + * gnus.el (gnus-group-faq-directory): Wrong paths. + Wed Apr 3 18:23:35 1996 Lars Magne Ingebrigtsen + + * gnus.el: September Gnus v0.63 is released. * message.el (message-insert-newsgroups): Capitilize Newsgroups. *** pub/sgnus/texi/gnus.texi Wed Apr 3 22:50:33 1996 --- sgnus/texi/gnus.texi Fri Apr 5 22:55:26 1996 *************** *** 432,440 **** killed. Your system administrator should have set this variable to something useful. ! Since she hasn't, Gnus will just subscribe you to a few randomly picked ! groups (i.e., @samp{*.newusers}). (@dfn{Random} is here defined as ! @dfn{whatever Lars thinks you should read}.) You'll also be subscribed to the Gnus documentation group, which should help you with most common problems. --- 432,440 ---- killed. Your system administrator should have set this variable to something useful. ! Since she hasn't, Gnus will just subscribe you to a few arbitrarily ! picked groups (i.e., @samp{*.newusers}). (@dfn{Arbitrary} is here ! defined as @dfn{whatever Lars thinks you should read}.) You'll also be subscribed to the Gnus documentation group, which should help you with most common problems. *************** *** 1618,1624 **** @item G D @kindex G D (Group) @findex gnus-group-enter-directory ! Read a random directory as if with were a newsgroup with the @code{nneething} backend (@code{gnus-group-enter-directory}). @item G f --- 1618,1624 ---- @item G D @kindex G D (Group) @findex gnus-group-enter-directory ! Read an arbitrary directory as if with were a newsgroup with the @code{nneething} backend (@code{gnus-group-enter-directory}). @item G f *************** *** 1765,1771 **** put the admin address somewhere convenient. @item comment ! This parameter allows you to enter a random comment on the group. @item @var{(variable form)} You can use the group parameters to set variables local to the group you --- 1765,1771 ---- put the admin address somewhere convenient. @item comment ! This parameter allows you to enter a arbitrary comment on the group. @item @var{(variable form)} You can use the group parameters to set variables local to the group you *************** *** 5753,5759 **** @item B i @kindex B i (Summary) @findex gnus-summary-import-article ! Import a random file into the current mail newsgroup (@code{gnus-summary-import-article}). You will be prompted for a file name, a @code{From} header and a @code{Subject} header. --- 5753,5759 ---- @item B i @kindex B i (Summary) @findex gnus-summary-import-article ! Import an arbitrary file into the current mail newsgroup (@code{gnus-summary-import-article}). You will be prompted for a file name, a @code{From} header and a @code{Subject} header. *************** *** 7269,7280 **** any case, if this returns a non-@code{nil} value, then the style is said to @dfn{match}. ! Each style may contain a random amount of @dfn{attributes}. Each ! attribute consists of a @var{(name . value)} pair. The attribute name ! can be one of @code{signature}, @code{organization} or @code{from}. ! The attribute name can also be a string. In that case, this will be ! used as a header name, and the value will be inserted in the headers of ! the article. The attribute value can be a string (used verbatim), a function (the return value will be used), a variable (its value will be used) or a --- 7269,7280 ---- any case, if this returns a non-@code{nil} value, then the style is said to @dfn{match}. ! Each style may contain a arbitrary amount of @dfn{attributes}. Each ! attribute consists of a @var{(name . value)} pair. The attribute name ! can be one of @code{signature}, @code{organization} or @code{from}. The ! attribute name can also be a string. In that case, this will be used as ! a header name, and the value will be inserted in the headers of the ! article. The attribute value can be a string (used verbatim), a function (the return value will be used), a variable (its value will be used) or a *************** *** 7574,7581 **** backend, and the second is the @dfn{address}, or @dfn{name}, if you will. ! After these two elements, there may be a random number of @var{(variable ! form)} pairs. To go back to the first example---imagine that you want to read from port @code{15} from that machine. This is what the select method should --- 7574,7581 ---- backend, and the second is the @dfn{address}, or @dfn{name}, if you will. ! After these two elements, there may be a arbitrary number of ! @var{(variable form)} pairs. To go back to the first example---imagine that you want to read from port @code{15} from that machine. This is what the select method should *************** *** 8861,8867 **** From the @code{nndir} backend (which reads a single spool-like directory), it's just a hop and a skip to @code{nneething}, which ! pretends that any random directory is a newsgroup. Strange, but true. When @code{nneething} is presented with a directory, it will scan this directory and assign article numbers to each file. When you enter such --- 8861,8868 ---- From the @code{nndir} backend (which reads a single spool-like directory), it's just a hop and a skip to @code{nneething}, which ! pretends that any arbitrary directory is a newsgroup. Strange, but ! true. When @code{nneething} is presented with a directory, it will scan this directory and assign article numbers to each file. When you enter such *************** *** 8870,8878 **** forgetting. @code{nneething} does this in a two-step process. First, it snoops each file in question. If the file looks like an article (i.e., the first few lines look like headers), it will use this as the head. ! If this is just some random file without a head (eg. a C source file), ! @code{nneething} will cobble up a header out of thin air. It will use ! file ownership, name and date and do whatever it can with these elements. All this should happen automatically for you, and you will be presented --- 8871,8879 ---- forgetting. @code{nneething} does this in a two-step process. First, it snoops each file in question. If the file looks like an article (i.e., the first few lines look like headers), it will use this as the head. ! If this is just some arbitrary file without a head (eg. a C source ! file), @code{nneething} will cobble up a header out of thin air. It ! will use file ownership, name and date and do whatever it can with these elements. All this should happen automatically for you, and you will be presented *************** *** 9851,9858 **** entries will result in new score entries being added for all follow-ups to articles that matches these score entries. ! Following this key is a random number of score entries, where each score ! entry has one to four elements. @enumerate @item --- 9852,9859 ---- entries will result in new score entries being added for all follow-ups to articles that matches these score entries. ! Following this key is a arbitrary number of score entries, where each ! score entry has one to four elements. @enumerate @item *************** *** 10089,10095 **** As you see, each element in this alist has a mark as a key (either a variable name or a ``real'' mark---a character). Following this key is ! a random number of header/score pairs. If there are no header/score pairs following the key, no adaptive scoring will be done on articles that have that key as the article mark. For instance, articles with @code{gnus-unread-mark} in the example above will not get adaptive score --- 10090,10096 ---- As you see, each element in this alist has a mark as a key (either a variable name or a ``real'' mark---a character). Following this key is ! a arbitrary number of header/score pairs. If there are no header/score pairs following the key, no adaptive scoring will be done on articles that have that key as the article mark. For instance, articles with @code{gnus-unread-mark} in the example above will not get adaptive score *************** *** 10399,10407 **** @item gnus-apply-kill-hook @vindex gnus-apply-kill-hook A hook called to apply kill files to a group. It is ! @code{(gnus-apply-kill-file)} by default. If you don't want kill files ! to be processed, you should set this variable to @code{nil}. @item gnus-kill-file-mode-hook @vindex gnus-kill-file-mode-hook --- 10400,10412 ---- @item gnus-apply-kill-hook @vindex gnus-apply-kill-hook + @findex gnus-apply-kill-file-unless-scored + @findex gnus-apply-kill-file A hook called to apply kill files to a group. It is ! @code{(gnus-apply-kill-file)} by default. If you want to ignore the ! kill file if you have a score file for the same group, you can set this ! hook to @code{(gnus-apply-kill-file-unless-scored)}. If you don't want ! kill files to be processed, you should set this variable to @code{nil}. @item gnus-kill-file-mode-hook @vindex gnus-kill-file-mode-hook *************** *** 10576,10582 **** Note that the @samp{%(} specs (and friends) do not make any sense on the mode-line variables. ! All these format variables can also be random elisp forms. In that case, they will be @code{eval}ed to insert the required lines. @kindex M-x gnus-update-format --- 10581,10587 ---- Note that the @samp{%(} specs (and friends) do not make any sense on the mode-line variables. ! All these format variables can also be arbitrary elisp forms. In that case, they will be @code{eval}ed to insert the required lines. @kindex M-x gnus-update-format *************** *** 12951,12957 **** Emacs is the King of Editors because it's really a Lisp interpreter. Each and every key you tap runs some Emacs Lisp code snippet, and since Emacs Lisp is an interpreted language, that means that you can configure ! any key to run any random code. You just, like, do it. Gnus is written in Emacs Lisp, and is run as a bunch of interpreted functions. (These are byte-compiled for speed, but it's still --- 12956,12962 ---- Emacs is the King of Editors because it's really a Lisp interpreter. Each and every key you tap runs some Emacs Lisp code snippet, and since Emacs Lisp is an interpreted language, that means that you can configure ! any key to run any arbitrary code. You just, like, do it. Gnus is written in Emacs Lisp, and is run as a bunch of interpreted functions. (These are byte-compiled for speed, but it's still