*** pub/rgnus/lisp/gnus-group.el Sat Mar 8 08:37:25 1997 --- rgnus/lisp/gnus-group.el Sun Mar 9 18:41:34 1997 *************** *** 2623,2628 **** --- 2623,2629 ---- (interactive) (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) (setq gnus-zombie-list nil) + (gnus-dribble-touch) (gnus-group-list-groups)) (defun gnus-group-kill-region (begin end) *** pub/rgnus/lisp/gnus-int.el Fri Mar 7 23:51:18 1997 --- rgnus/lisp/gnus-int.el Sun Mar 9 18:41:35 1997 *************** *** 201,207 **** "Check whether a connection to METHOD has been opened." (when (stringp method) (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'server-opened) (nth 1 method))) (defun gnus-status-message (method) "Return the status message from METHOD. --- 201,207 ---- "Check whether a connection to METHOD has been opened." (when (stringp method) (setq method (gnus-server-to-method method))) ! (funcall (inline (gnus-get-function method 'server-opened)) (nth 1 method))) (defun gnus-status-message (method) "Return the status message from METHOD. *************** *** 219,228 **** (defun gnus-request-group (group &optional dont-check method) "Request GROUP. If DONT-CHECK, no information is required." ! (let ((method (or method (gnus-find-method-for-group group)))) (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-group) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-list-active-group (group) --- 219,228 ---- (defun gnus-request-group (group &optional dont-check method) "Request GROUP. If DONT-CHECK, no information is required." ! (let ((method (or method (inline (gnus-find-method-for-group group))))) (when (stringp method) ! (setq method (inline (gnus-server-to-method method)))) ! (funcall (inline (gnus-get-function method 'request-group)) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-list-active-group (group) *************** *** 243,249 **** (defun gnus-close-group (group) "Request the GROUP be closed." ! (let ((method (gnus-find-method-for-group group))) (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) --- 243,249 ---- (defun gnus-close-group (group) "Request the GROUP be closed." ! (let ((method (inline (gnus-find-method-for-group group)))) (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) *** pub/rgnus/lisp/gnus-score.el Fri Mar 7 23:51:21 1997 --- rgnus/lisp/gnus-score.el Sun Mar 9 18:41:35 1997 *************** *** 2190,2196 **** (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) (if (not (setq trace gnus-score-trace)) ! (gnus-error 1 "No score rules apply to the current article.") (set-buffer "*Score Trace*") (gnus-add-current-to-buffer-list) (while trace --- 2190,2198 ---- (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) (if (not (setq trace gnus-score-trace)) ! (gnus-error ! 1 "No score rules apply to the current article (default score %d)." ! gnus-summary-default-score) (set-buffer "*Score Trace*") (gnus-add-current-to-buffer-list) (while trace *** pub/rgnus/lisp/gnus-start.el Fri Mar 7 23:51:23 1997 --- rgnus/lisp/gnus-start.el Sun Mar 9 18:41:35 1997 *************** *** 1290,1301 **** (> (cdr cache-active) (cdr active)) (setcdr active (cdr cache-active))))))) (defun gnus-get-unread-articles-in-group (info active &optional update) (when active ;; Allow the backend to update the info in the group. (when (and update (gnus-request-update-info ! info (gnus-find-method-for-group (gnus-info-group info)))) (gnus-activate-group (gnus-info-group info) nil t)) (let* ((range (gnus-info-read info)) (num 0)) --- 1290,1324 ---- (> (cdr cache-active) (cdr active)) (setcdr active (cdr cache-active))))))) + (defun gnus-activate-group (group &optional scan dont-check method) + ;; Check whether a group has been activated or not. + ;; If SCAN, request a scan of that group as well. + (let ((method (or method (inline (gnus-find-method-for-group group)))) + active) + (and (inline (gnus-check-server method)) + ;; We escape all bugs and quit here to make it possible to + ;; continue if a group is so out-there that it reports bugs + ;; and stuff. + (progn + (and scan + (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan group method)) + t) + (condition-case () + (inline (gnus-request-group group dont-check method)) + (error nil) + (quit nil)) + (gnus-set-active group (setq active (gnus-parse-active))) + ;; Return the new active info. + active))) + (defun gnus-get-unread-articles-in-group (info active &optional update) (when active ;; Allow the backend to update the info in the group. (when (and update (gnus-request-update-info ! info (inline (gnus-find-method-for-group ! (gnus-info-group info))))) (gnus-activate-group (gnus-info-group info) nil t)) (let* ((range (gnus-info-read info)) (num 0)) *************** *** 1400,1408 **** ;; newsgroup to t. This means that Gnus thinks that there are ;; unread articles, but it has no idea how many. (if (and (setq method (gnus-info-method info)) ! (not (gnus-server-equal ! gnus-select-method ! (setq method (gnus-server-get-method nil method)))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (when (<= (gnus-info-level info) foreign-level) --- 1423,1432 ---- ;; newsgroup to t. This means that Gnus thinks that there are ;; unread articles, but it has no idea how many. (if (and (setq method (gnus-info-method info)) ! (not (inline ! (gnus-server-equal ! gnus-select-method ! (setq method (gnus-server-get-method nil method))))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (when (<= (gnus-info-level info) foreign-level) *************** *** 1462,1489 **** (while list (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) - (defun gnus-activate-group (group &optional scan dont-check method) - ;; Check whether a group has been activated or not. - ;; If SCAN, request a scan of that group as well. - (let ((method (or method (gnus-find-method-for-group group))) - active) - (and (gnus-check-server method) - ;; We escape all bugs and quit here to make it possible to - ;; continue if a group is so out-there that it reports bugs - ;; and stuff. - (progn - (and scan - (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan group method)) - t) - (condition-case () - (gnus-request-group group dont-check method) - (error nil) - (quit nil)) - (gnus-set-active group (setq active (gnus-parse-active))) - ;; Return the new active info. - active))) - (defun gnus-parse-active () "Parse active info in the nntp server buffer." (save-excursion --- 1486,1491 ---- *************** *** 1589,1598 **** (gmethod (gnus-server-get-method nil method)) groups info) (while (setq info (pop newsrc)) ! (when (gnus-server-equal ! (gnus-find-method-for-group ! (gnus-info-group info) info) ! gmethod) (push (gnus-group-real-name (gnus-info-group info)) groups))) (when groups --- 1591,1602 ---- (gmethod (gnus-server-get-method nil method)) groups info) (while (setq info (pop newsrc)) ! (when (inline ! (gnus-server-equal ! (inline ! (gnus-find-method-for-group ! (gnus-info-group info) info)) ! gmethod)) (push (gnus-group-real-name (gnus-info-group info)) groups))) (when groups *************** *** 2253,2259 **** ;; Don't write foreign groups to .newsrc. (when (or (null (setq method (gnus-info-method info))) (equal method "native") ! (gnus-server-equal method gnus-select-method)) (insert (gnus-info-group info) (if (> (gnus-info-level info) gnus-level-subscribed) "!" ":")) --- 2257,2263 ---- ;; Don't write foreign groups to .newsrc. (when (or (null (setq method (gnus-info-method info))) (equal method "native") ! (inline (gnus-server-equal method gnus-select-method))) (insert (gnus-info-group info) (if (> (gnus-info-level info) gnus-level-subscribed) "!" ":")) *************** *** 2393,2401 **** (narrow-to-region (point-min) (point))) ;; If these are groups from a foreign select method, we insert the ;; group prefix in front of the group names. ! (and method (not (gnus-server-equal ! (gnus-server-get-method nil method) ! (gnus-server-get-method nil gnus-select-method))) (let ((prefix (gnus-group-prefixed-name "" method))) (goto-char (point-min)) (while (and (not (eobp)) --- 2397,2407 ---- (narrow-to-region (point-min) (point))) ;; If these are groups from a foreign select method, we insert the ;; group prefix in front of the group names. ! (and method (not (inline ! (gnus-server-equal ! (gnus-server-get-method nil method) ! (gnus-server-get-method ! nil gnus-select-method)))) (let ((prefix (gnus-group-prefixed-name "" method))) (goto-char (point-min)) (while (and (not (eobp)) *** pub/rgnus/lisp/gnus-topic.el Fri Mar 7 23:51:24 1997 --- rgnus/lisp/gnus-topic.el Sun Mar 9 18:41:36 1997 *************** *** 236,243 **** result found) (while (and topology (not (setq found (equal (caaar topology) topic))) ! (not (setq result (gnus-topic-parent-topic topic ! (car topology))))) (setq topology (cdr topology))) (or result (and found parent)))) --- 236,243 ---- result found) (while (and topology (not (setq found (equal (caaar topology) topic))) ! (not (setq result (gnus-topic-parent-topic ! topic (car topology))))) (setq topology (cdr topology))) (or result (and found parent)))) *** pub/rgnus/lisp/gnus-util.el Fri Mar 7 23:51:25 1997 --- rgnus/lisp/gnus-util.el Sun Mar 9 18:41:36 1997 *************** *** 145,151 **** (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (symbol-function func))) ! (if (byte-code-function-p fval) (let ((flist (append fval nil))) (setcar flist 'byte-code) flist) --- 145,151 ---- (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (symbol-function func))) ! (if (compiled-function-p fval) (let ((flist (append fval nil))) (setcar flist 'byte-code) flist) *************** *** 458,464 **** (let ((ids (inline (gnus-split-references references)))) (car (last ids (or n 1)))))) ! (defun gnus-buffer-live-p (buffer) "Say whether BUFFER is alive or not." (and buffer (get-buffer buffer) --- 458,464 ---- (let ((ids (inline (gnus-split-references references)))) (car (last ids (or n 1)))))) ! (defsubst gnus-buffer-live-p (buffer) "Say whether BUFFER is alive or not." (and buffer (get-buffer buffer) *** pub/rgnus/lisp/gnus.el Sun Mar 9 02:26:58 1997 --- rgnus/lisp/gnus.el Sun Mar 9 18:41:37 1997 *************** *** 226,232 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.24" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) --- 226,232 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.25" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) *************** *** 2378,2404 **** (memq option (assoc (format "%s" (car method)) gnus-valid-select-methods))) (defun gnus-server-extend-method (group method) ;; This function "extends" a virtual server. If the server is ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ;; called "hello+alt.alt". ! (if (or (not (gnus-similar-server-opened method)) (not (cddr method))) method `(,(car method) ,(concat (cadr method) "+" group) (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method)))) - (defun gnus-similar-server-opened (method) - (let ((opened gnus-opened-servers)) - (while (and method opened) - (when (and (equal (cadr method) (cadaar opened)) - (not (equal method (caar opened)))) - (setq method nil)) - (pop opened)) - (not method))) - (defun gnus-server-status (method) "Return the status of METHOD." (nth 1 (assoc method gnus-opened-servers))) --- 2378,2404 ---- (memq option (assoc (format "%s" (car method)) gnus-valid-select-methods))) + (defun gnus-similar-server-opened (method) + (let ((opened gnus-opened-servers)) + (while (and method opened) + (when (and (equal (cadr method) (cadaar opened)) + (not (equal method (caar opened)))) + (setq method nil)) + (pop opened)) + (not method))) + (defun gnus-server-extend-method (group method) ;; This function "extends" a virtual server. If the server is ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ;; called "hello+alt.alt". ! (if (or (not (inline (gnus-similar-server-opened method))) (not (cddr method))) method `(,(car method) ,(concat (cadr method) "+" group) (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method)))) (defun gnus-server-status (method) "Return the status of METHOD." (nth 1 (assoc method gnus-opened-servers))) *************** *** 2426,2434 **** gnus-select-method (setq method (cond ((stringp method) ! (gnus-server-to-method method)) ((stringp (cadr method)) ! (gnus-server-extend-method group method)) (t method))) (cond ((equal (cadr method) "") --- 2426,2434 ---- gnus-select-method (setq method (cond ((stringp method) ! (inline (gnus-server-to-method method))) ((stringp (cadr method)) ! (inline (gnus-server-extend-method group method))) (t method))) (cond ((equal (cadr method) "") *************** *** 2438,2444 **** (t (gnus-server-add-address method))))))) ! (defun gnus-check-backend-function (func group) "Check whether GROUP supports function FUNC. GROUP can either be a string (a group name) or a select method." (ignore-errors --- 2438,2444 ---- (t (gnus-server-add-address method))))))) ! (defsubst gnus-check-backend-function (func group) "Check whether GROUP supports function FUNC. GROUP can either be a string (a group name) or a select method." (ignore-errors *** pub/rgnus/lisp/messagexmas.el Fri Mar 7 23:51:28 1997 --- rgnus/lisp/messagexmas.el Sun Mar 9 18:41:37 1997 *************** *** 101,108 **** "Create a rot table with offset N." (let ((i -1) (table (make-string 256 0)) ! (a (char-int ?a)) ! (A (char-int ?A))) (while (< (incf i) 256) (aset table i i)) (concat --- 101,108 ---- "Create a rot table with offset N." (let ((i -1) (table (make-string 256 0)) ! (a (char-to-int ?a)) ! (A (char-to-int ?A))) (while (< (incf i) 256) (aset table i i)) (concat *** pub/rgnus/lisp/nndir.el Fri Mar 7 23:51:29 1997 --- rgnus/lisp/nndir.el Sun Mar 9 18:41:37 1997 *************** *** 63,70 **** server)) (unless (assq 'nndir-directory defs) (push `(nndir-directory ,server) defs)) - ;(when (equal server "") - ; (setq server (cadr (assq 'nndir-directory defs)))) (push `(nndir-current-group ,(file-name-nondirectory (directory-file-name nndir-directory))) defs) --- 63,68 ---- *** pub/rgnus/lisp/nnfolder.el Fri Mar 7 23:51:30 1997 --- rgnus/lisp/nnfolder.el Sun Mar 9 18:41:37 1997 *************** *** 217,238 **** (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) ! (nnfolder-possibly-change-group group server t) ! (nnmail-get-new-mail ! 'nnfolder ! (lambda () ! (let ((bufs nnfolder-buffer-alist)) ! (save-excursion ! (while bufs ! (if (not (buffer-name (nth 1 (car bufs)))) ! (setq nnfolder-buffer-alist ! (delq (car bufs) nnfolder-buffer-alist)) ! (set-buffer (nth 1 (car bufs))) ! (nnfolder-save-buffer) ! (kill-buffer (current-buffer))) ! (setq bufs (cdr bufs)))))) ! nnfolder-directory ! group)) ;; Don't close the buffer if we're not shutting down the server. This way, ;; we can keep the buffer in the group buffer cache, and not have to grovel --- 217,239 ---- (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) ! (when nnfolder-get-new-mail ! (nnfolder-possibly-change-group group server) ! (nnmail-get-new-mail ! 'nnfolder ! (lambda () ! (let ((bufs nnfolder-buffer-alist)) ! (save-excursion ! (while bufs ! (if (not (buffer-name (nth 1 (car bufs)))) ! (setq nnfolder-buffer-alist ! (delq (car bufs) nnfolder-buffer-alist)) ! (set-buffer (nth 1 (car bufs))) ! (nnfolder-save-buffer) ! (kill-buffer (current-buffer))) ! (setq bufs (cdr bufs)))))) ! nnfolder-directory ! group))) ;; Don't close the buffer if we're not shutting down the server. This way, ;; we can keep the buffer in the group buffer cache, and not have to grovel *************** *** 362,368 **** (goto-char (point-min)) (when (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last (nnfolder-save-buffer)))) result)) (deffoo nnfolder-request-accept-article (group &optional server last) --- 363,370 ---- (goto-char (point-min)) (when (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (when last ! (nnfolder-save-buffer)))) result)) (deffoo nnfolder-request-accept-article (group &optional server last) *************** *** 473,479 **** (point)) (point-max)))))) ! (defun nnfolder-possibly-change-group (group &optional server scanning) ;; Change servers. (when (and server (not (nnfolder-server-opened server))) --- 475,481 ---- (point)) (point-max)))))) ! (defun nnfolder-possibly-change-group (group &optional server) ;; Change servers. (when (and server (not (nnfolder-server-opened server))) *** pub/rgnus/lisp/nnmail.el Sun Mar 9 02:26:58 1997 --- rgnus/lisp/nnmail.el Sun Mar 9 18:41:38 1997 *************** *** 771,777 **** (setq end (point-max)))) (goto-char end)))) ! (defun nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." ;; Algorithm used to find the the next article in the ;; brain-dead Unix mbox format: --- 771,777 ---- (setq end (point-max)))) (goto-char end)))) ! (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." ;; Algorithm used to find the the next article in the ;; brain-dead Unix mbox format: *** pub/rgnus/lisp/nnmh.el Fri Mar 7 23:51:32 1997 --- rgnus/lisp/nnmh.el Sun Mar 9 18:41:38 1997 *************** *** 291,308 **** (nnmh-possibly-change-directory group server) (nnmail-check-syntax) (nnmail-cache-insert (nnmail-fetch-field "message-id")) ! (if (stringp group) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail ! (list (cons group (nnmh-active-number group))) ! noinsert))) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) ! noinsert)))) ! (when last ! (nnmail-cache-close))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) --- 291,309 ---- (nnmh-possibly-change-directory group server) (nnmail-check-syntax) (nnmail-cache-insert (nnmail-fetch-field "message-id")) ! (prog1 ! (if (stringp group) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail ! (list (cons group (nnmh-active-number group))) ! noinsert))) ! (and ! (nnmail-activate 'nnmh) ! (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) ! noinsert)))) ! (when last ! (nnmail-cache-close)))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) *** pub/rgnus/lisp/nnoo.el Fri Mar 7 23:51:33 1997 --- rgnus/lisp/nnoo.el Sun Mar 9 18:41:38 1997 *************** *** 207,213 **** (pop defs)) (nconc bstate (list (cons current state)))))) ! (defun nnoo-current-server-p (backend server) (equal (nnoo-current-server backend) server)) (defun nnoo-current-server (backend) --- 207,213 ---- (pop defs)) (nconc bstate (list (cons current state)))))) ! (defsubst nnoo-current-server-p (backend server) (equal (nnoo-current-server backend) server)) (defun nnoo-current-server (backend) *** pub/rgnus/lisp/nntp.el Fri Mar 7 23:51:34 1997 --- rgnus/lisp/nntp.el Sun Mar 9 18:41:39 1997 *************** *** 172,177 **** --- 172,329 ---- + ;;; Internal functions. + + (defsubst nntp-send-string (process string) + "Send STRING to PROCESS." + (process-send-string process (concat string nntp-end-of-line))) + + (defsubst nntp-wait-for (process wait-for buffer &optional decode discard) + "Wait for WAIT-FOR to arrive from PROCESS." + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-min)) + (while (or (not (memq (following-char) '(?2 ?3 ?4 ?5))) + (looking-at "480")) + (when (looking-at "480") + (erase-buffer) + (funcall nntp-authinfo-function)) + (nntp-accept-process-output process) + (goto-char (point-min))) + (prog1 + (if (looking-at "[45]") + (progn + (nntp-snarf-error-message) + nil) + (goto-char (point-max)) + (let ((limit (point-min))) + (while (not (re-search-backward wait-for limit t)) + ;; We assume that whatever we wait for is less than 1000 + ;; characters long. + (setq limit (max (- (point-max) 1000) (point-min))) + (nntp-accept-process-output process) + (goto-char (point-max)))) + (nntp-decode-text (not decode)) + (unless discard + (save-excursion + (set-buffer buffer) + (goto-char (point-max)) + (insert-buffer-substring (process-buffer process)) + ;; Nix out "nntp reading...." message. + (when nntp-have-messaged + (setq nntp-have-messaged nil) + (message "")) + t))) + (unless discard + (erase-buffer))))) + + (defsubst nntp-find-connection (buffer) + "Find the connection delivering to BUFFER." + (let ((alist nntp-connection-alist) + (buffer (if (stringp buffer) (get-buffer buffer) buffer)) + process entry) + (while (setq entry (pop alist)) + (when (eq buffer (cadr entry)) + (setq process (car entry) + alist nil))) + (when process + (if (memq (process-status process) '(open run)) + process + (when (buffer-name (process-buffer process)) + (kill-buffer (process-buffer process))) + (setq nntp-connection-alist (delq entry nntp-connection-alist)) + nil)))) + + (defsubst nntp-find-connection-entry (buffer) + "Return the entry for the connection to BUFFER." + (assq (nntp-find-connection buffer) nntp-connection-alist)) + + (defun nntp-find-connection-buffer (buffer) + "Return the process connection buffer tied to BUFFER." + (let ((process (nntp-find-connection buffer))) + (when process + (process-buffer process)))) + + (defsubst nntp-retrieve-data (command address port buffer + &optional wait-for callback decode) + "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." + (let ((process (or (nntp-find-connection buffer) + (nntp-open-connection buffer)))) + (if (not process) + (nnheader-report 'nntp "Couldn't open connection to %s" address) + (unless (or nntp-inhibit-erase nnheader-callback-function) + (save-excursion + (set-buffer (process-buffer process)) + (erase-buffer))) + (when command + (nntp-send-string process command)) + (cond + ((eq callback 'ignore) + t) + ((and callback wait-for) + (save-excursion + (set-buffer (process-buffer process)) + (unless nntp-inside-change-function + (erase-buffer)) + (setq nntp-process-decode decode + nntp-process-to-buffer buffer + nntp-process-wait-for wait-for + nntp-process-callback callback + nntp-process-start-point (point-max) + after-change-functions + (list 'nntp-after-change-function-callback))) + t) + (wait-for + (nntp-wait-for process wait-for buffer decode)) + (t t))))) + + (defsubst nntp-send-command (wait-for &rest strings) + "Send STRINGS to server and wait until WAIT-FOR returns." + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer))) + (nntp-retrieve-data + (mapconcat 'identity strings " ") + nntp-address nntp-port-number nntp-server-buffer + wait-for nnheader-callback-function)) + + (defun nntp-send-command-nodelete (wait-for &rest strings) + "Send STRINGS to server and wait until WAIT-FOR returns." + (nntp-retrieve-data + (mapconcat 'identity strings " ") + nntp-address nntp-port-number nntp-server-buffer + wait-for nnheader-callback-function)) + + (defun nntp-send-command-and-decode (wait-for &rest strings) + "Send STRINGS to server and wait until WAIT-FOR returns." + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer))) + (nntp-retrieve-data + (mapconcat 'identity strings " ") + nntp-address nntp-port-number nntp-server-buffer + wait-for nnheader-callback-function t)) + + (defun nntp-send-buffer (wait-for) + "Send the current buffer to server and wait until WAIT-FOR returns." + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) + (save-excursion + (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) + (erase-buffer))) + (nntp-encode-text) + (process-send-region (nntp-find-connection nntp-server-buffer) + (point-min) (point-max)) + (nntp-retrieve-data + nil nntp-address nntp-port-number nntp-server-buffer + wait-for nnheader-callback-function)) + + + ;;; Interface functions. (nnoo-define-basics nntp) *************** *** 561,638 **** ;;; Internal functions. - (defun nntp-send-command (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - - (defun nntp-send-command-nodelete (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - - (defun nntp-send-command-and-decode (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function t)) - - (defun nntp-send-buffer (wait-for) - "Send the current buffer to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer))) - (nntp-encode-text) - (process-send-region (nntp-find-connection nntp-server-buffer) - (point-min) (point-max)) - (nntp-retrieve-data - nil nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - - (defun nntp-find-connection (buffer) - "Find the connection delivering to BUFFER." - (let ((alist nntp-connection-alist) - (buffer (if (stringp buffer) (get-buffer buffer) buffer)) - process entry) - (while (setq entry (pop alist)) - (when (eq buffer (cadr entry)) - (setq process (car entry) - alist nil))) - (when process - (if (memq (process-status process) '(open run)) - process - (when (buffer-name (process-buffer process)) - (kill-buffer (process-buffer process))) - (setq nntp-connection-alist (delq entry nntp-connection-alist)) - nil)))) - - (defun nntp-find-connection-entry (buffer) - "Return the entry for the connection to BUFFER." - (assq (nntp-find-connection buffer) nntp-connection-alist)) - - (defun nntp-find-connection-buffer (buffer) - "Return the process connection buffer tied to BUFFER." - (let ((process (nntp-find-connection buffer))) - (when process - (process-buffer process)))) - (defun nntp-make-process-buffer (buffer) "Create a new, fresh buffer usable for nntp process connections." (save-excursion --- 713,718 ---- *************** *** 730,811 **** (save-excursion (funcall callback (buffer-name (get-buffer nntp-process-to-buffer)))))))))) - - (defun nntp-retrieve-data (command address port buffer - &optional wait-for callback decode) - "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." - (let ((process (or (nntp-find-connection buffer) - (nntp-open-connection buffer)))) - (if (not process) - (nnheader-report 'nntp "Couldn't open connection to %s" address) - (unless (or nntp-inhibit-erase nnheader-callback-function) - (save-excursion - (set-buffer (process-buffer process)) - (erase-buffer))) - (when command - (nntp-send-string process command)) - (cond - ((eq callback 'ignore) - t) - ((and callback wait-for) - (save-excursion - (set-buffer (process-buffer process)) - (unless nntp-inside-change-function - (erase-buffer)) - (setq nntp-process-decode decode - nntp-process-to-buffer buffer - nntp-process-wait-for wait-for - nntp-process-callback callback - nntp-process-start-point (point-max) - after-change-functions - (list 'nntp-after-change-function-callback))) - t) - (wait-for - (nntp-wait-for process wait-for buffer decode)) - (t t))))) - - (defun nntp-send-string (process string) - "Send STRING to PROCESS." - (process-send-string process (concat string nntp-end-of-line))) - - (defun nntp-wait-for (process wait-for buffer &optional decode discard) - "Wait for WAIT-FOR to arrive from PROCESS." - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-min)) - (while (or (not (memq (following-char) '(?2 ?3 ?4 ?5))) - (looking-at "480")) - (when (looking-at "480") - (erase-buffer) - (funcall nntp-authinfo-function)) - (nntp-accept-process-output process) - (goto-char (point-min))) - (prog1 - (if (looking-at "[45]") - (progn - (nntp-snarf-error-message) - nil) - (goto-char (point-max)) - (let ((limit (point-min))) - (while (not (re-search-backward wait-for limit t)) - ;; We assume that whatever we wait for is less than 1000 - ;; characters long. - (setq limit (max (- (point-max) 1000) (point-min))) - (nntp-accept-process-output process) - (goto-char (point-max)))) - (nntp-decode-text (not decode)) - (unless discard - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) - ;; Nix out "nntp reading...." message. - (when nntp-have-messaged - (setq nntp-have-messaged nil) - (message "")) - t))) - (unless discard - (erase-buffer))))) (defun nntp-snarf-error-message () "Save the error message in the current buffer." --- 810,815 ---- *** pub/rgnus/lisp/nnvirtual.el Fri Mar 7 23:51:34 1997 --- rgnus/lisp/nnvirtual.el Sun Mar 9 18:41:39 1997 *************** *** 579,585 **** )) ! (defun nnvirtual-reverse-map-sequence (group articles) "Return list of virtual article numbers for all ARTICLES in GROUP. The ARTICLES should be sorted, and can be a compressed sequence. If any of the article numbers has no corresponding virtual article, --- 579,585 ---- )) ! (defsubst nnvirtual-reverse-map-sequence (group articles) "Return list of virtual article numbers for all ARTICLES in GROUP. The ARTICLES should be sorted, and can be a compressed sequence. If any of the article numbers has no corresponding virtual article, *** pub/rgnus/lisp/ChangeLog Sun Mar 9 02:26:54 1997 --- rgnus/lisp/ChangeLog Sun Mar 9 18:41:34 1997 *************** *** 1,3 **** --- 1,34 ---- + Sun Mar 9 18:38:37 1997 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.25 is released. + + Sun Mar 9 04:11:02 1997 Lars Magne Ingebrigtsen + + * gnus.el: Inlined and defsubsts various functions. + + * nnmail.el (nnmail-search-unix-mail-delim): Made into subst. + + * nnfolder.el (nnfolder-request-scan): Don't do anything when not + getting mail. + + * nnmh.el (nnmh-request-accept-article): Return the correct + value. + + * gnus-group.el (gnus-group-kill-all-zombies): Touch dribble. + + * gnus-score.el (gnus-score-find-trace): Message default score. + + Sat Mar 8 18:17:53 1997 Steven L Baur + + * gnus-util.el (gnus-byte-code): Use better (and still compatible) + name of `compiled-function-p'. + + Sat Mar 8 18:17:53 1997 Steven L Baur + + * messagexmas.el (message-xmas-make-caesar-translation-table): + char-int is a braindamaged and stupid name for a conversion + function. + Sun Mar 9 01:51:16 1997 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.4.24 is released. *** pub/rgnus/texi/widget.texi Sun Mar 9 02:27:01 1997 --- rgnus/texi/widget.texi Sun Mar 9 18:41:40 1997 *************** *** 1,6 **** \input texinfo.tex ! @c $Id: widget.texi,v 1.87 1997/03/08 16:21:38 abraham Exp $ @c %**start of header @setfilename widget --- 1,6 ---- \input texinfo.tex ! @c $Id: widget.texi,v 3.63 1997/03/09 00:54:16 larsi Exp $ @c %**start of header @setfilename widget