diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/ChangeLog dgnus/lisp/ChangeLog *** pub/dgnus/lisp/ChangeLog Tue Apr 25 13:56:28 1995 --- dgnus/lisp/ChangeLog Wed Apr 26 16:45:59 1995 *************** *** 1,3 **** --- 1,80 ---- + Wed Apr 26 15:57:28 1995 Lars Magne Ingebrigtsen + + * gnus-message.el (gnus-inews-check-post): Would warn about too + long lines when the last line didn't have a newline. + + * gnus-score.el (gnus-score-string): Would loop forever on empty + matches. + + Wed Apr 26 15:08:00 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-groups-to-gnus-format): Would ding on non-existant + groups. + (gnus-summary-next-group): Did not keep pint in group buffer + updated. + + Wed Apr 26 14:42:17 1995 Lars Magne Ingebrigtsen + + * nntp.el (nntp-request-article): Would sometime deliver the wrong + article in async mode. + + Wed Apr 26 10:08:36 1995 Lars Ingebrigtsen + + * gnus-message.el (gnus-summary-post-forward): New command and + keystroke. + + * gnus-uu.el (gnus-uu-digest-mail-forward): Name change. + (gnus-uu-digest-post-forward): New command and keystroke. + + * nntp.el (nntp-open-server): Refuse to connect to servers that + have previously timed out. + + * gnus.el (gnus-summary-next-group): Allow 0 as a pointer to go to + the next group. + (gnus-group-edit-group): All group editing functions have changed. + + Tue Apr 25 20:35:40 1995 Lars Ingebrigtsen + + * gnus.el (gnus-summary-exit-no-update): Go to the right (next) + group on all kinds of exits. + (gnus-article-mode-map): Slight improvement in the duplicated + keystrokes. + + Tue Apr 25 16:33:58 1995 Lars Magne Ingebrigtsen + + * nnspool.el (nnspool-sift-nov-with-sed): New function. + (nnspool-sift-nov-with-sed): New variable. + + * gnus-score.el (gnus-score-remove-lines-adaptive): New function. + + * gnus.el (gnus-summary-remove-lines-marked-with): Do the adaptive + thing. + + * gnus-score.el (gnus-score-string): Allow exact matches. + (gnus-score-adaptive): Use exact matches. + + * gnus.el (gnus-article-de-quoted-unreadable): Replaced with Per's + functions. + + * gnus-score.el (gnus-default-adaptive-score-alist): Name change. + + Tue Apr 25 14:20:52 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-insert-pseudos): Didn't treat + pseudos-separately properly. + + Tue Apr 25 15:08:38 1995 Scott Byer + + * nnmail.el (nnmail-request-post-buffer) changed how this function + deals with the list form of follow-to. Before calling mail-setup, + it now gathers and strips out of the list all "To" headers, and + calls mail-setup with that collection. This avoids the nasty + empty To: field problem. Also made sure that additional fields + are inserted after the To: field. + + * gnus-message.el (gnus-mail-reply-using-mail) Added the same fix + for replying. + Tue Apr 25 12:54:28 1995 Lars Magne Ingebrigtsen * gnus.el (gnus-valid-select-methods): nnvirtual groups should not *************** *** 5,10 **** --- 82,89 ---- (gnus-article-prepare): When trying to refer an article that didn't exist, the current article pointers would become confused. (gnus-summary-line-format-alist): Make sure `thread' is defined. + + * gnus.el: 0.59 is released. Mon Apr 24 10:50:09 1995 Scott Byer diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-message.el dgnus/lisp/gnus-message.el *** pub/dgnus/lisp/gnus-message.el Tue Apr 25 13:56:22 1995 --- dgnus/lisp/gnus-message.el Wed Apr 26 16:46:00 1995 *************** *** 39,44 **** --- 39,64 ---- (defvar gnus-post-news-buffer "*post-news*") (defvar gnus-winconf-post-news nil) + (defvar gnus-summary-send-map nil) + + (define-prefix-command 'gnus-summary-send-map) + (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) + (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) + (define-key gnus-summary-send-map "f" 'gnus-summary-followup) + (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) + (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) + (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) + (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) + (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) + (define-key gnus-summary-send-map "r" 'gnus-summary-reply) + (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) + (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) + (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) + (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward) + (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward) + (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward) + (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward) + ;;; Post news commands of Gnus group mode and summary mode (defun gnus-group-post-news () *************** *** 186,192 **** ;;;###autoload (fset 'postnews 'gnus-post-news) ! (defun gnus-post-news (post &optional group header article-buffer yank) "Begin editing a new USENET news article to be posted. Type \\[describe-mode] in the buffer to get a list of commands." (interactive (list t)) --- 206,212 ---- ;;;###autoload (fset 'postnews 'gnus-post-news) ! (defun gnus-post-news (post &optional group header article-buffer yank subject) "Begin editing a new USENET news article to be posted. Type \\[describe-mode] in the buffer to get a list of commands." (interactive (list t)) *************** *** 206,219 **** (set-buffer gnus-summary-buffer) (cons (current-buffer) gnus-current-article)))) (from (and header (header-from header))) ! subject follow-to real-group) (and gnus-interactive-post (not gnus-expert-user) post (not group) (progn (setq group (completing-read "Group: " gnus-active-hashtb)) ! (setq subject (read-string "Subject: ")))) (setq mail-reply-buffer article-buffer) (let ((gnus-newsgroup-name (or group gnus-newsgroup-name ""))) --- 226,240 ---- (set-buffer gnus-summary-buffer) (cons (current-buffer) gnus-current-article)))) (from (and header (header-from header))) ! follow-to real-group) (and gnus-interactive-post (not gnus-expert-user) post (not group) (progn (setq group (completing-read "Group: " gnus-active-hashtb)) ! (or subject ! (setq subject (read-string "Subject: "))))) (setq mail-reply-buffer article-buffer) (let ((gnus-newsgroup-name (or group gnus-newsgroup-name ""))) *************** *** 517,522 **** --- 538,544 ---- (< (current-column) 80)) (zerop (forward-line 1)))) (or (bolp) + (eobp) (gnus-yes-or-no-p (format "You have lines longer than 79 characters. Really post? ")))) *************** *** 1019,1028 **** (interactive) (gnus-summary-reply t)) ! (defun gnus-summary-mail-forward () "Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." ! (interactive) (gnus-summary-select-article t) (setq gnus-winconf-post-news (current-window-configuration)) (if gnus-split-window --- 1041,1050 ---- (interactive) (gnus-summary-reply t)) ! (defun gnus-summary-mail-forward (post) "Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." ! (interactive "P") (gnus-summary-select-article t) (setq gnus-winconf-post-news (current-window-configuration)) (if gnus-split-window *************** *** 1032,1040 **** (delete-other-windows) (bury-buffer gnus-article-buffer)) (let ((gnus-newsgroup-name gnus-newsgroup-name)) ! (funcall gnus-mail-forward-method)) (gnus-article-hide-headers-if-wanted)) (defun gnus-summary-mail-other-window () "Compose mail in other window. Customize the variable `gnus-mail-other-window-method' to use another --- 1054,1069 ---- (delete-other-windows) (bury-buffer gnus-article-buffer)) (let ((gnus-newsgroup-name gnus-newsgroup-name)) ! (if post ! (gnus-forward-using-post) ! (funcall gnus-mail-forward-method))) (gnus-article-hide-headers-if-wanted)) + (defun gnus-summary-post-forward () + "Forward the current article to a newsgroup." + (interactive) + (gnus-summary-mail-forward t)) + (defun gnus-summary-mail-other-window () "Compose mail in other window. Customize the variable `gnus-mail-other-window-method' to use another *************** *** 1051,1057 **** (group (gnus-group-real-name gnus-newsgroup-name)) (cur (cons (current-buffer) (cdr gnus-article-current))) from subject date to reply-to message-of ! references message-id sender follow-to cc) (set-buffer (get-buffer-create "*mail*")) (mail-mode) (make-local-variable 'gnus-article-reply) --- 1080,1086 ---- (group (gnus-group-real-name gnus-newsgroup-name)) (cur (cons (current-buffer) (cdr gnus-article-current))) from subject date to reply-to message-of ! references message-id sender follow-to cc sendto elt) (set-buffer (get-buffer-create "*mail*")) (mail-mode) (make-local-variable 'gnus-article-reply) *************** *** 1097,1109 **** (widen)) (setq news-reply-yank-from from) (setq news-reply-yank-message-id message-id) (mail-setup (or to-address ! (if (and follow-to (not (stringp follow-to))) "" (or follow-to reply-to from sender ""))) subject message-of nil gnus-article-buffer nil) (if (and follow-to (listp follow-to)) (progn (goto-char (point-min)) (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") (setq follow-to (cdr follow-to))))) --- 1126,1150 ---- (widen)) (setq news-reply-yank-from from) (setq news-reply-yank-message-id message-id) + + ;; Gather the "to" addresses out of the follow-to list and remove + ;; them as we go. + (if (and follow-to (listp follow-to)) + (while (setq elt (assoc "To" follow-to)) + (setq sendto (concat sendto (and sendto ", ") (cdr elt))) + (setq follow-to (delq elt follow-to)))) + (mail-setup (or to-address ! (if (and follow-to (not (stringp follow-to))) sendto (or follow-to reply-to from sender ""))) subject message-of nil gnus-article-buffer nil) + (if (and follow-to (listp follow-to)) (progn (goto-char (point-min)) + (re-search-forward "^To:" nil t) + (beginning-of-line) + (forward-line 1) (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") (setq follow-to (cdr follow-to))))) *************** *** 1161,1204 **** (set-window-configuration gnus-winconf-post-news)) (setq gnus-winconf-post-news nil))))) (defun gnus-mail-forward-using-mail () "Forward the current message to another user using mail." ;; This is almost a carbon copy of rmail-forward in rmail.el. (let ((forward-buffer (current-buffer)) ! (subject ! (concat "[" (if (memq 'mail (assoc (symbol-name ! (car (gnus-find-method-for-group ! gnus-newsgroup-name))) ! gnus-valid-select-methods)) ! (gnus-fetch-field "From") ! gnus-newsgroup-name) ! "] " (or (gnus-fetch-field "Subject") ""))) ! beg) ! ;; If only one window, use it for the mail buffer. ! ;; Otherwise, use another window for the mail buffer ! ;; so that the Rmail buffer remains visible ! ;; and sending the mail will get back to it. (if (if (one-window-p t) (mail nil nil subject) (mail-other-window nil nil subject)) (save-excursion (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) ! (setq beg (goto-char (point-max))) ! (insert "------- Start of forwarded message -------\n") ! (insert-buffer forward-buffer) ! (goto-char (point-max)) ! (insert "------- End of forwarded message -------\n") ! ;; Suggested by Sudish Joseph . ! (goto-char beg) ! (while (setq beg (next-single-property-change (point) 'invisible)) ! (goto-char beg) ! (delete-region beg (or (next-single-property-change ! (point) 'invisible) ! (point-max)))) ;; You have a chance to arrange the message. (run-hooks 'gnus-mail-forward-hook))))) (defun gnus-mail-other-window-using-mail () "Compose mail other window using mail." (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) --- 1202,1257 ---- (set-window-configuration gnus-winconf-post-news)) (setq gnus-winconf-post-news nil))))) + (defun gnus-forward-make-subject () + (concat "[" (if (memq 'mail (assoc (symbol-name + (car (gnus-find-method-for-group + gnus-newsgroup-name))) + gnus-valid-select-methods)) + (gnus-fetch-field "From") + gnus-newsgroup-name) + "] " (or (gnus-fetch-field "Subject") ""))) + + (defun gnus-forward-insert-buffer (buffer) + (let ((beg (goto-char (point-max)))) + (insert "------- Start of forwarded message -------\n") + (insert-buffer buffer) + (goto-char (point-max)) + (insert "------- End of forwarded message -------\n") + ;; Suggested by Sudish Joseph . + (goto-char beg) + (while (setq beg (next-single-property-change (point) 'invisible)) + (goto-char beg) + (delete-region beg (or (next-single-property-change + (point) 'invisible) + (point-max)))))) + (defun gnus-mail-forward-using-mail () "Forward the current message to another user using mail." ;; This is almost a carbon copy of rmail-forward in rmail.el. (let ((forward-buffer (current-buffer)) ! (subject (gnus-forward-make-subject))) ! ;; If only one window, use it for the mail buffer. Otherwise, use ! ;; another window for the mail buffer so that the Rmail buffer ! ;; remains visible and sending the mail will get back to it. (if (if (one-window-p t) (mail nil nil subject) (mail-other-window nil nil subject)) (save-excursion (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) ! (gnus-forward-insert-buffer forward-buffer) ;; You have a chance to arrange the message. (run-hooks 'gnus-mail-forward-hook))))) + (defun gnus-forward-using-post () + (let ((forward-buffer (current-buffer)) + (subject (gnus-forward-make-subject))) + (gnus-post-news 'post nil nil nil nil subject) + (save-excursion + (gnus-forward-insert-buffer forward-buffer) + ;; You have a chance to arrange the message. + (run-hooks 'gnus-mail-forward-hook)))) + (defun gnus-mail-other-window-using-mail () "Compose mail other window using mail." (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) *************** *** 1207,1210 **** (provide 'gnus-message) ! ;;; gnus-message.el ends here \ No newline at end of file --- 1260,1263 ---- (provide 'gnus-message) ! ;;; gnus-message.el ends here diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-mh.el dgnus/lisp/gnus-mh.el *** pub/dgnus/lisp/gnus-mh.el Tue Apr 25 13:56:22 1995 --- dgnus/lisp/gnus-mh.el Wed Apr 26 16:13:36 1995 *************** *** 102,108 **** gnus-user-login-name))) (setq cc (concat (if cc (concat cc ", ") "") orig-to)) ) ! ;; (setq mh-show-buffer buffer) )) ;; save excursion/restriction (mh-find-path) --- 102,110 ---- gnus-user-login-name))) (setq cc (concat (if cc (concat cc ", ") "") orig-to)) ) ! ;; mh-yank-cur-msg needs to have mh-show-buffer set in the ! ;; *Article* buffer ! (setq mh-show-buffer buffer) )) ;; save excursion/restriction (mh-find-path) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-score.el dgnus/lisp/gnus-score.el *** pub/dgnus/lisp/gnus-score.el Tue Apr 25 13:56:22 1995 --- dgnus/lisp/gnus-score.el Wed Apr 26 15:59:57 1995 *************** *** 30,42 **** (defvar gnus-score-expiry-days 7 "*Number of days before unused score file entries are expired.") - (defvar gnus-score-interactive-default-score 1000 - "*Scoring commands will raise/lower the score with this number as the default.") - (defvar gnus-orphan-score nil "*All orphans get this score added. Set in the score file.") ! (defvar gnus-adaptive-score-alist '((gnus-unread-mark) (gnus-ticked-mark (from 4)) (gnus-dormant-mark (from 5)) --- 30,39 ---- (defvar gnus-score-expiry-days 7 "*Number of days before unused score file entries are expired.") (defvar gnus-orphan-score nil "*All orphans get this score added. Set in the score file.") ! (defvar gnus-default-adaptive-score-alist '((gnus-unread-mark) (gnus-ticked-mark (from 4)) (gnus-dormant-mark (from 5)) *************** *** 54,59 **** --- 51,58 ---- (defvar gnus-current-score-file nil) + (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) + (defvar gnus-score-alist nil "Alist containing score information. The keys can be symbols or strings. The following symbols are defined. *************** *** 436,443 **** (defun gnus-summary-lower-followups-to-author (level) "Lower score by LEVEL for all followups to the current author." (interactive "P") ! (gnus-summary-raise-followups-to-author ! (- (gnus-score-default level)))) (defun gnus-summary-temporarily-raise-by-subject (level) "Temporarily raise score by LEVEL for current subject. --- 435,442 ---- (defun gnus-summary-lower-followups-to-author (level) "Lower score by LEVEL for all followups to the current author." (interactive "P") ! (gnus-summary-score-entry "followup" (gnus-summary-header "from") ! nil level (current-time-string) t t)) (defun gnus-summary-temporarily-raise-by-subject (level) "Temporarily raise score by LEVEL for current subject. *************** *** 514,524 **** (defun gnus-summary-raise-followups-to-author (level) "Raise score by LEVEL for all followups to the current author." (interactive "P") ! (let ((article (gnus-summary-article-number))) ! (if article (setq gnus-current-headers (gnus-get-header-by-number article)) ! (error "No article on current line"))) ! (gnus-kill-file-raise-followups-to-author ! (gnus-score-default level))) --- 513,520 ---- (defun gnus-summary-raise-followups-to-author (level) "Raise score by LEVEL for all followups to the current author." (interactive "P") ! (gnus-summary-score-entry "followup" (gnus-summary-header "from") ! nil level (current-time-string) t t)) *************** *** 549,558 **** (gnus-score-set 'expunge (list score)) (gnus-score-set 'touched '(t))) - (defun gnus-score-default (level) - (if level (prefix-numeric-value level) - gnus-score-interactive-default-score)) - (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. (let* ((alist --- 545,550 ---- *************** *** 656,661 **** --- 648,654 ---- (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) (orphan (gnus-score-get 'orphan alist)) + (adapt (gnus-score-get 'adapt alist)) (eval (gnus-score-get 'eval alist))) ;; We do not respect eval and files atoms from global score ;; files. *************** *** 667,672 **** --- 660,672 ---- (and eval (not global) (eval eval)) (setq gnus-scores-exclude-files exclude-files) (if orphan (setq gnus-orphan-score (car orphan))) + (setq gnus-adaptive-score-alist + (cond ((eq adapt t) + gnus-default-adaptive-score-alist) + ((eq adapt 'ignore) + nil) + ((consp adapt) + adapt))) (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) (setq gnus-summary-expunge-below *************** *** 1125,1130 **** --- 1125,1223 ---- (setq entries rest))))) (setq articles (cdr articles))))))) + + + (defun gnus-score-followup (scores header now expire) + ;; Insert the unique article headers in the buffer. + (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) + ;; gnus-score-index is used as a free variable. + alike last this art entries alist articles) + + (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) + articles gnus-scores-articles) + + (erase-buffer) + (while articles + (setq art (car articles) + this (aref (car art) gnus-score-index) + articles (cdr articles)) + (if (equal last this) + (setq alike (cons art alike)) + (if last + (progn + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike))) + (setq alike (list art) + last this))) + (and last ; Bwadr, duplicate code. + (progn + (insert last ?\n) + (put-text-property (1- (point)) (point) 'articles alike))) + + ;; Find matches. + (while scores + (setq alist (car scores) + scores (cdr scores) + entries (assoc header alist)) + (while (cdr entries) ;First entry is the header index. + (let* ((rest (cdr entries)) + (kill (car rest)) + (match (nth 0 kill)) + (type (or (nth 3 kill) 's)) + (score (or (nth 1 kill) gnus-score-interactive-default-score)) + (date (nth 2 kill)) + (found nil) + (mt (aref (symbol-name type) 0)) + (case-fold-search + (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) + (dmt (downcase mt)) + (search-func + (cond ((= dmt ?r) 're-search-forward) + ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) + (t (error "Illegal match type: %s" type)))) + arts art) + (goto-char (point-min)) + (if (= dmt ?e) + (while (funcall search-func match nil t) + (and (= (progn (beginning-of-line) (point)) + (match-beginning 0)) + (= (progn (end-of-line) (point)) + (match-end 0)) + (progn + (setq found (setq arts (get-text-property + (point) 'articles))) + ;; Found a match, update scores. + (while arts + (setq art (car arts) + arts (cdr arts)) + (gnus-score-add-followups (car art)))))) + (while (funcall search-func match nil t) + (end-of-line) + (setq found (setq arts (get-text-property (point) 'articles))) + ;; Found a match, update scores. + (while arts + (setq art (car arts) + arts (cdr arts)) + (gnus-score-add-followups (car art))))) + ;; Update expire date + (cond ((null date)) ;Permanent entry. + (found ;Match, update date. + (gnus-score-set 'touched '(t) alist) + (setcar (nthcdr 2 kill) now)) + ((< date expire) ;Old entry, remove. + (gnus-score-set 'touched '(t) alist) + (setcdr entries (cdr rest)) + (setq rest entries))) + (setq entries rest)))))) + + (defun gnus-score-add-followups (article) + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-score-entry + "references" (gnus-get-header-by-number article) 'e nil + (current-time-string) nil))) + + (defun gnus-score-string (scores header now expire) ;; Score ARTICLES according to HEADER in SCORES. ;; Update matches entries to NOW and remove unmatched entried older *************** *** 1180,1207 **** (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) (case-fold-search ! (not (or (eq type 'R) (eq type 'S) ! (eq type 'Regexp) (eq type 'String)))) ! (search-func (cond ((or (eq type 'r) (eq type 'R) ! (eq type 'regexp) (eq type 'Regexp)) ! 're-search-forward) ! ((or (eq type 's) (eq type 'S) ! (eq type 'string) (eq type 'String)) ! 'search-forward) ! (t ! (error "Illegal match type: %s" type)))) arts art) (goto-char (point-min)) ! (while (funcall search-func match nil t) ! (end-of-line 1) ! (setq found t ! arts (get-text-property (point) 'articles)) ! ;; Found a match, update scores. ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art))))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. --- 1273,1312 ---- (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) + (mt (aref (symbol-name type) 0)) (case-fold-search ! (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) ! (dmt (downcase mt)) ! (search-func ! (cond ((= dmt ?r) 're-search-forward) ! ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ! (t (error "Illegal match type: %s" type)))) arts art) (goto-char (point-min)) ! (if (= dmt ?e) ! (while (and (not (eobp)) (funcall search-func match nil t)) ! (and (= (progn (beginning-of-line) (point)) ! (match-beginning 0)) ! (= (progn (end-of-line) (point)) ! (match-end 0)) ! (progn ! (setq found (setq arts (get-text-property ! (point) 'articles))) ! ;; Found a match, update scores. ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art)))) ! (forward-line 1)))) ! (and (string= match "") (setq match "\n")) ! (while (funcall search-func match nil t) ! (end-of-line) ! (setq found (setq arts (get-text-property (point) 'articles))) ! ;; Found a match, update scores. ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art)))))) ;; Update expire date (cond ((null date)) ;Permanent entry. (found ;Match, update date. *************** *** 1236,1242 **** ("xref" 8 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ! ("all" -1 gnus-score-body))) (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) --- 1341,1348 ---- ("xref" 8 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ! ("all" -1 gnus-score-body) ! ("followup" 2 gnus-score-followup))) (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) *************** *** 1277,1285 **** (while elem (gnus-summary-score-entry (nth 1 (car elem)) (funcall (car (car elem)) headers) ! 's (nth 2 (car elem)) date nil t) (setq elem (cdr elem)))) (forward-line 1))))) ;;; ;;; Score mode. --- 1383,1429 ---- (while elem (gnus-summary-score-entry (nth 1 (car elem)) (funcall (car (car elem)) headers) ! 'e (nth 2 (car elem)) date nil t) (setq elem (cdr elem)))) (forward-line 1))))) + + (defun gnus-score-remove-lines-adaptive (marks) + (save-excursion + (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) + (alist malist) + (date (current-time-string)) + elem headers) + ;; First we transform the adaptive rule alist into something + ;; that's faster to process. + (while malist + (setq elem (car malist)) + (if (symbolp (car elem)) + (setcar elem (symbol-value (car elem)))) + (setq elem (cdr elem)) + (while elem + (setcdr (car elem) + (cons (symbol-name (car (car elem))) (cdr (car elem)))) + (setcar (car elem) + (intern + (concat "gnus-header-" + (downcase (symbol-name (car (car elem))))))) + (setq elem (cdr elem))) + (setq malist (cdr malist))) + ;; The we score away. + (goto-char (point-min)) + (while (re-search-forward marks nil t) + (beginning-of-line) + (setq elem (cdr (assq (gnus-summary-article-mark) alist))) + (if (not elem) + () + (setq headers (gnus-get-header-by-number + (gnus-summary-article-number))) + (while elem + (gnus-summary-score-entry + (nth 1 (car elem)) (funcall (car (car elem)) headers) + 'e (nth 2 (car elem)) date nil t) + (setq elem (cdr elem)))) + (delete-region (point) (progn (forward-line 1) (point))))))) ;;; ;;; Score mode. diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-uu.el dgnus/lisp/gnus-uu.el *** pub/dgnus/lisp/gnus-uu.el Tue Apr 25 13:56:22 1995 --- dgnus/lisp/gnus-uu.el Wed Apr 26 12:08:52 1995 *************** *** 296,302 **** gnus-uu-default-dir gnus-uu-default-dir))) (setq gnus-uu-saved-article-name file) ! (gnus-uu-decode-with-method 'gnus-uu-save-article n nil) (setq gnus-uu-generated-file-list (delete file gnus-uu-generated-file-list))) --- 296,302 ---- gnus-uu-default-dir gnus-uu-default-dir))) (setq gnus-uu-saved-article-name file) ! (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t) (setq gnus-uu-generated-file-list (delete file gnus-uu-generated-file-list))) *************** *** 362,368 **** ;; Digest and forward articles ! (defun gnus-uu-digest-and-forward (n) "Digests and forwards all articles in this series." (interactive "P") (gnus-uu-initialize) --- 362,368 ---- ;; Digest and forward articles ! (defun gnus-uu-digest-mail-forward (n &optional post) "Digests and forwards all articles in this series." (interactive "P") (gnus-uu-initialize) *************** *** 387,400 **** (progn (delete-region (point) (gnus-point-at-eol)) (insert "Various"))) ! (funcall gnus-mail-forward-method) (kill-buffer buf))) ;; Process marking. (defun gnus-uu-mark-by-regexp (regexp) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles (gnus-summary-set-process-mark (car articles)) --- 387,408 ---- (progn (delete-region (point) (gnus-point-at-eol)) (insert "Various"))) ! (if post ! (gnus-forward-using-post) ! (funcall gnus-mail-forward-method)) (kill-buffer buf))) + (defun gnus-uu-digest-post-forward (n) + "Digest and forward to a newsgroup." + (interactive "P") + (gnus-uu-digest-mail-forward n t)) + ;; Process marking. (defun gnus-uu-mark-by-regexp (regexp) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) + (gnus-set-global-variables) (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles (gnus-summary-set-process-mark (car articles)) *************** *** 405,410 **** --- 413,419 ---- (defun gnus-uu-mark-series () "Mark the current series with the process mark." (interactive) + (gnus-set-global-variables) (let ((articles (gnus-uu-find-articles-matching))) (while articles (gnus-summary-set-process-mark (car articles)) *************** *** 415,420 **** --- 424,430 ---- (defun gnus-uu-mark-region (beg end) "Marks all articles between point and mark." (interactive "r") + (gnus-set-global-variables) (save-excursion (goto-char beg) (while (< (point) end) *************** *** 425,430 **** --- 435,441 ---- (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) + (gnus-set-global-variables) (save-excursion (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) *************** *** 435,450 **** (defun gnus-uu-mark-sparse () "Mark all series that have some articles marked." (interactive) (let ((marked (nreverse gnus-newsgroup-processable)) ! subject articles total) (or marked (error "No articles marked with the process mark")) (setq gnus-newsgroup-processable nil) (save-excursion (while marked ! (setq subject (header-subject (gnus-get-header-by-number (car marked))) ! articles (gnus-uu-find-articles-matching ! (gnus-uu-reginize-string subject)) ! total (nconc total articles)) (while articles (gnus-summary-set-process-mark (car articles)) (setcdr marked (delq (car articles) (cdr marked))) --- 446,463 ---- (defun gnus-uu-mark-sparse () "Mark all series that have some articles marked." (interactive) + (gnus-set-global-variables) (let ((marked (nreverse gnus-newsgroup-processable)) ! subject articles total headers) (or marked (error "No articles marked with the process mark")) (setq gnus-newsgroup-processable nil) (save-excursion (while marked ! (and (setq headers (gnus-get-header-by-number (car marked))) ! (setq subject (header-subject headers) ! articles (gnus-uu-find-articles-matching ! (gnus-uu-reginize-string subject)) ! total (nconc total articles))) (while articles (gnus-summary-set-process-mark (car articles)) (setcdr marked (delq (car articles) (cdr marked))) *************** *** 456,461 **** --- 469,475 ---- (defun gnus-uu-mark-all () "Mark all articles in \"series\" order." (interactive) + (gnus-set-global-variables) (setq gnus-newsgroup-processable nil) (save-excursion (goto-char (point-min)) *************** *** 503,509 **** ;; Internal functions. ! (defun gnus-uu-decode-with-method (method n &optional save) (gnus-uu-initialize) (if save (setq gnus-uu-default-dir save)) (let ((articles (gnus-uu-get-list-of-articles n)) --- 517,523 ---- ;; Internal functions. ! (defun gnus-uu-decode-with-method (method n &optional save not-insert) (gnus-uu-initialize) (if save (setq gnus-uu-default-dir save)) (let ((articles (gnus-uu-get-list-of-articles n)) *************** *** 513,519 **** (setq files (gnus-uu-unpack-files files)) (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files)) (setq files (nreverse (gnus-uu-get-actions files))) ! (gnus-summary-insert-pseudos files))) (defun gnus-uu-save-files (files dir) (let ((len (length files)) --- 527,533 ---- (setq files (gnus-uu-unpack-files files)) (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files)) (setq files (nreverse (gnus-uu-get-actions files))) ! (or not-insert (gnus-summary-insert-pseudos files)))) (defun gnus-uu-save-files (files dir) (let ((len (length files)) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-visual.el dgnus/lisp/gnus-visual.el *** pub/dgnus/lisp/gnus-visual.el Tue Apr 25 13:56:22 1995 --- dgnus/lisp/gnus-visual.el Wed Apr 26 12:08:31 1995 *************** *** 307,314 **** ["Cancel article" gnus-summary-cancel-article t] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ! ["Forward" gnus-summary-mail-forward t] ! ["Digest and forward" gnus-uu-digest-and-forward t] ["Send a mail" gnus-summary-mail-other-window t] ["Reply & followup" gnus-summary-followup-and-reply t] ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] --- 307,316 ---- ["Cancel article" gnus-summary-cancel-article t] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ! ["Mail forward" gnus-summary-mail-forward t] ! ["Post forward" gnus-summary-post-forward t] ! ["Digest and mail" gnus-uu-digest-mail-forward t] ! ["Digest and post" gnus-uu-digest-post-forward t] ["Send a mail" gnus-summary-mail-other-window t] ["Reply & followup" gnus-summary-followup-and-reply t] ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus.el dgnus/lisp/gnus.el *** pub/dgnus/lisp/gnus.el Tue Apr 25 13:56:23 1995 --- dgnus/lisp/gnus.el Wed Apr 26 16:14:15 1995 *************** *** 344,349 **** --- 344,352 ---- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))") + (defvar gnus-score-interactive-default-score 1000 + "*Scoring commands will raise/lower the score with this number as the default.") + (defvar gnus-save-score nil "*If non-nil, save group scoring info.") *************** *** 721,728 **** "*If non-nil, put the article buffer in left-hand side of the window .") (defvar gnus-window-configuration ! '((summary (0 1 0)) ! (newsgroups (1 0 0)) (article (0 3 10))) "*Specify window configurations for each action. The format of the variable is either a list of (ACTION (G S A)), where --- 724,731 ---- "*If non-nil, put the article buffer in left-hand side of the window .") (defvar gnus-window-configuration ! '((newsgroups (1 0 0)) ! (summary (0 1 0)) (article (0 3 10))) "*Specify window configurations for each action. The format of the variable is either a list of (ACTION (G S A)), where *************** *** 1014,1023 **** Ready-mady functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and ! `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). ! ! The latter two only work on threads that have been scored prior to ! entering the newsgroup.") (defvar gnus-thread-score-function '+ "*Function used for calculating the total score of a thread. --- 1017,1023 ---- Ready-mady functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and ! `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") (defvar gnus-thread-score-function '+ "*Function used for calculating the total score of a thread. *************** *** 1279,1287 **** (list ?z 'score-char ?c) (list ?U 'unread ?c) (list ?t '(gnus-summary-number-of-articles-in-thread ! (if (boundp 'thread) (symbol-value 'thread) nil) t) ?d) (list ?e '(gnus-summary-number-of-articles-in-thread ! (if (boundp 'thread) (symbol-value 'thread) nil) t) ?c) (list ?u 'user-defined ?s)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the --- 1279,1287 ---- (list ?z 'score-char ?c) (list ?U 'unread ?c) (list ?t '(gnus-summary-number-of-articles-in-thread ! (if (boundp 'thread) (symbol-value 'thread)) nil) ?d) (list ?e '(gnus-summary-number-of-articles-in-thread ! (if (boundp 'thread) (symbol-value 'thread)) t) ?c) (list ?u 'user-defined ?s)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the *************** *** 1314,1320 **** (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.59" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1314,1320 ---- (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.60" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1507,1512 **** --- 1507,1513 ---- (eval-and-compile (autoload 'metamail-buffer "metamail") (autoload 'Info-goto-node "info") + (autoload 'hexl-hex-string-to-integer "hexl") (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'timezone-fix-time "timezone") *************** *** 1543,1549 **** (autoload 'gnus-uu-mark-series "gnus-uu" nil t) (autoload 'gnus-uu-mark-all "gnus-uu" nil t) (autoload 'gnus-uu-post-news "gnus-uu" nil t) ! (autoload 'gnus-uu-digest-and-forward "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t) --- 1544,1551 ---- (autoload 'gnus-uu-mark-series "gnus-uu" nil t) (autoload 'gnus-uu-mark-all "gnus-uu" nil t) (autoload 'gnus-uu-post-news "gnus-uu" nil t) ! (autoload 'gnus-uu-digest-mail-forward "gnus-uu" nil t) ! (autoload 'gnus-uu-digest-post-forward "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu "gnus-uu" nil t) (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t) *************** *** 1567,1572 **** --- 1569,1575 ---- (autoload 'gnus-kill-file-edit-file "gnus-kill") (autoload 'gnus-kill-file-raise-followups-to-author "gnus-kill") (autoload 'gnus-execute "gnus-kill") + (autoload 'gnus-expunge "gnus-kill") (autoload 'pp "pp") (autoload 'pp-to-string "pp") *************** *** 1579,1585 **** --- 1582,1590 ---- (autoload 'gnus-score-headers "gnus-score") (autoload 'gnus-current-score-file-nondirectory "gnus-score") (autoload 'gnus-score-adaptive "gnus-score") + (autoload 'gnus-score-remove-lines-adaptive "gnus-score") + (autoload 'gnus-summary-send-map "gnus-message" nil nil 'keymap) (autoload 'gnus-group-post-news "gnus-message" nil t) (autoload 'gnus-summary-post-news "gnus-message" nil t) (autoload 'gnus-summary-followup "gnus-message" nil t) *************** *** 1628,1633 **** --- 1633,1639 ---- (funcall (intern "cadr") props) buffer) (remove-text-properties start end ())))))) + ;;; Various macros and substs. (defmacro gnus-eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then returns to original window." *************** *** 1638,1650 **** (,@ forms)) (select-window GnusStartBufferWindow))))) - (defun gnus-make-hashtable (&optional hashsize) - "Make a hash table (default and minimum size is 255). - Optional argument HASHSIZE specifies the table size." - (make-vector (if hashsize - (max (gnus-create-hash-size hashsize) 255) - 255) 0)) - (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable)))) --- 1644,1649 ---- *************** *** 1654,1660 **** (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." ;; We cannot use define-abbrev since it only accepts string as value. ! ; (set (intern string hashtable) value)) (` (set (intern (, string) (, hashtable)) (, value)))) (defsubst gnus-buffer-substring (beg end) --- 1653,1659 ---- (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." ;; We cannot use define-abbrev since it only accepts string as value. ! ;; (set (intern string hashtable) value)) (` (set (intern (, string) (, hashtable)) (, value)))) (defsubst gnus-buffer-substring (beg end) *************** *** 1732,1744 **** (if (search-forward "\n\n") (narrow-to-region 1 (1- (point)))))) - ;; Get a number that is suitable for hashing; bigger than MIN - (defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - (1- i))) - (defun gnus-update-format-specifications () (setq gnus-summary-line-format-spec (gnus-parse-format --- 1731,1736 ---- *************** *** 2132,2137 **** --- 2124,2131 ---- ;; Return subject string. subject)) + ;; Remove any leading "re:"s, any trailing paren phrases, and simplify + ;; all whitespace. (defun gnus-simplify-subject-fuzzy (subject) (let ((case-fold-search t)) (save-excursion *************** *** 2147,2155 **** (replace-match " " t t)) ;; the 'move above makes sure we are at (point-max) (and (= (preceding-char) ? ) ! (delete-char -1)) (buffer-string)))) (defun gnus-add-current-to-buffer-list () (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))) --- 2141,2150 ---- (replace-match " " t t)) ;; the 'move above makes sure we are at (point-max) (and (= (preceding-char) ? ) ! (delete-char -1)) (buffer-string)))) + ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))) *************** *** 2161,2197 **** ;; Functions are more convenient than macros in some cases. (defun gnus-header-number (header) - "Return article number in HEADER." (header-number header)) (defun gnus-header-subject (header) - "Return subject string in HEADER." (header-subject header)) (defun gnus-header-from (header) - "Return author string in HEADER." (header-from header)) (defun gnus-header-xref (header) - "Return xref string in HEADER." (header-xref header)) (defun gnus-header-lines (header) - "Return lines in HEADER." (header-lines header)) (defun gnus-header-date (header) - "Return date in HEADER." (header-date header)) (defun gnus-header-id (header) - "Return Id in HEADER." (header-id header)) (defun gnus-header-references (header) - "Return references in HEADER." (header-references header)) (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. --- 2156,2186 ---- ;; Functions are more convenient than macros in some cases. (defun gnus-header-number (header) (header-number header)) (defun gnus-header-subject (header) (header-subject header)) (defun gnus-header-from (header) (header-from header)) (defun gnus-header-xref (header) (header-xref header)) (defun gnus-header-lines (header) (header-lines header)) (defun gnus-header-date (header) (header-date header)) (defun gnus-header-id (header) (header-id header)) (defun gnus-header-references (header) (header-references header)) + ;;; General various misc type functions. + (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. *************** *** 2223,2228 **** --- 2212,2218 ---- (and gnus-current-startup-file (get-file-buffer gnus-current-startup-file) (kill-buffer (get-file-buffer gnus-current-startup-file))) + ;; Clear the dribble buffer. (gnus-dribble-clear) ;; Kill global KILL file buffer. (if (get-file-buffer (gnus-newsgroup-kill-file nil)) *************** *** 2456,2469 **** (defun gnus-days-between (date1 date2) ;; Return the number of days between date1 and date2. ! (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) ) ! (timezone-parse-date date1))) ! (d2 (mapcar (lambda (s) (and s (string-to-int s)) ) ! (timezone-parse-date date2)))) ! (- (timezone-absolute-from-gregorian ! (nth 1 d1) (nth 2 d1) (car d1)) ! (timezone-absolute-from-gregorian ! (nth 1 d2) (nth 2 d2) (car d2))))) (defun gnus-day-number (date) (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) --- 2446,2452 ---- (defun gnus-days-between (date1 date2) ;; Return the number of days between date1 and date2. ! (- (gnus-day-number date1) (gnus-day-number date2))) (defun gnus-day-number (date) (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) *************** *** 2471,2476 **** --- 2454,2461 ---- (timezone-absolute-from-gregorian (nth 1 dat) (nth 2 dat) (car dat)))) + ;; Returns a floating point number that says how many seconds have + ;; lapsed between Jan 1 12:00:00 1970 and DATE. (defun gnus-seconds-since-epoch (date) (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date date))) *************** *** 2506,2513 **** (yes-or-no-p prompt) (message ""))) ! ;; Return a string of length POS+1 representing NUMber in BASE. The ! ;; resulting string will be left padded with zeds. (defun gnus-number-base-x (num pos base) (if (< pos 0) "" --- 2491,2498 ---- (yes-or-no-p prompt) (message ""))) ! ;; Return a string of length POS+1 representing NUMber in reverse ! ;; BASE. The resulting string will be left padded with zeds. (defun gnus-number-base-x (num pos base) (if (< pos 0) "" *************** *** 2539,2546 **** (nth (1- (string-to-number (aref datevec 1))) timezone-months-assoc)) "???"))))) ! ! ;; List and range functions (defun gnus-last-element (list) "Return last element of LIST." --- 2524,2544 ---- (nth (1- (string-to-number (aref datevec 1))) timezone-months-assoc)) "???"))))) ! ! ;; Make a hash table (default and minimum size is 255). ! ;; Optional argument HASHSIZE specifies the table size. ! (defun gnus-make-hashtable (&optional hashsize) ! (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) ! ! ;; Make a number that is suitable for hashing; bigger than MIN and one ! ;; less than 2^x. ! (defun gnus-create-hash-size (min) ! (let ((i 1)) ! (while (< i min) ! (setq i (* 2 i))) ! (1- i))) ! ! ;;; List and range functions (defun gnus-last-element (list) "Return last element of LIST." *************** *** 3595,3601 **** (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let (info) (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (error "No group on current line")) (setq gnus-winconf-edit-group (current-window-configuration)) --- 3593,3604 ---- (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((done-func (lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done 'part 'group))) ! (part (or part 'info)) ! info) (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (error "No group on current line")) (setq gnus-winconf-edit-group (current-window-configuration)) *************** *** 3604,3612 **** (emacs-lisp-mode) ;; Suggested by Hallvard B Furuseth . (use-local-map (copy-keymap emacs-lisp-mode-map)) ! (local-set-key "\C-c\C-c" 'gnus-group-edit-group-done) (erase-buffer) ! (insert ";; Type `C-c C-c' after you have edited the newsgroup entry.\n\n") (let ((cinfo (gnus-copy-sequence info)) marked) (if (not (setq marked (nth 3 cinfo))) --- 3607,3625 ---- (emacs-lisp-mode) ;; Suggested by Hallvard B Furuseth . (use-local-map (copy-keymap emacs-lisp-mode-map)) ! (local-set-key "\C-c\C-c" done-func) ! ;; We modify the func to let it know what part it is editing. ! (setcar (cdr (nth 4 done-func)) (list 'quote part)) ! (setcar (cdr (cdr (nth 4 done-func))) group) (erase-buffer) ! (insert ! (cond ! ((eq part 'method) ! ";; Type `C-c C-c' after editing the select method.\n\n") ! ((eq part 'params) ! ";; Type `C-c C-c' after editing the group parameters.\n\n") ! ((eq part 'info) ! ";; Type `C-c C-c' after editing the group info.\n\n"))) (let ((cinfo (gnus-copy-sequence info)) marked) (if (not (setq marked (nth 3 cinfo))) *************** *** 3618,3634 **** (setcdr (car marked) (gnus-compress-sequence (sort (cdr (car marked)) '<) t))) (setq marked (cdr marked)))) ! (cond ((eq part 'method) ! (insert ! "(gnus-group-set-method-info \"" group "\"\n " ! (pp-to-string (list 'quote (or (nth 4 info) "native"))) ")\n")) ! ((eq part 'params) ! (insert ! "(gnus-group-set-params-info \"" group "\"\n " ! (pp-to-string (list 'quote (nth 5 info))) ")\n")) ! (t ! (insert (pp-to-string ! (list 'gnus-group-set-info (list 'quote cinfo))))))))) (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." --- 3631,3645 ---- (setcdr (car marked) (gnus-compress-sequence (sort (cdr (car marked)) '<) t))) (setq marked (cdr marked)))) ! (insert ! (pp-to-string ! (cond ((eq part 'method) ! (or (nth 4 info) "native")) ! ((eq part 'params) ! (nth 5 info)) ! (t ! cinfo))) ! "\n")))) (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." *************** *** 3640,3656 **** (interactive (list (gnus-group-group-name))) (gnus-group-edit-group group 'params)) ! (defun gnus-group-edit-group-done () ! (interactive) (set-buffer (get-buffer-create gnus-group-edit-buffer)) ! (eval-current-buffer) ! (kill-buffer (current-buffer)) ! (and gnus-winconf-edit-group ! (set-window-configuration gnus-winconf-edit-group)) ! (setq gnus-winconf-edit-group nil) ! (set-buffer gnus-group-buffer) ! (gnus-group-update-group (gnus-group-group-name)) ! (gnus-group-position-cursor)) (defun gnus-group-make-help-group () "Create the (ding) Gnus documentation group." --- 3651,3671 ---- (interactive (list (gnus-group-group-name))) (gnus-group-edit-group group 'params)) ! (defun gnus-group-edit-group-done (part group) ! "Get info from buffer, update variables and jump to the group buffer." (set-buffer (get-buffer-create gnus-group-edit-buffer)) ! (goto-char (point-min)) ! (let ((form (read (current-buffer)))) ! (if (eq part 'info) ! (gnus-group-set-info form) ! (gnus-group-set-info form group part)) ! (kill-buffer (current-buffer)) ! (and gnus-winconf-edit-group ! (set-window-configuration gnus-winconf-edit-group)) ! (setq gnus-winconf-edit-group nil) ! (set-buffer gnus-group-buffer) ! (gnus-group-update-group (gnus-group-group-name)) ! (gnus-group-position-cursor))) (defun gnus-group-make-help-group () "Create the (ding) Gnus documentation group." *************** *** 4508,4514 **** (defvar gnus-summary-mode-map nil) (defvar gnus-summary-mark-map nil) (defvar gnus-summary-mscore-map nil) - (defvar gnus-summary-send-map nil) (defvar gnus-summary-extract-map nil) (defvar gnus-summary-extract-view-map nil) (defvar gnus-summary-article-map nil) --- 4523,4528 ---- *************** *** 4667,4689 **** (define-key gnus-summary-process-map "a" 'gnus-uu-mark-all) (define-key gnus-summary-process-map "S" 'gnus-uu-mark-sparse) - - (define-prefix-command 'gnus-summary-send-map) (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) - (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) - (define-key gnus-summary-send-map "f" 'gnus-summary-followup) - (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) - (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) - (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) - (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) - (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) - (define-key gnus-summary-send-map "r" 'gnus-summary-reply) - (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) - (define-key gnus-summary-send-map "\C-f" 'gnus-summary-mail-forward) - (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) - (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) - (define-key gnus-summary-send-map "\M-f" 'gnus-uu-digest-and-forward) - (define-prefix-command 'gnus-summary-goto-map) (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map) --- 4681,4687 ---- *************** *** 5031,5101 **** If NO-ARTICLE is non-nil, no article is selected initially." (message "Retrieving newsgroup: %s..." group) (gnus-summary-setup-buffer group) ! (if (gnus-select-newsgroup group show-all) ! (progn ! (gnus-set-global-variables) ! ;; Save the active value in effect when the group was entered. ! (setq gnus-newsgroup-active ! (gnus-copy-sequence ! (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) ! ;; You can change the subjects in this hook. ! (run-hooks 'gnus-select-group-hook) ! ;; Do score processing. ! (gnus-possibly-score-headers) ! ;; Update the format specifiers. ! (gnus-update-format-specifications) ! ;; Generate the summary buffer. ! (gnus-summary-prepare) ! (if (zerop (buffer-size)) ! (cond (gnus-newsgroup-dormant ! (gnus-summary-show-all-dormant)) ! ((and gnus-newsgroup-scored show-all) ! (gnus-summary-show-all-expunged)))) ! ;; Function `gnus-apply-kill-file' must be called in this hook. ! (run-hooks 'gnus-apply-kill-hook) ! (if (zerop (buffer-size)) ! (progn ! ;; This newsgroup is empty. ! (gnus-summary-catchup-and-exit nil t) ;Without confirmations. ! (message "No unread news") ! (gnus-kill-buffer kill-buffer)) ! (save-excursion ! (if kill-buffer ! (let ((gnus-summary-buffer kill-buffer)) ! (gnus-configure-windows 'newsgroups t)))) ! ;; Hide conversation thread subtrees. We cannot do this in ! ;; gnus-summary-prepare-hook since kill processing may not ! ;; work with hidden articles. ! (and gnus-show-threads ! gnus-thread-hide-subtree ! (gnus-summary-hide-all-threads)) ! ;; Show first unread article if requested. ! (goto-char (point-min)) ! (if (and (not no-article) ! gnus-auto-select-first ! (gnus-summary-first-unread-article)) ! (gnus-configure-windows 'article) ! (gnus-configure-windows 'summary)) ! (pop-to-buffer gnus-summary-buffer) ! (gnus-set-mode-line 'summary) ! (gnus-summary-position-cursor) ! ;; If in async mode, we send some info to the backend. ! (and gnus-newsgroup-async ! (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads)) ! (gnus-request-asynchronous ! gnus-newsgroup-name ! (if (and gnus-asynchronous-article-function ! (fboundp gnus-asynchronous-article-function)) ! (funcall gnus-asynchronous-article-function ! gnus-newsgroup-threads) ! gnus-newsgroup-threads))) ! (gnus-kill-buffer kill-buffer))) ! ;; Cannot select newsgroup GROUP. ! (message "Couldn't select newsgroup") ! (and (eq major-mode 'gnus-summary-mode) ! (kill-buffer (current-buffer))) ! (switch-to-buffer gnus-group-buffer) ! (gnus-group-next-unread-group 1))) (defun gnus-summary-prepare () ;; Generate the summary buffer. --- 5029,5110 ---- If NO-ARTICLE is non-nil, no article is selected initially." (message "Retrieving newsgroup: %s..." group) (gnus-summary-setup-buffer group) ! (let ((did-select (gnus-select-newsgroup group show-all))) ! (cond ! ((null did-select) ! (and (eq major-mode 'gnus-summary-mode) ! (not (equal (current-buffer) kill-buffer)) ! (progn ! (kill-buffer (current-buffer)) ! (switch-to-buffer (or kill-buffer gnus-group-buffer)) ! (gnus-group-next-unread-group 1))) ! nil) ! ((eq did-select 'quit) ! (and (eq major-mode 'gnus-summary-mode) ! (not (equal (current-buffer) kill-buffer)) ! (kill-buffer (current-buffer))) ! (gnus-kill-buffer kill-buffer) ! (switch-to-buffer gnus-group-buffer) ! (gnus-group-next-unread-group 1) ! (signal 'quit nil)) ! (t ! (gnus-set-global-variables) ! ;; Save the active value in effect when the group was entered. ! (setq gnus-newsgroup-active ! (gnus-copy-sequence ! (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) ! ;; You can change the subjects in this hook. ! (run-hooks 'gnus-select-group-hook) ! ;; Do score processing. ! (gnus-possibly-score-headers) ! ;; Update the format specifiers. ! (gnus-update-format-specifications) ! ;; Generate the summary buffer. ! (gnus-summary-prepare) ! (if (zerop (buffer-size)) ! (cond (gnus-newsgroup-dormant ! (gnus-summary-show-all-dormant)) ! ((and gnus-newsgroup-scored show-all) ! (gnus-summary-show-all-expunged)))) ! ;; Function `gnus-apply-kill-file' must be called in this hook. ! (run-hooks 'gnus-apply-kill-hook) ! (if (zerop (buffer-size)) ! (progn ! ;; This newsgroup is empty. ! (gnus-summary-catchup-and-exit nil t) ;Without confirmations. ! (message "No unread news") ! (gnus-kill-buffer kill-buffer)) ! (save-excursion ! (if kill-buffer ! (let ((gnus-summary-buffer kill-buffer)) ! (gnus-configure-windows 'newsgroups t)))) ! ;; Hide conversation thread subtrees. We cannot do this in ! ;; gnus-summary-prepare-hook since kill processing may not ! ;; work with hidden articles. ! (and gnus-show-threads ! gnus-thread-hide-subtree ! (gnus-summary-hide-all-threads)) ! ;; Show first unread article if requested. ! (goto-char (point-min)) ! (if (and (not no-article) ! gnus-auto-select-first ! (gnus-summary-first-unread-article)) ! (gnus-configure-windows 'article) ! (gnus-configure-windows 'summary)) ! (pop-to-buffer gnus-summary-buffer) ! (gnus-set-mode-line 'summary) ! (gnus-summary-position-cursor) ! ;; If in async mode, we send some info to the backend. ! (and gnus-newsgroup-async ! (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads)) ! (gnus-request-asynchronous ! gnus-newsgroup-name ! (if (and gnus-asynchronous-article-function ! (fboundp gnus-asynchronous-article-function)) ! (funcall gnus-asynchronous-article-function ! gnus-newsgroup-threads) ! gnus-newsgroup-threads))) ! (gnus-kill-buffer kill-buffer)))))) (defun gnus-summary-prepare () ;; Generate the summary buffer. *************** *** 5566,5573 **** (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) ! (if (not (setq articles (gnus-articles-to-read group read-all))) ! nil ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) --- 5575,5588 ---- (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) ! (setq articles (gnus-articles-to-read group read-all)) ! ! (cond ! ((null articles) ! (message "Couldn't select newsgroup") ! 'quit) ! ((eq articles 0) nil) ! (t ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) *************** *** 5622,5628 **** (header-number (gnus-last-element gnus-newsgroup-headers)))) (setq gnus-reffed-article-number -1) ;; GROUP is successfully selected. ! (or gnus-newsgroup-headers t)))) (defun gnus-articles-to-read (group read-all) ;; Find out what articles the user wants to read. --- 5637,5643 ---- (header-number (gnus-last-element gnus-newsgroup-headers)))) (setq gnus-reffed-article-number -1) ;; GROUP is successfully selected. ! (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group read-all) ;; Find out what articles the user wants to read. *************** *** 5663,5673 **** (if (string-equal input "") number input))) (t number)) ! (quit 0))) total-articles) ! (setq select (if (numberp select) select (string-to-number select))) ! (if (zerop select) ! () (if (and (not (zerop scored)) (<= (abs select) scored)) (progn (setq articles (sort scored-list '<)) --- 5678,5688 ---- (if (string-equal 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 (if (and (not (zerop scored)) (<= (abs select) scored)) (progn (setq articles (sort scored-list '<)) *************** *** 5839,5844 **** --- 5854,5860 ---- (- (frame-width) gnus-mode-non-string-length))) header) ;; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) + (if (< max-len 4) (setq max-len 4)) (and (numberp max-len) (progn (if (> (length mode-string) max-len) *************** *** 6710,6717 **** (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (pop-to-buffer gnus-group-buffer) ! (gnus-group-jump-to-group group) ! (gnus-group-next-group 1) (if (gnus-buffer-exists-p quit-buffer) (progn (switch-to-buffer quit-buffer) --- 6726,6733 ---- (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (pop-to-buffer gnus-group-buffer) ! (if (equal (gnus-group-group-name) group) ! (gnus-group-next-group 1)) (if (gnus-buffer-exists-p quit-buffer) (progn (switch-to-buffer quit-buffer) *************** *** 6758,6763 **** --- 6774,6780 ---- (gnus-group-jump-to-group group) (setq group nil)) (gnus-group-jump-to-group ingroup)) + (gnus-summary-search-group backward) (let ((group (or group (gnus-summary-search-group backward))) (buf gnus-summary-buffer)) (if (null group) *************** *** 6766,6778 **** ;; We are now in group mode buffer. ;; Make sure group mode buffer point is on GROUP. (gnus-group-jump-to-group group) ! (unwind-protect ! (gnus-summary-read-group group nil no-article buf) ! (and (string= gnus-newsgroup-name ingroup) ! (bufferp sumbuf) (buffer-name sumbuf) ! (progn ! (set-buffer (setq gnus-summary-buffer sumbuf)) ! (gnus-summary-exit-no-update t)))))))) (defun gnus-summary-prev-group (no-article) "Exit current newsgroup and then select previous unread newsgroup. --- 6783,6805 ---- ;; We are now in group mode buffer. ;; Make sure group mode buffer point is on GROUP. (gnus-group-jump-to-group group) ! (if (not (eq gnus-auto-select-next 'quietly)) ! (progn ! (gnus-summary-read-group group nil no-article buf) ! (and (string= gnus-newsgroup-name ingroup) ! (bufferp sumbuf) (buffer-name sumbuf) ! (progn ! (set-buffer (setq gnus-summary-buffer sumbuf)) ! (gnus-summary-exit-no-update t)))) ! (gnus-summary-read-group group nil no-article buf) ! (while (and (string= gnus-newsgroup-name ingroup) ! (bufferp sumbuf) (buffer-name sumbuf)) ! (set-buffer gnus-group-buffer) ! (gnus-group-next-unread-group 1) ! (recenter) ! (gnus-summary-read-group ! (gnus-group-group-name) nil no-article buf))))))) ! (defun gnus-summary-prev-group (no-article) "Exit current newsgroup and then select previous unread newsgroup. *************** *** 7689,7695 **** ;; after all. (or (memq (car articles) gnus-newsgroup-expirable) (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)) ! (setq articles (cdr articles)))))) (defun gnus-summary-edit-article () "Enter into a buffer and edit the current article. --- 7716,7723 ---- ;; after all. (or (memq (car articles) gnus-newsgroup-expirable) (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)) ! (setq articles (cdr articles))))) ! (gnus-summary-position-cursor)) (defun gnus-summary-edit-article () "Enter into a buffer and edit the current article. *************** *** 7776,7782 **** (defun gnus-summary-raise-thread (score) "Raise articles under current thread with SCORE." ! (interactive "p") (let (e) (save-excursion (let ((level (gnus-summary-thread-level))) --- 7804,7811 ---- (defun gnus-summary-raise-thread (score) "Raise articles under current thread with SCORE." ! (interactive "P") ! (setq score (1- (gnus-score-default score))) (let (e) (save-excursion (let ((level (gnus-summary-thread-level))) *************** *** 7803,7810 **** (defun gnus-summary-lower-thread (score) "Raise articles under current thread with SCORE." ! (interactive "p") ! (gnus-summary-raise-thread (- score))) (defun gnus-summary-kill-same-subject-and-select (unmark) "Mark articles which has the same subject as read, and then select the next. --- 7832,7839 ---- (defun gnus-summary-lower-thread (score) "Raise articles under current thread with SCORE." ! (interactive "P") ! (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) (defun gnus-summary-kill-same-subject-and-select (unmark) "Mark articles which has the same subject as read, and then select the next. *************** *** 8226,8235 **** (let ((buffer-read-only nil) (marks (concat "^[" marks "]"))) (goto-char (point-min)) ! (while (search-forward-regexp marks (point-max) t) ! (beginning-of-line) ! (delete-region (point) ! (progn (forward-line 1) (point))))) (or (zerop (buffer-size)) (if (eobp) (gnus-summary-prev-subject 1) --- 8255,8266 ---- (let ((buffer-read-only nil) (marks (concat "^[" marks "]"))) (goto-char (point-min)) ! (if gnus-use-adaptive-scoring ! (gnus-score-remove-lines-adaptive marks) ! (while (re-search-forward marks (point-max) t) ! (beginning-of-line) ! (delete-region (point) ! (progn (forward-line 1) (point)))))) (or (zerop (buffer-size)) (if (eobp) (gnus-summary-prev-subject 1) *************** *** 8935,8940 **** --- 8966,8972 ---- files action) (while ps (setq action (cdr (assq 'action (car ps)))) + (setq files (list (cdr (assq 'name (car ps))))) (while (and ps (cdr ps) (string= (or action "1") (or (cdr (assq 'action (car (cdr ps)))) "2"))) *************** *** 8942,8951 **** (setcdr ps (cdr (cdr ps)))) (if (not files) () ! (setcdr (assq 'command (car ps)) ! (apply (if (string-match "%s" action) ! 'format 'concat) ! action (mapconcat (lambda (f) f) files " ")))) (setq ps (cdr ps))))) (if gnus-view-pseudos (while pslist --- 8974,8988 ---- (setcdr ps (cdr (cdr ps)))) (if (not files) () ! (if (not (string-match "%s" action)) ! (setq files (cons " " files))) ! (setq files (cons " " files)) ! (and (assq 'execute (car ps)) ! (setcdr (assq 'execute (car ps)) ! (funcall (if (string-match "%s" action) ! 'format 'concat) ! action ! (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) (if gnus-view-pseudos (while pslist *************** *** 9053,9064 **** "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X" "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r" ! "t" "\M-t" "a" "f" "F" "C" "S" "r" "R" "\C-c\C-f" ! "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "m" "M" ! "V" "\C-c\C-d" "q" "Q"))) (while commands (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) (setq commands (cdr commands))))) --- 9090,9107 ---- "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X" "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r" ! "t" "\M-t" "C" "S" ! "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "M" ! "V" "\C-c\C-d"))) (while commands (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) + (setq commands (cdr commands)))) + + (let ((commands (list "q" "Q" "r" "R" "\C-c\C-f" "m" "a" "f" "F"))) + (while commands + (define-key gnus-article-mode-map (car commands) + 'gnus-article-summary-command-nosave) (setq commands (cdr commands))))) *************** *** 9476,9521 **** (process-send-eof process)) (error "Couldn't start process")))))))) (defun gnus-article-de-quoted-unreadable () "Do a naive translation of a quoted-printable-encoded article. This is in no way, shape or form meant as a replacement for real MIME processing, but is simply a stop-gap measure until MIME support is written." ! (interactive) (save-excursion ! (save-restriction ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (case-fold-search t)) ! (widen) ! (goto-char (point-min)) ! (if (and (or (search-forward "\nContent-Transfer-Encoding: " nil t) ! (looking-at "Content-Transfer-Encoding: ")) ! (search-forward "quoted-printable" nil (gnus-point-at-eol))) ! (progn ! (goto-char (point-min)) ! (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t) ! (replace-match ! (char-to-string ! (+ ! (* 16 (gnus-hex-char-to-integer ! (char-after (1+ (match-beginning 0))))) ! (gnus-hex-char-to-integer ! (char-after (1- (match-end 0)))))) t t)) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (while (search-forward "=\n" nil t) ! (replace-match "" t t)))))))) ! ! ;; Taken from hexl.el. ! (defun gnus-hex-char-to-integer (character) ! "Take a char and return its value as if it was a hex digit." ! (if (and (>= character ?0) (<= character ?9)) ! (- character ?0) ! (let ((ch (logior character 32))) ! (if (and (>= ch ?a) (<= ch ?f)) ! (- ch (- ?a 10)) ! (error (format "Invalid hex digit `%c'." ch)))))) (defun gnus-article-date-ut (date type) "Convert DATE date to universal time in the current article. --- 9519,9557 ---- (process-send-eof process)) (error "Couldn't start process")))))))) + + (defun gnus-mime-decode-quoted-printable (from to) + ;; Decode quoted-printable from region between FROM and TO. + (save-excursion + (goto-char from) + (while (search-forward "=" to t) + (cond ((eq (following-char) ?\n) + (delete-char -1) + (delete-char 1)) + ((looking-at "[0-9A-F][0-9A-F]") + (delete-char -1) + (insert (hexl-hex-string-to-integer + (buffer-substring (point) (+ 2 (point))))) + (delete-char 2)) + ((message "Malformed MIME quoted-printable message")))))) + (defun gnus-article-de-quoted-unreadable () "Do a naive translation of a quoted-printable-encoded article. This is in no way, shape or form meant as a replacement for real MIME processing, but is simply a stop-gap measure until MIME support is written." ! ;; Unquote quoted-printable from news articles. (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((case-fold-search t) ! (type (gnus-fetch-field "content-transfer-encoding"))) ! (cond ((and (stringp type) (string-match "quoted-printable" type)) ! (goto-char (point-min)) ! (search-forward "\n\n" nil 'move) ! (message "MIME Unquoting printable...") ! (gnus-mime-decode-quoted-printable (point) (point-max)) ! (message "MIME Unquoting printable...done"))) ! (set-buffer gnus-summary-buffer)))) (defun gnus-article-date-ut (date type) "Convert DATE date to universal time in the current article. *************** *** 9800,9806 **** (defun gnus-article-summary-command () "Execute the last keystroke in the summary buffer." (interactive) - (message " ") (let ((obuf (current-buffer)) (owin (current-window-configuration))) (switch-to-buffer gnus-summary-buffer 'norecord) --- 9836,9841 ---- *************** *** 9810,9815 **** --- 9845,9858 ---- (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))) + (switch-to-buffer gnus-summary-buffer 'norecord) + (execute-kbd-macro (this-command-keys)))) + ;; caesar-region written by phr@prep.ai.mit.edu Nov 86 ;; Modified by tower@prep Nov 86 ;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47. *************** *** 11107,11113 **** (cond ((not list-type) (message "Cannot read partial active file from %s server." (car (car methods))) ! (ding)) ((eq list-type 'active) (gnus-active-to-gnus-format (and gnus-have-read-active-file (car methods))) --- 11150,11157 ---- (cond ((not list-type) (message "Cannot read partial active file from %s server." (car (car methods))) ! (ding) ! (sit-for 2)) ((eq list-type 'active) (gnus-active-to-gnus-format (and gnus-have-read-active-file (car methods))) *************** *** 11224,11234 **** (forward-line 1))) (let (min max opoint) (while (not (eobp)) ! (read cur) (read cur) ! (setq min (read cur) ! max (read cur)) ! (set (let ((obarray hashtb)) (read cur)) ! (cons min max)) (forward-line 1)))) (error (progn (ding) (message "Possible error in active file.")))))) --- 11268,11280 ---- (forward-line 1))) (let (min max opoint) (while (not (eobp)) ! (if (= (following-char) ?2) ! (progn ! (read cur) (read cur) ! (setq min (read cur) ! max (read cur)) ! (set (let ((obarray hashtb)) (read cur)) ! (cons min max)))) (forward-line 1)))) (error (progn (ding) (message "Possible error in active file.")))))) *************** *** 12217,12222 **** --- 12263,12272 ---- (setq out (cons (car files) out))) (setq files (cdr files))) (setq gnus-internal-global-score-files out))) + + (defun gnus-score-default (level) + (if level (prefix-numeric-value level) + gnus-score-interactive-default-score)) (provide 'gnus) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnfolder.el dgnus/lisp/nnfolder.el *** pub/dgnus/lisp/nnfolder.el Tue Apr 25 13:56:24 1995 --- dgnus/lisp/nnfolder.el Wed Apr 26 16:00:39 1995 *************** *** 52,58 **** ;; Note that this variable may not be completely implemented yet. -SLB ! (defvar nnfolder-always-close t "If non-nil, nnfolder attempts to only ever have one mbox open at a time. This is a straight space/performance trade off, as the mboxes will have to be scaned every time they are read in. If nil (default), nnfolder will --- 52,58 ---- ;; Note that this variable may not be completely implemented yet. -SLB ! (defvar nnfolder-always-close nil "If non-nil, nnfolder attempts to only ever have one mbox open at a time. This is a straight space/performance trade off, as the mboxes will have to be scaned every time they are read in. If nil (default), nnfolder will diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnmail.el dgnus/lisp/nnmail.el *** pub/dgnus/lisp/nnmail.el Tue Apr 25 13:56:24 1995 --- dgnus/lisp/nnmail.el Wed Apr 26 16:00:39 1995 *************** *** 130,136 **** info follow-to respect-poster) (let ((method-address (cdr (assq 'to-address (nth 4 info)))) from subject date to reply-to message-of ! references message-id sender cc) (setq method-address (if (and (stringp method-address) (string= method-address "")) --- 130,136 ---- info follow-to respect-poster) (let ((method-address (cdr (assq 'to-address (nth 4 info)))) from subject date to reply-to message-of ! references message-id sender cc sendto elt) (setq method-address (if (and (stringp method-address) (string= method-address "")) *************** *** 173,187 **** (widen)) (setq news-reply-yank-from from) (setq news-reply-yank-message-id message-id) ! (mail-setup (if (and follow-to (listp follow-to)) "" (or method-address (concat (or sender reply-to from "") (if to (concat ", " to) "") (if cc (concat ", " cc) "")))) subject message-of nil article-buffer nil) (if (and follow-to (listp follow-to)) (progn (goto-char (point-min)) (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") --- 173,198 ---- (widen)) (setq news-reply-yank-from from) (setq news-reply-yank-message-id message-id) ! ! ;; Gather the "to" addresses out of the follow-to list and remove ! ;; them as we go. ! (if (and follow-to (listp follow-to)) ! (while (setq elt (assoc "To" follow-to)) ! (setq sendto (concat sendto (and sendto ", ") (cdr elt))) ! (setq follow-to (delq elt follow-to)))) ! (mail-setup (if (and follow-to (listp follow-to)) sendto (or method-address (concat (or sender reply-to from "") (if to (concat ", " to) "") (if cc (concat ", " cc) "")))) subject message-of nil article-buffer nil) + ;; Note that "To" elements should already be in the message. (if (and follow-to (listp follow-to)) (progn (goto-char (point-min)) + (re-search-forward "^To:" nil t) + (beginning-of-line) + (forward-line 1) (while follow-to (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnml.el dgnus/lisp/nnml.el *** pub/dgnus/lisp/nnml.el Tue Apr 25 13:56:24 1995 --- dgnus/lisp/nnml.el Wed Apr 26 15:43:51 1995 *************** *** 287,292 **** --- 287,293 ---- 0))) (nnmail-save-active nnml-group-alist nnml-active-file)) (nnml-save-nov) + (message "") rest)) (defun nnml-request-move-article *************** *** 658,664 **** (save-excursion (set-buffer (nnml-open-nov group)) (goto-char 1) ! (if (re-search-forward (concat "^" (int-to-string article) "\t")) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) t)) --- 659,665 ---- (save-excursion (set-buffer (nnml-open-nov group)) (goto-char 1) ! (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t) (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) t)) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnspool.el dgnus/lisp/nnspool.el *** pub/dgnus/lisp/nnspool.el Tue Apr 25 13:56:24 1995 --- dgnus/lisp/nnspool.el Tue Apr 25 18:51:08 1995 *************** *** 67,72 **** --- 67,77 ---- (defvar nnspool-nov-is-evil nil "Non-nil means that nnspool will never return NOV lines instead of headers.") + (defvar nnspool-sift-nov-with-sed t + "If non-nil, use sed to get the relevant portion from the overview file. + If nil, nnspool will load the entire file into a buffer and process it + there.") + (defconst nnspool-version "nnspool 2.0" *************** *** 96,101 **** --- 101,107 ---- (list 'nnspool-active-times-file nnspool-active-times-file) (list 'nnspool-large-newsgroup nnspool-large-newsgroup) (list 'nnspool-nov-is-evil nnspool-nov-is-evil) + (list 'nnspool-sift-nov-with-sed nnspool-sift-nov-with-sed) '(nnspool-current-directory nil) '(nnspool-current-group nil) '(nnspool-status-string ""))) *************** *** 343,384 **** (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (insert-file-contents nov) ! ;; First we find the first wanted line. We issue a number ! ;; of search-forwards - the first article we are lookign ! ;; for may be expired, so we have to go on searching until ! ;; we find one of the articles we want. ! (while (and articles ! (setq article (concat (int-to-string ! (car articles)) "\t")) ! (not (or (looking-at article) ! (search-forward (concat "\n" article) ! nil t)))) ! (setq articles (cdr articles))) ! (if (not articles) ! () ! (beginning-of-line) ! (delete-region (point-min) (point)) ! ;; Then we find the last wanted line. We go to the end ! ;; of the buffer and search backward much the same way ! ;; we did to find the first article. ! ;; !!! Perhaps it would be better just to do a (last articles), ! ;; and go forward successively over each line and ! ;; compare to avoid this (reverse), like this: ! ;; (while (and (>= last (read nntp-server-buffer))) ! ;; (zerop (forward-line 1)))) ! (setq articles (reverse articles)) ! (goto-char (point-max)) (while (and articles ! (not (search-backward ! (concat "\n" (int-to-string (car articles)) ! "\t") nil t))) (setq articles (cdr articles))) ! (if articles ! (progn ! (forward-line 2) ! (delete-region (point) (point-max))))) ! (or articles (progn (erase-buffer) nil))))))) (defun nnspool-find-article-by-message-id (id) "Return full pathname of an article identified by message-ID." --- 349,400 ---- (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (if nnspool-sift-nov-with-sed ! (nnspool-sift-nov-with-sed articles nov) ! (insert-file-contents nov) ! ;; First we find the first wanted line. We issue a number ! ;; of search-forwards - the first article we are lookign ! ;; for may be expired, so we have to go on searching until ! ;; we find one of the articles we want. (while (and articles ! (setq article (concat (int-to-string ! (car articles)) "\t")) ! (not (or (looking-at article) ! (search-forward (concat "\n" article) ! nil t)))) (setq articles (cdr articles))) ! (if (not articles) ! () ! (beginning-of-line) ! (delete-region (point-min) (point)) ! ;; Then we find the last wanted line. We go to the end ! ;; of the buffer and search backward much the same way ! ;; we did to find the first article. ! ;; !!! Perhaps it would be better just to do a (last articles), ! ;; and go forward successively over each line and ! ;; compare to avoid this (reverse), like this: ! ;; (while (and (>= last (read nntp-server-buffer))) ! ;; (zerop (forward-line 1)))) ! (setq articles (reverse articles)) ! (goto-char (point-max)) ! (while (and articles ! (not (search-backward ! (concat "\n" (int-to-string (car articles)) ! "\t") nil t))) ! (setq articles (cdr articles))) ! (if articles ! (progn ! (forward-line 2) ! (delete-region (point) (point-max))))) ! (or articles (progn (erase-buffer) nil)))))))) ! ! (defun nnspool-sift-nov-with-sed (articles file) ! (let ((first (car articles)) ! (last (progn (while (cdr articles) (setq articles (cdr articles))) ! (car articles)))) ! (call-process "sed" nil t nil "-e" ! (format "1,/^%d\t/d\n/^%d\t/,$d" ! (1- first) (1+ last)) file))) (defun nnspool-find-article-by-message-id (id) "Return full pathname of an article identified by message-ID." diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nntp.el dgnus/lisp/nntp.el *** pub/dgnus/lisp/nntp.el Tue Apr 25 13:56:24 1995 --- dgnus/lisp/nntp.el Wed Apr 26 14:35:20 1995 *************** *** 154,159 **** --- 154,160 ---- (defvar nntp-server-xover 'try) (defvar nntp-server-list-active-group 'try) (defvar nntp-current-group "") + (defvar nntp-timeout-servers nil) (defvar nntp-async-process nil) (defvar nntp-async-buffer nil) *************** *** 186,191 **** --- 187,193 ---- '(nntp-status-string nil) '(nntp-server-xover try) '(nntp-server-list-active-group try) + '(nntp-timeout-servers nil) '(nntp-current-group ""))) *************** *** 340,347 **** (setq nntp-current-server server) (or (nntp-server-opened server) (progn ! (run-hooks 'nntp-prepare-server-hook) ! (nntp-open-server-semi-internal nntp-address))))) (defun nntp-close-server (&optional server) "Close connection to SERVER." --- 342,351 ---- (setq nntp-current-server server) (or (nntp-server-opened server) (progn ! (if (member server nntp-timeout-servers) ! nil ! (run-hooks 'nntp-prepare-server-hook) ! (nntp-open-server-semi-internal nntp-address)))))) (defun nntp-close-server (&optional server) "Close connection to SERVER." *************** *** 363,368 **** --- 367,377 ---- (defun nntp-request-close () "Close all server connections." (let (proc) + (and nntp-async-process + (progn + (delete-process nntp-async-process) + (and (get-buffer nntp-async-buffer) + (kill-buffer nntp-async-buffer)))) (while nntp-server-alist (and (setq proc (nth 1 (assq 'nntp-server-process (car nntp-server-alist)))) *************** *** 409,418 **** (set-buffer nntp-async-buffer) (let ((opoint (point)) beg end) ! (if (and (or (re-search-forward (concat "2?? +" id) nil t) (progn (goto-char (point-min)) ! (re-search-forward (concat "2?? +" id) opoint t))) (progn (beginning-of-line) (setq beg (point) --- 418,427 ---- (set-buffer nntp-async-buffer) (let ((opoint (point)) beg end) ! (if (and (or (re-search-forward (concat "^2?? +" id) nil t) (progn (goto-char (point-min)) ! (re-search-forward (concat "^2?? +" id) opoint t))) (progn (beginning-of-line) (setq beg (point) *************** *** 682,687 **** --- 691,697 ---- (assoc server nntp-server-alist))))) (and proc (delete-process (process-name proc))) (nntp-close-server server) + (setq nntp-timeout-servers (cons server nntp-timeout-servers)) (setq nntp-status-string (message "Connection timed out to server %s." server)) (ding) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/texi/gnus.texi dgnus/texi/gnus.texi *** pub/dgnus/texi/gnus.texi Tue Apr 25 13:56:32 1995 --- dgnus/texi/gnus.texi Wed Apr 26 15:43:51 1995 *************** *** 234,239 **** --- 234,241 ---- @item Brian Edmonds has written @code{gnus-bbdb}, as well as other bits and pieces. + @item + Kevin Davidson came up with the name @dfn{ding}, so blame him. @item Stainless Steel Rat, Jack Vinson, Daniel Quinlan, Ilja Weis and Andrew Eskilsson have all contributed code and suggestions. *************** *** 1435,1440 **** --- 1437,1449 ---- @vindex nnspool-nov-is-evil If non-@code{nil}, @code{nnspool} won't try to use any @sc{nov} files that it finds. + + @item nnspool-sift-nov-with-sed + @vindex nnspool-sift-nov-with-sed + If non-@code{nil}, which is the default, use @code{sed} to get the + relevant portion from the overview file. If nil, @code{nnspool} will + load the entire file into a buffer and process it there. + @end table @node nnvirtual *************** *** 2755,2765 **** @findex gnus-summary-reply-with-original Mail a reply to the author of the current article and include the original message (@code{gnus-summary-reply-with-original}). ! @item S C-f ! @kindex S C-f (Summary) @findex gnus-summary-mail-forward Forward the current article to some other person (@code{gnus-summary-mail-forward}). @item S m @itemx m @kindex m (Summary) --- 2764,2779 ---- @findex gnus-summary-reply-with-original Mail a reply to the author of the current article and include the original message (@code{gnus-summary-reply-with-original}). ! @item S o m ! @kindex S o m (Summary) @findex gnus-summary-mail-forward Forward the current article to some other person (@code{gnus-summary-mail-forward}). + @item S o p + @kindex S o p (Summary) + @findex gnus-summary-post-forward + Forward the current article to a newsgroup + (@code{gnus-summary-post-forward}). @item S m @itemx m @kindex m (Summary) *************** *** 2767,2778 **** @findex gnus-summary-mail-other-window Send a mail to some other person (@code{gnus-summary-mail-other-window}). ! @item S M-f ! @kindex S M-f (Summary) ! @findex gnus-uu-digest-and-forward Digest the current series and forward the result using mail ! (@code{gnus-uu-digest-and-forward}). This command uses the process/prefix convention (@pxref{Process/Prefix}). @end table Variables for customizing outgoing mail: --- 2781,2797 ---- @findex gnus-summary-mail-other-window Send a mail to some other person (@code{gnus-summary-mail-other-window}). ! @item S O m ! @kindex S O m (Summary) ! @findex gnus-uu-digest-mail-forward Digest the current series and forward the result using mail ! (@code{gnus-uu-digest-mail-forward}). This command uses the process/prefix convention (@pxref{Process/Prefix}). + @item S O p + @kindex S O p (Summary) + @findex gnus-uu-digest-post-forward + Digest the current series and forward the result to a newsgroup + (@code{gnus-uu-digest-mail-forward}). @end table Variables for customizing outgoing mail: *************** *** 4763,4768 **** --- 4782,4788 ---- (mark-and-expunge -10) (read-only nil) (orphan -10) + (adapt t) (files "/hom/larsi/News/gnu.SCORE") (eval (ding))) @end lisp *************** *** 4815,4826 **** @table @dfn @item From, Subject, References, Xref, Message-ID For most header types, there are the @code{r} and @code{R} (regexp) as ! well as @code{s} and @code{S} (substring) types. If this element is not ! present, Gnus will assume that substring matching should be used. ! @code{R} and @code{S} differ from the other two in that the matches will ! be done in a case-sensitive manner. All these one-letter types are ! really just abbreviations for the @code{regexp} and @code{string} types, ! which you can use instead, if you feel like. @item Lines, Chars These two headers use different match types: @code{<}, @code{>}, @code{=}, @code{>=} and @code{<=}. --- 4835,4847 ---- @table @dfn @item From, Subject, References, Xref, Message-ID For most header types, there are the @code{r} and @code{R} (regexp) as ! well as @code{s} and @code{S} (substring) types and @code{e} and ! @code{E} (exact match) types. If this element is not present, Gnus will ! assume that substring matching should be used. @code{R} and @code{S} ! differ from the other two in that the matches will be done in a ! case-sensitive manner. All these one-letter types are really just ! abbreviations for the @code{regexp}, @code{string} and @code{exact} ! types, which you can use instead, if you feel like. @item Lines, Chars These two headers use different match types: @code{<}, @code{>}, @code{=}, @code{>=} and @code{<=}. *************** *** 4833,4838 **** --- 4854,4862 ---- @item Head, Body, All These three match keys use the same match types as the @code{From} (etc) header uses. + @item Followup + This match key will add a score entry on all articles that followup to + some author. Uses the same match types as the @code{From} header uses. @end table @end enumerate *************** *** 4863,4868 **** --- 4887,4897 ---- @item orphan The value of this entry should be a number. Articles that do not have parents will get this number added to their scores. + @item adapt + This entry controls the adaptive scoring. If it is @code{t}, the + default adaptive scoring rules will be used. If it is @code{ignore}, no + adaptive scoring will be performed on this group. If it is a list, this + list will be used as the adaptive scoring rules. @end table @node Score File Editing *************** *** 4904,4916 **** You turn on this ability by setting @code{gnus-use-adaptive-scoring} to @code{t}. ! @vindex gnus-adaptive-score-alist To give you complete control over the scoring process, you can customize ! the @code{gnus-adaptive-score-alist} variable. By default, it looks ! something like this: @lisp ! (defvar gnus-adaptive-score-alist '((gnus-unread-mark) (gnus-ticked-mark (from 4)) (gnus-dormant-mark (from 5)) --- 4933,4945 ---- You turn on this ability by setting @code{gnus-use-adaptive-scoring} to @code{t}. ! @vindex gnus-default-adaptive-score-alist To give you complete control over the scoring process, you can customize ! the @code{gnus-default-adaptive-score-alist} variable. By default, it ! looks something like this: @lisp ! (defvar gnus-default-adaptive-score-alist '((gnus-unread-mark) (gnus-ticked-mark (from 4)) (gnus-dormant-mark (from 5)) *************** *** 4939,4944 **** --- 4968,4976 ---- become properly trained and enhance the authors you like best, and kill the authors you like least, without you having to say so explicitly. + You can control what groups the adaptive scoring is to be performed on + by using the score files (@pxref{Score File Format}). This will also + let you use different rules in different groups. @node Scoring Tips @subsection Scoring Tips