*** pub/pgnus/lisp/binhex.el Sun Nov 29 16:03:52 1998 --- pgnus/lisp/binhex.el Mon Nov 30 22:46:59 1998 *************** *** 3,9 **** ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 ! ;; $Revision: 5.2 $ ;; Time-stamp: ;; Keywords: binhex --- 3,9 ---- ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 ! ;; $Revision: 5.3 $ ;; Time-stamp: ;; Keywords: binhex *** pub/pgnus/lisp/gnus-art.el Sun Nov 29 16:03:53 1998 --- pgnus/lisp/gnus-art.el Mon Nov 30 22:46:59 1998 *************** *** 636,641 **** --- 636,673 ---- (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) *************** *** 2350,2361 **** (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)) ;(url-standalone-mode (not gnus-plugged)) (b (point)) buffer-read-only) (if (mm-handle-undisplayer data) (mm-remove-part data) (forward-line 2) (when charset (unless (symbolp charset) --- 2382,2394 ---- (interactive "P") ; For compatibility reasons we are not using "z". (gnus-article-check-buffer) (let* ((data (get-text-property (point) 'gnus-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) *************** *** 2455,2460 **** --- 2488,2495 ---- (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 *************** *** 2465,2470 **** --- 2500,2506 ---- (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 ")") *************** *** 2544,2557 **** (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)))) (defun gnus-mime-display-single (handle) (let ((type (car (mm-handle-type handle))) (ignored gnus-ignored-mime-types) (not-attachment t) display text) (catch 'ignored (progn --- 2580,2592 ---- (funcall gnus-article-mime-part-function handles))) (defun gnus-mime-display-mixed (handles) ! (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 *************** *** 2575,2593 **** (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) (cond (display ! (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) (gnus-article-insert-newline) (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))))))) --- 2610,2631 ---- (gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display ! (and not-attachment text)))) ! (gnus-article-insert-newline) ! (gnus-article-insert-newline) ! (setq move t))) (cond (display ! (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) ! (when move ! (forward-line -2)) (gnus-article-insert-newline) (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))))))) *** pub/pgnus/lisp/gnus-async.el Fri Nov 20 05:25:06 1998 --- pgnus/lisp/gnus-async.el Mon Nov 30 22:47:00 1998 *************** *** 108,115 **** ,@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)) ;;; ;;; Article prefetch --- 108,115 ---- ,@forms) (gnus-async-release-semaphore 'gnus-async-article-semaphore))) ! (put 'gnus-async-with-semaphore 'lisp-indent-function 0) ! (put 'gnus-async-with-semaphore 'edebug-form-spec '(body)) ;;; ;;; Article prefetch *************** *** 241,258 **** (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) (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"))) (let ((entry (gnus-async-prefetched-article-entry group article))) (when entry (save-excursion --- 241,249 ---- (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 (equal group gnus-async-current-prefetch-group) (eq article gnus-async-current-prefetch-article)) ! (gnus-async-wait-for-article article)) (let ((entry (gnus-async-prefetched-article-entry group article))) (when entry (save-excursion *************** *** 262,267 **** --- 253,288 ---- (when (memq 'read gnus-prefetched-article-deletion-strategy) (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." *** pub/pgnus/lisp/gnus-sum.el Sun Nov 29 16:03:54 1998 --- pgnus/lisp/gnus-sum.el Mon Nov 30 22:47:00 1998 *************** *** 1542,1547 **** --- 1542,1548 ---- (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 *************** *** 8348,8372 **** (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")))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) --- 8349,8363 ---- (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) ! (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) *************** *** 9205,9211 **** (require 'gnus-art) (let ((gnus-unbuttonized-mime-types nil)) (gnus-summary-show-article))) ! (defun gnus-summary-toggle-display-buttonized () "Toggle the buttonizing of the article buffer." (interactive) --- 9196,9220 ---- (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) *** pub/pgnus/lisp/gnus-util.el Sat Nov 21 09:51:16 1998 --- pgnus/lisp/gnus-util.el Mon Nov 30 22:47:00 1998 *************** *** 497,507 **** (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))) (if (cdr funs) `(or (,function ,first ,last) (and (not (,function ,last ,first)) --- 497,512 ---- (first 't1) (last 't2)) (when (consp 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)) *** pub/pgnus/lisp/gnus.el Sun Nov 29 16:03:54 1998 --- pgnus/lisp/gnus.el Mon Nov 30 22:47:01 1998 *************** *** 254,260 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.56" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 254,260 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.57" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *** pub/pgnus/lisp/mm-bodies.el Sun Nov 29 16:03:54 1998 --- pgnus/lisp/mm-bodies.el Mon Nov 30 22:47:01 1998 *************** *** 137,142 **** --- 137,146 ---- (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)) *** pub/pgnus/lisp/mm-decode.el Sun Nov 29 16:03:55 1998 --- pgnus/lisp/mm-decode.el Mon Nov 30 22:47:01 1998 *************** *** 44,49 **** --- 44,57 ---- `(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 *************** *** 105,114 **** (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) (error nil)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") --- 113,122 ---- (let (ct ctl type subtype cte cd description id result) (save-restriction (mail-narrow-to-head) ! (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") *************** *** 116,122 **** id (mail-fetch-field "content-id")))) (if (not ctl) (mm-dissect-singlepart ! '("text/plain") nil no-strict-mime nil description) (setq type (split-string (car ctl) "/")) (setq subtype (cadr type) type (pop type)) --- 124,134 ---- id (mail-fetch-field "content-id")))) (if (not ctl) (mm-dissect-singlepart ! '("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)) *************** *** 145,151 **** (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))) (push (car res) mm-dissection-list) res))) --- 157,164 ---- (defun mm-dissect-singlepart (ctl cte &optional force cdl description) (when (or force (not (equal "text/plain" (car ctl)))) ! (let ((res (mm-make-handle ! (mm-copy-to-buffer) ctl cte nil cdl description))) (push (car res) mm-dissection-list) res))) *************** *** 512,525 **** (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)))))) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." --- 525,543 ---- (defun mm-get-image (handle) "Return an image instance based on HANDLE." ! (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." *** pub/pgnus/lisp/mml.el Sun Nov 29 16:03:55 1998 --- pgnus/lisp/mml.el Mon Nov 30 22:47:01 1998 *************** *** 97,106 **** ;; 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) (prog1 (buffer-substring beg (match-beginning 0)) ! (if (equal (match-string 0) "<#/multipart>") (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) --- 97,108 ---- ;; 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) (prog1 (buffer-substring beg (match-beginning 0)) ! (if (or (not (match-beginning 1)) ! (equal (match-string 2) "multipart")) (goto-char (match-beginning 0)) (when (looking-at "[ \t]*\n") (forward-line 1)))) *** pub/pgnus/lisp/nndb.el Sun Sep 6 21:34:46 1998 --- pgnus/lisp/nndb.el Mon Nov 30 22:47:01 1998 *************** *** 291,297 **** (nntp-send-buffer "^[23].*\n")) (set-buffer nntp-server-buffer) ! (setq msg (buffer-string (point-min) (point-max))) (or (string-match "^\\([0-9]+\\)" msg) (error "nndb: %s" msg)) (setq art (substring msg (match-beginning 1) (match-end 1))) --- 291,297 ---- (nntp-send-buffer "^[23].*\n")) (set-buffer nntp-server-buffer) ! (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))) *************** *** 318,324 **** (deffoo nndb-status-message (&optional server) "Return server status as a string." (set-buffer nntp-server-buffer) ! (buffer-string (point-min) (point-max))) ;; Import stuff from nntp --- 318,324 ---- (deffoo nndb-status-message (&optional server) "Return server status as a string." (set-buffer nntp-server-buffer) ! (buffer-substring (point-min) (point-max))) ;; Import stuff from nntp *** pub/pgnus/lisp/nnfolder.el Thu Sep 24 02:33:08 1998 --- pgnus/lisp/nnfolder.el Mon Nov 30 22:47:01 1998 *************** *** 90,95 **** --- 90,96 ---- (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) *************** *** 682,688 **** (defun nnfolder-read-folder (group) (let* ((file (nnfolder-group-pathname group)) ! (buffer (set-buffer (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. --- 683,692 ---- (defun nnfolder-read-folder (group) (let* ((file (nnfolder-group-pathname group)) ! (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. *** pub/pgnus/lisp/nnmail.el Sun Nov 8 01:04:37 1998 --- pgnus/lisp/nnmail.el Mon Nov 30 22:47:02 1998 *************** *** 496,501 **** --- 496,506 ---- (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) *** pub/pgnus/lisp/nnml.el Sun Oct 25 23:13:19 1998 --- pgnus/lisp/nnml.el Mon Nov 30 22:47:02 1998 *************** *** 86,91 **** --- 86,93 ---- (defvar nnml-nov-buffer-file-name nil) + (defvoo nnml-file-coding-system nnmail-file-coding-system-1) + ;;; Interface functions. *************** *** 183,189 **** (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))) (nnheader-report 'nnml "Couldn't read file: %s" path)) (t (nnheader-report 'nnml "Article %s retrieved" id) --- 185,193 ---- (nnheader-report 'nnml "No such file: %s" path)) ((file-directory-p path) (nnheader-report 'nnml "File is a directory: %s" 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) *** pub/pgnus/lisp/nntp.el Fri Nov 27 13:18:59 1998 --- pgnus/lisp/nntp.el Mon Nov 30 22:47:02 1998 *************** *** 209,214 **** --- 209,224 ---- (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")) *************** *** 325,341 **** ((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)) --- 335,341 ---- ((eq callback 'ignore) t) ((and callback wait-for) ! (nntp-async-wait process wait-for buffer decode callback) t) (wait-for (nntp-wait-for process wait-for buffer decode)) *************** *** 904,951 **** (eval (cadr entry)) (funcall (cadr entry))))))) ! (defun nntp-after-change-function-callback (beg end len) (unwind-protect ! (when nntp-process-callback (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. ! (when quit-flag ! (setq after-change-functions ! (list 'nntp-after-change-function-callback))))) (defun nntp-snarf-error-message () "Save the error message in the current buffer." --- 904,998 ---- (eval (cadr entry)) (funcall (cadr entry))))))) ! (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 ! ;; we only care about insertions at eob ! (when (and (eq 0 len) (eq (point-max) end)) (save-match-data ! (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 '(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." *************** *** 955,961 **** (nnheader-report 'nntp message) message)) ! (defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) --- 1002,1008 ---- (nnheader-report 'nntp message) message)) ! (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) *************** *** 965,971 **** (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) ! (accept-process-output process 1))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." --- 1012,1018 ---- (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) ! (accept-process-output process (or timeout 1)))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." *** pub/pgnus/lisp/uudecode.el Sun Nov 29 16:03:55 1998 --- pgnus/lisp/uudecode.el Mon Nov 30 22:47:02 1998 *************** *** 2,8 **** ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu ! ;; $Revision: 5.2 $ ;; Keywords: uudecode ;; This file is not part of GNU Emacs, but the same permissions --- 2,8 ---- ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu ! ;; $Revision: 5.3 $ ;; Keywords: uudecode ;; This file is not part of GNU Emacs, but the same permissions *** pub/pgnus/lisp/ChangeLog Sun Nov 29 16:03:52 1998 --- pgnus/lisp/ChangeLog Mon Nov 30 22:46:59 1998 *************** *** 1,3 **** --- 1,75 ---- + Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.57 is released. + + 1998-11-23 Felix Lee + + * 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 + + * 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 + + * gnus-art.el (gnus-mime-inline-part): Do not get part when + undisplay the part. + + 1998-11-30 03:38:35 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 * gnus.el: Pterodactyl Gnus v0.56 is released. *** pub/pgnus/texi/gnus.texi Sun Nov 29 16:03:57 1998 --- pgnus/texi/gnus.texi Mon Nov 30 22:47:04 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.56 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.57 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.56 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.57 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.56. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.57. @end ifinfo *** pub/pgnus/texi/message.texi Sun Nov 29 16:03:57 1998 --- pgnus/texi/message.texi Mon Nov 30 22:47:04 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.56 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.57 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.56 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.57 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.56. Message is distributed with the Gnus distribution bearing the same version number as this manual. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.57. Message is distributed with the Gnus distribution bearing the same version number as this manual.