From: akr Date: Sun, 2 May 1999 08:09:41 +0000 (+0000) Subject: * mime-view.el (unpack): New macro. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b955fbe10acbf91cd453a5af2108ae1f6904efc3;p=elisp%2Fsemi.git * 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 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,18 @@ 1999-05-02 Tanaka Akira + * 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 + * (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 --- 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))))