(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))))
projects / elisp / semi.git / blobdiff