From: yamaoka Date: Tue, 24 Nov 1998 12:24:06 +0000 (+0000) Subject: Sync up with Pterodactyl Gnus v0.54. X-Git-Tag: pgnus-ichikawa-199811302358~9 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f0c2d45d7a3aa9463cc66ffdec5e95a5cf555549;p=elisp%2Fgnus.git- Sync up with Pterodactyl Gnus v0.54. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6f6404b..b24c945 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,91 @@ +Tue Nov 24 10:43:06 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.54 is released. + +1998-11-24 11:21:32 Katsumi Yamaoka + + * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj. + +1998-11-24 11:14:54 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-save-part): Unquote. + +1998-11-24 11:14:39 Matt Armstrong + + * mm-decode.el (mm-save-part): Bind coding system for write. + +1998-11-24 10:42:30 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode-line-format): New default. + (gnus-article-mime-part-status): New function. + + * message.el (message-send-news): Check the body syntax before + encoding. + + * gnus-art.el (gnus-unbuttonized-mime-type): New function. + (gnus-mime-display-single): Use it. + (gnus-mime-display-alternative): Ditto. + + * mm-decode.el: Check for whether we are running under a term. + +1998-11-22 08:12:25 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-preferred-alternative): Default to first + alternative. + (mm-preferred-alternative): No, we dont. + +Tue Nov 24 03:01:48 1998 Shenghuo ZHU + + * mm-decode.el (mm-display-external): Use binary instead of + no-conversion. + * gnus-agent.el (gnus-agent-file-coding-system): Ditto. + * nnheader.el (nnheader-file-coding-system): Ditto. + * mm-util.el (mm-with-unibyte-buffer): Use binary instead of nil. + +Mon Nov 23 01:51:57 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-newsgroup-setup-default-charset): Use group + name without method. + +Mon Nov 23 01:26:40 1998 Shenghuo ZHU + + * gnus-sum.el (gnus-newsgroup-default-charset): Rename + coding-system -> default-charset. + (gnus-newsgroup-default-charset-alist): Ditto. + (gnus-summary-local-variables): Ditto. + (gnus-set-global-variables): Ditto. + (gnus-get-newsgroup-headers): Ditto. + (gnus-summary-from-or-to-or-newsgroups): Ditto. + (gnus-get-newsgroup-headers-xover): Ditto. + (gnus-newsgroup-setup-default-charset): Ditto. + (article-decode-mime-words): Ditto. + (article-decode-charset): Ditto. + (article-decode-encoded-words): Ditto. + (article-de-quoted-unreadable): Ditto. + (gnus-mime-view-all-parts): Ditto. + (gnus-mime-externalize-part): Ditto. + (gnus-mm-display-part): Ditto. + (gnus-mime-display-single): Ditto. + (gnus-mime-display-alternative): Ditto. + * lpath.el : Ditto. + +Mon Nov 23 00:54:33 1998 Shenghuo ZHU + + * rfc2047.el (rfc2047-decode-region): Do not decode nil charset. + * gnus-art.el (article-decode-charset): Overlay + rfc2047-default-charset. + * message.el (message-draft-coding-system): New variable. + (message-set-auto-save-file-name): Use message-draft-coding-system. + * nndraft.el (nndraft-request-article): Ditto. + * gnus-start.el (gnus-start-draft-setup): Set charset nil. + * gnus-agent.el (gnus-agent-queue-setup): Ditto. + +Sun Nov 22 04:42:22 1998 Shenghuo ZHU + + * mm-uu.el (mm-uu-test): New function. + (mm-uu-dissect): Inherit charset and cte from head. + * gnus-art.el (article-decode-charset): Use mm-uu-test. + Sat Nov 21 09:57:01 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.53 is released. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index e9bf52d..fd213ef 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -93,7 +93,7 @@ If nil, only read articles will be expired." (defvar gnus-agent-spam-hashtb nil) (defvar gnus-agent-file-name nil) (defvar gnus-agent-send-mail-function nil) -(defvar gnus-agent-file-coding-system 'no-conversion) +(defvar gnus-agent-file-coding-system 'binary) (defconst gnus-agent-scoreable-headers (list @@ -331,6 +331,7 @@ agent minor mode in all Gnus buffers." (gnus-request-create-group "queue" '(nndraft "")) (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group "nndraft:queue" nil '(nndraft ""))) + (gnus-group-set-parameter "nndraft:queue" 'charset "nil") (gnus-group-set-parameter "nndraft:queue" 'gnus-dummy '((gnus-draft-mode))))) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index fa6f3be..8d92c4f 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -410,7 +410,7 @@ beginning of a line." :type 'regexp :group 'gnus-article-various) -(defcustom gnus-article-mode-line-format "Gnus: %g %S" +(defcustom gnus-article-mode-line-format "Gnus: %g %S%m" "*The format specification for the article mode line. See `gnus-summary-mode-line-format' for a closer description." :type 'string @@ -617,6 +617,7 @@ displayed by the first non-nil matching CONTENT face." ;;; Internal variables +(defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist '((gnus-treat-body-highlight-signature gnus-article-highlight-signature nil) )) @@ -637,7 +638,8 @@ Initialized from `text-mode-syntax-table.") (defvar gnus-save-article-buffer nil) (defvar gnus-article-mode-line-format-alist - (nconc '((?w (gnus-article-wash-status) ?s)) + (nconc '((?w (gnus-article-wash-status) ?s) + (?m (gnus-article-mime-part-status) ?s)) gnus-summary-mode-line-format-alist)) (defvar gnus-number-of-articles-to-be-saved nil) @@ -1041,7 +1043,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (set-buffer gnus-article-buffer) (let ((inhibit-point-motion-hooks t) buffer-read-only - (rfc2047-default-charset gnus-newsgroup-coding-system) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (mail-decode-encoded-word-region (point-min) (point-max))))) @@ -1063,17 +1065,17 @@ If PROMPT (the prefix), prompt for a coding system to use." (prompt (mm-read-coding-system "Charset to decode: ")) (ctl - (mail-content-type-get ctl 'charset)) - (t - gnus-newsgroup-coding-system))) + (mail-content-type-get ctl 'charset)))) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced) buffer-read-only) (goto-char (point-max)) (widen) (forward-line 1) (narrow-to-region (point) (point-max)) - (when (or (not ctl) - (equal (car ctl) "text/plain")) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not (mm-uu-test))) (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) @@ -1097,7 +1099,7 @@ or not." (let ((buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding")) (charset - (or gnus-newsgroup-coding-system mm-default-coding-system)) + (or gnus-newsgroup-default-charset mm-default-coding-system)) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (when (or force (and type (string-match "quoted-printable" (downcase type)))) @@ -2216,7 +2218,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-configure-windows 'summary) (gnus-configure-windows 'article)) (gnus-set-global-variables)) - (gnus-set-mode-line 'article)) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article))) ;; The result from the `request' was an actual article - ;; or at least some text that is now displayed in the ;; article buffer. @@ -2261,7 +2265,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (when gnus-break-pages (gnus-narrow-to-page) t))) - (gnus-set-mode-line 'article) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)) (gnus-configure-windows 'article) (article-goto-body) (set-window-point (get-buffer-window (current-buffer)) (point)) @@ -2315,6 +2321,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-mime-externalize-part "e" "View Externally") (gnus-mime-pipe-part "|" "Pipe To Command..."))) +(defun gnus-article-mime-part-status () + (if gnus-article-mime-handle-alist-1 + (format " (%d parts)" (length gnus-article-mime-handle-alist-1)) + "")) + (defvar gnus-mime-button-map nil) (unless gnus-mime-button-map (setq gnus-mime-button-map (make-sparse-keymap)) @@ -2345,7 +2356,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (interactive) (gnus-article-check-buffer) (let ((handles gnus-article-mime-handles) - (rfc2047-default-charset gnus-newsgroup-coding-system) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (while handles (mm-display-part (pop handles))))) @@ -2372,11 +2383,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (url-standalone-mode (not gnus-plugged))) (mm-interactively-view-part data))) -(defun gnus-mime-copy-part () +(defun gnus-mime-copy-part (&optional handle) "Put the the MIME part under point into a new buffer." (interactive) (gnus-article-check-buffer) - (let* ((handle (get-text-property (point) 'gnus-data)) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (mm-get-part handle)) (buffer (generate-new-buffer (file-name-nondirectory @@ -2392,7 +2403,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-inline-part (&optional charset) "Insert the MIME part under point into the current buffer." - (interactive "P") ; For compatible reason, not using "z". + (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)) @@ -2409,19 +2420,52 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-insert-inline data contents) (goto-char b)))) -(defun gnus-mime-externalize-part () +(defun gnus-mime-externalize-part (&optional handle) "Insert the MIME part under point into the current buffer." (interactive) (gnus-article-check-buffer) - (let* ((handle (get-text-property (point) 'gnus-data)) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (url-standalone-mode (not gnus-plugged)) (mm-user-display-methods nil) - (rfc2047-default-charset gnus-newsgroup-coding-system) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (if (mm-handle-undisplayer handle) (mm-remove-part handle) (mm-display-part handle)))) +(defun gnus-article-part-wrapper (n function) + (save-current-buffer + (set-buffer gnus-article-buffer) + (when (> n (length gnus-article-mime-handle-alist)) + (error "No such part")) + (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) + (funcall function handle)))) + +(defun gnus-article-pipe-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'mm-pipe-part)) + +(defun gnus-article-save-part (n) + "Save MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'mm-save-part)) + +(defun gnus-article-interactively-view-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'mm-interactively-view-part)) + +(defun gnus-article-copy-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-copy-part)) + +(defun gnus-article-externalize-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-externalize-part)) + (defun gnus-article-view-part (n) "View MIME part N, which is the numerical prefix." (interactive "p") @@ -2446,7 +2490,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." handle id (list (not (mm-handle-displayed-p handle)))) (prog1 (let ((window (selected-window)) - (rfc2047-default-charset gnus-newsgroup-coding-system) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (save-excursion (unwind-protect @@ -2571,11 +2615,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((id (1+ (length gnus-article-mime-handle-alist)))) (push (cons id handle) gnus-article-mime-handle-alist) (when (or (not display) - (not (catch 'found - (let ((types gnus-unbuttonized-mime-types)) - (while types - (when (string-match (pop types) type) - (throw 'found t))))))) + (not (gnus-unbuttonized-mime-type-p type))) (gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display @@ -2585,7 +2625,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cond (display (forward-line -2) - (let ((rfc2047-default-charset gnus-newsgroup-coding-system) + (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)) @@ -2596,6 +2636,14 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))))))) +(defun gnus-unbuttonized-mime-type-p (type) + "Say whether TYPE is to be unbuttonized." + (catch 'found + (let ((types gnus-unbuttonized-mime-types)) + (while types + (when (string-match (pop types) type) + (throw 'found t)))))) + (defun gnus-article-insert-newline () "Insert a newline, but mark it as undeletable." (gnus-put-text-property @@ -2609,44 +2657,25 @@ If ALL-HEADERS is non-nil, no headers are hidden." (save-window-excursion (save-restriction (when ibegend - (narrow-to-region (car ibegend) (cdr ibegend)) + (narrow-to-region (car ibegend) + (or (cdr ibegend) + (progn + (goto-char (car ibegend)) + (forward-line 2) + (point)))) (delete-region (point-min) (point-max)) (mm-remove-parts handles)) (setq begend (list (point-marker))) ;; Do the toggle. (unless (setq not-pref (cadr (member preferred ihandles))) (setq not-pref (car ihandles))) - (gnus-add-text-properties - (setq from (point)) - (progn - (insert (format "%d. " id)) - (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)) - local-map ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face - face ,gnus-article-button-face - keymap ,gnus-mime-button-map - gnus-part ,id - gnus-data ,handle)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) - ;; Do the handles - (while (setq handle (pop handles)) + (when (or ibegend + (not (gnus-unbuttonized-mime-type-p + "multipart/alternative"))) (gnus-add-text-properties (setq from (point)) (progn - (insert (format "[%c] %-18s" - (if (equal handle preferred) ?* ? ) - (if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle))))) + (insert (format "%d. " id)) (point)) `(gnus-callback (lambda (handles) @@ -2654,7 +2683,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (setq gnus-article-mime-handle-alist ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative - ',ihandles ',handle ',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 @@ -2664,12 +2693,39 @@ If ALL-HEADERS is non-nil, no headers are hidden." (widget-convert-button 'link from (point) :action 'gnus-widget-press-button :button-keymap gnus-widget-button-keymap) - (insert " ")) - (insert "\n\n") + ;; Do the handles + (while (setq handle (pop handles)) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "[%c] %-18s" + (if (equal handle preferred) ?* ? ) + (if (stringp (car handle)) + (car handle) + (car (mm-handle-type 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 ',handle ',begend ,id)) + local-map ,gnus-mime-button-map + ,gnus-mouse-face-prop ,gnus-article-mouse-face + face ,gnus-article-button-face + keymap ,gnus-mime-button-map + gnus-part ,id + gnus-data ,handle)) + (widget-convert-button 'link from (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap) + (insert " ")) + (insert "\n\n")) (when preferred (if (stringp (car preferred)) (gnus-display-mime preferred) - (let ((rfc2047-default-charset gnus-newsgroup-coding-system) + (let ((rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (mm-display-part preferred))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 3738ed9..453a02b 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -721,6 +721,7 @@ prompt the user for the name of an NNTP server to use." (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))) + (gnus-group-set-parameter "nndraft:drafts" 'charset "nil") (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 2554e52..bc37277 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -810,12 +810,12 @@ which it may alter in any way.") :group 'gnus-summary :type 'regexp) -(defcustom gnus-newsgroup-coding-system-alist +(defcustom gnus-newsgroup-default-charset-alist '(("^hk\\>\\|^tw\\>\\|\\" . cn-big5) ("^cn\\>\\|\\" . cn-gb-2312) - ("^fj\\>" . iso-2022-jp-2) + ("^fj\\>\\|^japan\\>" . iso-2022-jp-2) ("^relcom\\>" . koi8-r)) - "Alist of Regexps (to match group names) and CODING-SYSTEMs to be applied." + "Alist of Regexps (to match group names) and default charsets to be applied." :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))) :group 'gnus) @@ -1013,7 +1013,7 @@ variable (string, integer, character, etc).") (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) -(defvar gnus-newsgroup-coding-system nil) +(defvar gnus-newsgroup-default-charset nil) (defvar gnus-newsgroup-iso-8859-1-forced nil) (defconst gnus-summary-local-variables @@ -1047,7 +1047,7 @@ variable (string, integer, character, etc).") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-coding-system gnus-newsgroup-iso-8859-1-forced) + gnus-newsgroup-default-charset gnus-newsgroup-iso-8859-1-forced) "Variables that are buffer-local to the summary buffers.") ;; Byte-compiler warning. @@ -1501,7 +1501,12 @@ increase the score of each group you read." "s" gnus-soup-add-article) (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) - "b" gnus-summary-display-buttonized) + "b" gnus-summary-display-buttonized + "v" gnus-article-view-part + "o" gnus-article-save-part + "c" gnus-article-copy-part + "e" gnus-article-externalize-part + "|" gnus-article-pipe-part) ) (defun gnus-summary-make-menu-bar () @@ -2361,7 +2366,7 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (coding-system gnus-newsgroup-coding-system) + (default-charset gnus-newsgroup-default-charset) (iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (save-excursion (set-buffer gnus-group-buffer) @@ -2376,7 +2381,7 @@ marks of articles." gnus-original-article-buffer original gnus-reffed-article-number reffed gnus-current-score-file score-file - gnus-newsgroup-coding-system coding-system + gnus-newsgroup-default-charset default-charset gnus-newsgroup-iso-8859-1-forced iso-8859-1-forced) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) @@ -2454,7 +2459,7 @@ marks of articles." (defun gnus-summary-from-or-to-or-newsgroups (header) (let ((to (cdr (assq 'To (mail-header-extra header)))) (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) - (rfc2047-default-charset gnus-newsgroup-coding-system) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (cond ((and to @@ -4484,7 +4489,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) headers id end ref - (rfc2047-default-charset gnus-newsgroup-coding-system) + (rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (save-excursion (set-buffer nntp-server-buffer) @@ -4647,7 +4652,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((rfc2047-default-charset gnus-newsgroup-coding-system) + (let ((rfc2047-default-charset gnus-newsgroup-default-charset) (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced) (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) @@ -9157,37 +9162,42 @@ save those articles instead." ;;; @ end ;;; -(defun gnus-newsgroup-setup-coding-system () - "Setup newsgroup default coding system." - (setq gnus-newsgroup-coding-system - (or (and gnus-newsgroup-name - (or (gnus-group-find-parameter - gnus-newsgroup-name 'charset) - (let ((alist gnus-newsgroup-coding-system-alist) - elem (charset nil)) - (while alist - (if (string-match - (car (setq elem (pop alist))) - gnus-newsgroup-name) - (setq alist nil - charset (cdr elem)))) - charset))) - rfc2047-default-charset)) - (setq gnus-newsgroup-iso-8859-1-forced - (and gnus-newsgroup-name - (or (gnus-group-find-parameter - gnus-newsgroup-name 'iso-8859-1-forced) - (string-match gnus-newsgroup-iso-8859-1-forced-regexp - gnus-newsgroup-name)))) - (if (stringp gnus-newsgroup-coding-system) - (setq gnus-newsgroup-coding-system - (intern (downcase gnus-newsgroup-coding-system)))) +(defun gnus-newsgroup-setup-default-charset () + "Setup newsgroup default charset." + (let ((name (and gnus-newsgroup-name + (string-match "[^:]+$" gnus-newsgroup-name) + (match-string 0 gnus-newsgroup-name)))) + (setq gnus-newsgroup-default-charset + (or (and gnus-newsgroup-name + (or (gnus-group-find-parameter + gnus-newsgroup-name 'charset) + (let ((alist gnus-newsgroup-default-charset-alist) + elem (charset nil)) + (while alist + (if (and name + (string-match + (car (setq elem (pop alist))) + name)) + (setq alist nil + charset (cdr elem)))) + charset))) + rfc2047-default-charset)) + (setq gnus-newsgroup-iso-8859-1-forced + (and gnus-newsgroup-name + (or (gnus-group-find-parameter + gnus-newsgroup-name 'iso-8859-1-forced) + (and name + (string-match gnus-newsgroup-iso-8859-1-forced-regexp + name)))))) + (if (stringp gnus-newsgroup-default-charset) + (setq gnus-newsgroup-default-charset + (intern (downcase gnus-newsgroup-default-charset)))) (setq gnus-newsgroup-iso-8859-1-forced (if (stringp gnus-newsgroup-iso-8859-1-forced) (intern (downcase gnus-newsgroup-iso-8859-1-forced)) (and gnus-newsgroup-iso-8859-1-forced - gnus-newsgroup-coding-system)))) - + gnus-newsgroup-default-charset)))) + ;;; ;;; MIME Commands ;;; diff --git a/lisp/gnus.el b/lisp/gnus.el index ef98f5d..be2abe6 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,10 +259,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.039" +(defconst gnus-version-number "6.10.040" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.53" +(defconst gnus-original-version-number "0.54" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" diff --git a/lisp/lpath.el b/lisp/lpath.el index 2ea3faf..1c2f9be 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -50,7 +50,7 @@ mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name gnus-newsgroup-name gnus-article-x-face-too-ugly - gnus-newsgroup-coding-system + gnus-newsgroup-default-charset gnus-newsgroup-iso-8859-1-forced mail-mode-hook enable-multibyte-characters adaptive-fill-first-line-regexp adaptive-fill-regexp diff --git a/lisp/message.el b/lisp/message.el index 9a28318..6b2bb9f 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1019,6 +1019,11 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-send-coding-system 'binary "Coding system to encode outgoing mail.") +(defvar message-draft-coding-system + (if (string-match "XEmacs\\|Lucid" emacs-version) + 'escape-quoted 'emacs-mule) + "Coding system to compose mail.") + ;;; Internal variables. (defvar message-default-charset nil) @@ -3782,7 +3787,8 @@ Headers already prepared in the buffer are not modified." (setq buffer-file-name (expand-file-name "*message*" message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) - (clear-visited-file-modtime))) + (clear-visited-file-modtime) + (setq buffer-file-coding-system message-draft-coding-system))) (defun message-disassociate-draft () "Disassociate the message buffer from the drafts directory." diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index e5e4dc8..fef9441 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -47,17 +47,20 @@ (defvar mm-inline-media-tests '(("image/jpeg" mm-inline-image - (and (featurep 'jpeg) (mm-image-fit-p handle))) + (and window-system (featurep 'jpeg) (mm-image-fit-p handle))) ("image/png" mm-inline-image - (and (featurep 'png) (mm-image-fit-p handle))) + (and window-system (featurep 'png) (mm-image-fit-p handle))) ("image/gif" mm-inline-image - (and (featurep 'gif) (mm-image-fit-p handle))) + (and window-system (featurep 'gif) (mm-image-fit-p handle))) ("image/tiff" mm-inline-image - (and (featurep 'tiff) (mm-image-fit-p handle))) - ("image/xbm" mm-inline-image (and (fboundp 'device-type) - (eq (device-type) 'x))) - ("image/xpm" mm-inline-image (featurep 'xpm)) - ("image/bmp" mm-inline-image (featurep 'bmp)) + (and window-system (featurep 'tiff) (mm-image-fit-p handle))) + ("image/xbm" mm-inline-image + (and window-system (fboundp 'device-type) + (eq (device-type) 'x))) + ("image/xpm" mm-inline-image + (and window-system (featurep 'xpm))) + ("image/bmp" mm-inline-image + (and window-system (featurep 'bmp))) ("text/plain" mm-inline-text t) ("text/enriched" mm-inline-text t) ("text/richtext" mm-inline-text t) @@ -81,7 +84,8 @@ "image/.*" "message/delivery-status" "multipart/.*")) (defvar mm-alternative-precedence - '("text/html" "text/enriched" "text/richtext" "text/plain") + '("image/jpeg" "image/gif" "text/html" "text/enriched" + "text/richtext" "text/plain") "List that describes the precedence of alternative parts.") (defvar mm-tmp-directory "/tmp/" @@ -237,7 +241,7 @@ external if displayed external." (select-window win))) (switch-to-buffer (generate-new-buffer "*mm*"))) (buffer-disable-undo) - (mm-set-buffer-file-coding-system 'no-conversion) + (mm-set-buffer-file-coding-system 'binary) (insert-buffer-substring cur) (message "Viewing with %s" method) (let ((mm (current-buffer))) @@ -261,7 +265,7 @@ external if displayed external." dir)) (setq file (make-temp-name (expand-file-name "mm." dir)))) (write-region (point-min) (point-max) - file nil 'nomesg nil 'no-conversion) + file nil 'nomesg nil 'binary) (message "Viewing with %s" method) (unwind-protect (setq process @@ -447,7 +451,12 @@ This overrides entries in the mailcap file." (when (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? " file))) - (write-region (point-min) (point-max) file))))) + (let ((coding-system-for-write + (if (equal "text" (car (split-string + (car (mm-handle-type handle)) "/"))) + buffer-file-coding-system + 'binary))) + (write-region (point-min) (point-max) file)))))) (defun mm-pipe-part (handle) "Pipe HANDLE to a process." @@ -473,7 +482,7 @@ This overrides entries in the mailcap file." (defun mm-preferred-alternative (handles &optional preferred) "Say which of HANDLES are preferred." (let ((prec (if preferred (list preferred) mm-alternative-precedence)) - p h result type) + p h result type handle) (while (setq p (pop prec)) (setq h handles) (while h @@ -481,6 +490,7 @@ This overrides entries in the mailcap file." (if (stringp (caar h)) (caar h) (car (mm-handle-type (car h))))) + (setq handle (car h)) (when (and (equal p type) (mm-automatic-display-p type) (or (stringp (caar h)) @@ -510,12 +520,11 @@ This overrides entries in the mailcap file." (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." - (or t - (let ((image (make-image-instance (mm-get-image handle)))) - (and (< (image-instance-width image) - (window-pixel-width)) - (< (image-instance-height image) - (window-pixel-height)))))) + (let ((image (make-annotation (mm-get-image handle)))) + (and (< (glyph-width (annotation-glyph image)) + (window-pixel-width)) + (< (glyph-height (annotation-glyph image)) + (window-pixel-height))))) (provide 'mm-decode) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index b83ce74..51ab0f0 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -220,7 +220,7 @@ See also `with-temp-file' and `with-output-to-string'." (get-buffer-create (generate-new-buffer-name " *temp*"))) (unwind-protect (with-current-buffer ,temp-buffer - (let (buffer-file-coding-system) + (let ((buffer-file-coding-system 'binary)) ,@forms)) (and (buffer-name ,temp-buffer) (kill-buffer ,temp-buffer)))) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index a1faf5b..1a61a72 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -2,7 +2,7 @@ ;; Copyright (c) 1998 by Shenghuo Zhu ;; Author: Shenghuo Zhu -;; $Revision: 1.1.2.4 $ +;; $Revision: 1.1.2.5 $ ;; Keywords: news postscript uudecode binhex shar ;; This file is not part of GNU Emacs, but the same permissions @@ -74,13 +74,27 @@ (defun mm-uu-dissect () "Dissect the current buffer and return a list of uu handles." - (save-excursion - (save-restriction - (mail-narrow-to-head) - (goto-char (point-max))) - (forward-line) - (let ((text-start (point)) start-char end-char - type file-name end-line result) + (let (ct ctl cte charset text-start start-char end-char + type file-name end-line result text-plain-type) + (save-excursion + (save-restriction + (mail-narrow-to-head) + (when (and (mail-fetch-field "mime-version") + (setq ct (mail-fetch-field "content-type"))) + (setq cte (message-fetch-field "content-transfer-encoding" t) + ctl (condition-case () (mail-header-parse-content-type ct) + (error nil)) + charset (and ctl (mail-content-type-get ctl 'charset))) + (if (stringp cte) + (setq cte (intern (downcase (mail-header-remove-whitespace + (mail-header-remove-comments + cte))))))) + (goto-char (point-max))) + (forward-line) + (setq text-start (point) + text-plain-type (cons "text/plain" + (if charset + (list (cons 'charset charset))))) (while (re-search-forward mm-uu-begin-line nil t) (beginning-of-line) (setq start-char (point)) @@ -95,7 +109,7 @@ (nnheader-translate-file-chars (match-string 1)))))) (setq end-line (symbol-value (intern (concat "mm-uu-" (symbol-name type) - "-end-line")))) + "-end-line")))) (when (re-search-forward end-line nil t) (forward-line) (setq end-char (point)) @@ -107,7 +121,7 @@ (if (> start-char text-start) (push (list (mm-uu-copy-to-buffer text-start start-char) - '("text/plain") nil nil nil nil) + text-plain-type cte nil nil nil) result)) (push (cond @@ -145,11 +159,31 @@ (if (> (point-max) (1+ text-start)) (push (list (mm-uu-copy-to-buffer text-start (point-max)) - '("text/plain") nil nil nil nil) + text-plain-type cte nil nil nil) result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) +;;;### autoload +(defun mm-uu-test () + "Check whether the current buffer contains uu stuffs." + (save-excursion + (save-restriction + (mail-narrow-to-head) + (goto-char (point-max))) + (forward-line) + (let (type end-line result) + (while (and (not result) (re-search-forward mm-uu-begin-line nil t)) + (forward-line) + (setq type (cdr (assq (aref (match-string 0) 0) + mm-uu-identifier-alist))) + (setq end-line (symbol-value + (intern (concat "mm-uu-" (symbol-name type) + "-end-line")))) + (if (re-search-forward end-line nil t) + (setq result t))) + result))) + (provide 'mm-uu) ;;; mm-uu.el ends here diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 912893e..e99b8be 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -109,7 +109,9 @@ (newest (if (file-newer-than-file-p file auto) file auto)) (nntp-server-buffer (or buffer nntp-server-buffer))) (when (and (file-exists-p newest) - (nnmail-find-file newest)) + (let ((nnmail-file-coding-system + message-draft-coding-system)) + (nnmail-find-file newest))) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index d3eb033..6423dac 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -270,10 +270,10 @@ Should be called narrowed to the head of the message." (prog1 (match-string 0) (delete-region (match-beginning 0) (match-end 0))))) - (when (mm-multibyte-p) + (when (and (mm-multibyte-p) rfc2047-default-charset) (mm-decode-coding-region b e rfc2047-default-charset)) (setq b (point))) - (when (mm-multibyte-p) + (when (and (mm-multibyte-p) rfc2047-default-charset) (mm-decode-coding-region b (point-max) rfc2047-default-charset)))))) (defun rfc2047-decode-string (string)