* wl-mime.el (wl-message-decrypt-pgp-nonmime): New function.

(wl-message-verify-pgp-nonmime): Ditto.
* wl-e21.el, wl-mule.el, wl-xmas.el (wl-message-define-keymap):
Bind them to C-c:d and C-c:v respectively.

Merge following code by Teranishi-san from [wl-en:00167].
* wl-mime.el (wl-mime-preview-application/pgp): New function.
(wl-mime-preview-application/pgp-encrypted): Ditto.
(wl-mime-setup): Add entry.

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 8d52d42..1552334 100644 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,15 @@
+2002-11-12  Yoichi NAKAYAMA  <yoichi@eken.phys.nagoya-u.ac.jp>
+
+       * wl-mime.el (wl-message-decrypt-pgp-nonmime): New function.
+       (wl-message-verify-pgp-nonmime): Ditto.
+       * wl-e21.el, wl-mule.el, wl-xmas.el (wl-message-define-keymap):
+       Bind them to C-c:d and C-c:v respectively.
+
+       Merge following code by Teranishi-san from [wl-en:00167].
+       * wl-mime.el (wl-mime-preview-application/pgp): New function.
+       (wl-mime-preview-application/pgp-encrypted): Ditto.
+       (wl-mime-setup): Add entry.
+
 2002-11-10  Yoichi NAKAYAMA  <yoichi@eken.phys.nagoya-u.ac.jp>
 
        * wl-summary.el (wl-summary-target-mark-erase): New function.

diff --git a/wl/wl-e21.el b/wl/wl-e21.el
index 49110ef..9fae1d9 100644 (file)
--- a/wl/wl-e21.el
+++ b/wl/wl-e21.el
@@ -530,6 +530,8 @@
   (let ((keymap (make-sparse-keymap)))
     (define-key keymap "D" 'wl-message-delete-current-part)
     (define-key keymap "l" 'wl-message-toggle-disp-summary)
+    (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime)
+    (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime)
     (define-key keymap [mouse-4] 'wl-message-wheel-down)
     (define-key keymap [mouse-5] 'wl-message-wheel-up)
     (define-key keymap [S-mouse-4] 'wl-message-wheel-down)

diff --git a/wl/wl-mime.el b/wl/wl-mime.el
index 19e2fc0..933ac6b 100644 (file)
--- a/wl/wl-mime.el
+++ b/wl/wl-mime.el
@@ -34,6 +34,11 @@
 (require 'mime-play)
 (require 'elmo)
 
+(eval-when-compile
+  (defalias-maybe 'pgg-decrypt-region 'ignore)
+  (defalias-maybe 'pgg-display-output-buffer 'ignore)
+  (defalias-maybe 'pgg-verify-region 'ignore))
+
 ;;; Draft
 
 (defalias 'wl-draft-editor-mode 'mime-edit-mode)
@@ -288,6 +293,110 @@ It calls following-method selected from variable
        (wl-summary-toggle-disp-msg 'off)
        (wl-summary-sync nil "update")))))
 
+(defun wl-message-decrypt-pgp-nonmime ()
+  "Decrypt PGP encrypted region"
+  (interactive)
+  (require 'pgg)
+  (save-excursion
+    (beginning-of-line)
+    (if (or (re-search-forward "^-+END PGP MESSAGE-+$" nil t)
+           (re-search-backward "^-+END PGP MESSAGE-+$" nil t))
+       (let (beg end status)
+         (setq end (match-end 0))
+         (if (setq beg (re-search-backward "^-+BEGIN PGP MESSAGE-+$" nil t))
+             (let ((inhibit-read-only t))
+               (setq status (pgg-decrypt-region beg end))
+               (pgg-display-output-buffer beg end status))
+           (message "Cannot find pgp encrypted region")))
+      (message "Cannot find pgp encrypted region"))))
+
+(defun wl-message-verify-pgp-nonmime ()
+  "Verify PGP signed region"
+  (interactive)
+  (require 'pgg)
+  (save-excursion
+    (beginning-of-line)
+    (if (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t)
+           (re-search-backward "^-+END PGP SIGNATURE-+$" nil t))
+       (let (beg end status)
+         (setq end (match-end 0))
+         (if (setq beg (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
+             (progn
+               (save-excursion
+                 (mime-show-echo-buffer)
+                 (set-buffer mime-echo-buffer-name)
+                 (set-window-start
+                  (get-buffer-window mime-echo-buffer-name)
+                  (point-max)))
+               (setq status (pgg-verify-region beg end nil 'fetch))
+               (set-buffer mime-echo-buffer-name)
+               (insert-buffer-substring
+                (if status pgg-output-buffer pgg-errors-buffer)))
+           (message "Cannot find pgp signed region")))
+      (message "Cannot find pgp signed region"))))
+
+;; XXX: encrypted multipart isn't represented as multipart
+(defun wl-mime-preview-application/pgp (parent-entity entity situation)
+  (require 'pgg)
+  (goto-char (point-max))
+  (let ((p (point))
+       raw-buf to-buf representation-type child-entity)
+    (goto-char p)
+    (save-restriction
+      (narrow-to-region p p)
+      (setq to-buf (current-buffer))
+      (with-temp-buffer
+       (setq raw-buf (current-buffer))
+       (mime-insert-entity entity)
+       (cond ((progn
+                (goto-char (point-min))
+                (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
+              (pgg-verify-region (match-beginning 0)(point-max) nil 'fetch)
+              (goto-char (point-min))
+              (delete-region
+               (point-min)
+               (and
+                (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
+                (match-end 0)))
+              (delete-region
+               (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
+                    (match-beginning 0))
+               (point-max))
+              (goto-char (point-min))
+              (while (re-search-forward "^- -" nil t)
+                (replace-match "-"))
+              (setq representation-type (if (mime-entity-cooked-p entity)
+                                            'cooked)))
+             ((progn
+                (goto-char (point-min))
+                (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
+              (pgg-decrypt-region (point-min)(point-max))
+              (delete-region (point-min) (point-max))
+              (insert-buffer pgg-output-buffer)
+              (setq representation-type 'elmo-buffer)))
+       (setq child-entity (mime-parse-message
+                           (mm-expand-class-name representation-type)
+                           nil
+                           parent-entity
+                           (mime-entity-node-id-internal parent-entity)))
+       (mime-display-entity
+        child-entity
+        nil
+        `((header . visible)
+          (body . visible)
+          (entity-button . invisible))
+        to-buf)))))
+
+(defun wl-mime-preview-application/pgp-encrypted (entity situation)
+  (let* ((entity-node-id (mime-entity-node-id entity))
+        (mother (mime-entity-parent entity))
+        (knum (car entity-node-id))
+        (onum (if (> knum 0)
+                  (1- knum)
+                (1+ knum)))
+        (orig-entity (nth onum (mime-entity-children mother))))
+    (wl-mime-preview-application/pgp entity orig-entity situation)))
+
 ;;; Summary
 (defun wl-summary-burst-subr (message-entity target number)
   ;; returns new number.
@@ -463,6 +572,14 @@ With ARG, ask destination folder."
      (major-mode . wl-original-message-mode)))
 
   (ctree-set-calist-strictly
+   'mime-preview-condition
+   '((type . application)(subtype . pgp-encrypted)
+     (encoding . t)
+     (body . invisible)
+     (body-presentation-method . wl-mime-preview-application/pgp-encrypted)
+     (major-mode . wl-original-message-mode)))
+
+  (ctree-set-calist-strictly
    'mime-acting-condition
    '((type . message) (subtype . partial)
      (method .  wl-mime-combine-message/partial-pieces)

diff --git a/wl/wl-mule.el b/wl/wl-mule.el
index 985768d..75038c0 100644 (file)
--- a/wl/wl-mule.el
+++ b/wl/wl-mule.el
@@ -102,6 +102,8 @@ Special commands:
   (let ((keymap (make-sparse-keymap)))
     (define-key keymap "D" 'wl-message-delete-current-part)
     (define-key keymap "l" 'wl-message-toggle-disp-summary)
+    (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime)
+    (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime)
     (define-key keymap [mouse-4] 'wl-message-wheel-down)
     (define-key keymap [mouse-5] 'wl-message-wheel-up)
     (define-key keymap [S-mouse-4] 'wl-message-wheel-down)

diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el
index 93da3a2..6667d89 100644 (file)
--- a/wl/wl-xmas.el
+++ b/wl/wl-xmas.el
@@ -448,6 +448,8 @@
   (let ((keymap (make-sparse-keymap)))
     (define-key keymap "D" 'wl-message-delete-current-part)
     (define-key keymap "l" 'wl-message-toggle-disp-summary)
+    (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime)
+    (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime)
     (define-key keymap 'button4 'wl-message-wheel-down)
     (define-key keymap 'button5 'wl-message-wheel-up)
     (define-key keymap [(shift button4)] 'wl-message-wheel-down)