+Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.52 is released.
+
+1998-11-20 04:32:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * rfc2047.el (rfc2047-encode-message-header): Encode the default
+ encoding.
+
+ * gnus-art.el (gnus-mime-display-single): Insert buttons for
+ undisplayed text types.
+
+ * mm-decode.el (mm-automatic-display-p): Only prefer inlinable
+ types.
+
+1998-11-19 Felix Lee <flee@cygnus.com>
+
+ * nntp.el (nntp-after-change-function-callback): recover from C-g.
+
+1998-11-19 Felix Lee <flee@cygnus.com>
+
+ * gnus-async.el (gnus-asynch-obarray): rename to
+ gnus-async-hashtb, and don't buffer-local it.
+
+ (gnus-async-article-callback): new function.
+ (gnus-make-async-article-function): use it.
+
+ (gnus-async-current-prefetch-group): new var.
+ (gnus-async-current-prefetch-article): new var.
+ (gnus-async-request-fetched-article): are we fetching it already?
+
+ (gnus-async-delete-prefected-entry): s/prefected/prefetched/
+
+1998-11-20 02:49:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-show-article): Require.
+
+ * message.el: Provide before hooks.
+ (message-send-news): Do MIME before headers.
+
+ * gnus-art.el (gnus-article-check-buffer): New function.
+ (gnus-article-read-summary-keys): Use it.
+
+ * mm-decode.el (mm-user-automatic-display): Display all inline
+ images.
+
+ * gnus-art.el (gnus-mime-display-single): Don't buttonize so
+ much.
+ (gnus-unbuttonized-mime-types): New variable.
+
+1998-11-19 06:29:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t.
+
+ * mm-decode.el (mm-quote-arg): Quote semicolons.
+
+ * gnus-art.el (gnus-mime-display-single): Don't display
+ attachments.
+ (gnus-mime-externalize-part): New command and keystroke.
+
+ * mm-decode.el (mm-dissect-buffer): Pass on the description info.
+ (mm-alternative-precedence): Changed order.
+
+1998-11-07 17:41:47 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus.el (gnus-method-simplify): New function.
+ (gnus-native-method-p): New function.
+ (gnus-secondary-method-p): Use gnus-method-equal.
+
+ * gnus-start.el (gnus-group-change-level): Shorten select method.
+
Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.51 is released.
(defcustom gnus-display-mime-function 'gnus-display-mime
"Function to display MIME articles."
- :group 'gnus-article-headers
+ :group 'gnus-article-mime
:type 'function)
(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
(defcustom gnus-ignored-mime-types nil
"List of MIME types that should be ignored by Gnus."
- :group 'gnus-mime
+ :group 'gnus-article-mime
+ :type '(repeat regexp))
+
+(defcustom gnus-unbuttonized-mime-types '(".*/.*")
+ "List of MIME types that should not be given buttons when rendered."
+ :group 'gnus-article-mime
:type '(repeat regexp))
(defcustom gnus-treat-body-highlight-signature t
(defcustom gnus-article-mime-part-function nil
"Function called with a MIME handle as the argument."
- :group 'gnus-article
+ :group 'gnus-article-mime
:type 'function)
;;; Internal variables
(gnus-mime-save-part "o" "Save...")
(gnus-mime-copy-part "c" "View In Buffer")
(gnus-mime-inline-part "i" "View Inline")
+ (gnus-mime-externalize-part "e" "View Externally")
(gnus-mime-pipe-part "|" "Pipe To Command...")))
(defvar gnus-mime-button-map nil)
(defun gnus-mime-button-menu (event)
"Construct a context-sensitive menu of MIME commands."
(interactive "e")
+ (gnus-article-check-buffer)
(let ((response (x-popup-menu
t `("MIME Part"
("" ,@(mapcar (lambda (c)
(defun gnus-mime-view-all-parts ()
"View all the MIME parts."
(interactive)
+ (gnus-article-check-buffer)
(let ((handles gnus-article-mime-handles))
(while handles
(mm-display-part (pop handles)))))
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(interactive)
+ (gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(mm-save-part data)))
(defun gnus-mime-pipe-part ()
"Pipe the MIME part under point to a process."
(interactive)
+ (gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(mm-pipe-part data)))
(defun gnus-mime-view-part ()
"Interactively choose a view method for the MIME part under point."
(interactive)
+ (gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data))
(url-standalone-mode (not gnus-plugged)))
(mm-interactively-view-part data)))
(defun gnus-mime-copy-part ()
"Put the the MIME part under point into a new buffer."
(interactive)
+ (gnus-article-check-buffer)
(let* ((handle (get-text-property (point) 'gnus-data))
(contents (mm-get-part handle))
(buffer (generate-new-buffer
(defun gnus-mime-inline-part ()
"Insert the MIME part under point into the current buffer."
(interactive)
+ (gnus-article-check-buffer)
(let* ((data (get-text-property (point) 'gnus-data))
(contents (mm-get-part data))
(url-standalone-mode (not gnus-plugged))
(mm-insert-inline data contents)
(goto-char b))))
+(defun gnus-mime-externalize-part ()
+ "Insert the MIME part under point into the current buffer."
+ (interactive)
+ (gnus-article-check-buffer)
+ (let* ((handle (get-text-property (point) 'gnus-data))
+ (url-standalone-mode (not gnus-plugged))
+ (mm-user-display-methods nil))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle))))
+
(defun gnus-article-view-part (n)
"View MIME part N, which is the numerical prefix."
(interactive "p")
(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
(when (string-match (pop ignored) type)
(throw 'ignored nil)))
(if (and (mm-automatic-display-p type)
- (mm-inlinable-part-p type)
- (or (not (mm-handle-disposition handle))
- (equal (car (mm-handle-disposition handle))
- "inline")))
+ (mm-inlinable-part-p type)
+ (setq not-attachment
+ (or (not (mm-handle-disposition handle))
+ (equal (car (mm-handle-disposition handle))
+ "inline"))))
(setq display t)
(when (equal (car (split-string type "/"))
"text")
(setq text t)))
(let ((id (1+ (length gnus-article-mime-handle-alist))))
(push (cons id handle) gnus-article-mime-handle-alist)
- (gnus-insert-mime-button handle id (list (or display text))))
+ (when (or (not display)
+ (not (catch 'found
+ (let ((types gnus-unbuttonized-mime-types))
+ (while types
+ (when (string-match (pop types) type)
+ (throw 'found t)))))))
+ (gnus-insert-mime-button
+ handle id (list (or display
+ (and (not not-attachment) text))))))
(insert "\n\n")
(cond
(display
(forward-line -2)
(mm-display-part handle t)
(goto-char (point-max)))
- (text
+ ((and text not-attachment)
(forward-line -2)
(insert "\n")
(mm-insert-inline handle (mm-get-part handle))
(point))
`(gnus-callback
(lambda (handles)
+ (unless ,(not ibegend)
+ (setq gnus-article-mime-handle-alist
+ ',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
- ',ihandles ',not-pref
- ',begend ,id))
+ ',ihandles ',not-pref ',begend ,id))
local-map ,gnus-mime-button-map
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
(point))
`(gnus-callback
(lambda (handles)
- (gnus-mime-display-alternative
- ',ihandles ',handle
- ',begend ,id))
+ (unless ,(not ibegend)
+ (setq gnus-article-mime-handle-alist
+ ',gnus-article-mime-handle-alist))
+ (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id))
local-map ,gnus-mime-button-map
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
(if (stringp (car preferred))
(gnus-display-mime preferred)
(mm-display-part preferred)
- (goto-char (point-max)))
+ (goto-char (point-max)))
(setcdr begend (point-marker))))
(when ibegend
(goto-char point))))
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)))
+(defun gnus-article-check-buffer ()
+ "Beep if not in an article buffer."
+ (unless (equal major-mode 'gnus-article-mode)
+ (error "Command invoked outside of a Gnus article buffer")))
+
(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
"Read a summary buffer key sequence and execute it from the article buffer."
(interactive "P")
+ (gnus-article-check-buffer)
(let ((nosaves
'("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
(defvar gnus-async-article-alist nil)
(defvar gnus-async-article-semaphore '(nil))
(defvar gnus-async-fetch-list nil)
-(defvar gnus-asynch-obarray nil)
+(defvar gnus-async-hashtb nil)
+(defvar gnus-async-current-prefetch-group nil)
+(defvar gnus-async-current-prefetch-article nil)
(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
(defvar gnus-async-header-prefetched nil)
(defun gnus-async-close ()
(gnus-kill-buffer gnus-async-prefetch-article-buffer)
(gnus-kill-buffer gnus-async-prefetch-headers-buffer)
- (setq gnus-async-article-alist nil
+ (setq gnus-async-hashtb nil
+ gnus-async-article-alist nil
gnus-async-header-prefetched nil))
(defun gnus-async-set-buffer ()
(nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
- (unless gnus-asynch-obarray
- (set (make-local-variable 'gnus-asynch-obarray)
- (gnus-make-hashtable 1023))))
+ (unless gnus-async-hashtb
+ (setq gnus-async-hashtb (gnus-make-hashtable 1023))))
(defun gnus-async-halt-prefetch ()
"Stop prefetching."
(when do-message
(gnus-message 9 "Prefetching article %d in group %s"
article group))
+ (setq gnus-async-current-prefetch-group group)
+ (setq gnus-async-current-prefetch-article article)
(gnus-request-article article group))))))))))
(defun gnus-make-async-article-function (group article mark summary next)
"Return a callback function."
`(lambda (arg)
- (save-excursion
- (when arg
- (gnus-async-set-buffer)
- (gnus-async-with-semaphore
- (setq
- gnus-async-article-alist
- (cons (list ',(intern (format "%s-%d" group article)
- gnus-asynch-obarray)
- ,mark (set-marker (make-marker) (point-max))
- ,group ,article)
- gnus-async-article-alist))))
- (if (not (gnus-buffer-live-p ,summary))
- (gnus-async-with-semaphore
- (setq gnus-async-fetch-list nil))
- (gnus-async-prefetch-article ,group ,next ,summary t)))))
+ (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next)))
+
+(defun gnus-async-article-callback (arg group article mark summary next)
+ "Function called when an async article is done being fetched."
+ (save-excursion
+ (setq gnus-async-current-prefetch-article nil)
+ (when arg
+ (gnus-async-set-buffer)
+ (gnus-async-with-semaphore
+ (setq
+ gnus-async-article-alist
+ (cons (list (intern (format "%s-%d" group article)
+ gnus-async-hashtb)
+ mark (set-marker (make-marker) (point-max))
+ group article)
+ gnus-async-article-alist))))
+ (if (not (gnus-buffer-live-p summary))
+ (gnus-async-with-semaphore
+ (setq gnus-async-fetch-list nil))
+ (gnus-async-prefetch-article group next summary t))))
(defun gnus-async-unread-p (data)
"Return non-nil if DATA represents an unread article."
(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
(copy-to-buffer buffer (cadr entry) (caddr entry))
;; Remove the read article from the prefetch buffer.
(when (memq 'read gnus-prefetched-article-deletion-strategy)
- (gnus-async-delete-prefected-entry entry))
+ (gnus-async-delete-prefetched-entry entry))
t)))))
-(defun gnus-async-delete-prefected-entry (entry)
+(defun gnus-async-delete-prefetched-entry (entry)
"Delete ENTRY from buffer and alist."
(ignore-errors
(delete-region (cadr entry) (caddr entry))
(gnus-async-set-buffer)
(while alist
(when (equal group (nth 3 (car alist)))
- (gnus-async-delete-prefected-entry (car alist)))
+ (gnus-async-delete-prefetched-entry (car alist)))
(pop alist))))))
(defun gnus-async-prefetched-article-entry (group article)
(let ((entry (save-excursion
(gnus-async-set-buffer)
(assq (intern (format "%s-%d" group article)
- gnus-asynch-obarray)
+ gnus-async-hashtb)
gnus-async-article-alist))))
;; Perhaps something has emptied the buffer?
(if (and 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
- ;; foreign select method has to be entered into the
- ;; info.
- (let ((method (or gnus-override-subscribe-method
- (gnus-group-method group))))
- (if (eq method gnus-select-method)
- (setq info (list group level nil))
- (setq info (list group level nil nil method)))))
+ ;; Shorten the select method if possible, if we need to
+ ;; store it at all (native groups).
+ (let ((method (gnus-method-simplify
+ (or gnus-override-subscribe-method
+ (gnus-group-method group)))))
+ (if method
+ (setq info (list group level nil nil method))
+ (setq info (list group level nil)))))
(unless previous
(setq previous
(let ((p gnus-newsrc-alist))
:group 'gnus-summary
:type '(repeat character))
-(defcustom gnus-inhibit-user-auto-expire nil
+(defcustom gnus-inhibit-user-auto-expire t
"*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
:group 'gnus-summary
:type 'boolean)
(if (not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force)
+ ;; We have to require this here to make sure that the following
+ ;; dynamic binding isn't shadowed by autoloading.
+ (require 'gnus-async)
+ (require 'gnus-art)
;; Bind the article treatment functions to nil.
(let ((gnus-have-all-headers t)
gnus-article-display-hook
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.037"
+(defconst gnus-version-number "6.10.038"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.51"
+(defconst gnus-original-version-number "0.52"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
possible
(list backend server))))))
+(defsubst gnus-native-method-p (method)
+ "Return whether METHOD is the native select method."
+ (gnus-method-equal method gnus-select-method))
+
(defsubst gnus-secondary-method-p (method)
"Return whether METHOD is a secondary select method."
(let ((methods gnus-secondary-select-methods)
(gmethod (gnus-server-get-method nil method)))
(while (and methods
- (not (equal (gnus-server-get-method nil (car methods))
- gmethod)))
+ (not (gnus-method-equal
+ (gnus-server-get-method nil (car methods))
+ gmethod)))
(setq methods (cdr methods)))
methods))
+(defun gnus-method-simplify (method)
+ "Return the shortest uniquely identifying string or method for METHOD."
+ (cond ((gnus-native-method-p method)
+ nil)
+ ((gnus-secondary-method-p method)
+ (format "%s:%s" (nth 0 method) (nth 1 method)))
+ (t
+ method)))
+
(defun gnus-groups-from-server (server)
"Return a list of all groups that are fetched from SERVER."
(let ((alist (cdr gnus-newsrc-alist))
(set-buffer buffer)
(set-buffer-modified-p nil)))
-(run-hooks 'message-load-hook)
-
(provide 'message)
+(run-hooks 'message-load-hook)
+
;;; message.el ends here
("message/delivery-status" . inline)))
(defvar mm-user-automatic-display
- '("text/plain" "text/enriched" "text/richtext" "text/html" "image/gif"
- "image/jpeg" "message/delivery-status" "multipart/.*"))
+ '("text/plain" "text/enriched" "text/richtext" "text/html"
+ "image/.*" "message/delivery-status" "multipart/.*"))
(defvar mm-alternative-precedence
- '("text/plain" "text/enriched" "text/richtext" "text/html")
+ '("text/html" "text/enriched" "text/richtext" "text/plain")
"List that describes the precedence of alternative parts.")
(defvar mm-tmp-directory "/tmp/"
description (mail-fetch-field "content-description")
id (mail-fetch-field "content-id"))))
(if (not ctl)
- (mm-dissect-singlepart '("text/plain") nil no-strict-mime nil nil)
+ (mm-dissect-singlepart
+ '("text/plain") nil no-strict-mime nil description)
(setq type (split-string (car ctl) "/"))
(setq subtype (cadr type)
type (pop type))
no-strict-mime
(and cd (condition-case ()
(mail-header-parse-content-disposition cd)
- (error nil)))))))
+ (error nil)))
+ description))))
(when id
(push (cons id result) mm-content-id-alist))
result))))
(let ((methods mm-user-automatic-display)
method result)
(while (setq method (pop methods))
- (when (string-match method type)
+ (when (and (string-match method type)
+ (mm-inlinable-p type))
(setq result t
methods nil)))
result))
"Return a version of ARG that is safe to evaluate in a shell."
(let ((pos 0) new-pos accum)
;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[!`\"$\\& \t{} ]" arg pos))
+ (while (setq new-pos (string-match "[;!`\"$\\& \t{} ]" arg pos))
(push (substring arg pos new-pos) accum)
(push "\\" accum)
(push (list (aref arg new-pos)) accum)
(setq image (make-image-specifier
(vector (intern type) :data (buffer-string)))))
(let ((annot (make-annotation image nil 'text)))
+ (mm-insert-inline handle ".\n")
(set-extent-property annot 'mm t)
- (set-extent-property annot 'duplicable t)
- (mm-insert-inline handle " \n"))))
+ (set-extent-property annot 'duplicable t))))
(defun mm-inline-text (handle)
(let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
(funcall (cadr entry)))))))
(defun nntp-after-change-function-callback (beg end len)
- (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))
+ (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
- (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))))))))))
+ (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."
(rfc2047-encode-region (point-min) (point-max)))
;; Hm.
(t))))
- (goto-char (point-max))))))))
+ (goto-char (point-max)))))
+ (when rfc2047-default-charset
+ (encode-coding-region (point-min) (point-max)
+ rfc2047-default-charset)))))
(defun rfc2047-encodable-p ()
"Say whether the current (narrowed) buffer contains characters that need encoding."
projects / elisp / gnus.git- / commitdiff