From: morioka Date: Thu, 27 Nov 1997 15:45:21 +0000 (+0000) Subject: (gnus-show-mime-method): Use `gnus-article-preview-mime-message' X-Git-Tag: gnus-6_7-tomo-199811302358~301 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=519187d30144fde7dffb917fa06e70e7565f1b88;p=elisp%2Fgnus.git- (gnus-show-mime-method): Use `gnus-article-preview-mime-message' instead of `metamail-buffer' in default. (gnus-decode-encoded-word-method): Use `gnus-article-decode-encoded-word' instead of `gnus-article-de-quoted-unreadable' in default. Abolish `gnus-hack-decode-rfc1522', `gnus-decode-rfc1522', `article-decode-rfc1522', `article-de-quoted-unreadable', `article-mime-decode-quoted-printable-buffer' and `article-mime-decode-quoted-printable'. (gnus-article-decode-rfc1522): New implementation (use `eword-decode-header'). (gnus-article-preview-mime-message): New function. (gnus-article-decode-encoded-word): New function. (gnus-content-header-filter): New function. (mime-view-quitting-method-for-gnus): New function. Add setting for mime-view. --- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 44bf80d..be097a0 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -33,6 +33,8 @@ (require 'gnus-spec) (require 'gnus-int) (require 'browse-url) +(require 'alist) +(require 'mime-view) (defgroup gnus-article nil "Article display." @@ -358,13 +360,13 @@ be used as possible file names." :group 'gnus-article-mime :type 'boolean) -(defcustom gnus-show-mime-method 'metamail-buffer +(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message "Function to process a MIME message. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) -(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable +(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word "*Function to decode MIME encoded words. The function is called from the article buffer." :group 'gnus-article-mime @@ -915,84 +917,90 @@ characters to translate to." (process-send-region "article-x-face" beg end) (process-send-eof "article-x-face")))))))))) -(defun gnus-hack-decode-rfc1522 () - "Emergency hack function for avoiding problems when decoding." - (let ((buffer-read-only nil)) - (goto-char (point-min)) - ;; Remove encoded TABs. - (while (search-forward "=09" nil t) - (replace-match " " t t)) - ;; Remove encoded newlines. - (goto-char (point-min)) - (while (search-forward "=10" nil t) - (replace-match " " t t)))) - -(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) -(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) -(defun article-decode-rfc1522 () - "Hack to remove QP encoding from headers." - (let ((case-fold-search t) - (inhibit-point-motion-hooks t) - (buffer-read-only nil) - string) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - (while (re-search-forward - "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) - (setq string (match-string 1)) - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (delete-region (point-min) (point-max)) - (insert string) - (article-mime-decode-quoted-printable - (goto-char (point-min)) (point-max)) - (subst-char-in-region (point-min) (point-max) ?_ ? ) - (goto-char (point-max))) - (goto-char (point-min)))))) - -(defun article-de-quoted-unreadable (&optional force) - "Do a naive translation of a quoted-printable-encoded article. -This is in no way, shape or form meant as a replacement for real MIME -processing, but is simply a stop-gap measure until MIME support is -written. -If FORCE, decode the article whether it is marked as quoted-printable -or not." - (interactive (list 'force)) - (save-excursion - (let ((case-fold-search t) - (buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding"))) - (gnus-article-decode-rfc1522) - (when (or force - (and type (string-match "quoted-printable" (downcase type)))) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (article-mime-decode-quoted-printable (point) (point-max)))))) - -(defun article-mime-decode-quoted-printable-buffer () - "Decode Quoted-Printable in the current buffer." - (article-mime-decode-quoted-printable (point-min) (point-max))) - -(defun article-mime-decode-quoted-printable (from to) - "Decode Quoted-Printable in the region between FROM and TO." - (interactive "r") - (goto-char from) - (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) - (delete-char -1) - (delete-char 1)) - ((looking-at "[0-9A-F][0-9A-F]") - (subst-char-in-region - (1- (point)) (point) ?= - (hexl-hex-string-to-integer - (buffer-substring (point) (+ 2 (point))))) - (delete-char 2)) - ((looking-at "=") - (delete-char 1)) - ((gnus-message 3 "Malformed MIME quoted-printable message"))))) +;; (defun gnus-hack-decode-rfc1522 () +;; "Emergency hack function for avoiding problems when decoding." +;; (let ((buffer-read-only nil)) +;; (goto-char (point-min)) +;; ;; Remove encoded TABs. +;; (while (search-forward "=09" nil t) +;; (replace-match " " t t)) +;; ;; Remove encoded newlines. +;; (goto-char (point-min)) +;; (while (search-forward "=10" nil t) +;; (replace-match " " t t)))) + +;; (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) +;; (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) +;; (defun article-decode-rfc1522 () +;; "Hack to remove QP encoding from headers." +;; (let ((case-fold-search t) +;; (inhibit-point-motion-hooks t) +;; (buffer-read-only nil) +;; string) +;; (save-restriction +;; (narrow-to-region +;; (goto-char (point-min)) +;; (or (search-forward "\n\n" nil t) (point-max))) +;; (goto-char (point-min)) +;; (while (re-search-forward +;; "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) +;; (setq string (match-string 1)) +;; (save-restriction +;; (narrow-to-region (match-beginning 0) (match-end 0)) +;; (delete-region (point-min) (point-max)) +;; (insert string) +;; (article-mime-decode-quoted-printable +;; (goto-char (point-min)) (point-max)) +;; (subst-char-in-region (point-min) (point-max) ?_ ? ) +;; (goto-char (point-max))) +;; (goto-char (point-min)))))) + +(defun gnus-article-decode-rfc1522 () + "Decode MIME encoded-words in header fields." + (let (buffer-read-only) + (eword-decode-header) + )) + +;; (defun article-de-quoted-unreadable (&optional force) +;; "Do a naive translation of a quoted-printable-encoded article. +;; This is in no way, shape or form meant as a replacement for real MIME +;; processing, but is simply a stop-gap measure until MIME support is +;; written. +;; If FORCE, decode the article whether it is marked as quoted-printable +;; or not." +;; (interactive (list 'force)) +;; (save-excursion +;; (let ((case-fold-search t) +;; (buffer-read-only nil) +;; (type (gnus-fetch-field "content-transfer-encoding"))) +;; (gnus-article-decode-rfc1522) +;; (when (or force +;; (and type (string-match "quoted-printable" (downcase type)))) +;; (goto-char (point-min)) +;; (search-forward "\n\n" nil 'move) +;; (article-mime-decode-quoted-printable (point) (point-max)))))) + +;; (defun article-mime-decode-quoted-printable-buffer () +;; "Decode Quoted-Printable in the current buffer." +;; (article-mime-decode-quoted-printable (point-min) (point-max))) + +;; (defun article-mime-decode-quoted-printable (from to) +;; "Decode Quoted-Printable in the region between FROM and TO." +;; (interactive "r") +;; (goto-char from) +;; (while (search-forward "=" to t) +;; (cond ((eq (following-char) ?\n) +;; (delete-char -1) +;; (delete-char 1)) +;; ((looking-at "[0-9A-F][0-9A-F]") +;; (subst-char-in-region +;; (1- (point)) (point) ?= +;; (hexl-hex-string-to-integer +;; (buffer-substring (point) (+ 2 (point))))) +;; (delete-char 2)) +;; ((looking-at "=") +;; (delete-char 1)) +;; ((gnus-message 3 "Malformed MIME quoted-printable message"))))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. @@ -1966,6 +1974,52 @@ commands: (forward-line line) (point))))) +;;; @@ article filters +;;; +(defun gnus-article-preview-mime-message () + (make-local-variable 'mime-button-mother-dispatcher) + (setq mime-button-mother-dispatcher + (function gnus-article-push-button)) + (let ((default-mime-charset + (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset)) + ) + (save-excursion + (mime-view-mode nil nil nil gnus-original-article-buffer + gnus-article-buffer + gnus-article-mode-map) + )) + (run-hooks 'gnus-mime-article-prepare-hook) + ) + +(defun gnus-article-decode-encoded-word () + "Header filter for gnus-article-mode. +It is registered to variable `mime-view-content-header-filter-alist'." + (goto-char (point-min)) + (let ((charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (save-restriction + (std11-narrow-to-header) + (goto-char (point-min)) + (while (re-search-forward "^[^ \t:]+:" nil t) + (let ((start (match-beginning 0)) + (end (std11-field-end)) + ) + (save-restriction + (narrow-to-region start end) + (decode-mime-charset-region start end charset) + (goto-char (point-max)) + ))) + (eword-decode-header) + ) + (decode-mime-charset-region (point) (point-max) charset) + (mime-maybe-hide-echo-buffer) + ) + (run-hooks 'gnus-mime-article-prepare-hook) + ) + (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. ARTICLE should either be an article number or a Message-ID. @@ -3177,6 +3231,56 @@ forbidden in URL encoding." (gnus-article-prev-page) (select-window win))) + +;;; @ for mime-view +;;; + +(defun gnus-content-header-filter () + "Header filter for mime-view. +It is registered to variable `mime-view-content-header-filter-alist'." + (goto-char (point-min)) + (while (re-search-forward "^[^ \t:]+:" nil t) + (let ((start (match-beginning 0)) + (end (std11-field-end)) + ) + (save-restriction + (narrow-to-region start end) + (decode-mime-charset-region start end default-mime-charset) + (goto-char (point-max)) + ))) + (eword-decode-header) + ) + +(defun mime-view-quitting-method-for-gnus () + (if (not gnus-show-mime) + (mime-view-kill-buffer)) + (delete-other-windows) + (gnus-article-show-summary) + (if (or (not gnus-show-mime) + (null gnus-have-all-headers)) + (gnus-summary-select-article nil t) + )) + +(set-alist 'mime-view-content-header-filter-alist + 'gnus-original-article-mode + (function gnus-content-header-filter)) + +(set-alist 'mime-text-decoder-alist + 'gnus-original-article-mode + (function mime-text-decode-buffer)) + +(set-alist 'mime-view-quitting-method-alist + 'gnus-original-article-mode + (function mime-view-quitting-method-for-gnus)) + +(set-alist 'mime-view-show-summary-method + 'gnus-original-article-mode + (function mime-view-quitting-method-for-gnus)) + + +;;; @ end +;;; + (gnus-ems-redefine) (provide 'gnus-art)