*** pub/sgnus/lisp/gnus-cus.el Wed Nov 15 21:36:37 1995 --- sgnus/lisp/gnus-cus.el Fri Nov 17 02:49:48 1995 *************** *** 27,32 **** --- 27,33 ---- (require 'custom) (require 'gnus-ems) + (require 'browse-url) ;; The following is just helper functions and data, not ment to be set ;; by the user. *** pub/sgnus/lisp/gnus-ems.el Wed Nov 15 21:36:37 1995 --- sgnus/lisp/gnus-ems.el Fri Nov 17 04:24:56 1995 *************** *** 84,89 **** --- 84,92 ---- '(progn (if (string-match "XEmacs\\|Lucid" emacs-version) () + + (defvar gnus-mouse-face-prop 'mouse-face) + ;; Added by Per Abrahamsen . (defvar gnus-display-type (condition-case nil *** pub/sgnus/lisp/gnus-msg.el Wed Nov 15 21:36:38 1995 --- sgnus/lisp/gnus-msg.el Fri Nov 17 02:34:23 1995 *************** *** 464,469 **** --- 464,470 ---- Type \\[describe-mode] in the buffer to get a list of commands." (interactive (list t)) (let* ((group (or group gnus-newsgroup-name)) + (pgroup group) (to-address (when group (gnus-group-get-parameter group 'to-address))) *************** *** 476,482 **** (when group (setq group (gnus-group-real-name group))) (if (or to-group ! (and (gnus-member-of-valid 'post (or group gnus-newsgroup-name)) (not mailing-list) (not to-address))) ;; This is news. --- 477,483 ---- (when group (setq group (gnus-group-real-name group))) (if (or to-group ! (and (gnus-member-of-valid 'post (or pgroup gnus-newsgroup-name)) (not mailing-list) (not to-address))) ;; This is news. *************** *** 1676,1685 **** (fboundp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (goto-char (point-min)) ! (if (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$") nil t) ! (forward-line 1) ! (goto-char (point-max))) (run-hooks 'gnus-post-prepare-hook) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) --- 1677,1685 ---- (fboundp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (goto-char (point-min)) ! (if group ! (re-search-forward "^Subject: " nil t) ! (re-search-forward "^Newsgroups: " nil t)) (run-hooks 'gnus-post-prepare-hook) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) *************** *** 2279,2299 **** (defun gnus-inews-insert-bfcc () "Insert Bcc and Fcc headers." (save-excursion ! (save-restriction ! (gnus-inews-narrow-to-headers) ! ;; Handle author copy using BCC field. ! (if (and gnus-mail-self-blind (not (mail-fetch-field "bcc"))) ! (progn ! (mail-position-on-field "Bcc") ! (insert (if (stringp gnus-mail-self-blind) ! gnus-mail-self-blind ! (user-login-name))))) ! ;; Handle author copy using FCC field. ! (if gnus-author-copy ! (progn ! (mail-position-on-field "Fcc") ! (insert gnus-author-copy)))))) (defun gnus-inews-insert-gcc () (let* ((group gnus-outgoing-message-group) --- 2279,2295 ---- (defun gnus-inews-insert-bfcc () "Insert Bcc and Fcc headers." (save-excursion ! ;; Handle author copy using BCC field. ! (when (and gnus-mail-self-blind (not (mail-fetch-field "bcc"))) ! (mail-position-on-field "Bcc") ! (insert (if (stringp gnus-mail-self-blind) ! gnus-mail-self-blind ! (user-login-name)))) ! ;; Handle author copy using FCC field. ! (when gnus-author-copy ! (mail-position-on-field "Fcc") ! (insert gnus-author-copy)))) (defun gnus-inews-insert-gcc () (let* ((group gnus-outgoing-message-group) *** pub/sgnus/lisp/gnus-vis.el Wed Nov 15 21:36:41 1995 --- sgnus/lisp/gnus-vis.el Fri Nov 17 04:15:10 1995 *************** *** 29,34 **** --- 29,36 ---- (require 'gnus-ems) (require 'easymenu) (require 'custom) + (require 'browse-url) + (eval-when-compile (require 'cl)) (defvar gnus-group-menu-hook nil "*Hook run after the creation of the group mode menu.") *************** *** 220,229 **** (assq (1+ lines) gnus-cite-attribution-alist))) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ! ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ! (,gnus-button-url-regexp 0 t gnus-button-url 0)) "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where --- 222,231 ---- (assq (1+ lines) gnus-cite-attribution-alist))) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ! ("]*\\)>" 0 t browse-url-browser-function 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ! (,gnus-button-url-regexp 0 t browse-url-browser-function 0)) "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where *************** *** 242,248 **** ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0) ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) ! ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)) "Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each --- 244,250 ---- ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0) ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) ! ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url-browser-function 0)) "Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each *************** *** 257,278 **** ;(eval-when-compile ; (defvar browse-url-browser-function)) - ;see gnus-cus.el - ;(defvar gnus-button-url - ; (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) - ; ((fboundp 'w3-fetch) 'w3-fetch) - ; ((eq window-system 'x) 'gnus-netscape-open-url)) - ; "*Function to fetch URL. - ;The function will be called with one argument, the URL to fetch. - ;Useful values of this function are: - - ;w3-fetch: - ; defined in the w3 emacs package by William M. Perry. - ;gnus-netscape-open-url: - ; open url in existing netscape, start netscape if none found. - ;gnus-netscape-start-url: - ; start new netscape with url.") - (eval-and-compile --- 259,264 ---- *************** *** 935,947 **** (let* ((beg (progn (beginning-of-line) (point))) (end (progn (end-of-line) (point))) ;; Fix by Mike Dugan . ! (from (if (get-text-property beg 'mouse-face) beg (1+ (or (next-single-property-change ! beg 'mouse-face nil end) beg)))) (to (1- (or (next-single-property-change ! from 'mouse-face nil end) end)))) ;; If no mouse-face prop on line (e.g. xemacs) we ;; will have to = from = end, so we highlight the --- 921,933 ---- (let* ((beg (progn (beginning-of-line) (point))) (end (progn (end-of-line) (point))) ;; Fix by Mike Dugan . ! (from (if (get-text-property beg gnus-mouse-face-prop) beg (1+ (or (next-single-property-change ! beg gnus-mouse-face-prop nil end) beg)))) (to (1- (or (next-single-property-change ! from gnus-mouse-face-prop nil end) end)))) ;; If no mouse-face prop on line (e.g. xemacs) we ;; will have to = from = end, so we highlight the *************** *** 1131,1137 **** (prog2 (insert (car button)) (point) (insert " ")) (list 'gnus-callback (cdr button) 'face gnus-carpal-button-face ! 'mouse-face 'highlight)))) (let ((fill-column (- (window-width) 2))) (fill-region (point-min) (point-max))) (set-window-point (get-buffer-window (current-buffer)) --- 1117,1123 ---- (prog2 (insert (car button)) (point) (insert " ")) (list 'gnus-callback (cdr button) 'face gnus-carpal-button-face ! gnus-mouse-face-prop 'highlight)))) (let ((fill-column (- (window-width) 2))) (fill-region (point-min) (point-max))) (set-window-point (get-buffer-window (current-buffer)) *************** *** 1414,1420 **** (add-text-properties from to (nconc (and gnus-article-mouse-face ! (list 'mouse-face gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data))))) --- 1400,1406 ---- (add-text-properties from to (nconc (and gnus-article-mouse-face ! (list gnus-mouse-face-prop gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data))))) *** pub/sgnus/lisp/gnus-xmas.el Wed Nov 15 21:36:42 1995 --- sgnus/lisp/gnus-xmas.el Fri Nov 17 04:24:56 1995 *************** *** 135,141 **** (progn (setq info (nth 2 entry)) (gnus-group-insert-group-line ! nil group (gnus-info-group info) (gnus-info-marks info) (car entry) (gnus-info-method info))) (setq active (gnus-gethash group gnus-active-hashtb)) --- 135,141 ---- (progn (setq info (nth 2 entry)) (gnus-group-insert-group-line ! nil group (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))) (setq active (gnus-gethash group gnus-active-hashtb)) *************** *** 258,263 **** --- 258,265 ---- (or (boundp 'standard-display-table) (setq standard-display-table nil)) (or (boundp 'read-event) (fset 'read-event 'next-command-event)) + (defvar gnus-mouse-face-prop 'highlight) + ;; Fix by "jeff (j.d.) sparkes" . (defvar gnus-display-type (device-class) "A symbol indicating the display Emacs is running under. *** pub/sgnus/lisp/gnus.el Wed Nov 15 21:36:43 1995 --- sgnus/lisp/gnus.el Fri Nov 17 04:15:14 1995 *************** *** 1433,1439 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.13" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1433,1439 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.14" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1647,1653 **** gnus-tmp-name)) gnus-tmp-closing-bracket " " gnus-tmp-subject-or-nil "\n") ! (put-text-property b (+ b 28) 'mouse-face gnus-mouse-face))) (defvar gnus-summary-line-format-spec (gnus-byte-code 'gnus-summary-line-format-spec)) --- 1647,1653 ---- gnus-tmp-name)) gnus-tmp-closing-bracket " " gnus-tmp-subject-or-nil "\n") ! (put-text-property b (+ b 28) gnus-mouse-face-prop gnus-mouse-face))) (defvar gnus-summary-line-format-spec (gnus-byte-code 'gnus-summary-line-format-spec)) *************** *** 1662,1668 **** (format "%5s: " gnus-tmp-number-of-unread-unticked)) (let ((b (point))) (insert gnus-tmp-group "\n") ! (put-text-property b (1- (point)) 'mouse-face gnus-mouse-face))) (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) --- 1662,1668 ---- (format "%5s: " gnus-tmp-number-of-unread-unticked)) (let ((b (point))) (insert gnus-tmp-group "\n") ! (put-text-property b (1- (point)) gnus-mouse-face-prop gnus-mouse-face))) (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) *************** *** 1890,1905 **** (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." - ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable)))) - ;;(` (abbrev-expansion (, string) (, hashtable))) (` (symbol-value (intern-soft (, string) (, hashtable))))) (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)))) ;; modified by MORIOKA Tomohiko ;; function `substring' might cut on a middle of multi-octet ;; character. --- 1890,1916 ---- (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." (` (symbol-value (intern-soft (, string) (, hashtable))))) (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." (` (set (intern (, string) (, hashtable)) (, value)))) + (defmacro gnus-intern-safe (string hashtable) + "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." + `(let ((symbol (intern ,string ,hashtable))) + (or (boundp symbol) + (setq symbol nil)) + symbol)) + + (defmacro gnus-active (group) + "Get active info on GROUP." + `(gnus-gethash ,group gnus-active-hashtb)) + + (defmacro gnus-set-active (group active) + "Set GROUP's active info." + `(gnus-sethash ,group ,active gnus-active-hashtb)) + ;; modified by MORIOKA Tomohiko ;; function `substring' might cut on a middle of multi-octet ;; character. *************** *** 2142,2148 **** (save-excursion (let ((gnus-process-mark 128) (gnus-group-marked '("dummy.group"))) ! (gnus-sethash "dummy.group" '(0 . 0) gnus-active-hashtb) (gnus-set-work-buffer) (gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil) (goto-char (point-min)) --- 2153,2159 ---- (save-excursion (let ((gnus-process-mark 128) (gnus-group-marked '("dummy.group"))) ! (gnus-set-active "dummy.group" '(0 . 0)) (gnus-set-work-buffer) (gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil) (goto-char (point-min)) *************** *** 2153,2165 **** (defun gnus-mouse-face-function (form) (` (put-text-property (point) (progn (insert (, form)) (point)) ! 'mouse-face gnus-mouse-face))) (defun gnus-max-width-function (el max-width) (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) (` (let ((val (eval (, el)))) (if (numberp val) ! (setq val (int-to-string val) val)) (if (> (length val) (, max-width)) (substring val 0 (, max-width)) val)))) --- 2164,2176 ---- (defun gnus-mouse-face-function (form) (` (put-text-property (point) (progn (insert (, form)) (point)) ! ,gnus-mouse-face-prop gnus-mouse-face))) (defun gnus-max-width-function (el max-width) (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) (` (let ((val (eval (, el)))) (if (numberp val) ! (setq val (int-to-string val))) (if (> (length val) (, max-width)) (substring val 0 (, max-width)) val)))) *************** *** 2640,2645 **** --- 2651,2657 ---- gnus-newsgroup-headers nil gnus-newsgroup-name nil gnus-server-alist nil + gnus-opened-servers nil gnus-current-select-method nil) ;; Reset any score variables. (and gnus-use-scoring (gnus-score-close)) *************** *** 3818,3831 **** ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. (if (not (gnus-goto-char ! (text-property-any (point-min) (point-max) ! 'gnus-group (intern group)))) (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) (while (and newsrc (not (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-group ! (intern (car (car newsrc))))))) (setq newsrc (cdr newsrc))) (or newsrc (progn (goto-char (point-max)) (forward-line -1)))))) --- 3830,3845 ---- ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. (if (not (gnus-goto-char ! (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) (while (and newsrc (not (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-group ! (gnus-intern-safe ! (car (car newsrc)) gnus-active-hashtb))))) (setq newsrc (cdr newsrc))) (or newsrc (progn (goto-char (point-max)) (forward-line -1)))))) *************** *** 3893,3899 **** (add-text-properties (point) (prog1 (1+ (point)) (insert " " mark " *: " group "\n")) ! (list 'gnus-group (intern group) 'gnus-unread t 'gnus-level level)))) ;; This loop is used when listing all groups. --- 3907,3913 ---- (add-text-properties (point) (prog1 (1+ (point)) (insert " " mark " *: " group "\n")) ! (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t 'gnus-level level)))) ;; This loop is used when listing all groups. *************** *** 3902,3908 **** (point) (prog1 (1+ (point)) (insert " " mark " *: " (setq group (pop groups)) "\n")) ! (list 'gnus-group (intern group) 'gnus-unread t 'gnus-level level)))))) --- 3916,3922 ---- (point) (prog1 (1+ (point)) (insert " " mark " *: " (setq group (pop groups)) "\n")) ! (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t 'gnus-level level)))))) *************** *** 4079,4085 **** (progn (setcar (nthcdr 2 entry) info) (if (and (not (eq (car entry) t)) ! (gnus-gethash (gnus-info-group info) gnus-active-hashtb)) (let ((marked (gnus-info-marks info))) (setcar entry (length (gnus-list-of-unread-articles (car info))))))) --- 4093,4099 ---- (progn (setcar (nthcdr 2 entry) info) (if (and (not (eq (car entry) t)) ! (gnus-active (gnus-info-group info))) (let ((marked (gnus-info-marks info))) (setcar entry (length (gnus-list-of-unread-articles (car info))))))) *************** *** 4112,4132 **** active info) (if entry (progn (setq info (nth 2 entry)) (gnus-group-insert-group-line nil group (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))) ! (setq active (gnus-gethash group gnus-active-hashtb)) (gnus-group-insert-group-line nil group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) ! nil (if active (- (1+ (cdr active)) (car active)) 0) nil)))) (defun gnus-group-insert-group-line (gformat gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number gnus-tmp-method) (let* ((gformat (or gformat gnus-group-line-format-spec)) ! (gnus-tmp-active (gnus-gethash gnus-tmp-group gnus-active-hashtb)) (gnus-tmp-number-total (if gnus-tmp-active (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) --- 4126,4150 ---- active info) (if entry (progn + ;; (Un)subscribed group. (setq info (nth 2 entry)) (gnus-group-insert-group-line nil group (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))) ! ;; This group is dead. (gnus-group-insert-group-line nil group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) ! nil ! (if (setq active (gnus-active group)) ! (- (1+ (cdr active)) (car active)) 0) ! nil)))) (defun gnus-group-insert-group-line (gformat gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number gnus-tmp-method) (let* ((gformat (or gformat gnus-group-line-format-spec)) ! (gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-number-total (if gnus-tmp-active (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) *************** *** 4187,4193 **** (eval gformat) (add-text-properties ! b (1+ b) (list 'gnus-group (intern gnus-tmp-group) 'gnus-unread (if (numberp gnus-tmp-number) (string-to-int gnus-tmp-number-of-unread-unticked) --- 4205,4212 ---- (eval gformat) (add-text-properties ! b (1+ b) (list 'gnus-group (gnus-intern-safe ! gnus-tmp-group gnus-active-hashtb) 'gnus-unread (if (numberp gnus-tmp-number) (string-to-int gnus-tmp-number-of-unread-unticked) *************** *** 4204,4210 **** ;; The buffer may be narrowed. (save-restriction (widen) ! (let ((ident (intern group)) (loc (point-min)) found buffer-read-only visible) ;; Enter the current status into the dribble buffer. --- 4223,4229 ---- ;; The buffer may be narrowed. (save-restriction (widen) ! (let ((ident (gnus-intern-safe group gnus-active-hashtb)) (loc (point-min)) found buffer-read-only visible) ;; Enter the current status into the dribble buffer. *************** *** 4233,4239 **** (gnus-goto-char (text-property-any (point-min) (point-max) ! 'gnus-group (intern (car (car entry))))))) (setq entry (cdr entry))) (or entry (goto-char (point-max)))) ;; Finally insert the line. --- 4252,4260 ---- (gnus-goto-char (text-property-any (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! (car (car entry)) ! gnus-active-hashtb))))) (setq entry (cdr entry))) (or entry (goto-char (point-max)))) ;; Finally insert the line. *************** *** 4412,4418 **** (setq number (cond ((numberp all) all) (entry (car entry)) ! ((setq active (gnus-gethash group gnus-active-hashtb)) (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) --- 4433,4439 ---- (setq number (cond ((numberp all) all) (entry (car entry)) ! ((setq active (gnus-active group)) (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) *************** *** 4484,4509 **** (error "Empty group name")) (let ((b (text-property-any ! (point-min) (point-max) 'gnus-group (intern group)))) (if b ;; Either go to the line in the group buffer... (goto-char b) ;; ... or insert the line. (or ! (gnus-gethash group gnus-active-hashtb) (gnus-activate-group group) (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) (goto-char (text-property-any ! (point-min) (point-max) 'gnus-group (intern group))))) ;; Adjust cursor point. (gnus-group-position-point)) (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (let ((b (text-property-any (point-min) (point-max) ! 'gnus-group (intern group)))) (and b (goto-char b)))) (defun gnus-group-next-group (n) --- 4505,4533 ---- (error "Empty group name")) (let ((b (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (if b ;; Either go to the line in the group buffer... (goto-char b) ;; ... or insert the line. (or ! (gnus-active group) (gnus-activate-group group) (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) (goto-char (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) ;; Adjust cursor point. (gnus-group-position-point)) (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." (let ((b (text-property-any (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! group gnus-active-hashtb)))) (and b (goto-char b)))) (defun gnus-group-next-group (n) *************** *** 4640,4646 **** (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) ! (gnus-sethash nname (cons 1 0) gnus-active-hashtb) (or (gnus-ephemeral-group-p name) (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) --- 4664,4670 ---- (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) ! (gnus-set-active nname (cons 1 0)) (or (gnus-ephemeral-group-p name) (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) *************** *** 5218,5224 **** (gnus-group-update-group group)) ((and (stringp group) (or (not (memq gnus-select-method gnus-have-read-active-file)) ! (gnus-gethash group gnus-active-hashtb))) ;; Add new newsgroup. (gnus-group-change-level group --- 5242,5248 ---- (gnus-group-update-group group)) ((and (stringp group) (or (not (memq gnus-select-method gnus-have-read-active-file)) ! (gnus-active group))) ;; Add new newsgroup. (gnus-group-change-level group *************** *** 5462,5468 **** (defun gnus-get-new-news-in-group (group) (when (and group (gnus-activate-group group 'scan)) (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-gethash group gnus-active-hashtb)) (gnus-group-update-group-line) t)) --- 5486,5492 ---- (defun gnus-get-new-news-in-group (group) (when (and group (gnus-activate-group group 'scan)) (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-active group)) (gnus-group-update-group-line) t)) *************** *** 5548,5554 **** (mapatoms (lambda (group) (and (string-match regexp (symbol-value group)) ! (gnus-gethash (symbol-name group) gnus-active-hashtb) (setq groups (cons (symbol-name group) groups)))) gnus-description-hashtb)) (if (not groups) --- 5572,5578 ---- (mapatoms (lambda (group) (and (string-match regexp (symbol-value group)) ! (gnus-active (symbol-name group)) (setq groups (cons (symbol-name group) groups)))) gnus-description-hashtb)) (if (not groups) *************** *** 6543,6549 **** '(progn (gnus-summary-skip-intangible) (or (get-text-property (point) 'gnus-number) ! gnus-newsgroup-end))) (defmacro gnus-summary-article-header (&optional number) (` (gnus-data-header (gnus-data-find --- 6567,6575 ---- '(progn (gnus-summary-skip-intangible) (or (get-text-property (point) 'gnus-number) ! (progn ! (forward-line -1) ! gnus-newsgroup-end)))) (defmacro gnus-summary-article-header (&optional number) (` (gnus-data-header (gnus-data-find *************** *** 6876,6882 **** ;; 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 summary buffer in some way with this hook. (run-hooks 'gnus-select-group-hook) ;; Set any local variables in the group parameters. --- 6902,6908 ---- ;; Save the active value in effect when the group was entered. (setq gnus-newsgroup-active (gnus-copy-sequence ! (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. (run-hooks 'gnus-select-group-hook) ;; Set any local variables in the group parameters. *************** *** 7147,7153 **** sub nil)) (setq sub (cdr sub)))) ;; It's an ordinary thread, so we check it. ! (when (member (car sub) headers) (setq thread sub threads nil))) (setq threads (cdr threads))) --- 7173,7179 ---- sub nil)) (setq sub (cdr sub)))) ;; It's an ordinary thread, so we check it. ! (when (eq (car sub) (car headers)) (setq thread sub threads nil))) (setq threads (cdr threads))) *************** *** 7530,7536 **** (let ((name (intern (format "gnus-newsgroup-%s" (car thing))))) (set name (copy-sequence (cdr (assq (cdr thing) marked)))))) '((marked . tick) (replied . reply) ! (exirable . expire) (killed . killed) (bookmarks . bookmark) (dormant . dormant) (scored . score))))) --- 7556,7562 ---- (let ((name (intern (format "gnus-newsgroup-%s" (car thing))))) (set name (copy-sequence (cdr (assq (cdr thing) marked)))))) '((marked . tick) (replied . reply) ! (expirable . expire) (killed . killed) (bookmarks . bookmark) (dormant . dormant) (scored . score))))) *************** *** 7601,7611 **** ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all ! (zerop (length gnus-newsgroup-unreads))) ! (if (zerop (length gnus-newsgroup-marked)) ! (gnus-uncompress-range ! (gnus-gethash group gnus-active-hashtb)) ! gnus-newsgroup-marked) (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) --- 7627,7635 ---- ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all ! (and (zerop (length gnus-newsgroup-marked)) ! (zerop (length gnus-newsgroup-unreads)))) ! (gnus-uncompress-range (gnus-active group)) (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) *************** *** 7620,7646 **** read-all) (t (condition-case () ! (cond ((and (or (<= scored marked) ! (= scored number)) ! (numberp gnus-large-newsgroup) ! (> number gnus-large-newsgroup)) ! (let ((input ! (read-string ! (format ! "How many articles from %s (default %d): " ! gnus-newsgroup-name number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! ((and (> scored marked) (< scored number)) ! (let ((input ! (read-string ! (format ! "%s %s (%d scored, %d total): " ! "How many articles from" ! group scored number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! (t number)) (quit nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) --- 7644,7668 ---- read-all) (t (condition-case () ! (cond ! ((and (or (<= scored marked) (= scored number)) ! (numberp gnus-large-newsgroup) ! (> number gnus-large-newsgroup)) ! (let ((input ! (read-string ! (format ! "How many articles from %s (default %d): " ! gnus-newsgroup-name number)))) ! (if (string-match "^[ \t]*$" input) number input))) ! ((and (> scored marked) (< scored number)) ! (let ((input ! (read-string ! (format "%s %s (%d scored, %d total): " ! "How many articles from" ! group scored number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! (t number)) (quit nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) *************** *** 7674,7681 **** (defun gnus-adjust-marked-articles (info &optional active) "Remove all marked articles that are no longer legal." (let* ((marked-lists (gnus-info-marks info)) ! (active (or active (gnus-gethash (gnus-info-group info) ! gnus-active-hashtb))) (min (car active)) m prev) ;; There are many types of marked articles. --- 7696,7702 ---- (defun gnus-adjust-marked-articles (info &optional active) "Remove all marked articles that are no longer legal." (let* ((marked-lists (gnus-info-marks info)) ! (active (or active (gnus-active (gnus-info-group info)))) (min (car active)) m prev) ;; There are many types of marked articles. *************** *** 7915,7921 **** (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! (active (gnus-gethash group gnus-active-hashtb)) exps expirable range) ;; First peel off all illegal article numbers. (if active --- 7936,7942 ---- (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! (active (gnus-active group)) exps expirable range) ;; First peel off all illegal article numbers. (if active *************** *** 8250,8257 **** (set id-dep (list header))))) (if header (progn ! (if (boundp (setq ref-dep (intern (or ref "none") ! dependencies))) (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) (list (symbol-value id-dep)))) --- 8271,8277 ---- (set id-dep (list header))))) (if header (progn ! (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) (list (symbol-value id-dep)))) *************** *** 8285,8305 **** "Find article ID and insert the summary line for that article." (let ((header (gnus-read-header id)) number) ! (if (not header) ! () ; We couldn't fetch ID. ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. (gnus-rebuild-thread (mail-header-id header)) (gnus-summary-goto-subject (setq number (mail-header-number header))) ! (and (> number 0) ! (progn ! ;; We have to update the boundaries, possibly. ! (and (> number gnus-newsgroup-end) ! (setq gnus-newsgroup-end number)) ! (and (< number gnus-newsgroup-begin) ! (setq gnus-newsgroup-begin number)) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected)))) ;; Report back a success. number))) --- 8305,8323 ---- "Find article ID and insert the summary line for that article." (let ((header (gnus-read-header id)) number) ! (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. (gnus-rebuild-thread (mail-header-id header)) (gnus-summary-goto-subject (setq number (mail-header-number header))) ! (when (> number 0) ! ;; We have to update the boundaries, possibly. ! (and (> number gnus-newsgroup-end) ! (setq gnus-newsgroup-end number)) ! (and (< number gnus-newsgroup-begin) ! (setq gnus-newsgroup-begin number)) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected))) ;; Report back a success. number))) *************** *** 8479,8485 **** ;; the range of active articles. (defun gnus-list-of-unread-articles (group) (let* ((read (gnus-info-read (gnus-get-info group))) ! (active (gnus-gethash group gnus-active-hashtb)) (last (cdr active)) first nlast unread) ;; If none are read, then all are unread. --- 8497,8503 ---- ;; the range of active articles. (defun gnus-list-of-unread-articles (group) (let* ((read (gnus-info-read (gnus-get-info group))) ! (active (gnus-active group)) (last (cdr active)) first nlast unread) ;; If none are read, then all are unread. *************** *** 8514,8520 **** (defun gnus-list-of-read-articles (group) (let* ((info (gnus-get-info group)) (marked (gnus-info-marks info)) ! (active (gnus-gethash group gnus-active-hashtb))) (and info active (gnus-set-difference (gnus-sorted-complement --- 8532,8538 ---- (defun gnus-list-of-read-articles (group) (let* ((info (gnus-get-info group)) (marked (gnus-info-marks info)) ! (active (gnus-active group))) (and info active (gnus-set-difference (gnus-sorted-complement *************** *** 9500,9514 **** (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") ! (if (or (not (stringp message-id)) ! (zerop (length message-id))) ! () ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. ! (or (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (or (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) (let ((header (car (gnus-gethash (downcase message-id) gnus-newsgroup-dependencies)))) (if header --- 9518,9531 ---- (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") ! (when (and (stringp message-id) ! (not (zerop (length message-id)))) ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. ! (unless (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (unless (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) (let ((header (car (gnus-gethash (downcase message-id) gnus-newsgroup-dependencies)))) (if header *************** *** 9516,9527 **** (gnus-summary-goto-article (mail-header-number header) nil t) ;; We fetch the article (let ((gnus-override-method gnus-refer-article-method) ! (gnus-ancient-mark gnus-read-mark) ! (tmp-point (window-start ! (get-buffer-window gnus-article-buffer))) ! number tmp-buf) ! (and gnus-refer-article-method ! (gnus-check-server gnus-refer-article-method)) (when (setq number (gnus-summary-insert-subject message-id)) (gnus-summary-select-article nil nil nil number))))))) --- 9533,9543 ---- (gnus-summary-goto-article (mail-header-number header) nil t) ;; We fetch the article (let ((gnus-override-method gnus-refer-article-method) ! number) ! ;; Start the special refer-article method, if necessary. ! (when gnus-refer-article-method ! (gnus-check-server gnus-refer-article-method)) ! ;; Fetch the header, and display the article. (when (setq number (gnus-summary-insert-subject message-id)) (gnus-summary-select-article nil nil nil number))))))) *************** *** 9851,9857 **** (progn (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) ! (or (gnus-gethash to-newsgroup gnus-active-hashtb) (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) --- 9867,9873 ---- (progn (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) ! (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) *************** *** 10003,10009 **** (progn (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) ! (or (gnus-gethash to-newsgroup gnus-active-hashtb) (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) --- 10019,10025 ---- (progn (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) ! (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) *************** *** 10625,10642 **** (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil) plist) ! (if (not forward) ! () ;; Go to the right position on the line. (forward-char forward) ;; Replace the old mark with the new mark. (subst-char-in-region (point) (1+ (point)) (following-char) mark) ;; Optionally update the marks by some user rule. ! (and (eq type 'unread) ! (progn ! (gnus-data-set-mark (gnus-data-find (gnus-summary-article-number)) ! mark) ! (gnus-summary-update-line (eq mark gnus-unread-mark))))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." --- 10641,10656 ---- (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil) plist) ! (when forward ;; Go to the right position on the line. (forward-char forward) ;; Replace the old mark with the new mark. (subst-char-in-region (point) (1+ (point)) (following-char) mark) ;; Optionally update the marks by some user rule. ! (when (eq type 'unread) ! (gnus-data-set-mark ! (gnus-data-find (gnus-summary-article-number)) mark) ! (gnus-summary-update-line (eq mark gnus-unread-mark)))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." *************** *** 11868,11874 **** (erase-buffer) ;; There may be some overlays that we have to kill... (insert "i") ! (let ((overlays (overlays-at (point-min)))) (while overlays (delete-overlay (car overlays)) (setq overlays (cdr overlays)))) --- 11882,11889 ---- (erase-buffer) ;; There may be some overlays that we have to kill... (insert "i") ! (let ((overlays (and (fboundp 'overlays-at) ! (overlays-at (point-min))))) (while overlays (delete-overlay (car overlays)) (setq overlays (cdr overlays)))) *************** *** 12249,12265 **** (defun gnus-headers-decode-quoted-printable () "Hack to remove QP encoding from headers." (let ((case-fold-search t) string) (goto-char (point-min)) ! (while (re-search-forward "=?iso-8859-1?q?\\([^ \t\n]*\\)?=" nil t) ! (replace-match (setq string (match-string 1)) t t) ! (narrow-to-region ! (match-beginning 0) (+ (match-beginning 0) (length string))) ! (goto-char (point-min)) ! (while (search-forward "_" nil t) ! (replace-match " ")) ! (gnus-mime-decode-quoted-printable (point-min) (point-max)) ! (widen)))) (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naive translation of a quoted-printable-encoded article. --- 12264,12281 ---- (defun gnus-headers-decode-quoted-printable () "Hack to remove QP encoding from headers." (let ((case-fold-search t) + (inhibit-point-motion-hooks t) string) (goto-char (point-min)) ! (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) ! (setq string (match-string 1)) ! (narrow-to-region (match-beginning 0) (match-end 0)) ! (delete-region (point-min) (point-max)) ! (insert string) ! (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) ! (subst-char-in-region (point-min) (point-max) ?_ ? ) ! (widen) ! (goto-char (point-min))))) (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naive translation of a quoted-printable-encoded article. *************** *** 12282,12288 **** (gnus-headers-decode-quoted-printable))))) (defun gnus-mime-decode-quoted-printable (from to) ! ;; Decode quoted-printable from region between FROM and TO. (goto-char from) (while (search-forward "=" to t) (cond ((eq (following-char) ?\n) --- 12298,12304 ---- (gnus-headers-decode-quoted-printable))))) (defun gnus-mime-decode-quoted-printable (from to) ! "Decode Quoted-Printable in the region between FROM and TO." (goto-char from) (while (search-forward "=" to t) (cond ((eq (following-char) ?\n) *************** *** 12353,12359 **** (gnus-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. ! (when (zerop (nnheader-remove-header date-regexp t)) (goto-char (point-max))) (insert (cond --- 12369,12376 ---- (gnus-narrow-to-headers) (let ((buffer-read-only nil)) ;; Delete any old Date headers. ! (if (zerop (nnheader-remove-header date-regexp t)) ! (beginning-of-line) (goto-char (point-max))) (insert (cond *************** *** 12959,12967 **** (funcall (gnus-get-function method 'open-server) (nth 1 method) (nthcdr 2 method)))) ;; If this hasn't been opened before, we add it to the list. ! (or elem ! (setq elem (list method nil) ! gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. (setcar (cdr elem) (if result 'ok 'denied)) ;; Return the result from the "open" call. --- 12976,12984 ---- (funcall (gnus-get-function method 'open-server) (nth 1 method) (nthcdr 2 method)))) ;; If this hasn't been opened before, we add it to the list. ! (unless elem ! (setq elem (list method nil) ! gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. (setcar (cdr elem) (if result 'ok 'denied)) ;; Return the result from the "open" call. *************** *** 13378,13384 **** ;; The group is already known. () (and (symbol-value group-sym) ! (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)) (let ((do-sub (gnus-matches-options-n group))) (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) --- 13395,13401 ---- ;; The group is already known. () (and (symbol-value group-sym) ! (gnus-set-active group (symbol-value group-sym))) (let ((do-sub (gnus-matches-options-n group))) (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) *************** *** 13431,13437 **** (setq gnus-killed-list (cons group gnus-killed-list))))))) gnus-active-hashtb) (while groups ! (if (gnus-gethash (car groups) gnus-active-hashtb) (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) --- 13448,13454 ---- (setq gnus-killed-list (cons group gnus-killed-list))))))) gnus-active-hashtb) (while groups ! (if (gnus-active (car groups)) (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) *************** *** 13532,13538 **** (progn (setq info (cdr entry)) (setq num (car entry))) ! (setq active (gnus-gethash group gnus-active-hashtb)) (setq num (if active (- (1+ (cdr active)) (car active)) t)) ;; Check whether the group is foreign. If so, the --- 13549,13555 ---- (progn (setq info (cdr entry)) (setq num (car entry))) ! (setq active (gnus-active group)) (setq num (if active (- (1+ (cdr active)) (car active)) t)) ;; Check whether the group is foreign. If so, the *************** *** 13582,13588 **** ;; Find all bogus newsgroup that are subscribed. (while newsrc (setq group (car (car newsrc))) ! (if (or (gnus-gethash group gnus-active-hashtb) ; Active (nth 4 (car newsrc)) ; Foreign (and confirm (not (gnus-y-or-n-p --- 13599,13605 ---- ;; Find all bogus newsgroup that are subscribed. (while newsrc (setq group (car (car newsrc))) ! (if (or (gnus-active group) ; Active (nth 4 (car newsrc)) ; Foreign (and confirm (not (gnus-y-or-n-p *************** *** 13608,13614 **** (setq killed (symbol-value (car dead-lists))) (while killed (setq group (car killed)) ! (or (gnus-gethash group gnus-active-hashtb) ;; The group is bogus. (set (car dead-lists) (delete group (symbol-value (car dead-lists))))) --- 13625,13631 ---- (setq killed (symbol-value (car dead-lists))) (while killed (setq group (car killed)) ! (or (gnus-active group) ;; The group is bogus. (set (car dead-lists) (delete group (symbol-value (car dead-lists))))) *************** *** 13648,13654 **** (while newsrc (setq info (car newsrc) group (gnus-info-group info) ! active (gnus-gethash group gnus-active-hashtb)) ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't --- 13665,13671 ---- (while newsrc (setq info (car newsrc) group (gnus-info-group info) ! active (gnus-active group)) ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't *************** *** 13691,13697 **** (gnus-get-unread-articles-in-group info active) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. ! (gnus-sethash group nil gnus-active-hashtb) (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) (setq newsrc (cdr newsrc))) --- 13708,13714 ---- (gnus-get-unread-articles-in-group info active) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. ! (gnus-set-active group nil) (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) (setq newsrc (cdr newsrc))) *************** *** 13833,13842 **** (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) ! (gnus-sethash group (setq active (cons (read (current-buffer)) ! (read (current-buffer)))) ! gnus-active-hashtb) ;; Return the new active info. active)))))) --- 13850,13858 ---- (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) ! (gnus-set-active group (setq active (cons (read (current-buffer)) ! (read (current-buffer))))) ;; Return the new active info. active)))))) *************** *** 13847,13854 **** UNREAD and TICKED lists. Note: UNSELECTED has to be sorted over `<'. Returns whether the updating was successful." ! (let* ((active (or gnus-newsgroup-active ! (gnus-gethash group gnus-active-hashtb))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (marked (gnus-info-marks info)) --- 13863,13869 ---- UNREAD and TICKED lists. Note: UNSELECTED has to be sorted over `<'. Returns whether the updating was successful." ! (let* ((active (or gnus-newsgroup-active (gnus-active group))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (marked (gnus-info-marks info)) *************** *** 13896,13903 **** (if domarks bookmark (cdr (assq 'bookmark marked))) (if domarks score (cdr (assq 'score marked)))) ;; Set the number of unread articles in gnus-newsrc-hashtb. ! (gnus-get-unread-articles-in-group ! info (gnus-gethash group gnus-active-hashtb)) t))) (defun gnus-make-articles-unread (group articles) --- 13911,13917 ---- (if domarks bookmark (cdr (assq 'bookmark marked))) (if domarks score (cdr (assq 'score marked)))) ;; Set the number of unread articles in gnus-newsrc-hashtb. ! (gnus-get-unread-articles-in-group info (gnus-active group)) t))) (defun gnus-make-articles-unread (group articles) *************** *** 14802,14807 **** --- 14816,14822 ---- (defvar gnus-backlog-buffer " *Gnus Backlog*") (defvar gnus-backlog-articles nil) + (defvar gnus-backlog-hashtb nil) (defun gnus-backlog-buffer () (or (get-buffer gnus-backlog-buffer) *************** *** 14811,14818 **** (setq buffer-read-only t) (gnus-add-current-to-buffer-list)))) (defun gnus-backlog-enter-article (group number buffer) ! (let ((ident (intern (concat group ":" (int-to-string number)))) b) (if (memq ident gnus-backlog-articles) () ; It's already kept. --- 14826,14840 ---- (setq buffer-read-only t) (gnus-add-current-to-buffer-list)))) + (defun gnus-backlog-setup () + "Initialize backlog variables." + (unless gnus-backlog-hashtb + (setq gnus-backlog-hashtb (make-vector 1023 0)))) + (defun gnus-backlog-enter-article (group number buffer) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) b) (if (memq ident gnus-backlog-articles) () ; It's already kept. *************** *** 14849,14855 **** (1+ (point)) 'gnus-backlog nil (point-max))))))) (defun gnus-backlog-request-article (group number buffer) ! (let ((ident (intern (concat group ":" (int-to-string number)))) beg end) (if (not (memq ident gnus-backlog-articles)) () ; It wasn't in the backlog. --- 14871,14879 ---- (1+ (point)) 'gnus-backlog nil (point-max))))))) (defun gnus-backlog-request-article (group number buffer) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) beg end) (if (not (memq ident gnus-backlog-articles)) () ; It wasn't in the backlog. *** pub/sgnus/lisp/nnheader.el Wed Nov 15 21:36:43 1995 --- sgnus/lisp/nnheader.el Fri Nov 17 02:34:24 1995 *************** *** 37,42 **** --- 37,43 ---- ;;; Code: (require 'mail-utils) + (eval-when-compile (require 'cl)) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") *** pub/sgnus/lisp/nntp.el Wed Nov 15 21:36:44 1995 --- sgnus/lisp/nntp.el Fri Nov 17 02:34:23 1995 *************** *** 180,338 **** (defvar nntp-current-server nil) (defvar nntp-server-alist nil) (defvar nntp-server-variables ! (list ! (list 'nntp-server-hook nntp-server-hook) ! (list 'nntp-server-opened-hook nntp-server-opened-hook) ! (list 'nntp-port-number nntp-port-number) ! (list 'nntp-address nntp-address) ! (list 'nntp-large-newsgroup nntp-large-newsgroup) ! (list 'nntp-buggy-select nntp-buggy-select) ! (list 'nntp-maximum-request nntp-maximum-request) ! (list 'nntp-debug-read nntp-debug-read) ! (list 'nntp-nov-is-evil nntp-nov-is-evil) ! (list 'nntp-xover-commands nntp-xover-commands) ! (list 'nntp-connection-timeout nntp-connection-timeout) ! (list 'nntp-news-default-headers nntp-news-default-headers) ! (list 'nntp-prepare-server-hook nntp-prepare-server-hook) ! (list 'nntp-async-number nntp-async-number) ! '(nntp-async-process nil) ! '(nntp-async-buffer nil) ! '(nntp-async-articles nil) ! '(nntp-async-fetched nil) ! '(nntp-async-group-alist nil) ! '(nntp-server-process nil) ! '(nntp-status-string nil) ! '(nntp-server-xover try) ! '(nntp-server-list-active-group try) ! '(nntp-current-group ""))) ;;; Interface functions. ! (defun nntp-retrieve-headers (sequence &optional newsgroup server fetch-old) ! "Retrieve the headers to the articles in SEQUENCE." ! (nntp-possibly-change-server newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) ! (nntp-retrieve-headers-with-xover sequence fetch-old)) 'nov ! (let ((number (length sequence)) (count 0) (received 0) (last-point (point-min))) ;; Send HEAD command. ! (while sequence (nntp-send-strings-to-server ! "HEAD" (if (numberp (car sequence)) (int-to-string (car sequence)) ! (car sequence))) ! (setq sequence (cdr sequence) count (1+ count)) ! ;; Every 400 header requests we have to read stream in order ! ;; to avoid deadlock. ! (if (or (null sequence) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (progn ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! ;; If number of headers is greater than 100, give ! ;; informative messages. ! (and (numberp nntp-large-newsgroup) ! (> number nntp-large-newsgroup) ! (zerop (% received 20)) ! (message "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) ! (nntp-accept-response))))) ;; Wait for text of last command. (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) ! (if (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "NNTP: Receiving headers...done")) ! ;; Now all of replies are received. ! (setq received number) ! ;; First, fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " ")) ! ;; Remove all "\r"'s (goto-char (point-min)) (while (search-forward "\r" nil t) ! (replace-match "")) 'headers)))) (defun nntp-retrieve-groups (groups &optional server) (nntp-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) ! (and (eq nntp-server-list-active-group 'try) ! (nntp-try-list-active (car groups))) (erase-buffer) (let ((count 0) (received 0) (last-point (point-min)) ! (command (if nntp-server-list-active-group ! "LIST ACTIVE" "GROUP"))) (while groups (nntp-send-strings-to-server command (car groups)) (setq groups (cdr groups)) (setq count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (if (or (null groups) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (progn ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (nntp-accept-response))))) ;; Wait for the reply from the final command. ! (if nntp-server-list-active-group ! (progn ! (goto-char (point-max)) ! (re-search-backward "^[0-9]" nil t) ! (if (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))))) ;; Now all replies are received. We remove CRs. (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) ! (if nntp-server-list-active-group ! (progn ! ;; We have read active entries, so we just delete the ! ;; superfluos gunk. ! (goto-char (point-min)) ! (while (re-search-forward "^[.2-5]" nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! 'active) ! 'group)))) (defun nntp-open-server (server &optional defs) (nnheader-init-server-buffer) --- 180,340 ---- (defvar nntp-current-server nil) (defvar nntp-server-alist nil) (defvar nntp-server-variables ! `((nntp-server-hook ,nntp-server-hook) ! (nntp-server-opened-hook ,nntp-server-opened-hook) ! (nntp-port-number ,nntp-port-number) ! (nntp-address ,nntp-address) ! (nntp-large-newsgroup ,nntp-large-newsgroup) ! (nntp-buggy-select ,nntp-buggy-select) ! (nntp-maximum-request ,nntp-maximum-request) ! (nntp-debug-read ,nntp-debug-read) ! (nntp-nov-is-evil ,nntp-nov-is-evil) ! (nntp-xover-commands ,nntp-xover-commands) ! (nntp-connection-timeout ,nntp-connection-timeout) ! (nntp-news-default-headers ,nntp-news-default-headers) ! (nntp-prepare-server-hook ,nntp-prepare-server-hook) ! (nntp-async-number ,nntp-async-number) ! (nntp-async-process nil) ! (nntp-async-buffer nil) ! (nntp-async-articles nil) ! (nntp-async-fetched nil) ! (nntp-async-group-alist nil) ! (nntp-server-process nil) ! (nntp-status-string nil) ! (nntp-server-xover try) ! (nntp-server-list-active-group try) ! (nntp-current-group ""))) ;;; Interface functions. ! (defun nntp-retrieve-headers (articles &optional group server fetch-old) ! "Retrieve the headers of ARTICLES." ! (nntp-possibly-change-server group server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) ! (nntp-retrieve-headers-with-xover articles fetch-old)) ! ;; We successfully retrieved the headers via XOVER. 'nov ! ;; XOVER didn't work, so we do it the hard, slow and inefficient ! ;; way. ! (let ((number (length articles)) (count 0) (received 0) (last-point (point-min))) ;; Send HEAD command. ! (while articles (nntp-send-strings-to-server ! "HEAD" (if (numberp (car articles)) ! (int-to-string (car articles)) ! ;; `articles' is either a list of article numbers ! ;; or a list of article IDs. ! (car articles))) ! (setq articles (cdr articles) count (1+ count)) ! ;; Every 400 header requests we have to read the stream in ! ;; order to avoid deadlocks. ! (when (or (null articles) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! ;; If number of headers is greater than 100, give ! ;; informative messages. ! (and (numberp nntp-large-newsgroup) ! (> number nntp-large-newsgroup) ! (zerop (% received 20)) ! (message "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) ! (nntp-accept-response)))) ;; Wait for text of last command. (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "NNTP: Receiving headers...done")) ! ;; Now all of replies are received. Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! ;; Remove all "\r"'s. (goto-char (point-min)) (while (search-forward "\r" nil t) ! (replace-match "" t t)) 'headers)))) (defun nntp-retrieve-groups (groups &optional server) + "Retrieve group info on GROUPS." (nntp-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) ! ;; The first time this is run, this variable is `try'. So we ! ;; try. ! (when (eq nntp-server-list-active-group 'try) ! (nntp-try-list-active (car groups))) (erase-buffer) (let ((count 0) (received 0) (last-point (point-min)) ! (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) (while groups + ;; Send the command to the server. (nntp-send-strings-to-server command (car groups)) (setq groups (cdr groups)) (setq count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (when (or (null groups) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (nntp-accept-response)))) ;; Wait for the reply from the final command. ! (when nntp-server-list-active-group ! (goto-char (point-max)) ! (re-search-backward "^[0-9]" nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response)))) ;; Now all replies are received. We remove CRs. (goto-char (point-min)) (while (search-forward "\r" nil t) (replace-match "" t t)) ! (if (not nntp-server-list-active-group) ! 'group ! ;; We have read active entries, so we just delete the ! ;; superfluos gunk. ! (goto-char (point-min)) ! (while (re-search-forward "^[.2-5]" nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! 'active)))) (defun nntp-open-server (server &optional defs) (nnheader-init-server-buffer) *************** *** 417,438 **** ;; Empty message if nothing. (or nntp-status-string ""))) ! (defun nntp-request-article (id &optional newsgroup server buffer) ! "Request article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (let (found) ;; First we see whether we can get the article from the async buffer. ! (if (and (numberp id) ! nntp-async-articles ! (memq id nntp-async-fetched)) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (let ((opoint (point)) ! (art (if (numberp id) (int-to-string id) id)) ! beg end) ! (if (and (or (re-search-forward (concat "^2.. +" art) nil t) (progn (goto-char (point-min)) (re-search-forward (concat "^2.. +" art) opoint t))) --- 419,440 ---- ;; Empty message if nothing. (or nntp-status-string ""))) ! (defun nntp-request-article (id &optional group server buffer) ! "Request article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (let (found) ;; First we see whether we can get the article from the async buffer. ! (when (and (numberp id) ! nntp-async-articles ! (memq id nntp-async-fetched)) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (let ((opoint (point)) ! (art (if (numberp id) (int-to-string id) id)) ! beg end) ! (when (and (or (re-search-forward (concat "^2.. +" art) nil t) (progn (goto-char (point-min)) (re-search-forward (concat "^2.. +" art) opoint t))) *************** *** 440,456 **** (beginning-of-line) (setq beg (point) end (re-search-forward "^\\.\r?\n" nil t)))) ! (progn ! (setq found t) ! (save-excursion ! (set-buffer (or buffer nntp-server-buffer)) ! (erase-buffer) ! (insert-buffer-substring nntp-async-buffer beg end) ! (let ((nntp-server-buffer (current-buffer))) ! (nntp-decode-text))) ! (delete-region beg end) ! (and nntp-async-articles ! (nntp-async-fetch-articles id))))))) (if found id --- 442,457 ---- (beginning-of-line) (setq beg (point) end (re-search-forward "^\\.\r?\n" nil t)))) ! (setq found t) ! (save-excursion ! (set-buffer (or buffer nntp-server-buffer)) ! (erase-buffer) ! (insert-buffer-substring nntp-async-buffer beg end) ! (let ((nntp-server-buffer (current-buffer))) ! (nntp-decode-text))) ! (delete-region beg end) ! (when nntp-async-articles ! (nntp-async-fetch-articles id)))))) (if found id *************** *** 468,488 **** (nntp-find-group-and-number))) (nntp-decode-text) (and nntp-async-articles (nntp-async-fetch-articles id))))) ! (if buffer (set-process-buffer ! nntp-server-process nntp-server-buffer)))))) ! (defun nntp-request-body (id &optional newsgroup server) ! "Request body of article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") (nntp-send-command "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) (nntp-decode-text))) ! (defun nntp-request-head (id &optional newsgroup server) ! "Request head of article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (prog1 (and (nntp-send-command "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id)) --- 469,489 ---- (nntp-find-group-and-number))) (nntp-decode-text) (and nntp-async-articles (nntp-async-fetch-articles id))))) ! (when buffer ! (set-process-buffer nntp-server-process nntp-server-buffer)))))) ! (defun nntp-request-body (id &optional group server) ! "Request body of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") (nntp-send-command "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id)) (nntp-decode-text))) ! (defun nntp-request-head (id &optional group server) ! "Request head of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (prog1 (and (nntp-send-command "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id)) *************** *** 491,560 **** (nntp-find-group-and-number))) (nntp-decode-text))) ! (defun nntp-request-stat (id &optional newsgroup server) ! "Request STAT of article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) (defun nntp-request-group (group &optional server dont-check) "Select GROUP." ! (nntp-send-command "^.*\r?\n" "GROUP" group) ! (setq nntp-current-group group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (looking-at "[23]"))) (defun nntp-request-asynchronous (group &optional server articles) ! (and nntp-async-articles (nntp-async-request-group group)) ! (and ! nntp-async-number ! (if (not (or (nntp-async-server-opened) ! (nntp-async-open-server))) ! (progn ! (message "Can't open second connection to %s" nntp-address) ! (ding) ! (setq nntp-async-articles nil) ! (sit-for 2)) ! (setq nntp-async-articles articles) ! (setq nntp-async-fetched nil) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (erase-buffer)) ! (nntp-async-send-strings "GROUP" group) ! t))) (defun nntp-list-active-group (group &optional server) (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) (defun nntp-request-group-description (group &optional server) ! "Get description of GROUP." ! (if (nntp-possibly-change-server nil server) ! (prog1 ! (nntp-send-command "^.*\r?\n" "XGTITLE" group) ! (nntp-decode-text)))) (defun nntp-close-group (group &optional server) (setq nntp-current-group nil) t) (defun nntp-request-list (&optional server) ! "List active groups." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST") (nntp-decode-text))) (defun nntp-request-list-newsgroups (&optional server) ! "List groups." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") (nntp-decode-text))) (defun nntp-request-newgroups (date &optional server) ! "List new groups." (nntp-possibly-change-server nil server) (let* ((date (timezone-parse-date date)) (time-string --- 492,566 ---- (nntp-find-group-and-number))) (nntp-decode-text))) ! (defun nntp-request-stat (id &optional group server) ! "Request STAT of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (nntp-send-command "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) (defun nntp-request-group (group &optional server dont-check) "Select GROUP." ! (setq nntp-current-group ! (when (nntp-send-command "^2.*\r?\n" "GROUP" group) ! group))) (defun nntp-request-asynchronous (group &optional server articles) ! "Enable pre-fetch in GROUP." ! (when nntp-async-articles ! (nntp-async-request-group group)) ! (when nntp-async-number ! (if (not (or (nntp-async-server-opened) ! (nntp-async-open-server))) ! ;; Couldn't open the second connection ! (progn ! (message "Can't open second connection to %s" nntp-address) ! (ding) ! (setq nntp-async-articles nil) ! (sit-for 2)) ! ;; We opened the second connection (or it was opened already). ! (setq nntp-async-articles articles) ! (setq nntp-async-fetched nil) ! ;; Clear any old data. ! (save-excursion ! (set-buffer nntp-async-buffer) ! (erase-buffer)) ! ;; Select the correct current group on this server. ! (nntp-async-send-strings "GROUP" group) ! t))) (defun nntp-list-active-group (group &optional server) + "Return the active info on GROUP (which can be a regexp." + (nntp-possibly-change-server group server) (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) (defun nntp-request-group-description (group &optional server) ! "Get the description of GROUP." ! (nntp-possibly-change-server nil server) ! (prog1 ! (nntp-send-command "^.*\r?\n" "XGTITLE" group) ! (nntp-decode-text))) (defun nntp-close-group (group &optional server) + "Close GROUP." (setq nntp-current-group nil) t) (defun nntp-request-list (&optional server) ! "List all active groups." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST") (nntp-decode-text))) (defun nntp-request-list-newsgroups (&optional server) ! "Get descriptions on all groups on SERVER." (nntp-possibly-change-server nil server) (prog1 (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS") (nntp-decode-text))) (defun nntp-request-newgroups (date &optional server) ! "List groups that have arrived since DATE." (nntp-possibly-change-server nil server) (let* ((date (timezone-parse-date date)) (time-string *************** *** 574,599 **** (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") (nntp-decode-text))) ! (defun nntp-request-last (&optional newsgroup server) "Decrease the current article pointer." ! (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "LAST")) ! (defun nntp-request-next (&optional newsgroup server) "Advance the current article pointer." ! (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "NEXT")) (defun nntp-request-post (&optional server) "Post the current buffer." (nntp-possibly-change-server nil server) ! (if (nntp-send-command "^[23].*\r?\n" "POST") ! (progn ! (nntp-encode-text) ! (nntp-send-region-to-server (point-min) (point-max)) ! ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not ! ;; appended to end of the status message. ! (nntp-wait-for-response "^[23].*\n")))) ;;; Internal functions. --- 580,604 ---- (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS") (nntp-decode-text))) ! (defun nntp-request-last (&optional group server) "Decrease the current article pointer." ! (nntp-possibly-change-server group server) (nntp-send-command "^[23].*\r?\n" "LAST")) ! (defun nntp-request-next (&optional group server) "Advance the current article pointer." ! (nntp-possibly-change-server group server) (nntp-send-command "^[23].*\r?\n" "NEXT")) (defun nntp-request-post (&optional server) "Post the current buffer." (nntp-possibly-change-server nil server) ! (when (nntp-send-command "^[23].*\r?\n" "POST") ! (nntp-encode-text) ! (nntp-send-region-to-server (point-min) (point-max)) ! ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not ! ;; appended to end of the status message. ! (nntp-wait-for-response "^[23].*\n"))) ;;; Internal functions. *************** *** 616,631 **** "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (and (file-exists-p "~/.nntp-authinfo") ! (save-excursion ! (set-buffer (get-buffer-create " *tull*")) ! (insert-file-contents "~/.nntp-authinfo") ! (goto-char (point-min)) ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) ! (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" ! (buffer-substring (point) ! (progn (end-of-line) (point)))) ! (kill-buffer (current-buffer))))) (defun nntp-default-sentinel (proc status) "Default sentinel function for NNTP server process." --- 621,638 ---- "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (when (file-exists-p "~/.nntp-authinfo") ! (save-excursion ! (set-buffer (get-buffer-create " *authinfo*")) ! (buffer-disable-undo) ! (erase-buffer) ! (insert-file-contents "~/.nntp-authinfo") ! (goto-char (point-min)) ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) ! (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" ! (buffer-substring (point) (progn (end-of-line) (point)))) ! (kill-buffer (current-buffer))))) (defun nntp-default-sentinel (proc status) "Default sentinel function for NNTP server process." *************** *** 641,656 **** (car servers)))))) (setq servers (cdr servers))) (setq server (car (car servers)))) ! (and server ! nntp-warn-about-losing-connection ! (progn ! (message "nntp: Connection closed to server %s" server) ! (ding))))) (defun nntp-kill-connection (server) (let ((proc (nth 1 (assq 'nntp-server-process (assoc server nntp-server-alist))))) ! (and proc (delete-process (process-name proc))) (nntp-close-server server) (setq nntp-status-string (message "Connection timed out to server %s." server)) --- 648,664 ---- (car servers)))))) (setq servers (cdr servers))) (setq server (car (car servers)))) ! (when (and server ! nntp-warn-about-losing-connection) ! (message "nntp: Connection closed to server %s" server) ! (ding)))) (defun nntp-kill-connection (server) + "Choke the connection to SERVER." (let ((proc (nth 1 (assq 'nntp-server-process (assoc server nntp-server-alist))))) ! (when proc ! (delete-process (process-name proc))) (nntp-close-server server) (setq nntp-status-string (message "Connection timed out to server %s." server)) *************** *** 671,689 **** (goto-char (point-max)) (or (bolp) (insert "\n")) ;; Delete status line. ! (goto-char (point-min)) ! (delete-region (point) (progn (forward-line 1) (point))) ! ;; Delete `^M' at the end of lines. ! (while (not (eobp)) ! (end-of-line) ! (and (= (preceding-char) ?\r) ! (delete-char -1)) ! (forward-line 1)) ;; Delete `.' at end of the buffer (end of text mark). (goto-char (point-max)) (forward-line -1) ! (if (looking-at "^\\.\n") ! (delete-region (point) (progn (forward-line 1) (point)))) ;; Replace `..' at beginning of line with `.'. (goto-char (point-min)) ;; (replace-regexp "^\\.\\." ".") --- 679,693 ---- (goto-char (point-max)) (or (bolp) (insert "\n")) ;; Delete status line. ! (delete-region (goto-char (point-min)) (progn (forward-line 1) (point))) ! ;; Delete `^M's. ! (while (search-forward "\r" nil t) ! (replace-match "" t t)) ;; Delete `.' at end of the buffer (end of text mark). (goto-char (point-max)) (forward-line -1) ! (when (looking-at "^\\.\n") ! (delete-region (point) (progn (forward-line 1) (point)))) ;; Replace `..' at beginning of line with `.'. (goto-char (point-min)) ;; (replace-regexp "^\\.\\." ".") *************** *** 695,715 **** 1. Insert `.' at beginning of line. 2. Insert `.' at end of buffer (end of text mark)." (save-excursion - ;; Insert newline at end of buffer. - (goto-char (point-max)) - (or (bolp) (insert "\n")) ;; Replace `.' at beginning of line with `..'. (goto-char (point-min)) - ;; (replace-regexp "^\\." "..") (while (search-forward "\n." nil t) (insert ".")) - ;; Insert `.' at end of buffer (end of text mark). (goto-char (point-max)) (insert ".\r\n"))) ;;; ! ;;; Synchronous Communication with NNTP Server. ;;; (defun nntp-send-command (response cmd &rest args) --- 699,717 ---- 1. Insert `.' at beginning of line. 2. Insert `.' at end of buffer (end of text mark)." (save-excursion ;; Replace `.' at beginning of line with `..'. (goto-char (point-min)) (while (search-forward "\n." nil t) (insert ".")) (goto-char (point-max)) + ;; Insert newline at end of buffer. + (or (bolp) (insert "\n")) + ;; Insert `.' at end of buffer (end of text mark). (insert ".\r\n"))) ;;; ! ;;; Synchronous Communication with NNTP servers. ;;; (defun nntp-send-command (response cmd &rest args) *************** *** 764,793 **** (end-of-line) (setq nntp-status-string (buffer-substring (point-min) (point))) ! (if status ! (progn ! (setq wait t) ! (while wait ! (goto-char (point-max)) ! (forward-line -1) ;(beginning-of-line) ! ;;(message (buffer-substring ! ;; (point) ! ;; (save-excursion (end-of-line) (point)))) ! (if (looking-at regexp) ! (setq wait nil) ! (if nntp-debug-read ! (let ((newnum (/ (buffer-size) dotsize))) ! (if (not (= dotnum newnum)) ! (progn ! (setq dotnum newnum) ! (message "NNTP: Reading %s" ! (make-string dotnum ?.)))))) ! (nntp-accept-response))) ! ;; Remove "...". ! (if (and nntp-debug-read (> dotnum 0)) ! (message "")) ! ;; Successfully received server response. ! t))))) --- 766,791 ---- (end-of-line) (setq nntp-status-string (buffer-substring (point-min) (point))) ! (when status ! (setq wait t) ! (while wait ! (goto-char (point-max)) ! (forward-line -1) ! (if (looking-at regexp) ! (setq wait nil) ! (when nntp-debug-read ! (let ((newnum (/ (buffer-size) dotsize))) ! (if (not (= dotnum newnum)) ! (progn ! (setq dotnum newnum) ! (message "NNTP: Reading %s" ! (make-string dotnum ?.)))))) ! (nntp-accept-response))) ! ;; Remove "...". ! (when (and nntp-debug-read (> dotnum 0)) ! (message "")) ! ;; Successfully received server response. ! t)))) *************** *** 830,840 **** (string-match (format "\\([^ :]+\\):%d" number) xref)) (substring xref (match-beginning 1) (match-end 1))) (t ""))) ! (and (string-match "\r" group) ! (setq group (substring group 0 (match-beginning 0)))) (cons group number))))) ! (defun nntp-retrieve-headers-with-xover (sequence &optional fetch-old) (erase-buffer) (cond --- 828,838 ---- (string-match (format "\\([^ :]+\\):%d" number) xref)) (substring xref (match-beginning 1) (match-end 1))) (t ""))) ! (when (string-match "\r" group) ! (setq group (substring group 0 (match-beginning 0)))) (cons group number))))) ! (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (erase-buffer) (cond *************** *** 848,867 **** (nntp-send-xover-command (if fetch-old (if (numberp fetch-old) ! (max 1 (- (car sequence) fetch-old)) 1) ! (car sequence)) ! (nntp-last-element sequence) 'wait) (goto-char (point-min)) ! (if (looking-at "[1-5][0-9][0-9] ") ! (delete-region (point) (progn (forward-line 1) (point)))) (while (search-forward "\r" nil t) (replace-match "" t t)) (goto-char (point-max)) (forward-line -1) ! (if (looking-at "\\.") ! (delete-region (point) (progn (forward-line 1) (point))))) ;; We do it the hard way. For each gap, an XOVER command is sent ;; to the server. We do not wait for a reply from the server, we --- 846,865 ---- (nntp-send-xover-command (if fetch-old (if (numberp fetch-old) ! (max 1 (- (car articles) fetch-old)) 1) ! (car articles)) ! (nntp-last-element articles) 'wait) (goto-char (point-min)) ! (when (looking-at "[1-5][0-9][0-9] ") ! (delete-region (point) (progn (forward-line 1) (point)))) (while (search-forward "\r" nil t) (replace-match "" t t)) (goto-char (point-max)) (forward-line -1) ! (when (looking-at "\\.") ! (delete-region (point) (progn (forward-line 1) (point))))) ;; We do it the hard way. For each gap, an XOVER command is sent ;; to the server. We do not wait for a reply from the server, we *************** *** 877,927 **** ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. ! (while (and nntp-server-xover sequence) ! (setq first (car sequence)) ;; Search forward until we find a gap, or until we run out of ;; articles. ! (while (and (cdr sequence) ! (< (- (nth 1 sequence) (car sequence)) nntp-nov-gap)) ! (setq sequence (cdr sequence))) ! ! (if (not (nntp-send-xover-command first (car sequence))) ! () ! (setq sequence (cdr sequence) count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (if (or (null sequence) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (progn ! (accept-process-output) ! ;; On some Emacs versions the preceding function has ! ;; a tendency to change the buffer. Perhaps. It's ! ;; quite difficult to reporduce, because it only ! ;; seems to happen once in a blue moon. ! (set-buffer buf) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9][0-9][0-9] " nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (accept-process-output) ! (set-buffer buf)))))) ! (if (not nntp-server-xover) ! () ;; Wait for the reply from the final command. (goto-char (point-max)) (re-search-backward "^[0-9][0-9][0-9] " nil t) ! (if (looking-at "^[23]") ! (while (progn ! (goto-char (point-max)) ! (forward-line -1) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) ;; We remove any "." lines and status lines. (goto-char (point-min)) --- 875,922 ---- ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. ! (while (and nntp-server-xover articles) ! (setq first (car articles)) ;; Search forward until we find a gap, or until we run out of ;; articles. ! (while (and (cdr articles) ! (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) ! (setq articles (cdr articles))) ! ! (when (nntp-send-xover-command first (car articles)) ! (setq articles (cdr articles) count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (when (or (null articles) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (accept-process-output) ! ;; On some Emacs versions the preceding function has ! ;; a tendency to change the buffer. Perhaps. It's ! ;; quite difficult to reporduce, because it only ! ;; seems to happen once in a blue moon. ! (set-buffer buf) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9][0-9][0-9] " nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (accept-process-output) ! (set-buffer buf))))) ! (when nntp-server-xover ;; Wait for the reply from the final command. (goto-char (point-max)) (re-search-backward "^[0-9][0-9][0-9] " nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (point-max)) ! (forward-line -1) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) ;; We remove any "." lines and status lines. (goto-char (point-min)) *************** *** 933,938 **** --- 928,934 ---- nntp-server-xover) (defun nntp-send-xover-command (beg end &optional wait-for-reply) + "Send the XOVER command to the server." (let ((range (format "%d-%d" beg end))) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this *************** *** 940,948 **** (if wait-for-reply (nntp-send-command "^\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. ! (progn ! (nntp-send-strings-to-server nntp-server-xover range) ! t)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ;; We try them all until we get at positive response. --- 936,942 ---- (if wait-for-reply (nntp-send-command "^\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. ! (nntp-send-strings-to-server nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ;; We try them all until we get at positive response. *************** *** 961,1014 **** (setq nntp-server-xover (car commands)))) (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. ! (if (eq nntp-server-xover 'try) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (setq nntp-server-xover nil))) nntp-server-xover)))) (defun nntp-send-strings-to-server (&rest strings) ! "Send list of STRINGS to news server as command and its arguments." (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) ;; We open the nntp server if it is down. (or (nntp-server-opened nntp-current-server) (nntp-open-server nntp-current-server) (error (nntp-status-message))) ;; Send the strings. ! (process-send-string nntp-server-process cmd))) (defun nntp-send-region-to-server (begin end) ! "Send current buffer region (from BEGIN to END) to news server." (save-excursion ! ;; We have to work in the buffer associated with NNTP server ! ;; process because of NEmacs hack. ! (copy-to-buffer nntp-server-buffer begin end) ! (set-buffer nntp-server-buffer) ! (setq begin (point-min)) ! (setq end (point-max)) ! ;; `process-send-region' does not work if text to be sent is very ! ;; large. I don't know maximum size of text sent correctly. ! (let ((last nil) (size 100)) ;Size of text sent at once. ! (save-restriction ! (narrow-to-region begin end) ! (goto-char begin) ! (while (not (eobp)) ! ;;(setq last (min end (+ (point) size))) ! ;; NEmacs gets confused if character at `last' is Kanji. ! (setq last (save-excursion ! (goto-char (min end (+ (point) size))) ! (or (eobp) (forward-char 1)) ;Adjust point ! (point))) ! (process-send-region nntp-server-process (point) last) ! ;; I don't know whether the next codes solve the known ! ;; problem of communication error of GNU Emacs. ! (accept-process-output) ! ;;(sit-for 0) ! (goto-char last)))) ! ;; We cannot erase buffer, because reply may be received. ! (delete-region begin end))) (defun nntp-open-server-semi-internal (server &optional service) "Open SERVER. --- 955,1002 ---- (setq nntp-server-xover (car commands)))) (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. ! (when (eq nntp-server-xover 'try) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (setq nntp-server-xover nil))) nntp-server-xover)))) (defun nntp-send-strings-to-server (&rest strings) ! "Send STRINGS to the server." (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) ;; We open the nntp server if it is down. (or (nntp-server-opened nntp-current-server) (nntp-open-server nntp-current-server) (error (nntp-status-message))) ;; Send the strings. ! (process-send-string nntp-server-process cmd) ! t)) (defun nntp-send-region-to-server (begin end) ! "Send the current buffer region (from BEGIN to END) to the server." (save-excursion ! ;; If we're not the the nntp server buffer, we copy the region ! ;; over to that buffer. ! (if (eq (get-buffer nntp-server-buffer) (current-buffer)) ! (let ((orig (current-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring orig begin end)) ! ;; We are in the nntp buffer, so we just narrow it. ! (narrow-to-region begin end)) ! ;; `process-send-region' does not work if the text to be sent is very ! ;; large, so we send it piecemeal. ! (let ((last (point-min)) (size 100)) ;Size of text sent at once. ! (while (/= last (point-max)) ! (process-send-region ! nntp-server-process last (setq last (min (+ last size) (point-max)))) ! ;; Read any output from the server. May be unnecessary. ! (accept-process-output))) ! ;; Delete the area we sent. ! (delete-region (point-min) (point-max)) ! (widen))) (defun nntp-open-server-semi-internal (server &optional service) "Open SERVER. *************** *** 1158,1169 **** (setq list (cdr list))) (car list)) ! (defun nntp-possibly-change-server (newsgroup server) ! ;; We see whether it is necessary to change the newsgroup. ! (and newsgroup (progn ! (not (equal newsgroup nntp-current-group)) ! (nntp-request-group newsgroup server))) (and server (or (nntp-server-opened server) (nntp-open-server server)))) --- 1146,1157 ---- (setq list (cdr list))) (car list)) ! (defun nntp-possibly-change-server (group server) ! ;; We see whether it is necessary to change the group. ! (and group (progn ! (not (equal group nntp-current-group)) ! (nntp-request-group group server))) (and server (or (nntp-server-opened server) (nntp-open-server server)))) *** pub/sgnus/lisp/ChangeLog Wed Nov 15 21:36:50 1995 --- sgnus/lisp/ChangeLog Fri Nov 17 03:58:12 1995 *************** *** 1,4 **** --- 1,38 ---- + Fri Nov 17 03:35:58 1995 Lars Magne Ingebrigtsen + + * gnus-vis.el ((require 'cl)): Require cl. + + * gnus.el (gnus-active): New macro. + (gnus-intern-safe): Ditto. + (gnus-set-active): Ditto. + + Fri Nov 17 01:33:26 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-max-width-function): Totally bugged out. + + * gnus-msg.el (gnus-new-news): Set point on Subject. + (gnus-inews-insert-bfcc): Don't narrow to headers. + + * gnus.el (gnus-articles-to-read): `C-u SPC' would have no real + effect. + (gnus-article-date-ut): Would chop up lines. + + * nnheader.el: Require cl. + + Fri Nov 17 00:11:10 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-select-newsgroup): Expiry marks would disappear. + (gnus-headers-decode-quoted-printable): Use subst-char instead of + search/replace. + (gnus-remove-thread): Didn't remove properly. + + Thu Nov 16 06:28:17 1995 Lars Ingebrigtsen + + * gnus.el: Intern group in active hashtb throughout. + Wed Nov 15 06:13:48 1995 Lars Ingebrigtsen + + * gnus.el: 0.13 is released. * gnus-score.el (gnus-score-get): Turned into a defsubst. (gnus-score-find-bnews): Slightly less funcalling.