* mime-view.el (unpack): New macro.

(unpack-skip): New function.
(unpack-fixed): New function.
(unpack-byte): New function.
(unpack-short): New function.
(unpack-long): New function.
(unpack-string): New function.
(unpack-string-sjis): New function.
(postpet-decode): New function.
(mime-display-application/x-postpet): Use `postpet-decode'.

diff --git a/ChangeLog b/ChangeLog
index 7acf445..a63d46d 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 1999-05-02  Tanaka Akira  <akr@jaist.ac.jp>
 
+       * mime-view.el (unpack): New macro.
+       (unpack-skip): New function.
+       (unpack-fixed): New function.
+       (unpack-byte): New function.
+       (unpack-short): New function.
+       (unpack-long): New function.
+       (unpack-string): New function.
+       (unpack-string-sjis): New function.
+       (postpet-decode): New function.
+       (mime-display-application/x-postpet): Use `postpet-decode'.
+
+1999-05-02  Tanaka Akira  <akr@jaist.ac.jp>
+
        * (mime-edit-use-long-mime-charset-comment): Use `defvar' to define.
 
        * mime-edit.el (mime-edit-define-charset): Check

diff --git a/mime-view.el b/mime-view.el
index 4b88e52..8d2a9c3 100644 (file)
--- a/mime-view.el
+++ b/mime-view.el
@@ -545,114 +545,98 @@ Each elements are regexp of field-name.")
     (run-hooks 'mime-display-text/x-vcard-hook)
     ))
 
+(put 'unpack 'lisp-indent-function 1)
+(defmacro unpack (string &rest body)
+  `(let* ((*unpack*string* (string-as-unibyte ,string))
+         (*unpack*index* 0)
+         (*unpack*length* (length *unpack*string*)))
+     ,@body))
+
+(defun unpack-skip (len)
+  (setq *unpack*index* (+ len *unpack*index*)))
+
+(defun unpack-fixed (len)
+  (prog1
+      (substring *unpack*string* *unpack*index* (+ *unpack*index* len))
+    (unpack-skip len)))
+
+(defun unpack-byte ()
+  (char-int (aref (unpack-fixed 1) 0)))
+
+(defun unpack-short ()
+  (let* ((b0 (unpack-byte))
+        (b1 (unpack-byte)))
+    (+ (* 256 b0) b1)))
+
+(defun unpack-long ()
+  (let* ((s0 (unpack-short))
+        (s1 (unpack-short)))
+    (+ (* 65536 s0) s1)))
+
+(defun unpack-string ()
+  (let ((len (unpack-byte)))
+    (unpack-fixed len)))
+
+(defun unpack-string-sjis ()
+  (decode-mime-charset-string (unpack-string) 'shift_jis))
+
+(defun postpet-decode (string)
+  (unpack string
+    (let ((res))
+      (unpack-skip 4)
+      (set-alist 'res 'carryingcount (unpack-long))
+      (unpack-skip 8)
+      (set-alist 'res 'sentyear (unpack-short))
+      (set-alist 'res 'sentmonth (unpack-short))
+      (set-alist 'res 'sentday (unpack-short))
+      (unpack-skip 8)
+      (set-alist 'res 'petname (unpack-string-sjis))
+      (set-alist 'res 'owner (unpack-string-sjis))
+      (set-alist 'res 'pettype (unpack-fixed 4))
+      (set-alist 'res 'health (unpack-short))
+      (unpack-skip 2)
+      (set-alist 'res 'sex (unpack-long))
+      (unpack-skip 1)
+      (set-alist 'res 'brain (unpack-byte))
+      (unpack-skip 39)
+      (set-alist 'res 'happiness (unpack-byte))
+      (unpack-skip 14)
+      (set-alist 'res 'petbirthyear (unpack-short))
+      (set-alist 'res 'petbirthmonth (unpack-short))
+      (set-alist 'res 'petbirthday (unpack-short))
+      (unpack-skip 8)
+      (set-alist 'res 'from (unpack-string))
+      (unpack-skip 5)
+      (unpack-skip 160)
+      (unpack-skip 4)
+      (unpack-skip 8)
+      (unpack-skip 8)
+      (unpack-skip 26)
+      (set-alist 'res 'treasure (unpack-short))
+      (set-alist 'res 'money (unpack-long))
+      res)))
+
 (defun mime-display-application/x-postpet (entity situation)
   (save-restriction
     (narrow-to-region (point-max)(point-max))
-    (let ((contents (string-as-unibyte (mime-entity-content entity)))
-         (p 0) l
-         petname owner pettype from
-         carryingcount sentyear sentmonth sentday
-         petbirthyear petbirthmonth petbirthday
-         brain health happiness sex treasure money
-         )
-      
-      (setq p (+ p 4))
-      
-      (setq carryingcount
-           (+ (char-int (aref contents (+ 3 p)))
-              (* 256 (char-int (aref contents (+ 2 p))))
-              (* 256 256 (char-int (aref contents (1+ p))))
-              (* 256 256 256 (char-int (aref contents p)))))
-      (setq p (+ p 4))
-      
-      (setq p (+ p 8))
-            
-      (setq sentyear
-           (+ (char-int (aref contents (1+ p)))
-              (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 2))
-      
-      (setq sentmonth
-           (+ (char-int (aref contents (1+ p)))
-              (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 2))
-      
-      (setq sentday
-           (+ (char-int (aref contents (1+ p)))
-              (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 2))
-      
-      (setq p (+ p 8))
-      
-      (setq petname (decode-mime-charset-string (substring contents (1+ p) (setq p (+ p 1 (char-int (aref contents p))))) 'shift_jis))
-      (setq owner (decode-mime-charset-string (substring contents (1+ p) (setq p (+ p 1 (char-int (aref contents p))))) 'shift_jis))
-      (setq pettype (substring contents p (setq p (+ p 4))))
-      
-;;      (setq p (+ p 1))
-;;      (setq health (char-int (aref contents p)))
-      ;; 2 byte
-      (setq health (+ (char-int (aref contents (1+ p)))
-                     (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 1))
-      
-      (setq p (+ p 2))
-      (setq p (+ p 4))
-      (setq sex (char-int (aref contents p)))
-
-      (setq p (+ p 2))
-      (setq brain (char-int (aref contents p)))
-      (setq p (+ p 40))
-      (setq happiness (char-int (aref contents p)))
-      (setq p (+ p 15))
-      
-      (setq petbirthyear
-           (+ (char-int (aref contents (1+ p)))
-              (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 2))
-      
-      (setq petbirthmonth
-           (+ (char-int (aref contents (1+ p)))
-              (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 2))
-      
-      (setq petbirthday
-           (+ (char-int (aref contents (1+ p)))
-              (* 256 (char-int (aref contents p)))))
-      (setq p (+ p 2))
-      
-      (setq p (+ p 8))
-      (setq from (substring contents (1+ p) (setq p (+ p 1 (char-int (aref contents p))))))
-      (setq p (+ p 5))
-      (setq p (+ p 160))      
-      (setq p (+ p 4))
-      (setq p (+ p 8))
-      
-      (setq p (+ p 8))
-      (setq p (+ p 26))
-      (setq p (+ p 1))
-      (setq treasure (char-int (aref contents p)))
-      (setq p (+ p 1))
-      (setq money (+ (char-int (aref contents (+ 3 p)))
-                     (* 256 (char-int (aref contents (+ 2 p))))
-                     (* 256 256 (char-int (aref contents (1+ p))))
-                     (* 256 256 256 (char-int (aref contents p)))))
-      (insert "Petname: " petname "\n"
-             "Owner: " owner "\n"
-             "Pettype: " pettype "\n"
-             "From: " from "\n"
-             "CarryingCount: " (int-to-string carryingcount) "\n"
-             "SentYaer: " (int-to-string sentyear) "\n"
-             "SentMonth: " (int-to-string sentmonth) "\n"
-             "Sentday: " (int-to-string sentday) "\n"
-             "PetbirthYear: " (int-to-string petbirthyear) "\n"
-             "PetbirthMonth: " (int-to-string petbirthmonth) "\n"
-             "PetbirthDay: " (int-to-string petbirthday) "\n"
-             "Health: " (int-to-string health) "\n"
-             "Sex: " (int-to-string sex) "\n"
-             "Brain: " (int-to-string brain) "\n"
-             "Happiness: " (int-to-string happiness) "\n"
-             "Treasure: " (int-to-string treasure) "\n"
-             "Money: " (int-to-string money) "\n"
+    (let ((pet (postpet-decode (string-as-unibyte (mime-entity-content entity)))))
+      (insert "Petname: " (cdr (assq 'petname pet)) "\n"
+             "Owner: " (cdr (assq 'owner pet)) "\n"
+             "Pettype: " (cdr (assq 'pettype pet)) "\n"
+             "From: " (cdr (assq 'from pet)) "\n"
+             "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet))) "\n"
+             "SentYaer: " (int-to-string (cdr (assq 'sentyear pet))) "\n"
+             "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet))) "\n"
+             "Sentday: " (int-to-string (cdr (assq 'sentday pet))) "\n"
+             "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet))) "\n"
+             "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet))) "\n"
+             "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet))) "\n"
+             "Health: " (int-to-string (cdr (assq 'health pet))) "\n"
+             "Sex: " (int-to-string (cdr (assq 'sex pet))) "\n"
+             "Brain: " (int-to-string (cdr (assq 'brain pet))) "\n"
+             "Happiness: " (int-to-string (cdr (assq 'happiness pet))) "\n"
+             "Treasure: " (int-to-string (cdr (assq 'treasure pet))) "\n"
+             "Money: " (int-to-string (cdr (assq 'money pet))) "\n"
              )
       (run-hooks 'mime-display-application/x-postpet-hook))))