tm-view.el

   1 ;;;
   2 ;;; A MIME viewer for GNU Emacs
   3 ;;;
   4 ;;; by Morioka Tomohiko, 1994/07/13
   5
   6 (provide 'tm-view)
   7
   8
   9 ;;; @ require modules
  10 ;;;
  11
  12 (require 'tl-str)
  13 (require 'tl-list)
  14 (require 'tl-header)
  15 (require 'tiny-mime)
  16 (require 'tm-misc)
  17
  18
  19 ;;; @ version
  20 ;;;
  21
  22 (defconst mime/viewer-RCS-ID
  23   "$Id: tm-view.el,v 5.12 1994/10/17 07:28:34 morioka Exp $")
  24
  25 (defconst mime/viewer-version (get-version-string mime/viewer-RCS-ID))
  26
  27
  28 ;;; @ constants
  29 ;;;
  30
  31 (defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
  32 (defconst mime/token-regexp
  33   (concat "[^" mime/tspecials "]*"))
  34 (defconst mime/content-type-subtype-regexp
  35   (concat mime/token-regexp "/" mime/token-regexp))
  36 (defconst mime/content-parameter-value-regexp
  37   (concat "\\("
  38           message/quoted-string-regexp
  39           "\\|[^; \t\n]\\)*"))
  40
  41 (defconst mime/output-buffer-name "*MIME-out*")
  42 (defconst mime/decoding-buffer-name "*MIME-decoding*")
  43
  44
  45 ;;; @ variables
  46 ;;;
  47
  48 (defvar mime/content-decoding-condition
  49 ;;(setq mime/content-decoding-condition
  50   '(((type . "text/plain")
  51      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name))
  52     ((type . "text/x-latex")
  53      (method "tm-latex" nil 'file 'type 'encoding 'mode 'name))
  54     ((type . "audio/basic")
  55      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
  56     ((type . "image/gif")
  57      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  58     ((type . "image/jpeg")
  59      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  60     ((type . "image/tiff")
  61      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  62     ((type . "image/x-tiff")
  63      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  64     ((type . "image/x-xbm")
  65      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  66     ((type . "image/x-pic")
  67      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  68     ((type . "video/mpeg")
  69      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
  70     ((type . "application/octet-stream")
  71      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
  72     ;;((type . "message/external-body")
  73     ;; (method "xterm" nil
  74     ;;         "-e" "showexternal"
  75     ;;         'file '"access-type" '"name" '"site" '"directory"))
  76     ((type . "message/partial")
  77      (method . mime/decode-message/partial-region))
  78     ((method "metamail" t
  79              "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
  80     ))
  81
  82 (defvar mime/content-filter-alist nil)
  83
  84 (defvar mime/make-content-subject-function
  85   (function
  86    (lambda (cid subj ctype)
  87      (insert
  88       (format "[%s %s (%s)]\n"
  89               (if (listp cid)
  90                   (mapconcat (function
  91                               (lambda (num)
  92                                 (format "%s" (+ num 1))
  93                                 ))
  94                              cid ".")
  95                 "0")
  96               subj (car ctype)))
  97      )))
  98
  99 (defvar mime/make-content-header-filter
 100 ;;(setq mime/make-content-header-filter
 101   (function
 102    (lambda (cid)
 103      (if (listp cid)
 104          (delete-region (goto-char (point-min))
 105                         (or (and (re-search-forward "^$" nil t)
 106                                  (match-end 0))
 107                             (point-max))
 108                         )
 109        )
 110      )))
 111
 112 (defvar mime/default-showing-Content-Type-list
 113 ;;(setq mime/default-showing-Content-Type-list
 114   '("text/plain" "text/richtext" "text/enriched" "text/x-latex" nil))
 115
 116 (defvar mime/go-to-top-node-method-alist
 117 ;;(setq mime/go-to-top-node-method-alist
 118   '((gnus-article-mode . (lambda ()
 119                            (mime/exit-view-mode)
 120                            (delete-other-windows)
 121                            (gnus-article-show-summary)
 122                            ))
 123     (rmail-mode . (lambda ()
 124                     (mime/exit-view-mode)
 125                     (rmail-summary)
 126                     (delete-other-windows)
 127                     ))
 128     (mh-show-mode . (lambda ()
 129                       (let ((win (get-buffer-window
 130                                   mime/output-buffer-name))
 131                             (buf
 132                              (nth 2 (car mime/preview-flat-content-list)))
 133                             )
 134                         (if win
 135                             (delete-window win)
 136                           )
 137                         (mime/exit-view-mode)
 138                         (pop-to-buffer
 139                          (let ((name (buffer-name buf)))
 140                            (string-match "show-" name)
 141                            (substring name (match-end 0))
 142                            ))
 143                         )))
 144     (mime/show-message-mode . (lambda ()
 145                                 (set-window-configuration
 146                                  mime/show-mode-old-window-configuration)
 147                                 (let ((mother mime/mother-buffer))
 148                                   (kill-buffer
 149                                    (nth 2 (car
 150                                            mime/preview-flat-content-list)))
 151                                   (mime/exit-view-mode)
 152                                   (pop-to-buffer mother)
 153                                   (goto-char (point-min))
 154                                   (mime/up-content)
 155                                   )))
 156     ))
 157
 158 (defvar mime/use-internal-decoder nil)
 159
 160 (defvar mime/body-decoding-mode "play" "MIME body decoding mode")
 161
 162
 163 ;;; @ parser
 164 ;;;
 165
 166 (defun mime/parse-contents ()
 167   (save-excursion
 168     (save-restriction
 169       (goto-char (point-min))
 170       (let* ((ctl (mime/Content-Type))
 171              (ctype (car ctl))
 172              (boundary (assoc "boundary" (cdr ctl)))
 173              beg end dest)
 174         (if (stringp ctype)
 175             (setq ctype (downcase ctype))
 176           )
 177         (search-forward "\n\n" nil t)
 178         (cond (boundary
 179                (let ((sep (concat "\n--"
 180                                   (setq boundary
 181                                         (message/strip-quoted-string
 182                                          (cdr boundary)))
 183                                   "\n"))
 184                      cb ce ct ret ncb)
 185                  (setq beg (match-end 0))
 186                  (search-forward (concat "\n--" boundary "--\n") nil t)
 187                  (setq end (match-beginning 0))
 188                  (save-excursion
 189                    (save-restriction
 190                      (narrow-to-region beg end)
 191                      (goto-char (point-min))
 192                      (search-forward (concat "--" boundary "\n") nil t)
 193                      (setq cb (match-end 0))
 194                      (while (search-forward sep nil t)
 195                        (setq ce (match-beginning 0))
 196                        (setq ncb (match-end 0))
 197                        (save-excursion
 198                          (save-restriction
 199                            (narrow-to-region cb ce)
 200                            (setq ret (mime/parse-contents))
 201                            ))
 202                        (setq dest (nconc dest (list ret)))
 203                        (goto-char (nth 1 ret))
 204                        (search-forward (concat "--" boundary "\n") nil t)
 205                        (goto-char (setq cb (match-end 0)))
 206                        )
 207                      (setq ce (point-max))
 208                      (save-excursion
 209                        (save-restriction
 210                          (narrow-to-region cb ce)
 211                          (setq ret (mime/parse-contents))
 212                          ))
 213                      (setq dest (append dest (list ret)))
 214                      ))
 215                  (setq beg (point-min))
 216                  (goto-char beg)
 217                  (search-forward (concat "\n--" boundary "--\n") nil t)
 218                  (setq end (match-beginning 0))
 219                  ))
 220               ((string= ctype "message/rfc822")
 221                (save-excursion
 222                  (save-restriction
 223                    (narrow-to-region (match-end 0) (point-max))
 224                    (setq dest (list (mime/parse-contents)))
 225                    ))
 226                (setq beg (point-min))
 227                (setq end (point-max))
 228                )
 229               (t (setq beg (point-min))
 230                  (setq end (point-max))
 231                  ))
 232         (list beg end dest)
 233         ))))
 234
 235 (defun mime/Content-Type ()
 236   (save-excursion
 237     (save-restriction
 238       (if (and (re-search-forward "^Content-Type:[ \t]*" nil t)
 239                  (progn
 240                    (narrow-to-region
 241                     (point)
 242                     (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t)
 243                          (match-end 0))
 244                     )
 245                    (goto-char (point-min))
 246                    (re-search-forward mime/content-type-subtype-regexp nil t)
 247                    ))
 248             (let ((ctype
 249                    (downcase
 250                     (buffer-substring (match-beginning 0) (match-end 0))
 251                     ))
 252                   dest attribute value)
 253               (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t)
 254                           (re-search-forward mime/token-regexp nil t)
 255                           )
 256                 (setq attribute
 257                       (downcase
 258                        (buffer-substring (match-beginning 0) (match-end 0))
 259                        ))
 260                 (if (and (re-search-forward "=[ \t\n]*" nil t)
 261                          (re-search-forward mime/content-parameter-value-regexp
 262                                             nil t)
 263                          )
 264                     (setq dest
 265                           (put-alist attribute
 266                                      (message/strip-quoted-string
 267                                       (buffer-substring (match-beginning 0)
 268                                                         (match-end 0)))
 269                                      dest))
 270                   )
 271                 )
 272               (cons ctype dest)
 273               )))))
 274
 275 (defun mime/Content-Transfer-Encoding (&optional default-encoding)
 276   (save-excursion
 277     (save-restriction
 278       (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
 279                (re-search-forward mime/token-regexp nil t)
 280                )
 281           (downcase (buffer-substring (match-beginning 0) (match-end 0)))
 282         default-encoding)
 283       )))
 284
 285 (defun mime/get-subject (param)
 286   (save-excursion
 287     (save-restriction
 288       (let (ret)
 289         (or (and (setq ret (assoc "name" param))
 290                  (message/strip-quoted-string (cdr ret))
 291                  )
 292             (and (setq ret (assoc "x-name" param))
 293                  (message/strip-quoted-string (cdr ret))
 294                  )
 295             (progn
 296               (narrow-to-region (point-min)
 297                                 (or (and (search-forward "\n\n" nil t)
 298                                          (match-beginning 0)
 299                                          )
 300                                     (point-max)))
 301               (or
 302                (message/get-field-body "Content-Description")
 303                (message/get-field-body "Subject")
 304                ))
 305             ""))
 306       )))
 307
 308 (defun mime/get-name (param)
 309   (replace-as-filename (mime/get-subject param))
 310   )
 311
 312 (defun mime/make-preview-buffer (&optional buf cl obuf)
 313   (let ((the-buf (current-buffer)) fcl)
 314     (if (null buf)
 315         (setq buf (current-buffer))
 316       (setq buf (get-buffer buf))
 317       )
 318     (if (null cl)
 319         (progn
 320           (switch-to-buffer buf)
 321           (setq cl mime/content-list)
 322           ))
 323     (if (null obuf)
 324         (setq obuf (concat "*Preview-" (buffer-name buf) "*"))
 325       )
 326     (setq fcl (mime/make-flat-content-list cl))
 327     (if (get-buffer obuf)
 328         (progn
 329           (switch-to-buffer obuf)
 330           (erase-buffer)
 331           ))
 332     (let ((r fcl) cell cid ctype beg end e nb ne subj dest str)
 333       (while r
 334         (setq cell (car r))
 335         (setq beg (car cell))
 336         (setq end (nth 1 cell))
 337         (setq cid (mime/get-point-content-number beg cl))
 338         (switch-to-buffer buf)
 339         (save-excursion
 340           (save-restriction
 341             (narrow-to-region beg end)
 342             (goto-char beg)
 343             (setq ctype (mime/Content-Type))
 344             (setq e
 345                   (if (not (member (car ctype)
 346                                    mime/default-showing-Content-Type-list))
 347                       (progn
 348                         (goto-char beg)
 349                         (search-forward "\n\n" nil t)
 350                         (match-end 0)
 351                         )
 352                     (+ end 1)
 353                     ))
 354             ))
 355         (if (> e (point-max))
 356             (setq e (point-max))
 357           )
 358         (setq str (buffer-substring beg e))
 359         (switch-to-buffer obuf)
 360         (setq nb (point))
 361         (insert str)
 362         (setq ne (point))
 363         (save-excursion
 364           (save-restriction
 365             (narrow-to-region nb ne)
 366             (mime/decode-message-header)
 367             (setq subj (mime/get-subject (cdr ctype)))
 368             (let ((f (cdr (assoc (car ctype) mime/content-filter-alist))))
 369               (if (and f (fboundp f))
 370                   (funcall f)
 371                 ))
 372             (funcall mime/make-content-header-filter cid)
 373             (goto-char nb)
 374             (funcall mime/make-content-subject-function cid subj ctype)
 375             (setq ne (point-max))
 376             (setq dest (nconc dest (list (list nb (- ne 1) buf beg end))))
 377             ))
 378         (goto-char ne)
 379         (setq r (cdr r))
 380         )
 381       (set-buffer-modified-p nil)
 382       (setq buffer-read-only t)
 383       (switch-to-buffer the-buf)
 384       (list obuf dest)
 385       )))
 386
 387 (defun mime/parse-message ()
 388   (interactive)
 389   (make-variable-buffer-local 'mime/content-list)
 390   (setq mime/content-list (mime/parse-contents))
 391   (let ((ret (mime/make-preview-buffer)))
 392     (make-variable-buffer-local 'mime/preview-buffer)
 393     (setq mime/preview-buffer (car ret))
 394     ret))
 395
 396 ;;; @ content information
 397 ;;;
 398
 399 (defun mime/get-point-content-number (p &optional cl)
 400   (if (null cl)
 401       (setq cl mime/content-list)
 402     )
 403   (let ((b (car cl))
 404         (e (nth 1 cl))
 405         (c (nth 2 cl))
 406         )
 407     (if (and (<= b p)(<= p e))
 408         (or (let (co ret (sn 0))
 409               (catch 'tag
 410                 (while c
 411                   (setq co (car c))
 412                   (setq ret (mime/get-point-content-number p co))
 413                   (cond ((eq ret t) (throw 'tag (list sn)))
 414                         (ret (throw 'tag (cons sn ret)))
 415                         )
 416                   (setq c (cdr c))
 417                   (setq sn (+ sn 1))
 418                   )))
 419             t))))
 420
 421 (defun mime/get-content-region (cn &optional cl)
 422   (if (null cl)
 423       (setq cl mime/content-list)
 424     )
 425   (if (eq cn t)
 426       cl
 427     (let ((sn (car cn)))
 428       (if (null sn)
 429           cl
 430         (let ((rcl (nth sn (nth 2 cl))))
 431           (if rcl
 432               (mime/get-content-region (cdr cn) rcl)
 433             ))
 434         ))))
 435
 436 (defun mime/make-flat-content-list (&optional cl)
 437   (if (null cl)
 438       (setq cl mime/content-list)
 439     )
 440   (let ((dest (list cl))
 441         (rcl (nth 2 cl))
 442         )
 443     (while rcl
 444       (setq dest (append dest (mime/make-flat-content-list (car rcl))))
 445       (setq rcl (cdr rcl))
 446       )
 447     dest))
 448
 449 (defun mime/get-point-preview-content (p &optional fcl)
 450   (if (null fcl)
 451       (setq fcl mime/preview-flat-content-list)
 452     )
 453   (catch 'tag
 454     (let ((r fcl) cell)
 455       (while r
 456         (setq cell (car r))
 457         (if (and (<= (car cell) p)(<= p (nth 1 cell)))
 458             (throw 'tag cell)
 459           )
 460         (setq r (cdr r))
 461         ))
 462     (car (last fcl))
 463     ))
 464
 465
 466 ;;; @ decoder
 467 ;;;
 468
 469 (defun mime/base64-decode-region (beg end &optional buf filename)
 470   (let ((the-buf (current-buffer)) ret)
 471     (if (null buf)
 472         (setq buf (get-buffer-create mime/decoding-buffer-name))
 473       )
 474     (save-excursion
 475       (save-restriction
 476         (switch-to-buffer buf)
 477         (erase-buffer)
 478         (switch-to-buffer the-buf)
 479         (narrow-to-region beg end)
 480         (goto-char (point-min))
 481         (while (re-search-forward
 482                 (concat "^"
 483                         mime/Base64-encoded-text-regexp
 484                         "$") nil t)
 485           (setq ret (mime/base64-decode-string
 486                      (buffer-substring (match-beginning 0)
 487                                        (match-end 0)
 488                                        )))
 489           (switch-to-buffer buf)
 490           (insert ret)
 491           (switch-to-buffer the-buf)
 492           )))
 493     (if filename
 494         (progn
 495           (switch-to-buffer buf)
 496           (let ((kanji-flag nil)
 497                 (mc-flag nil)
 498                 (file-coding-system
 499                  (if (featurep 'mule) *noconv*))
 500                 )
 501             (write-file filename)
 502             (kill-buffer buf)
 503             (switch-to-buffer the-buf)
 504             )))
 505     ))
 506
 507 (defun mime/make-method-args (cal format)
 508   (mapcar (function
 509            (lambda (arg)
 510              (if (stringp arg)
 511                  arg
 512                (let ((ret (cdr (assoc (eval arg) cal))))
 513                  (if ret
 514                      ret
 515                    "")
 516                  ))
 517              ))
 518           format))
 519
 520 (defun mime/start-external-method-region (beg end cal)
 521   (let ((e end))
 522     (if (< end (point-max))
 523         (setq e (+ end 1))
 524       )
 525     (save-excursion
 526       (save-restriction
 527         (narrow-to-region beg e)
 528         (goto-char beg)
 529         (let ((method (cdr (assoc 'method cal)))
 530               (name (mime/get-name cal))
 531               )
 532           (if method
 533               (let ((file (make-temp-name
 534                            (expand-file-name "TM" mime/tmp-dir)))
 535                     b args)
 536                 (if (nth 1 method)
 537                     (setq b beg)
 538                   (search-forward "\n\n" nil t)
 539                   (setq b (match-end 0))
 540                   )
 541                 (goto-char b)
 542                 (write-region b e file)
 543                 (setq cal (put-alist
 544                            'name (replace-as-filename name) cal))
 545                 (setq cal (put-alist 'file file cal))
 546                 (setq args (nconc
 547                             (list (car method)
 548                                   mime/output-buffer-name (car method)
 549                                   )
 550                             (mime/make-method-args cal (cdr (cdr method)))
 551                             ))
 552                 (apply (function start-process) args)
 553                 (mime/show-output-buffer)
 554                 ))))))
 555   )
 556
 557 (defun mime/decode-message/partial-region (beg end cal)
 558   (goto-char beg)
 559   (let* ((root-dir (expand-file-name
 560                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 561          (id (cdr (assoc "id" cal)))
 562          (number (cdr (assoc "number" cal)))
 563          (total (cdr (assoc "total" cal)))
 564          (the-buf (current-buffer))
 565          file
 566          (mother mime/preview-buffer))
 567     (if (not (file-exists-p root-dir))
 568         (shell-command (concat "mkdir " root-dir))
 569       )
 570     (setq id (replace-as-filename id))
 571     (setq root-dir (concat root-dir "/" id))
 572     (if (not (file-exists-p root-dir))
 573         (shell-command (concat "mkdir " root-dir))
 574       )
 575     (setq file (concat root-dir "/FULL"))
 576     (if (not (file-exists-p file))
 577         (progn
 578           (re-search-forward "^$")
 579           (goto-char (+ (match-end 0) 1))
 580           (setq file (concat root-dir "/" number))
 581           (write-region (point) (point-max) file)
 582           (if (get-buffer "*MIME-temp*")
 583               (kill-buffer "*MIME-temp*")
 584             )
 585           (switch-to-buffer "*MIME-temp*")
 586           (let ((i 1)
 587                 (max (string-to-int total))
 588                 )
 589             (catch 'tag
 590               (while (<= i max)
 591                 (setq file (concat root-dir "/" (int-to-string i)))
 592                 (if (not (file-exists-p file))
 593                     (progn
 594                       (switch-to-buffer the-buf)
 595                       (throw 'tag nil)
 596                       ))
 597                 (insert-file-contents file)
 598                 (goto-char (point-max))
 599                 (setq i (+ i 1))
 600                 )
 601               (delete-other-windows)
 602               (write-file (concat root-dir "/FULL"))
 603               (setq major-mode 'mime/show-message-mode)
 604               (mime/viewer-mode mother)
 605               (pop-to-buffer (current-buffer))
 606               ))
 607           )
 608       (progn
 609         (delete-other-windows)
 610         (find-file file)
 611         (setq major-mode 'mime/show-message-mode)
 612         (mime/viewer-mode mother)
 613         (pop-to-buffer (current-buffer))
 614         ))
 615     ))
 616
 617 (defun mime/get-content-decoding-alist (al)
 618   (let ((r mime/content-decoding-condition) ret)
 619     (catch 'tag
 620       (while r
 621         (if (setq ret (nth 1 (assoc-unify (car r) al)))
 622             (throw 'tag ret)
 623           )
 624         (setq r (cdr r))
 625         ))))
 626
 627 (defun mime/decode-content-region (beg end)
 628   (interactive "*r")
 629   (let (ctl encoding)
 630     (save-excursion
 631       (save-restriction
 632         (narrow-to-region beg end)
 633         (and (goto-char beg)
 634              (setq ctl (mime/Content-Type))
 635              (goto-char beg)
 636              (setq encoding (mime/Content-Transfer-Encoding "7bit"))
 637              )))
 638     (if ctl
 639         (let ((ctype (downcase (car ctl))) method cal ret)
 640           (setq ctl (cdr ctl))
 641           (setq cal (nconc (list (cons 'type ctype)
 642                                  (cons 'encoding encoding)
 643                                  )
 644                            ctl))
 645           (if mime/body-decoding-mode
 646               (setq cal (cons
 647                          (cons 'mode mime/body-decoding-mode)
 648                          cal))
 649             )
 650           (setq ret (mime/get-content-decoding-alist cal))
 651           (setq method (cdr (assoc 'method ret)))
 652           (cond ((and (symbolp method)
 653                       (fboundp method))
 654                  (funcall method beg end ret)
 655                  )
 656                 ((and (listp method)(stringp (car method)))
 657                  (mime/start-external-method-region beg end ret)
 658                  )
 659                 (t (mime/show-output-buffer
 660                     "No method are specified for %s\n" ctype)
 661                    ))
 662           ))
 663     ))
 664
 665 (defun mime/show-output-buffer (&rest forms)
 666   (let ((the-buf (current-buffer)))
 667     (if (null (get-buffer-window mime/output-buffer-name))
 668         (split-window-vertically (/ (* (window-height) 3) 4))
 669       )
 670     (pop-to-buffer mime/output-buffer-name)
 671     (goto-char (point-max))
 672     (if forms
 673         (insert (apply (function format) forms))
 674       )
 675     (pop-to-buffer the-buf)
 676     ))
 677
 678
 679
 680 ;;; @ MIME viewer mode
 681 ;;;
 682
 683 (defun mime/viewer-mode (&optional mother)
 684   (interactive)
 685   (let ((buf (get-buffer mime/output-buffer-name))
 686         (the-buf (current-buffer))
 687         )
 688     (if buf
 689         (progn
 690           (switch-to-buffer buf)
 691           (erase-buffer)
 692           (switch-to-buffer the-buf)
 693           )))
 694   (let ((ret (mime/parse-message))
 695         (mode major-mode))
 696     (switch-to-buffer (car ret))
 697     (setq major-mode 'mime/viewer-mode)
 698     (setq mode-name "MIME-View")
 699
 700     (make-variable-buffer-local 'mime/viewer-original-major-mode)
 701     (setq mime/viewer-original-major-mode
 702           (if mother
 703               (progn
 704                 (make-variable-buffer-local
 705                  'mime/show-mode-old-window-configuration)
 706                 (setq mime/show-mode-old-window-configuration
 707                       (current-window-configuration))
 708                 (make-variable-buffer-local 'mime/mother-buffer)
 709                 (setq mime/mother-buffer mother)
 710                 'mime/show-message-mode)
 711             mode))
 712     (let ((keymap (current-local-map)))
 713       (if (null keymap)
 714           (setq keymap (make-sparse-keymap))
 715         (setq keymap (copy-keymap keymap))
 716         )
 717       (use-local-map keymap)
 718       (define-key keymap "u" 'mime/up-content)
 719       (define-key keymap "p" 'mime/previous-content)
 720       (define-key keymap "n" 'mime/next-content)
 721       (define-key keymap " " 'mime/scroll-up-content)
 722       (define-key keymap "\M- " 'mime/scroll-down-content)
 723       (define-key keymap "\177" 'mime/scroll-down-content)
 724       (define-key keymap "\C-m" 'mime/next-line-content)
 725       (define-key keymap "\C-\M-m" 'mime/previous-line-content)
 726       (define-key keymap "v" 'mime/play-content)
 727       (define-key keymap "e" 'mime/extract-content)
 728       (define-key keymap "\C-c\C-p" 'mime/print-content)
 729       (define-key keymap "\C-c\C-x" 'mime/exit-view-mode)
 730
 731       (make-variable-buffer-local 'mime/preview-flat-content-list)
 732       (setq mime/preview-flat-content-list (nth 1 ret))
 733
 734       (goto-char
 735        (let ((ce (nth 1 (car mime/preview-flat-content-list)))
 736              e)
 737          (goto-char (point-min))
 738          (search-forward "\n\n" nil t)
 739          (setq e (match-end 0))
 740          (if (<= e ce)
 741             e
 742            ce)))
 743       )))
 744
 745 (defun mime/decode-content ()
 746   (interactive)
 747   (let ((pc (mime/get-point-preview-content (point))))
 748     (if pc
 749         (let ((the-buf (current-buffer)))
 750           (switch-to-buffer (nth 2 pc))
 751           (mime/decode-content-region (nth 3 pc)(nth 4 pc))
 752           (if (eq (current-buffer) (nth 2 pc))
 753               (switch-to-buffer the-buf)
 754             )
 755           ))))
 756
 757 (defun mime/play-content ()
 758   (interactive)
 759   (let ((mime/body-decoding-mode "play"))
 760     (mime/decode-content)
 761     ))
 762
 763 (defun mime/extract-content ()
 764   (interactive)
 765   (let ((mime/body-decoding-mode "extract"))
 766     (mime/decode-content)
 767     ))
 768
 769 (defun mime/print-content ()
 770   (interactive)
 771   (let ((mime/body-decoding-mode "print"))
 772     (mime/decode-content)
 773     ))
 774
 775 (defun mime/up-content ()
 776   (interactive)
 777   (let ((pc (mime/get-point-preview-content (point)))
 778         (the-buf (current-buffer))
 779         cn r)
 780     (switch-to-buffer (nth 2 pc))
 781     (setq cn (mime/get-point-content-number (nth 3 pc)))
 782     (if (eq cn t)
 783         (if (setq r (assoc major-mode mime/go-to-top-node-method-alist))
 784             (progn
 785               (switch-to-buffer the-buf)
 786               (funcall (cdr r))
 787               ))
 788       (setq r (mime/get-content-region (butlast cn)))
 789       (switch-to-buffer the-buf)
 790       (catch 'tag
 791         (let ((rfcl mime/preview-flat-content-list) cell)
 792           (while rfcl
 793             (setq cell (car rfcl))
 794             (if (and (= (car r)(nth 3 cell))
 795                      (= (nth 1 r)(nth 4 cell))
 796                      )
 797                 (progn
 798                   (goto-char (nth 0 cell))
 799                   (throw 'tag nil)
 800                   ))
 801             (setq rfcl (cdr rfcl))
 802             )))
 803       )))
 804
 805 (defun mime/previous-content ()
 806   (interactive)
 807   (let* ((fcl mime/preview-flat-content-list)
 808          (p (point))
 809          (i (- (length fcl) 1))
 810          )
 811     (catch 'tag
 812       (while (>= i 0)
 813         (if (> p (car (nth i fcl)))
 814             (throw 'tag (goto-char (car (nth i fcl))))
 815           )
 816         (setq i (- i 1))
 817         ))
 818     ))
 819
 820 (defun mime/next-content ()
 821   (interactive)
 822   (let ((fcl mime/preview-flat-content-list)
 823         (p (point))
 824         )
 825     (catch 'tag
 826       (while fcl
 827         (if (< p (car (car fcl)))
 828             (throw 'tag (goto-char (car (car fcl))))
 829           )
 830         (setq fcl (cdr fcl))
 831         ))
 832     ))
 833
 834 (defun mime/scroll-up-content (&optional h)
 835   (interactive)
 836   (if (null h)
 837       (setq h (- (window-height) 1))
 838     )
 839   (let ((fcl mime/preview-flat-content-list)
 840         (p (point))
 841         np)
 842     (setq np (or (catch 'tag
 843                    (while fcl
 844                      (if (< p (car (car fcl)))
 845                          (throw 'tag (car (car fcl)))
 846                        )
 847                      (setq fcl (cdr fcl))
 848                      ))
 849                  (point-max)))
 850     (forward-line h)
 851     (if (> (point) np)
 852         (goto-char np)
 853       )))
 854
 855 (defun mime/scroll-down-content (&optional h)
 856   (interactive)
 857   (if (null h)
 858       (setq h (- (window-height) 1))
 859     )
 860   (let ((fcl mime/preview-flat-content-list)
 861         (p (point))
 862         pp)
 863     (setq pp (or (let ((i (- (length fcl) 1)))
 864                    (catch 'tag
 865                      (while (> i 0)
 866                        (if (> p (nth 1 (nth i fcl)))
 867                            (throw 'tag (nth 1 (nth i fcl)))
 868                          )
 869                        (setq i (- i 1))
 870                        )))
 871                  (point-min)))
 872     (forward-line (- h))
 873     (if (< (point) pp)
 874         (goto-char pp)
 875       )))
 876
 877 (defun mime/next-line-content ()
 878   (interactive)
 879   (mime/scroll-up-content 1)
 880   )
 881
 882 (defun mime/previous-line-content ()
 883   (interactive)
 884   (mime/scroll-down-content 1)
 885   )
 886
 887 (defun mime/exit-view-mode ()
 888   (interactive)
 889   (kill-buffer (current-buffer))
 890   )
 891
 892 (fset 'mime/view-mode 'mime/viewer-mode)
 893
 894 (run-hooks 'tm-view-load-hook)