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