postpet.el

   1 ;;; postpet.el --- Postpet support for GNU Emacs
   2
   3 ;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Tanaka Akira  <akr@jaist.ac.jp>
   6 ;; Keywords: Postpet, MIME, multimedia, mail, news
   7
   8 ;; This file is part of SEMI (Sample of Elastic MIME Interfaces).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Code:
  26
  27 (require 'mime)
  28 (require 'alist)
  29
  30 (put 'unpack 'lisp-indent-function 1)
  31 (defmacro unpack (string &rest body)
  32   `(let* ((*unpack*string* (string-as-unibyte ,string))
  33           (*unpack*index* 0))
  34      ,@body))
  35
  36 (defun unpack-skip (len)
  37   (setq *unpack*index* (+ len *unpack*index*)))
  38
  39 (defun unpack-fixed (len)
  40   (prog1
  41       (substring *unpack*string* *unpack*index* (+ *unpack*index* len))
  42     (unpack-skip len)))
  43
  44 (defun unpack-byte ()
  45   (char-int (aref (unpack-fixed 1) 0)))
  46
  47 (defun unpack-short ()
  48   (let* ((b0 (unpack-byte))
  49          (b1 (unpack-byte)))
  50     (+ (* 256 b0) b1)))
  51
  52 (defun unpack-long ()
  53   (let* ((s0 (unpack-short))
  54          (s1 (unpack-short)))
  55     (+ (* 65536 s0) s1)))
  56
  57 (defun unpack-string ()
  58   (let ((len (unpack-byte)))
  59     (unpack-fixed len)))
  60
  61 (defun unpack-string-sjis ()
  62   (decode-mime-charset-string (unpack-string) 'shift_jis))
  63
  64 ;;;###autoload
  65 (defun postpet-decode (string)
  66   (condition-case nil
  67       (unpack string
  68         (let (res)
  69           (unpack-skip 4)
  70           (set-alist 'res 'carryingcount (unpack-long))
  71           (unpack-skip 8)
  72           (set-alist 'res 'sentyear (unpack-short))
  73           (set-alist 'res 'sentmonth (unpack-short))
  74           (set-alist 'res 'sentday (unpack-short))
  75           (unpack-skip 8)
  76           (set-alist 'res 'petname (unpack-string-sjis))
  77           (set-alist 'res 'owner (unpack-string-sjis))
  78           (set-alist 'res 'pettype (unpack-fixed 4))
  79           (set-alist 'res 'health (unpack-short))
  80           (unpack-skip 2)
  81           (set-alist 'res 'sex (unpack-long))
  82           (unpack-skip 1)
  83           (set-alist 'res 'brain (unpack-byte))
  84           (unpack-skip 39)
  85           (set-alist 'res 'happiness (unpack-byte))
  86           (unpack-skip 14)
  87           (set-alist 'res 'petbirthyear (unpack-short))
  88           (set-alist 'res 'petbirthmonth (unpack-short))
  89           (set-alist 'res 'petbirthday (unpack-short))
  90           (unpack-skip 8)
  91           (set-alist 'res 'from (unpack-string))
  92           (unpack-skip 5)
  93           (unpack-skip 160)
  94           (unpack-skip 4)
  95           (unpack-skip 8)
  96           (unpack-skip 8)
  97           (unpack-skip 26)
  98           (set-alist 'res 'treasure (unpack-short))
  99           (set-alist 'res 'money (unpack-long))
 100           res))
 101     (error nil)))
 102
 103 ;;;###autoload
 104 (defun mime-display-application/x-postpet (entity situation)
 105   (save-restriction
 106     (narrow-to-region (point-max)(point-max))
 107     (let ((pet (postpet-decode (mime-entity-content entity))))
 108       (if pet
 109           (insert
 110            "Petname: " (cdr (assq 'petname pet))
 111            "\n"
 112            "Owner: " (cdr (assq 'owner pet))
 113            "\n"
 114            "Pettype: " (cdr (assq 'pettype pet))
 115            "\n"
 116            "From: " (cdr (assq 'from pet))
 117            "\n"
 118            "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet)))
 119            "\n"
 120            "SentYear: " (int-to-string (cdr (assq 'sentyear pet)))
 121            "\n"
 122            "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet)))
 123            "\n"
 124            "SentDay: " (int-to-string (cdr (assq 'sentday pet)))
 125            "\n"
 126            "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet)))
 127            "\n"
 128            "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet)))
 129            "\n"
 130            "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet)))
 131            "\n"
 132            "Health: " (int-to-string (cdr (assq 'health pet)))
 133            "\n"
 134            "Sex: " (int-to-string (cdr (assq 'sex pet)))
 135            "\n"
 136            "Brain: " (int-to-string (cdr (assq 'brain pet)))
 137            "\n"
 138            "Happiness: " (int-to-string (cdr (assq 'happiness pet)))
 139            "\n"
 140            "Treasure: " (int-to-string (cdr (assq 'treasure pet)))
 141            "\n"
 142            "Money: " (int-to-string (cdr (assq 'money pet)))
 143            "\n")
 144         (insert "Invalid format\n"))
 145       (run-hooks 'mime-display-application/x-postpet-hook))))
 146
 147
 148 ;;; @ end
 149 ;;;
 150
 151 (provide 'postpet)
 152
 153 ;;; postpet.el ends here