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