X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-view.el;h=9ea5f7fb1a0f91bef14280d6c4911d2b8fc17da6;hb=8b87e18f7b6e6fced757c12428271a9433d335bd;hp=659b30d2a47f88b13e680f1212fe079ed0829f35;hpb=fcc5735889b842a3c7839c1147d1cc5b8d5dd723;p=gnus diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 659b30d2a..9ea5f7fb1 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,5 +1,6 @@ ;;; mm-view.el --- functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -41,25 +42,34 @@ (defvar mm-text-html-renderer-alist '((w3 . mm-inline-text-html-render-with-w3) (w3m . mm-inline-text-html-render-with-w3m) + (w3m-standalone mm-inline-render-with-stdin nil + "w3m" "-dump" "-T" "text/html") (links mm-inline-render-with-file mm-links-remove-leading-blank "links" "-dump" file) (lynx mm-inline-render-with-stdin nil - "lynx" "-dump" "-force_html" "-stdin") + "lynx" "-dump" "-force_html" "-stdin" "-nolist") (html2text mm-inline-render-with-function html2text)) "The attributes of renderer types for text/html.") (defvar mm-text-html-washer-alist '((w3 . gnus-article-wash-html-with-w3) (w3m . gnus-article-wash-html-with-w3m) + (w3m-standalone mm-inline-wash-with-stdin nil + "w3m" "-dump" "-T" "text/html") (links mm-inline-wash-with-file mm-links-remove-leading-blank "links" "-dump" file) (lynx mm-inline-wash-with-stdin nil - "lynx" "-dump" "-force_html" "-stdin") + "lynx" "-dump" "-force_html" "-stdin" "-nolist") (html2text html2text)) "The attributes of washer types for text/html.") +(defcustom mm-fill-flowed t + "If non-nil a format=flowed article will be displayed flowed." + :type 'boolean + :group 'mime-display) + ;;; Internal variables. ;;; @@ -69,25 +79,27 @@ (defun mm-inline-image-emacs (handle) (let ((b (point-marker)) buffer-read-only) - (insert "\n") (put-image (mm-get-image handle) b) (mm-handle-set-undisplayer handle - `(lambda () (remove-images ,b (1+ ,b)))))) + `(lambda () + (let ((b ,b) + buffer-read-only) + (remove-images b b) + (delete-region b (+ b 2))))))) (defun mm-inline-image-xemacs (handle) - (insert "\n") - (forward-char -1) - (let ((b (point)) - (annot (make-annotation (mm-get-image handle) nil 'text)) + (insert "\n\n") + (forward-char -2) + (let ((annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) + (let ((b ,(point-marker)) + buffer-read-only) (delete-annotation ,annot) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))) + (delete-region (- b 2) b)))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) @@ -177,62 +189,6 @@ (delete-region ,(point-min-marker) ,(point-max-marker))))))))) -(defvar mm-w3m-mode-map nil - "Local keymap for inlined text/html part rendered by emacs-w3m. It will -be different from `w3m-mode-map' to use in the article buffer.") - -(defvar mm-w3m-mode-command-alist - '((backward-char) - (describe-mode) - (forward-char) - (goto-line) - (next-line) - (previous-line) - (w3m-antenna) - (w3m-antenna-add-current-url) - (w3m-bookmark-add-current-url) - (w3m-bookmark-add-this-url) - (w3m-bookmark-view) - (w3m-close-window) - (w3m-copy-buffer) - (w3m-delete-buffer) - (w3m-dtree) - (w3m-edit-current-url) - (w3m-edit-this-url) - (w3m-gohome) - (w3m-goto-url) - (w3m-goto-url-new-session) - (w3m-history) - (w3m-history-restore-position) - (w3m-history-store-position) - (w3m-namazu) - (w3m-next-buffer) - (w3m-previous-buffer) - (w3m-quit) - (w3m-redisplay-with-charset) - (w3m-reload-this-page) - (w3m-scroll-down-or-previous-url) - (w3m-scroll-up-or-next-url) - (w3m-search) - (w3m-select-buffer) - (w3m-switch-buffer) - (w3m-view-header) - (w3m-view-parent-page) - (w3m-view-previous-page) - (w3m-view-source) - (w3m-weather)) - "Alist of commands to use for emacs-w3m in the article buffer. Each -element looks like (FROM-COMMAND . TO-COMMAND); FROM-COMMAND should be -registered in `w3m-mode-map' which will be substituted by TO-COMMAND -in `mm-w3m-mode-map'. If TO-COMMAND is nil, an article command key -will not be substituted.") - -(defvar mm-w3m-mode-dont-bind-keys (list [up] [right] [left] [down]) - "List of keys which should not be bound for the emacs-w3m commands.") - -(defvar mm-w3m-mode-ignored-keys (list [down-mouse-2]) - "List of keys which should ignore.") - (defvar mm-w3m-setup nil "Whether gnus-article-mode has been setup to use emacs-w3m.") @@ -240,36 +196,28 @@ will not be substituted.") "Setup gnus-article-mode to use emacs-w3m." (unless mm-w3m-setup (require 'w3m) - (unless mm-w3m-mode-map - (setq mm-w3m-mode-map (copy-keymap w3m-mode-map)) - (dolist (def mm-w3m-mode-command-alist) - (condition-case nil - (substitute-key-definition (car def) (cdr def) mm-w3m-mode-map) - (error))) - (dolist (key mm-w3m-mode-dont-bind-keys) - (condition-case nil - (define-key mm-w3m-mode-map key nil) - (error))) - (dolist (key mm-w3m-mode-ignored-keys) - (condition-case nil - (define-key mm-w3m-mode-map key 'ignore) - (error)))) (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist) (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve) w3m-cid-retrieve-function-alist)) - (setq mm-w3m-setup t))) + (setq mm-w3m-setup t)) + (setq w3m-display-inline-images mm-inline-text-html-with-images)) + +(defun mm-w3m-cid-retrieve-1 (url handle) + (if (mm-multiple-handles handle) + (dolist (elem handle) + (mm-w3m-cid-retrieve-1 url elem)) + (when (and (listp handle) + (equal url (mm-handle-id handle))) + (mm-insert-part handle) + (throw 'found-handle (mm-handle-media-type handle))))) (defun mm-w3m-cid-retrieve (url &rest args) "Insert a content pointed by URL if it has the cid: scheme." (when (string-match "\\`cid:" url) - (setq url (concat "<" (substring url (match-end 0)) ">")) (catch 'found-handle - (dolist (handle (with-current-buffer w3m-current-buffer - gnus-article-mime-handles)) - (when (and (listp handle) - (equal url (mm-handle-id handle))) - (mm-insert-part handle) - (throw 'found-handle (mm-handle-media-type handle))))))) + (mm-w3m-cid-retrieve-1 (concat "<" (substring url (match-end 0)) ">") + (with-current-buffer w3m-current-buffer + gnus-article-mime-handles))))) (defun mm-inline-text-html-render-with-w3m (handle) "Render a text/html part using emacs-w3m." @@ -289,14 +237,16 @@ will not be substituted.") (delete-region (point-min) (point-max)) (insert (mm-decode-string text charset))) (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) - (w3m-display-inline-images mm-inline-text-html-with-images) w3m-force-redisplay) (w3m-region (point-min) (point-max))) - (when mm-inline-text-html-with-w3m-keymap + (when (and mm-inline-text-html-with-w3m-keymap + (boundp 'w3m-minor-mode-map) + w3m-minor-mode-map) (add-text-properties (point-min) (point-max) - (append '(mm-inline-text-html-with-w3m t) - (gnus-local-map-property mm-w3m-mode-map))))) + (list 'keymap w3m-minor-mode-map + ;; Put the mark meaning this part was rendered by emacs-w3m. + 'mm-inline-text-html-with-w3m t)))) (mm-handle-set-undisplayer handle `(lambda () @@ -368,7 +318,7 @@ will not be substituted.") (if entry (setq func (cdr entry))) (cond - ((gnus-functionp func) + ((functionp func) (funcall func handle)) (t (apply (car func) handle (cdr func)))))) @@ -400,7 +350,8 @@ will not be substituted.") (mm-insert-part handle) (goto-char (point-max))) (insert (mm-decode-string (mm-get-part handle) charset))) - (when (and (equal type "plain") + (when (and mm-fill-flowed + (equal type "plain") (equal (cdr (assoc 'format (mm-handle-type handle))) "flowed")) (save-restriction @@ -413,7 +364,8 @@ will not be substituted.") (set-text-properties (point-min) (point-max) nil) (when (or (equal type "enriched") (equal type "richtext")) - (enriched-decode (point-min) (point-max))) + (ignore-errors + (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () @@ -479,7 +431,8 @@ will not be substituted.") gnus-article-prepare-hook (gnus-newsgroup-charset (or charset gnus-newsgroup-charset))) - (run-hooks 'gnus-article-decode-hook) + (let ((gnus-original-article-buffer (mm-handle-buffer handle))) + (run-hooks 'gnus-article-decode-hook)) (gnus-article-prepare-display) (setq handles gnus-article-mime-handles)) (goto-char (point-min)) @@ -599,7 +552,7 @@ will not be substituted.") t) (defun mm-view-pkcs7-decrypt (handle) - (insert-buffer (mm-handle-buffer handle)) + (insert-buffer-substring (mm-handle-buffer handle)) (goto-char (point-min)) (insert "MIME-Version: 1.0\n") (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")