(gnus-read-group): Added check to ask confirmation if

[gnus] / lisp / mm-view.el

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 64f3ab4..cea0886 100644 (file)
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -1,5 +1,5 @@
 ;;; mm-view.el --- functions for viewing MIME objects
 ;;; 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 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.


@@ -34,27 +34,34 @@
   (autoload 'vcard-parse-string "vcard")
   (autoload 'vcard-format-string "vcard")
   (autoload 'fill-flowed "flow-fill")
   (autoload 'vcard-parse-string "vcard")
   (autoload 'vcard-format-string "vcard")
   (autoload 'fill-flowed "flow-fill")

+  (autoload 'html2text "html2text")

   (unless (fboundp 'diff-mode)
     (autoload 'diff-mode "diff-mode" "" t nil)))
 
 (defvar mm-text-html-renderer-alist
   '((w3  . mm-inline-text-html-render-with-w3)
     (w3m . mm-inline-text-html-render-with-w3m)
   (unless (fboundp 'diff-mode)
     (autoload 'diff-mode "diff-mode" "" t nil)))
 
 (defvar mm-text-html-renderer-alist
   '((w3  . mm-inline-text-html-render-with-w3)
     (w3m . mm-inline-text-html-render-with-w3m)

-    (links mm-inline-render-with-file 
+    (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
           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)
   "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)

-    (links mm-inline-wash-with-file 
+    (w3m-standalone mm-inline-render-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
           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.")
 
 ;;; Internal variables.
   "The attributes of washer types for text/html.")
 
 ;;; Internal variables.


@@ -66,25 +73,28 @@
 (defun mm-inline-image-emacs (handle)
   (let ((b (point-marker))
        buffer-read-only)
 (defun mm-inline-image-emacs (handle)
   (let ((b (point-marker))
        buffer-read-only)

-    (insert "\n")

     (put-image (mm-get-image handle) b)
     (put-image (mm-get-image handle) b)

+    (insert "\n\n")

     (mm-handle-set-undisplayer
      handle
     (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)
 
 (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 ()
        buffer-read-only)
     (mm-handle-set-undisplayer
      handle
      `(lambda ()

-       (let (buffer-read-only)
+       (let ((b ,(point-marker))
+             buffer-read-only)

          (delete-annotation ,annot)
          (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)))
 
     (set-extent-property annot 'mm t)
     (set-extent-property annot 'duplicable t)))
 


@@ -108,9 +118,8 @@
   (let ((text (mm-get-part handle))
        (b (point))
        (url-standalone-mode t)
   (let ((text (mm-get-part handle))
        (b (point))
        (url-standalone-mode t)

-       (url-gateway-unplugged t)
+       (url-gateway-unplugged t)

        (w3-honor-stylesheets nil)
        (w3-honor-stylesheets nil)

-       (w3-delay-image-loads t)

        (url-current-object
         (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
        (width (window-width))
        (url-current-object
         (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
        (width (window-width))


@@ -143,23 +152,25 @@
                  ;; Don't let w3 set the global version of
                  ;; this variable.
                  (fill-column fill-column))
                  ;; Don't let w3 set the global version of
                  ;; this variable.
                  (fill-column fill-column))

-             (condition-case var
+             (if (or debug-on-error debug-on-quit)

                  (w3-region (point-min) (point-max))
                  (w3-region (point-min) (point-max))

-               (error
-                (delete-region (point-min) (point-max))
-                (let ((b (point))
-                      (charset (mail-content-type-get
-                                (mm-handle-type handle) 'charset)))
-                  (if (or (eq charset 'gnus-decoded)
-                          (eq mail-parse-charset 'gnus-decoded))
+               (condition-case ()
+                   (w3-region (point-min) (point-max))
+                 (error
+                  (delete-region (point-min) (point-max))
+                  (let ((b (point))
+                        (charset (mail-content-type-get
+                                  (mm-handle-type handle) 'charset)))
+                    (if (or (eq charset 'gnus-decoded)
+                            (eq mail-parse-charset 'gnus-decoded))

                       (save-restriction
                         (narrow-to-region (point) (point))
                         (mm-insert-part handle)
                         (goto-char (point-max)))
                       (save-restriction
                         (narrow-to-region (point) (point))
                         (mm-insert-part handle)
                         (goto-char (point-max)))

-                    (insert (mm-decode-string (mm-get-part handle)
-                                              charset))))
-                (message
-                 "Error while rendering html; showing as text/plain"))))))
+                      (insert (mm-decode-string (mm-get-part handle)
+                                                charset))))
+                  (message
+                   "Error while rendering html; showing as text/plain")))))))

        (mm-handle-set-undisplayer
         handle
         `(lambda ()
        (mm-handle-set-undisplayer
         handle
         `(lambda ()


@@ -173,59 +184,6 @@
              (delete-region ,(point-min-marker)
                             ,(point-max-marker)))))))))
 
              (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-setup nil
   "Whether gnus-article-mode has been setup to use emacs-w3m.")
 
 (defvar mm-w3m-setup nil
   "Whether gnus-article-mode has been setup to use emacs-w3m.")
 


@@ -233,20 +191,11 @@ will not be substituted.")
   "Setup gnus-article-mode to use emacs-w3m."
   (unless mm-w3m-setup
     (require 'w3m)
   "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))))

     (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
       (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
            w3m-cid-retrieve-function-alist))
     (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 (url &rest args)
   "Insert a content pointed by URL if it has the cid: scheme."
 
 (defun mm-w3m-cid-retrieve (url &rest args)
   "Insert a content pointed by URL if it has the cid: scheme."


@@ -260,6 +209,28 @@ will not be substituted.")
          (mm-insert-part handle)
          (throw 'found-handle (mm-handle-media-type handle)))))))
 
          (mm-insert-part handle)
          (throw 'found-handle (mm-handle-media-type handle)))))))
 

+(eval-and-compile
+  (unless (or (featurep 'xemacs)
+             (>= emacs-major-version 21))
+    (defvar mm-w3m-mode-map nil
+      "Keymap for text/html part rendered by `mm-w3m-preview-text/html'.
+This map is overwritten by `mm-w3m-local-map-property' based on the
+value of `w3m-minor-mode-map'.  Therefore, in order to add some
+commands to this map, add them to `w3m-minor-mode-map' instead of this
+map.")))
+
+(defun mm-w3m-local-map-property ()
+  (when (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map)
+    (if (or (featurep 'xemacs)
+           (>= emacs-major-version 21))
+       (list 'keymap w3m-minor-mode-map)
+      (list 'local-map
+           (or mm-w3m-mode-map
+               (progn
+                 (setq mm-w3m-mode-map (copy-keymap w3m-minor-mode-map))
+                 (set-keymap-parent mm-w3m-mode-map gnus-article-mode-map)
+                 mm-w3m-mode-map))))))
+

 (defun mm-inline-text-html-render-with-w3m (handle)
   "Render a text/html part using emacs-w3m."
   (mm-setup-w3m)
 (defun mm-inline-text-html-render-with-w3m (handle)
   "Render a text/html part using emacs-w3m."
   (mm-setup-w3m)


@@ -277,17 +248,14 @@ will not be substituted.")
        (when charset
          (delete-region (point-min) (point-max))
          (insert (mm-decode-string text charset)))
        (when charset
          (delete-region (point-min) (point-max))
          (insert (mm-decode-string text charset)))

-       (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
-                                      nil
-                                    "\\`cid:"))
-             (w3m-display-inline-images mm-inline-text-html-with-images)
+       (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)

              w3m-force-redisplay)
          (w3m-region (point-min) (point-max)))
        (when mm-inline-text-html-with-w3m-keymap
          (add-text-properties
           (point-min) (point-max)
              w3m-force-redisplay)
          (w3m-region (point-min) (point-max)))
        (when mm-inline-text-html-with-w3m-keymap
          (add-text-properties
           (point-min) (point-max)

-          (append '(mm-inline-text-html-with-w3m t)
-                  (gnus-local-map-property mm-w3m-mode-map)))))
+          (nconc (mm-w3m-local-map-property)
+                 '(mm-inline-text-html-with-w3m t)))))

       (mm-handle-set-undisplayer
        handle
        `(lambda ()
       (mm-handle-set-undisplayer
        handle
        `(lambda ()


@@ -309,7 +277,7 @@ will not be substituted.")
     (delete-region (match-beginning 0) (match-end 0))))
 
 (defun mm-inline-wash-with-file (post-func cmd &rest args)
     (delete-region (match-beginning 0) (match-end 0))))
 
 (defun mm-inline-wash-with-file (post-func cmd &rest args)

-  (let ((file (make-temp-name 
+  (let ((file (mm-make-temp-file

               (expand-file-name "mm" mm-tmp-directory))))
     (let ((coding-system-for-write 'binary))
       (write-region (point-min) (point-max) file nil 'silent))
               (expand-file-name "mm" mm-tmp-directory))))
     (let ((coding-system-for-write 'binary))
       (write-region (point-min) (point-max) file nil 'silent))


@@ -336,8 +304,8 @@ will not be substituted.")
 
 (defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
   (let ((source (mm-get-part handle)))
 
 (defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
   (let ((source (mm-get-part handle)))

-    (mm-insert-inline 
-     handle 
+    (mm-insert-inline
+     handle

      (mm-with-unibyte-buffer
        (insert source)
        (apply 'mm-inline-wash-with-stdin post-func cmd args)
      (mm-with-unibyte-buffer
        (insert source)
        (apply 'mm-inline-wash-with-stdin post-func cmd args)


@@ -345,8 +313,8 @@ will not be substituted.")
 
 (defun mm-inline-render-with-function (handle func &rest args)
   (let ((source (mm-get-part handle)))
 
 (defun mm-inline-render-with-function (handle func &rest args)
   (let ((source (mm-get-part handle)))

-    (mm-insert-inline 
-     handle 
+    (mm-insert-inline
+     handle

      (mm-with-unibyte-buffer
        (insert source)
        (apply func args)
      (mm-with-unibyte-buffer
        (insert source)
        (apply func args)


@@ -359,7 +327,7 @@ will not be substituted.")
     (if entry
        (setq func (cdr entry)))
     (cond
     (if entry
        (setq func (cdr entry)))
     (cond

-     ((gnus-functionp func)
+     ((functionp func)

       (funcall func handle))
      (t
       (apply (car func) handle (cdr func))))))
       (funcall func handle))
      (t
       (apply (car func) handle (cdr func))))))


@@ -404,7 +372,8 @@ will not be substituted.")
       (set-text-properties (point-min) (point-max) nil)
       (when (or (equal type "enriched")
                (equal type "richtext"))
       (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 ()
       (mm-handle-set-undisplayer
        handle
        `(lambda ()


@@ -432,9 +401,8 @@ will not be substituted.")
 (defun mm-w3-prepare-buffer ()
   (require 'w3)
   (let ((url-standalone-mode t)
 (defun mm-w3-prepare-buffer ()
   (require 'w3)
   (let ((url-standalone-mode t)

-       (url-gateway-unplugged t)
-       (w3-honor-stylesheets nil)
-       (w3-delay-image-loads t))
+       (url-gateway-unplugged t)
+       (w3-honor-stylesheets nil))

     (w3-prepare-buffer)))
 
 (defun mm-view-message ()
     (w3-prepare-buffer)))
 
 (defun mm-view-message ()


@@ -471,7 +439,8 @@ will not be substituted.")
              gnus-article-prepare-hook
              (gnus-newsgroup-charset
               (or charset gnus-newsgroup-charset)))
              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))
          (gnus-article-prepare-display)
          (setq handles gnus-article-mime-handles))
        (goto-char (point-min))


@@ -546,7 +515,7 @@ will not be substituted.")
                        ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
                        ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
                        ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))
                        ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
                        ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
                        ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))

-  
+

 ;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
 (defvar mm-pkcs7-enveloped-magic
 ;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
 (defvar mm-pkcs7-enveloped-magic


@@ -557,7 +526,7 @@ will not be substituted.")
                        ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
                        ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
                        ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))
                        ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
                        ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
                        ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))

-  
+

 (defun mm-view-pkcs7-get-type (handle)
   (mm-with-unibyte-buffer
     (mm-insert-part handle)
 (defun mm-view-pkcs7-get-type (handle)
   (mm-with-unibyte-buffer
     (mm-insert-part handle)


@@ -571,10 +540,29 @@ will not be substituted.")
 (defun mm-view-pkcs7 (handle)
   (case (mm-view-pkcs7-get-type handle)
     (enveloped (mm-view-pkcs7-decrypt handle))
 (defun mm-view-pkcs7 (handle)
   (case (mm-view-pkcs7-get-type handle)
     (enveloped (mm-view-pkcs7-decrypt handle))

+    (signed (mm-view-pkcs7-verify handle))

     (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
 
     (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
 

+(defun mm-view-pkcs7-verify (handle)
+  ;; A bogus implementation of PKCS#7. FIXME::
+  (mm-insert-part handle)
+  (goto-char (point-min))
+  (if (search-forward "Content-Type: " nil t)
+      (delete-region (point-min) (match-beginning 0)))
+  (goto-char (point-max))
+  (if (re-search-backward "--\r?\n?" nil t)
+      (delete-region (match-end 0) (point-max)))
+  (goto-char (point-min))
+  (while (search-forward "\r\n" nil t)
+    (replace-match "\n"))
+  (message "Verify signed PKCS#7 message is unimplemented.")
+  (sit-for 1)
+  t)
+
+(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro)
+

 (defun mm-view-pkcs7-decrypt (handle)
 (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")
   (goto-char (point-min))
   (insert "MIME-Version: 1.0\n")
   (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")


@@ -583,10 +571,15 @@ will not be substituted.")
    (if (= (length smime-keys) 1)
        (cadar smime-keys)
      (smime-get-key-by-email
    (if (= (length smime-keys) 1)
        (cadar smime-keys)
      (smime-get-key-by-email

-      (completing-read "Decrypt this part with which key? "
-                      smime-keys nil nil
-                      (and (listp (car-safe smime-keys))
-                           (caar smime-keys)))))))
+      (gnus-completing-read-maybe-default
+       (concat "Decipher using which key? "
+              (if smime-keys (concat "(default " (caar smime-keys) ") ")
+                ""))
+       smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
+  (goto-char (point-min))
+  (while (search-forward "\r\n" nil t)
+    (replace-match "\n"))
+  (goto-char (point-min)))

 
 (provide 'mm-view)
 
 
 (provide 'mm-view)