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.15 1994/10/26 16:02:22 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       (while (re-search-forward "_" nil t)
 479         (replace-match " ")
 480         )
 481       (goto-char (point-min))
 482       (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
 483         (replace-match
 484          (mime/Quoted-Printable-decode-string
 485           (buffer-substring (match-beginning 0)(match-end 0))
 486           ))
 487         )
 488       )))
 489
 490 (defun mime/Base64-decode-region (beg end)
 491   (interactive "*r")
 492   (save-excursion
 493     (save-restriction
 494       (narrow-to-region beg end)
 495       (goto-char (point-min))
 496       (while (search-forward "\n" nil t)
 497         (replace-match "")
 498         )
 499       (let ((str (buffer-substring (point-min)(point-max))))
 500         (delete-region (point-min)(point-max))
 501         (insert (mime/base64-decode-string str))
 502         ))))
 503
 504 (defun mime/make-method-args (cal format)
 505   (mapcar (function
 506            (lambda (arg)
 507              (if (stringp arg)
 508                  arg
 509                (let ((ret (cdr (assoc (eval arg) cal))))
 510                  (if ret
 511                      ret
 512                    "")
 513                  ))
 514              ))
 515           format))
 516
 517 (defun mime/start-external-method-region (beg end cal)
 518   (let ((e end))
 519     (if (< end (point-max))
 520         (setq e (+ end 1))
 521       )
 522     (save-excursion
 523       (save-restriction
 524         (narrow-to-region beg e)
 525         (goto-char beg)
 526         (let ((method (cdr (assoc 'method cal)))
 527               (name (mime/get-name cal))
 528               )
 529           (if method
 530               (let ((file (make-temp-name
 531                            (expand-file-name "TM" mime/tmp-dir)))
 532                     b args)
 533                 (if (nth 1 method)
 534                     (setq b beg)
 535                   (search-forward "\n\n" nil t)
 536                   (setq b (match-end 0))
 537                   )
 538                 (goto-char b)
 539                 (write-region b e file)
 540                 (setq cal (put-alist
 541                            'name (replace-as-filename name) cal))
 542                 (setq cal (put-alist 'file file cal))
 543                 (setq args (nconc
 544                             (list (car method)
 545                                   mime/output-buffer-name (car method)
 546                                   )
 547                             (mime/make-method-args cal (cdr (cdr method)))
 548                             ))
 549                 (apply (function start-process) args)
 550                 (mime/show-output-buffer)
 551                 ))))))
 552   )
 553
 554 (defun mime/decode-message/partial-region (beg end cal)
 555   (goto-char beg)
 556   (let* ((root-dir (expand-file-name
 557                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 558          (id (cdr (assoc "id" cal)))
 559          (number (cdr (assoc "number" cal)))
 560          (total (cdr (assoc "total" cal)))
 561          (the-buf (current-buffer))
 562          file
 563          (mother mime/preview-buffer))
 564     (if (not (file-exists-p root-dir))
 565         (shell-command (concat "mkdir " root-dir))
 566       )
 567     (setq id (replace-as-filename id))
 568     (setq root-dir (concat root-dir "/" id))
 569     (if (not (file-exists-p root-dir))
 570         (shell-command (concat "mkdir " root-dir))
 571       )
 572     (setq file (concat root-dir "/FULL"))
 573     (if (not (file-exists-p file))
 574         (progn
 575           (re-search-forward "^$")
 576           (goto-char (+ (match-end 0) 1))
 577           (setq file (concat root-dir "/" number))
 578           (write-region (point) (point-max) file)
 579           (if (get-buffer "*MIME-temp*")
 580               (kill-buffer "*MIME-temp*")
 581             )
 582           (switch-to-buffer "*MIME-temp*")
 583           (let ((i 1)
 584                 (max (string-to-int total))
 585                 )
 586             (catch 'tag
 587               (while (<= i max)
 588                 (setq file (concat root-dir "/" (int-to-string i)))
 589                 (if (not (file-exists-p file))
 590                     (progn
 591                       (switch-to-buffer the-buf)
 592                       (throw 'tag nil)
 593                       ))
 594                 (insert-file-contents file)
 595                 (goto-char (point-max))
 596                 (setq i (+ i 1))
 597                 )
 598               (delete-other-windows)
 599               (write-file (concat root-dir "/FULL"))
 600               (setq major-mode 'mime/show-message-mode)
 601               (mime/viewer-mode mother)
 602               (pop-to-buffer (current-buffer))
 603               ))
 604           )
 605       (progn
 606         (delete-other-windows)
 607         (find-file file)
 608         (setq major-mode 'mime/show-message-mode)
 609         (mime/viewer-mode mother)
 610         (pop-to-buffer (current-buffer))
 611         ))
 612     ))
 613
 614 (defun mime/get-content-decoding-alist (al)
 615   (let ((r mime/content-decoding-condition) ret)
 616     (catch 'tag
 617       (while r
 618         (if (setq ret (nth 1 (assoc-unify (car r) al)))
 619             (throw 'tag ret)
 620           )
 621         (setq r (cdr r))
 622         ))))
 623
 624 (defun mime/decode-content-region (beg end)
 625   (interactive "*r")
 626   (let (ctl encoding)
 627     (save-excursion
 628       (save-restriction
 629         (narrow-to-region beg end)
 630         (and (goto-char beg)
 631              (setq ctl (mime/Content-Type))
 632              (goto-char beg)
 633              (setq encoding (mime/Content-Transfer-Encoding "7bit"))
 634              )))
 635     (if ctl
 636         (let ((ctype (downcase (car ctl))) method cal ret)
 637           (setq ctl (cdr ctl))
 638           (setq cal (nconc (list (cons 'type ctype)
 639                                  (cons 'encoding encoding)
 640                                  )
 641                            ctl))
 642           (if mime/body-decoding-mode
 643               (setq cal (cons
 644                          (cons 'mode mime/body-decoding-mode)
 645                          cal))
 646             )
 647           (setq ret (mime/get-content-decoding-alist cal))
 648           (setq method (cdr (assoc 'method ret)))
 649           (cond ((and (symbolp method)
 650                       (fboundp method))
 651                  (funcall method beg end ret)
 652                  )
 653                 ((and (listp method)(stringp (car method)))
 654                  (mime/start-external-method-region beg end ret)
 655                  )
 656                 (t (mime/show-output-buffer
 657                     "No method are specified for %s\n" ctype)
 658                    ))
 659           ))
 660     ))
 661
 662 (defun mime/show-output-buffer (&rest forms)
 663   (let ((the-buf (current-buffer)))
 664     (if (null (get-buffer-window mime/output-buffer-name))
 665         (split-window-vertically (/ (* (window-height) 3) 4))
 666       )
 667     (pop-to-buffer mime/output-buffer-name)
 668     (goto-char (point-max))
 669     (if forms
 670         (insert (apply (function format) forms))
 671       )
 672     (pop-to-buffer the-buf)
 673     ))
 674
 675
 676 ;;; @ content filter
 677 ;;;
 678
 679 (defun mime/decode-text/plain (ctl)
 680   (interactive)
 681   (save-excursion
 682     (save-restriction
 683       (let ((charset (cdr (assoc "charset" (cdr ctl))))
 684             (encoding
 685              (save-excursion
 686                (save-restriction
 687                  (goto-char (point-min))
 688                  (narrow-to-region (point-min)
 689                                    (or (and (search-forward "\n\n" nil t)
 690                                             (match-beginning 0))
 691                                        (point-max)))
 692                  (goto-char (point-min))
 693                  (mime/Content-Transfer-Encoding "7bit")
 694                  )))
 695             (beg (point-min)) (end (point-max))
 696             )
 697         (goto-char (point-min))
 698         (if (search-forward "\n\n" nil t)
 699             (setq beg (match-end 0))
 700           )
 701         (if (cond ((string= encoding "quoted-printable")
 702                    (mime/Quoted-Printable-decode-region beg end)
 703                    t)
 704                   ((string= encoding "base64")
 705                    (mime/Base64-decode-region beg end)
 706                    t))
 707             (mime/code-convert-region-to-emacs beg (point-max) charset)
 708           )
 709         ))))
 710
 711
 712 ;;; @ MIME viewer mode
 713 ;;;
 714
 715 (defun mime/viewer-mode (&optional mother)
 716   (interactive)
 717   (let ((buf (get-buffer mime/output-buffer-name))
 718         (the-buf (current-buffer))
 719         )
 720     (if buf
 721         (progn
 722           (switch-to-buffer buf)
 723           (erase-buffer)
 724           (switch-to-buffer the-buf)
 725           )))
 726   (let ((ret (mime/parse-message))
 727         (mode major-mode))
 728     (switch-to-buffer (car ret))
 729     (setq major-mode 'mime/viewer-mode)
 730     (setq mode-name "MIME-View")
 731
 732     (make-variable-buffer-local 'mime/viewer-original-major-mode)
 733     (setq mime/viewer-original-major-mode
 734           (if mother
 735               (progn
 736                 (make-variable-buffer-local
 737                  'mime/show-mode-old-window-configuration)
 738                 (setq mime/show-mode-old-window-configuration
 739                       (current-window-configuration))
 740                 (make-variable-buffer-local 'mime/mother-buffer)
 741                 (setq mime/mother-buffer mother)
 742                 'mime/show-message-mode)
 743             mode))
 744     (let ((keymap (current-local-map)))
 745       (if (null keymap)
 746           (setq keymap (make-sparse-keymap))
 747         (setq keymap (copy-keymap keymap))
 748         )
 749       (use-local-map keymap)
 750       (define-key keymap "u" 'mime/up-content)
 751       (define-key keymap "p" 'mime/previous-content)
 752       (define-key keymap "n" 'mime/next-content)
 753       (define-key keymap " " 'mime/scroll-up-content)
 754       (define-key keymap "\M- " 'mime/scroll-down-content)
 755       (define-key keymap "\177" 'mime/scroll-down-content)
 756       (define-key keymap "\C-m" 'mime/next-line-content)
 757       (define-key keymap "\C-\M-m" 'mime/previous-line-content)
 758       (define-key keymap "v" 'mime/play-content)
 759       (define-key keymap "e" 'mime/extract-content)
 760       (define-key keymap "\C-c\C-p" 'mime/print-content)
 761       (define-key keymap "\C-c\C-x" 'mime/exit-view-mode)
 762
 763       (make-variable-buffer-local 'mime/preview-flat-content-list)
 764       (setq mime/preview-flat-content-list (nth 1 ret))
 765
 766       (goto-char
 767        (let ((ce (nth 1 (car mime/preview-flat-content-list)))
 768              e)
 769          (goto-char (point-min))
 770          (search-forward "\n\n" nil t)
 771          (setq e (match-end 0))
 772          (if (<= e ce)
 773             e
 774            ce)))
 775       )))
 776
 777 (defun mime/decode-content ()
 778   (interactive)
 779   (let ((pc (mime/get-point-preview-content (point))))
 780     (if pc
 781         (let ((the-buf (current-buffer)))
 782           (switch-to-buffer (nth 2 pc))
 783           (mime/decode-content-region (nth 3 pc)(nth 4 pc))
 784           (if (eq (current-buffer) (nth 2 pc))
 785               (switch-to-buffer the-buf)
 786             )
 787           ))))
 788
 789 (defun mime/play-content ()
 790   (interactive)
 791   (let ((mime/body-decoding-mode "play"))
 792     (mime/decode-content)
 793     ))
 794
 795 (defun mime/extract-content ()
 796   (interactive)
 797   (let ((mime/body-decoding-mode "extract"))
 798     (mime/decode-content)
 799     ))
 800
 801 (defun mime/print-content ()
 802   (interactive)
 803   (let ((mime/body-decoding-mode "print"))
 804     (mime/decode-content)
 805     ))
 806
 807 (defun mime/up-content ()
 808   (interactive)
 809   (let ((pc (mime/get-point-preview-content (point)))
 810         (the-buf (current-buffer))
 811         cn r)
 812     (switch-to-buffer (nth 2 pc))
 813     (setq cn (mime/get-point-content-number (nth 3 pc)))
 814     (if (eq cn t)
 815         (if (setq r (assoc major-mode mime/go-to-top-node-method-alist))
 816             (progn
 817               (switch-to-buffer the-buf)
 818               (funcall (cdr r))
 819               ))
 820       (setq r (mime/get-content-region (butlast cn)))
 821       (switch-to-buffer the-buf)
 822       (catch 'tag
 823         (let ((rfcl mime/preview-flat-content-list) cell)
 824           (while rfcl
 825             (setq cell (car rfcl))
 826             (if (and (= (car r)(nth 3 cell))
 827                      (= (nth 1 r)(nth 4 cell))
 828                      )
 829                 (progn
 830                   (goto-char (nth 0 cell))
 831                   (throw 'tag nil)
 832                   ))
 833             (setq rfcl (cdr rfcl))
 834             )))
 835       )))
 836
 837 (defun mime/previous-content ()
 838   (interactive)
 839   (let* ((fcl mime/preview-flat-content-list)
 840          (p (point))
 841          (i (- (length fcl) 1))
 842          )
 843     (catch 'tag
 844       (while (>= i 0)
 845         (if (> p (car (nth i fcl)))
 846             (throw 'tag (goto-char (car (nth i fcl))))
 847           )
 848         (setq i (- i 1))
 849         ))
 850     ))
 851
 852 (defun mime/next-content ()
 853   (interactive)
 854   (let ((fcl mime/preview-flat-content-list)
 855         (p (point))
 856         )
 857     (catch 'tag
 858       (while fcl
 859         (if (< p (car (car fcl)))
 860             (throw 'tag (goto-char (car (car fcl))))
 861           )
 862         (setq fcl (cdr fcl))
 863         ))
 864     ))
 865
 866 (defun mime/scroll-up-content (&optional h)
 867   (interactive)
 868   (if (null h)
 869       (setq h (- (window-height) 1))
 870     )
 871   (let ((fcl mime/preview-flat-content-list)
 872         (p (point))
 873         np)
 874     (setq np (or (catch 'tag
 875                    (while fcl
 876                      (if (< p (car (car fcl)))
 877                          (throw 'tag (car (car fcl)))
 878                        )
 879                      (setq fcl (cdr fcl))
 880                      ))
 881                  (point-max)))
 882     (forward-line h)
 883     (if (> (point) np)
 884         (goto-char np)
 885       )))
 886
 887 (defun mime/scroll-down-content (&optional h)
 888   (interactive)
 889   (if (null h)
 890       (setq h (- (window-height) 1))
 891     )
 892   (let ((fcl mime/preview-flat-content-list)
 893         (p (point))
 894         pp)
 895     (setq pp (or (let ((i (- (length fcl) 1)))
 896                    (catch 'tag
 897                      (while (> i 0)
 898                        (if (> p (nth 1 (nth i fcl)))
 899                            (throw 'tag (nth 1 (nth i fcl)))
 900                          )
 901                        (setq i (- i 1))
 902                        )))
 903                  (point-min)))
 904     (forward-line (- h))
 905     (if (< (point) pp)
 906         (goto-char pp)
 907       )))
 908
 909 (defun mime/next-line-content ()
 910   (interactive)
 911   (mime/scroll-up-content 1)
 912   )
 913
 914 (defun mime/previous-line-content ()
 915   (interactive)
 916   (mime/scroll-down-content 1)
 917   )
 918
 919 (defun mime/exit-view-mode ()
 920   (interactive)
 921   (kill-buffer (current-buffer))
 922   )
 923
 924 (fset 'mime/view-mode 'mime/viewer-mode)
 925
 926 (run-hooks 'tm-view-load-hook)