:group 'mime-view
:type 'file)
+(defcustom mime-preview-move-scroll nil
+ "*Decides whether to scroll when moving to next entity.
+When t, scroll the buffer. Non-nil but not t means scroll when
+the next entity is within next-screen-context-lines from top or
+buttom. Nil means don't scroll at all."
+ :group 'mime-view
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t)
+ (sexp :tag "Situation" 1)))
;;; @ in raw-buffer (representation space)
;;;
(cons (cons 'encoding (or (mime-entity-encoding entity)
"7bit"))
situation)))
-
- ;; major-mode
- ;; (or (assq 'major-mode situation)
- ;; (setq situation
- ;; (cons (cons 'major-mode
- ;; (with-current-buffer (mime-entity-buffer entity)
- ;; major-mode))
- ;; situation)))
situation))
(ctree-set-calist-strictly
'mime-preview-condition
+ '((type . application)(subtype . x-postpet)
+ (body . visible)
+ (body-presentation-method . mime-display-application/x-postpet)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
'((type . text)(subtype . t)
(body . visible)
(body-presentation-method . mime-display-text/plain)))
(enriched-decode beg (point-max))
)))
+(put 'unpack 'lisp-indent-function 1)
+(defmacro unpack (string &rest body)
+ `(let* ((*unpack*string* (string-as-unibyte ,string))
+ (*unpack*index* 0))
+ ,@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)
+ (condition-case nil
+ (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))
+ (error nil)))
+
+(defun mime-display-application/x-postpet (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (let ((pet (postpet-decode (mime-entity-content entity))))
+ (if pet
+ (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"
+ "SentYear: " (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"
+ )
+ (insert "Invalid format\n"))
+ (run-hooks 'mime-display-application/x-postpet-hook))))
+
+
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
"\
(defun mime-display-multipart/mixed (entity situation)
(let ((children (mime-entity-children entity))
- (original-major-mode (cdr (assq 'major-mode situation)))
+ (original-major-mode-cell (assq 'major-mode situation))
(default-situation
(cdr (assq 'childrens-situation situation))))
- (if original-major-mode
+ (if original-major-mode-cell
(setq default-situation
- (cons (cons 'major-mode original-major-mode)
- default-situation))
- )
+ (cons original-major-mode-cell default-situation)))
(while children
(mime-display-entity (car children) nil default-situation)
(setq children (cdr children))
(defun mime-display-multipart/alternative (entity situation)
(let* ((children (mime-entity-children entity))
- (original-major-mode (cdr (assq 'major-mode situation)))
+ (original-major-mode-cell (assq 'major-mode situation))
(default-situation
(cdr (assq 'childrens-situation situation)))
(i 0)
(p 0)
(max-score 0)
situations)
- (if original-major-mode
+ (if original-major-mode-cell
(setq default-situation
- (cons (cons 'major-mode original-major-mode)
- default-situation))
- )
+ (cons original-major-mode-cell default-situation)))
(setq situations
(mapcar (function
(lambda (child)
(eq (cdr (assq 'header situation)) 'visible))
(header-presentation-method
(or (cdr (assq 'header-presentation-method situation))
- (cdr (assq major-mode mime-header-presentation-method-alist))))
+ (cdr (assq (cdr (assq 'major-mode situation))
+ mime-header-presentation-method-alist))))
(body-presentation-method
(cdr (assq 'body-presentation-method situation)))
(children (mime-entity-children entity)))
(defvar mouse-button-2 'button2)
)
(t
+ (defvar mime-view-popup-menu
+ (let ((menu (make-sparse-keymap mime-view-menu-title)))
+ (nconc menu
+ (mapcar (function
+ (lambda (item)
+ (list (intern (nth 1 item)) 'menu-item
+ (nth 1 item)(nth 2 item))
+ ))
+ mime-view-menu-list))))
+ (defun mime-view-popup-menu (event)
+ "Popup the menu in the MIME Viewer buffer"
+ (interactive "@e")
+ (let ((menu mime-view-popup-menu) events func)
+ (setq events (x-popup-menu t menu))
+ (and events
+ (setq func (lookup-key menu (apply #'vector events)))
+ (commandp func)
+ (funcall func))))
(defvar mouse-button-2 [mouse-2])
))
mouse-button-3 (function mime-view-xemacs-popup-menu))
)
((>= emacs-major-version 19)
+ (define-key mime-view-mode-map
+ mouse-button-3 (function mime-view-popup-menu))
(define-key mime-view-mode-map [menu-bar mime-view]
(cons mime-view-menu-title
(make-sparse-keymap mime-view-menu-title)))
(while (setq point (previous-single-property-change
(point) 'mime-view-entity))
(goto-char point)
- (if (eq r (get-text-property (point) 'mime-view-entity))
- (throw 'tag t)
+ (when (eq r (get-text-property (point) 'mime-view-entity))
+ (if (or (eq mime-preview-move-scroll t)
+ (and mime-preview-move-scroll
+ (>= point
+ (save-excursion
+ (move-to-window-line -1)
+ (forward-line (* -1 next-screen-context-lines))
+ (beginning-of-line)
+ (point)))))
+ (recenter next-screen-context-lines))
+ (throw 'tag t)
)
)
(mime-preview-quit)
If there is no previous entity, it calls function registered in
variable `mime-preview-over-to-previous-method-alist'."
(interactive)
- (while (null (get-text-property (point) 'mime-view-entity))
+ (while (and (not (bobp))
+ (null (get-text-property (point) 'mime-view-entity)))
(backward-char)
)
(let ((point (previous-single-property-change (point) 'mime-view-entity)))
- (if point
+ (if (and point
+ (>= point (point-min)))
(if (get-text-property (1- point) 'mime-view-entity)
- (goto-char point)
+ (progn (goto-char point)
+ (if
+ (or (eq mime-preview-move-scroll t)
+ (and mime-preview-move-scroll
+ (<= point
+ (save-excursion
+ (move-to-window-line 0)
+ (forward-line next-screen-context-lines)
+ (end-of-line)
+ (point)))))
+ (recenter (* -1 next-screen-context-lines))))
(goto-char (1- point))
(mime-preview-move-to-previous)
)
(forward-char)
)
(let ((point (next-single-property-change (point) 'mime-view-entity)))
- (if point
+ (if (and point
+ (<= point (point-max)))
(progn
(goto-char point)
(if (null (get-text-property point 'mime-view-entity))
(mime-preview-move-to-next)
+ (and
+ (or (eq mime-preview-move-scroll t)
+ (and mime-preview-move-scroll
+ (>= point
+ (save-excursion
+ (move-to-window-line -1)
+ (forward-line
+ (* -1 next-screen-context-lines))
+ (beginning-of-line)
+ (point)))))
+ (recenter next-screen-context-lines))
))
(let ((f (assq (mime-preview-original-major-mode)
mime-preview-over-to-next-method-alist)))
(bottom (window-end (selected-window))))
(if (and (not h)
(> bottom point))
- (goto-char point)
+ (progn (goto-char point)
+ (recenter next-screen-context-lines))
(condition-case nil
(scroll-up h)
(end-of-buffer
(top (window-start (selected-window))))
(if (and (not h)
(< top point))
- (goto-char point)
+ (progn (goto-char point)
+ (recenter (* -1 next-screen-context-lines)))
(condition-case nil
(scroll-down h)
(beginning-of-buffer
projects / elisp / semi.git / blobdiff