+Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.57 is released.
+
+1998-11-23 Felix Lee <flee@cygnus.com>
+
+ * nntp.el (nntp-async-needs-kluge): new setting.
+ (nntp-async-timer): new var.
+ (nntp-async-process-list): new var.
+ (nntp-async-kluge): new function.
+ (nntp-async-timer-handler): new function.
+ (nntp-async-wait): new function.
+ (nntp-async-stop): new function.
+ (nntp-after-change-function): renamed, and split apart.
+ (nntp-async-trigger): new function.
+ (nntp-do-callback): new function.
+ (nntp-accept-process-output): add optional timeout arg.
+
+ * gnus-async.el (gnus-async-request-fetched-article): fixed.
+ (gnus-async-wait-for-article): new function.
+ (gnus-async-with-semaphore): s/asynch/async/.
+
+1998-11-30 16:54:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-with-article): Don't encode.
+ (gnus-insert-mime-button): Fall back on filename from C-D.
+ (gnus-mime-display-single): Have dots right on text/plain
+ attachments.
+
+ * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in
+ broken parts.
+
+ * gnus-art.el (gnus-with-article): Flush cache and backlog.
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Also do
+ binhex.
+
+ * gnus-sum.el (gnus-summary-reparent-thread): Use new macro.
+ (gnus-summary-repair-multipart): New command and keystroke.
+
+ * gnus-art.el (gnus-with-article-buffer): New macro.
+
+Sun Nov 29 23:51:57 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-inline-part): Do not get part when
+ undisplay the part.
+
+1998-11-30 03:38:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el (gnus-make-sort-function-1): Allow lambdas.
+
+ * mml.el (mml-read-part): Partition right.
+
+ * mm-decode.el (mm-handle-set-cache): New macro.
+ (mm-handle-cache): Ditto.
+ (mm-make-handle): Ditto.
+ (mm-dissect-singlepart): Use it.
+ (mm-get-image): Use the cache.
+
+1998-11-29 23:44:44 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-display-mixed): Rewrite.
+ (gnus-mime-display-single): Don't insert lines between parts.
+
+Sun Nov 29 04:55:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-file-coding-system-1): New variable.
+ * nnfolder.el (nnfolder-file-coding-system): Ditto.
+ (nnfolder-read-folder): Use nnfolder-file-coding-system.
+ * nnml.el (nnml-file-coding-system): New variable.
+ (nnml-request-article): Use nnml-file-coding-system.
+
Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.56 is released.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Create Date: Oct 1, 1998
-;; $Revision: 1.1.1.3 $
+;; $Revision: 1.1.1.4 $
;; Time-stamp: <Tue Oct 6 23:48:38 EDT 1998 zsh>
;; Keywords: binhex
(max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE, copy the contents of the original article buffer to a new buffer, and then perform FORMS there.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ (let ((buf (format "%s" (buffer-string))))
+ (with-temp-buffer
+ (insert buf)
+ ,@forms
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article"))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
(interactive "P") ; For compatibility reasons we are not using "z".
(gnus-article-check-buffer)
(let* ((data (get-text-property (point) 'gnus-data))
- (contents (mm-get-part data))
+ contents
;(url-standalone-mode (not gnus-plugged))
(b (point))
buffer-read-only)
(if (mm-handle-undisplayer data)
(mm-remove-part data)
+ (setq contents (mm-get-part data))
(forward-line 2)
(when charset
(unless (symbolp charset)
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
(let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
+ (filename (mail-content-type-get (mm-handle-disposition handle)
+ 'filename))
(gnus-tmp-type (car (mm-handle-type handle)))
(gnus-tmp-description (mm-handle-description handle))
(gnus-tmp-dots
(set-buffer (mm-handle-buffer handle))
(buffer-size)))
b e)
+ (setq gnus-tmp-name (or gnus-tmp-name filename))
(setq gnus-tmp-name
(if gnus-tmp-name
(concat " (" gnus-tmp-name ")")
(funcall gnus-article-mime-part-function handles)))
(defun gnus-mime-display-mixed (handles)
- (let (handle)
- (while (setq handle (pop handles))
- (gnus-mime-display-part handle))))
+ (mapcar 'gnus-mime-display-part handles))
(defun gnus-mime-display-single (handle)
(let ((type (car (mm-handle-type handle)))
(ignored gnus-ignored-mime-types)
(not-attachment t)
+ (move nil)
display text)
(catch 'ignored
(progn
(gnus-article-insert-newline)
(gnus-insert-mime-button
handle id (list (or display
- (and (not not-attachment) text))))
- (gnus-article-insert-newline)))
- (gnus-article-insert-newline)
+ (and not-attachment text))))
+ (gnus-article-insert-newline)
+ (gnus-article-insert-newline)
+ (setq move t)))
(cond
(display
- (forward-line -2)
+ (when move
+ (forward-line -2))
(let ((rfc2047-default-charset gnus-newsgroup-default-charset)
(mm-charset-iso-8859-1-forced
gnus-newsgroup-iso-8859-1-forced))
(mm-display-part handle t))
(goto-char (point-max)))
((and text not-attachment)
- (forward-line -2)
+ (when move
+ (forward-line -2))
(gnus-article-insert-newline)
(mm-insert-inline handle (mm-get-part handle))
(goto-char (point-max))))))))
,@forms)
(gnus-async-release-semaphore 'gnus-async-article-semaphore)))
-(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
-(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
+(put 'gnus-async-with-semaphore 'lisp-indent-function 0)
+(put 'gnus-async-with-semaphore 'edebug-form-spec '(body))
;;;
;;; Article prefetch
(defun gnus-async-request-fetched-article (group article buffer)
"See whether we have ARTICLE from GROUP and put it in BUFFER."
(when (numberp article)
- (when (and gnus-async-current-prefetch-group
- (string= group gnus-async-current-prefetch-group)
+ (when (and (equal group gnus-async-current-prefetch-group)
(eq article gnus-async-current-prefetch-article))
- (save-excursion
- (gnus-async-set-buffer)
- (gnus-message 5 "Waiting for async article...")
- (let ((proc (nntp-find-connection (current-buffer)))
- (nntp-server-buffer (current-buffer))
- (nntp-have-messaged nil))
- (while (eq article (car gnus-async-fetch-list))
- (nntp-accept-process-output proc)))
- (gnus-message 5 "Waiting for async article...done")))
+ (gnus-async-wait-for-article article))
(let ((entry (gnus-async-prefetched-article-entry group article)))
(when entry
(save-excursion
(gnus-async-delete-prefetched-entry entry))
t)))))
+(defun gnus-async-wait-for-article (article)
+ "Wait until ARTICLE is no longer the currently-being-fetched article."
+ (save-excursion
+ (gnus-async-set-buffer)
+ (let ((proc (nntp-find-connection (current-buffer)))
+ (nntp-server-buffer (current-buffer))
+ (nntp-have-messaged nil)
+ (tries 0))
+ (condition-case nil
+ ;; FIXME: we could stop waiting after some
+ ;; timeout, but this is the wrong place to do it.
+ ;; rather than checking time-spent-waiting, we
+ ;; should check time-since-last-output, which
+ ;; needs to be done in nntp.el.
+ (while (eq article gnus-async-current-prefetch-article)
+ (incf tries)
+ (when (nntp-accept-process-output proc 1)
+ (setq tries 0))
+ (when (and (not nntp-have-messaged) (eq 3 tries))
+ (gnus-message 5 "Waiting for async article...")
+ (setq nntp-have-messaged t)))
+ (quit
+ ;; if the user interrupted on a slow/hung connection,
+ ;; do something friendly.
+ (when (< 3 tries)
+ (setq gnus-async-current-prefetch-article nil))
+ (signal 'quit nil)))
+ (when nntp-have-messaged
+ (gnus-message 5 "")))))
+
(defun gnus-async-delete-prefetched-entry (entry)
"Delete ENTRY from buffer and alist."
(ignore-errors
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
"b" gnus-summary-display-buttonized
+ "m" gnus-summary-repair-multipart
"v" gnus-article-view-part
"o" gnus-article-save-part
"c" gnus-article-copy-part
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent"))
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil current-article))
- (set-buffer gnus-original-article-buffer)
- (let ((buf (format "%s" (buffer-string))))
- (with-temp-buffer
- (insert buf)
- (goto-char (point-min))
- (if (re-search-forward "^References: " nil t)
- (progn
- (re-search-forward "^[^ \t]" nil t)
- (forward-line -1)
- (end-of-line)
- (insert " " message-id))
- (insert "References: " message-id "\n"))
- (unless (gnus-request-replace-article
- current-article (car gnus-article-current)
- (current-buffer))
- (error "Couldn't replace article"))))
+ (gnus-with-article current-article
+ (goto-char (point-min))
+ (if (re-search-forward "^References: " nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil t)
+ (forward-line -1)
+ (end-of-line)
+ (insert " " message-id))
+ (insert "References: " message-id "\n")))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-update-article current-article)
(require 'gnus-art)
(let ((gnus-unbuttonized-mime-types nil))
(gnus-summary-show-article)))
-
+
+(defun gnus-summary-repair-multipart (article)
+ "Add a Content-Type header to a multipart article without one."
+ (interactive (list (gnus-summary-article-number)))
+ (gnus-with-article article
+ (message-narrow-to-head)
+ (goto-char (point-max))
+ (widen)
+ (when (search-forward "\n--" nil t)
+ (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
+ (message-narrow-to-head)
+ (message-remove-header "Mime-Version")
+ (message-remove-header "Content-Type")
+ (goto-char (point-max))
+ (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
+ separator))
+ (insert "Mime-Version: 1.0\n")
+ (widen)))))
+
(defun gnus-summary-toggle-display-buttonized ()
"Toggle the buttonizing of the article buffer."
(interactive)
(first 't1)
(last 't2))
(when (consp function)
- (if (eq (car function) 'not)
- (setq function (cadr function)
- first 't2
- last 't1)
- (error "Invalid sort spec: %s" function)))
+ (cond
+ ;; Reversed spec.
+ ((eq (car function) 'not)
+ (setq function (cadr function)
+ first 't2
+ last 't1))
+ ((gnus-functionp function)
+ )
+ (t
+ (error "Invalid sort spec: %s" function))))if
(if (cdr funs)
`(or (,function ,first ,last)
(and (not (,function ,last ,first))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.56"
+(defconst gnus-version-number "0.57"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(condition-case ()
(uudecode-decode-region (point-min) (point-max))
(error nil)))
+ ((eq encoding 'x-binhex)
+ (condition-case ()
+ (binhex-decode-region (point-min) (point-max))
+ (error nil)))
((functionp encoding)
(condition-case ()
(funcall encoding (point-min) (point-max))
`(nth 4 ,handle))
(defmacro mm-handle-description (handle)
`(nth 5 ,handle))
+(defmacro mm-handle-cache (handle)
+ `(nth 6 ,handle))
+(defmacro mm-handle-set-cache (handle contents)
+ `(setcar (nthcdr 6 ,handle) ,contents))
+(defmacro mm-make-handle (&optional buffer type encoding undisplayer
+ disposition description cache)
+ `(list ,buffer ,type ,encoding ,undisplayer
+ ,disposition ,description ,cache))
(defvar mm-inline-media-tests
'(("image/jpeg" mm-inline-image
(let (ct ctl type subtype cte cd description id result)
(save-restriction
(mail-narrow-to-head)
- (when (and (or no-strict-mime
- (mail-fetch-field "mime-version"))
- (setq ct (mail-fetch-field "content-type")))
- (setq ctl (condition-case () (mail-header-parse-content-type ct)
+ (when (or no-strict-mime
+ (mail-fetch-field "mime-version"))
+ (setq ct (mail-fetch-field "content-type")
+ ctl (condition-case () (mail-header-parse-content-type ct)
(error nil))
cte (mail-fetch-field "content-transfer-encoding")
cd (mail-fetch-field "content-disposition")
id (mail-fetch-field "content-id"))))
(if (not ctl)
(mm-dissect-singlepart
- '("text/plain") nil no-strict-mime nil description)
+ '("text/plain") nil no-strict-mime
+ (and cd (condition-case ()
+ (mail-header-parse-content-disposition cd)
+ (error nil)))
+ description)
(setq type (split-string (car ctl) "/"))
(setq subtype (cadr type)
type (pop type))
(defun mm-dissect-singlepart (ctl cte &optional force cdl description)
(when (or force
(not (equal "text/plain" (car ctl))))
- (let ((res (list (mm-copy-to-buffer) ctl cte nil cdl description)))
+ (let ((res (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description)))
(push (car res) mm-dissection-list)
res)))
(defun mm-get-image (handle)
"Return an image instance based on HANDLE."
- (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))))
- (mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (car (mm-handle-type handle)))
- (make-image-specifier
- (vector (intern type) :data (buffer-string))))))
+ (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+ spec)
+ (or (mm-handle-cache handle)
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (car (mm-handle-type handle)))
+ (prog1
+ (setq spec
+ (make-image-specifier
+ (vector (intern type) :data (buffer-string))))
+ (mm-handle-set-cache handle spec))))))
(defun mm-image-fit-p (handle)
"Say whether the image in HANDLE will fit the current window."
;; If the tag ended at the end of the line, we go to the next line.
(when (looking-at "[ \t]*\n")
(forward-line 1))
- (if (re-search-forward "<#/?\\(multipart\\|part\\|external\\)." nil t)
+ (if (re-search-forward
+ "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t)
(prog1
(buffer-substring beg (match-beginning 0))
- (if (equal (match-string 0) "<#/multipart>")
+ (if (or (not (match-beginning 1))
+ (equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
(nntp-send-buffer "^[23].*\n"))
(set-buffer nntp-server-buffer)
- (setq msg (buffer-string (point-min) (point-max)))
+ (setq msg (buffer-substring (point-min) (point-max)))
(or (string-match "^\\([0-9]+\\)" msg)
(error "nndb: %s" msg))
(setq art (substring msg (match-beginning 1) (match-end 1)))
(deffoo nndb-status-message (&optional server)
"Return server status as a string."
(set-buffer nntp-server-buffer)
- (buffer-string (point-min) (point-max)))
+ (buffer-substring (point-min) (point-max)))
;; Import stuff from nntp
(defvoo nnfolder-buffer-alist nil)
(defvoo nnfolder-scantime-alist nil)
(defvoo nnfolder-active-timestamp nil)
+(defvoo nnfolder-file-coding-system nnmail-file-coding-system-1)
\f
(defun nnfolder-read-folder (group)
(let* ((file (nnfolder-group-pathname group))
- (buffer (set-buffer (nnheader-find-file-noselect file))))
+ (buffer (set-buffer
+ (let ((nnmail-file-coding-system
+ nnfolder-file-coding-system))
+ (nnheader-find-file-noselect file)))))
(if (equal (cadr (assoc group nnfolder-scantime-alist))
(nth 5 (file-attributes file)))
;; This looks up-to-date, so we don't do any scanning.
(defvar nnmail-file-coding-system 'binary
"Coding system used in nnmail.")
+(defvar nnmail-file-coding-system-1
+ (if (string-match "nt" system-configuration)
+ 'raw-text-dos 'binary)
+ "Another coding system used in nnmail.")
+
(defun nnmail-find-file (file)
"Insert FILE in server buffer safely."
(set-buffer nntp-server-buffer)
(defvar nnml-nov-buffer-file-name nil)
+(defvoo nnml-file-coding-system nnmail-file-coding-system-1)
+
\f
;;; Interface functions.
(nnheader-report 'nnml "No such file: %s" path))
((file-directory-p path)
(nnheader-report 'nnml "File is a directory: %s" path))
- ((not (save-excursion (nnmail-find-file path)))
+ ((not (save-excursion (let ((nnmail-file-coding-system
+ nnml-file-coding-system))
+ (nnmail-find-file path))))
(nnheader-report 'nnml "Couldn't read file: %s" path))
(t
(nnheader-report 'nnml "Article %s retrieved" id)
(defvoo nntp-server-xover 'try)
(defvoo nntp-server-list-active-group 'try)
+(defvar nntp-async-needs-kluge
+ (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
+ "*When non-nil, nntp will poll asynchronous connections
+once a second. By default, this is turned on only for Emacs
+20.3, which has a bug that breaks nntp's normal method of
+noticing asynchronous data.")
+
+(defvar nntp-async-timer nil)
+(defvar nntp-async-process-list nil)
+
(eval-and-compile
(autoload 'nnmail-read-passwd "nnmail")
(autoload 'open-ssl-stream "ssl"))
((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)))
+ (nntp-async-wait process wait-for buffer decode callback)
t)
(wait-for
(nntp-wait-for process wait-for buffer decode))
(eval (cadr entry))
(funcall (cadr entry)))))))
-(defun nntp-after-change-function-callback (beg end len)
+(defun nntp-async-wait (process wait-for buffer decode callback)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (unless nntp-inside-change-function
+ (erase-buffer))
+ (setq nntp-process-wait-for wait-for
+ nntp-process-to-buffer buffer
+ nntp-process-decode decode
+ nntp-process-callback callback
+ nntp-process-start-point (point-max))
+ (setq after-change-functions '(nntp-after-change-function))
+ (if nntp-async-needs-kluge
+ (nntp-async-kluge process))))
+
+(defun nntp-async-kluge (process)
+ ;; emacs 20.3 bug: process output with encoding 'binary
+ ;; doesn't trigger after-change-functions.
+ (unless nntp-async-timer
+ (setq nntp-async-timer
+ (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
+ (add-to-list 'nntp-async-process-list process))
+
+(defun nntp-async-timer-handler ()
+ (mapcar
+ (lambda (proc)
+ (if (memq (process-status proc) '(open run))
+ (nntp-async-trigger proc)
+ (nntp-async-stop proc)))
+ nntp-async-process-list))
+
+(defun nntp-async-stop (proc)
+ (setq nntp-async-process-list (delq proc nntp-async-process-list))
+ (when (and nntp-async-timer (not nntp-async-process-list))
+ (nnheader-cancel-timer nntp-async-timer)
+ (setq nntp-async-timer nil)))
+
+(defun nntp-after-change-function (beg end len)
(unwind-protect
- (when nntp-process-callback
+ ;; we only care about insertions at eob
+ (when (and (eq 0 len) (eq (point-max) end))
(save-match-data
- (if (and (= beg (point-min))
- (memq (char-after beg) '(?4 ?5)))
- ;; Report back error messages.
- (save-excursion
- (goto-char beg)
- (if (looking-at "480")
- (nntp-handle-authinfo nntp-process-to-buffer)
- (nntp-snarf-error-message)
- (funcall nntp-process-callback nil)))
- (goto-char end)
- (when (and (> (point) nntp-process-start-point)
- (re-search-backward nntp-process-wait-for
- nntp-process-start-point t))
- (when (gnus-buffer-exists-p nntp-process-to-buffer)
- (let ((cur (current-buffer))
- (start nntp-process-start-point))
- (save-excursion
- (set-buffer nntp-process-to-buffer)
- (goto-char (point-max))
- (let ((b (point)))
- (insert-buffer-substring cur start)
- (narrow-to-region b (point-max))
- (nntp-decode-text)
- (widen)))))
- (goto-char end)
- (let ((callback nntp-process-callback)
- (nntp-inside-change-function t))
- (setq nntp-process-callback nil)
- (save-excursion
- (funcall callback
- (buffer-name (get-buffer
- nntp-process-to-buffer)))))))))
-
- ;; Any throw from after-change-functions will leave it
- ;; set to nil. So we reset it here, if necessary.
+ (nntp-async-trigger (get-buffer-process (current-buffer)))))
+ ;; any throw from after-change-functions will leave it
+ ;; set to nil. so we reset it here, if necessary.
(when quit-flag
- (setq after-change-functions
- (list 'nntp-after-change-function-callback)))))
+ (setq after-change-functions '(nntp-after-change-function)))))
+
+(defun nntp-async-trigger (process)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (when nntp-process-callback
+ ;; do we have an error message?
+ (goto-char nntp-process-start-point)
+ (if (memq (following-char) '(?4 ?5))
+ ;; wants credentials?
+ (if (looking-at "480")
+ (nntp-handle-authinfo nntp-process-to-buffer)
+ ;; report error message.
+ (nntp-snarf-error-message)
+ (nntp-do-callback nil))
+
+ ;; got what we expect?
+ (goto-char (point-max))
+ (when (re-search-backward
+ nntp-process-wait-for nntp-process-start-point t)
+ (nntp-async-stop process)
+ ;; convert it.
+ (when (gnus-buffer-exists-p nntp-process-to-buffer)
+ (let ((buf (current-buffer))
+ (start nntp-process-start-point)
+ (decode nntp-process-decode))
+ (save-excursion
+ (set-buffer nntp-process-to-buffer)
+ (goto-char (point-max))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert-buffer-substring buf start)
+ (when decode
+ (nntp-decode-text))))))
+ ;; report it.
+ (goto-char (point-max))
+ (nntp-do-callback
+ (buffer-name (get-buffer nntp-process-to-buffer))))))))
+
+(defun nntp-do-callback (arg)
+ (let ((callback nntp-process-callback)
+ (nntp-inside-change-function t))
+ (setq nntp-process-callback nil)
+ (funcall callback arg)))
(defun nntp-snarf-error-message ()
"Save the error message in the current buffer."
(nnheader-report 'nntp message)
message))
-(defun nntp-accept-process-output (process)
+(defun nntp-accept-process-output (process &optional timeout)
"Wait for output from PROCESS and message some dots."
(save-excursion
(set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
(unless (< len 10)
(setq nntp-have-messaged t)
(nnheader-message 7 "nntp read: %dk" len)))
- (accept-process-output process 1)))
+ (accept-process-output process (or timeout 1))))
(defun nntp-accept-response ()
"Wait for output from the process that outputs to BUFFER."
;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 5.2 $
+;; $Revision: 5.3 $
;; Keywords: uudecode
;; This file is not part of GNU Emacs, but the same permissions
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.56 Manual
+@settitle Pterodactyl Message 0.57 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.56 Manual
+@title Pterodactyl Message 0.57 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.56. Message is
+This manual corresponds to Pterodactyl Message 0.57. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / elisp / gnus.git- / commitdiff