(mime-user-acting-condition): New variable.
[elisp/semi.git] / mime-pgp.el
index 1949119..498cbf7 100644 (file)
     (set-window-buffer p-win mime-preview-buffer)
     ))
 
-(set-atype 'mime-acting-condition
-          '((type . application)(subtype . pgp)
-            (method . mime-method-for-application/pgp)))
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . pgp)
+                          (message-button . visible)))
 
-(set-atype 'mime-acting-condition
-          '((type . text)(subtype . x-pgp)
-            (method . mime-method-for-application/pgp)))
+(ctree-set-calist-strictly
+ 'mime-acting-condition '((type . application)(subtype . pgp)
+                         (method . mime-method-for-application/pgp)))
+
+(ctree-set-calist-strictly
+ 'mime-acting-condition '((type . text)(subtype . x-pgp)
+                         (method . mime-method-for-application/pgp)))
 
 
 ;;; @ Internal method for multipart/signed
   "Internal method to verify multipart/signed."
   (mime-raw-play-entity
    ;; entity-info of signature
-   (mime-raw-entity-node-id-to-entity-info
+   (mime-raw-find-entity-from-node-id
     ;; entity-node-id of signature
-    (cons 1 (reverse (mime-raw-point-to-entity-number start)))
-    mime-raw-message-info)
+    (cons 1 (mime-raw-point-to-entity-node-id start)))
    (cdr (assq 'mode cal)) ; play-mode
    ))
 
-(set-atype 'mime-acting-condition
-          '((type . multipart)(subtype . signed)
-            (method . mime-method-to-verify-multipart/signed)))
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . multipart)(subtype . signed)
+   (method . mime-method-to-verify-multipart/signed)))
 
 
 ;;; @ Internal method for application/pgp-signature
@@ -177,84 +181,64 @@ It should be ISO 639 2 letter language code such as en, ja, ...")
 (defun mime-method-to-verify-application/pgp-signature (start end cal)
   "Internal method to check PGP/MIME signature."
   (let* ((encoding (cdr (assq 'encoding cal)))
-        (entity-number (mime-raw-point-to-entity-number start))
-        (entity-node-id (reverse entity-number))
-        (rmcnum (cdr entity-node-id))
+        (entity-node-id (mime-raw-point-to-entity-node-id start))
+        (mother-node-id (cdr entity-node-id))
         (knum (car entity-node-id))
         (onum (if (> knum 0)
                   (1- knum)
                 (1+ knum)))
-        (raw-buf (current-buffer))
-        (oinfo (mime-raw-entity-node-id-to-entity-info
-                (cons onum rmcnum) mime-raw-message-info))
-        kbuf
+        (oinfo (mime-raw-find-entity-from-node-id
+                (cons onum mother-node-id) mime-raw-message-info))
         (basename (expand-file-name "tm" mime-temp-directory))
         (orig-file (make-temp-name basename))
         (sig-file (concat orig-file ".sig"))
         )
-    (save-excursion
-      (let ((p-min (mime-entity-info-point-min oinfo))
-           (p-max (mime-entity-info-point-max oinfo))
-           )
-       (set-buffer (get-buffer-create mime-temp-buffer-name))
-       (insert-buffer-substring raw-buf p-min p-max)
-       )
-      (goto-char (point-min))
-      (while (re-search-forward "\n" nil t)
-       (replace-match "\r\n")
-       )
-      (as-binary-output-file (write-region (point-min)(point-max) orig-file))
-      (kill-buffer (current-buffer))
-      )
+    (mime-raw-write-region (mime-entity-point-min oinfo)
+                          (mime-entity-point-max oinfo)
+                          orig-file)
     (save-excursion (mime-show-echo-buffer))
-    (save-excursion
-      (let ((p-min (save-excursion
-                    (goto-char start)
-                    (and (search-forward "\n\n")
-                         (match-end 0))
-                    )))
-       (set-buffer (setq kbuf (get-buffer-create mime-temp-buffer-name)))
-       (insert-buffer-substring raw-buf p-min end)
-       )
-      (mime-decode-region (point-min)(point-max) encoding)
-      (as-binary-output-file (write-region (point-min)(point-max) sig-file))
-      (or (mime-pgp-check-signature mime-echo-buffer-name orig-file)
-         (let (pgp-id)
-           (save-excursion
-             (set-buffer mime-echo-buffer-name)
-             (goto-char (point-min))
-             (let ((regexp (cdr (assq (or mime-pgp-default-language 'en)
-                                      mime-pgp-key-expected-regexp-alist))))
-               (cond ((not (stringp regexp))
-                      (message
-                       "Please specify right regexp for specified language")
-                      )
-                     ((re-search-forward regexp nil t)
-                      (setq pgp-id
-                            (concat "0x" (buffer-substring-no-properties
-                                          (match-beginning 1)
-                                          (match-end 1))))
-                      ))))
-           (if (and pgp-id
-                    (y-or-n-p
-                     (format "Key %s not found; attempt to fetch? " pgp-id))
+    (mime-write-decoded-region (save-excursion
+                                (goto-char start)
+                                (and (search-forward "\n\n")
+                                     (match-end 0))
+                                ) end sig-file encoding)
+    (or (mime-pgp-check-signature mime-echo-buffer-name orig-file)
+       (let (pgp-id)
+         (save-excursion
+           (set-buffer mime-echo-buffer-name)
+           (goto-char (point-min))
+           (let ((regexp (cdr (assq (or mime-pgp-default-language 'en)
+                                    mime-pgp-key-expected-regexp-alist))))
+             (cond ((not (stringp regexp))
+                    (message
+                     "Please specify right regexp for specified language")
                     )
-               (progn
-                 (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
-                 (mime-pgp-check-signature mime-echo-buffer-name orig-file)
-                 ))
-           ))
-      (let ((other-window-scroll-buffer mime-echo-buffer-name))
-       (scroll-other-window 8)
-       )
-      (kill-buffer kbuf)
-      (delete-file orig-file)
-      (delete-file sig-file)
-      )))
-
-(set-atype 'mime-acting-condition
-          '((type . application)(subtype . pgp-signature)
-            (method . mime-method-to-verify-application/pgp-signature)))
+                   ((re-search-forward regexp nil t)
+                    (setq pgp-id
+                          (concat "0x" (buffer-substring-no-properties
+                                        (match-beginning 1)
+                                        (match-end 1))))
+                    ))))
+         (if (and pgp-id
+                  (y-or-n-p
+                   (format "Key %s not found; attempt to fetch? " pgp-id))
+                  )
+             (progn
+               (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
+               (mime-pgp-check-signature mime-echo-buffer-name orig-file)
+               ))
+         ))
+    (let ((other-window-scroll-buffer mime-echo-buffer-name))
+      (scroll-other-window 8)
+      )
+    (delete-file orig-file)
+    (delete-file sig-file)
+    ))
+
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . application)(subtype . pgp-signature)
+   (method . mime-method-to-verify-application/pgp-signature)))
 
 
 ;;; @ Internal method for application/pgp-encrypted
@@ -262,24 +246,24 @@ It should be ISO 639 2 letter language code such as en, ja, ...")
 ;;; It is based on RFC 2015 (PGP/MIME).
 
 (defun mime-method-to-decrypt-application/pgp-encrypted (start end cal)
-  (let* ((entity-number (mime-raw-point-to-entity-number start))
-        (entity-node-id (reverse entity-number))
-        (rmcnum (cdr entity-node-id))
+  (let* ((entity-node-id (mime-raw-point-to-entity-node-id start))
+        (mother-node-id (cdr entity-node-id))
         (knum (car entity-node-id))
         (onum (if (> knum 0)
                   (1- knum)
                 (1+ knum)))
-        (oinfo (mime-raw-entity-node-id-to-entity-info
-                (cons onum rmcnum) mime-raw-message-info))
-        (obeg (mime-entity-info-point-min oinfo))
-        (oend (mime-entity-info-point-max oinfo))
+        (oinfo (mime-raw-find-entity-from-node-id
+                (cons onum mother-node-id) mime-raw-message-info))
+        (obeg (mime-entity-point-min oinfo))
+        (oend (mime-entity-point-max oinfo))
         )
     (mime-method-for-application/pgp obeg oend cal)
     ))
 
-(set-atype 'mime-acting-condition
-          '((type . application)(subtype . pgp-encrypted)
-            (method . mime-method-to-decrypt-application/pgp-encrypted)))
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . application)(subtype . pgp-encrypted)
+   (method . mime-method-to-decrypt-application/pgp-encrypted)))
 
 
 ;;; @ Internal method for application/pgp-keys
@@ -305,9 +289,10 @@ It should be ISO 639 2 letter language code such as en, ja, ...")
     (kill-buffer (current-buffer))
     ))
 
-(set-atype 'mime-acting-condition
-          '((type . application)(subtype . pgp-keys)
-            (method . mime-method-to-add-application/pgp-keys)))
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . application)(subtype . pgp-keys)
+   (method . mime-method-to-add-application/pgp-keys)))
 
         
 ;;; @ end