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 6.11 1995/03/23 09:59:10 morioka Exp $")
  24
  25 (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID))
  26 (defconst mime/viewer-version mime-viewer/version)
  27
  28
  29 ;;; @ constants
  30 ;;;
  31
  32 (defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=")
  33 (defconst mime/token-regexp
  34   (concat "[^" mime/tspecials "]*"))
  35 (defconst mime/content-type-subtype-regexp
  36   (concat mime/token-regexp "/" mime/token-regexp))
  37 (defconst mime/content-parameter-value-regexp
  38   (concat "\\("
  39           message/quoted-string-regexp
  40           "\\|[^; \t\n]*\\)"))
  41
  42 (defconst mime/output-buffer-name "*MIME-out*")
  43 (defconst mime/decoding-buffer-name "*MIME-decoding*")
  44
  45
  46 ;;; @ variables
  47 ;;;
  48
  49 (defvar mime/content-decoding-condition
  50 ;;(setq mime/content-decoding-condition
  51   '(((type . "text/plain")
  52      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name))
  53     ;;((type . "text/x-latex")
  54     ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name))
  55     ((type . "audio/basic")
  56      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
  57     ((type . "image/gif")
  58      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  59     ((type . "image/jpeg")
  60      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  61     ((type . "image/tiff")
  62      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  63     ((type . "image/x-tiff")
  64      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  65     ((type . "image/x-xbm")
  66      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  67     ((type . "image/x-pic")
  68      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  69     ((type . "video/mpeg")
  70      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
  71     ((type . "application/octet-stream")
  72      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
  73     ;;((type . "message/external-body")
  74     ;; (method "xterm" nil
  75     ;;         "-e" "showexternal"
  76     ;;         'file '"access-type" '"name" '"site" '"directory"))
  77     ((type . "message/partial")
  78      (method . mime/decode-message/partial-region))
  79     ((method "metamail" t
  80              "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
  81     ))
  82
  83 (defvar mime-viewer/content-filter-alist
  84   '(("text/plain" . mime-viewer/filter-text/plain)))
  85
  86 (defvar mime-viewer/content-subject-function
  87   (function
  88    (lambda (cnum subj ctype params)
  89      (insert
  90       (format "[%s %s (%s)]\n"
  91               (if (listp cnum)
  92                   (mapconcat (function
  93                               (lambda (num)
  94                                 (format "%s" (+ num 1))
  95                                 ))
  96                              cnum ".")
  97                 "0")
  98               subj ctype))
  99      )))
 100
 101 (defvar mime-viewer/content-header-filter-function
 102   (function mime-viewer/default-content-header-filter-function))
 103
 104 (defvar mime-viewer/childrens-header-showing-Content-Type-list
 105   '("message/rfc822"))
 106
 107 (defvar mime-viewer/ignored-field-list
 108   '("Received"))
 109
 110 (defun mime-viewer/default-content-header-filter-function (cnum cinfo)
 111   (if (and (listp cnum)
 112            (not (member
 113                  (mime::content-info/type
 114                   (mime::article/get-content-region (butlast cnum) cinfo)
 115                   )
 116                  mime-viewer/childrens-header-showing-Content-Type-list)
 117                 ))
 118       (delete-region (goto-char (point-min))
 119                      (or (and (re-search-forward "^$" nil t)
 120                               (match-end 0))
 121                          (point-max))
 122                      )
 123     (save-excursion
 124       (save-restriction
 125         (narrow-to-region (goto-char (point-min))
 126                           (or (and (re-search-forward "^$" nil t)
 127                                    (match-end 0))
 128                               (point-max))
 129                           )
 130         (mapcar (function
 131                  (lambda (field)
 132                    (goto-char (point-min))
 133                    (while (and (re-search-forward
 134                                 (concat "^" (regexp-quote field) ":")
 135                                 nil t)
 136                                (progn
 137                                  (delete-region
 138                                   (match-beginning 0)
 139                                   (and
 140                                    (re-search-forward
 141                                     (concat message/field-body-regexp "\n")
 142                                     nil t)
 143                                    (match-end 0)
 144                                    ))
 145                                  t))
 146                      )
 147                    )) mime-viewer/ignored-field-list)
 148         ))))
 149
 150 (defvar mime-viewer/default-showing-Content-Type-list
 151   '("text/plain" "text/richtext" "text/enriched"
 152     "text/x-latex" "application/x-latex"
 153     "application/octet-stream" nil))
 154
 155 (defvar mime-viewer/quitting-method-alist
 156   '((gnus-article-mode
 157      . (lambda ()
 158          (mime-viewer/kill-buffer)
 159          (delete-other-windows)
 160          (gnus-article-show-summary)
 161          ))
 162     (rmail-mode
 163      . (lambda ()
 164          (mime-viewer/kill-buffer)
 165          (rmail-summary)
 166          (delete-other-windows)
 167          ))
 168     (mh-show-mode
 169      . (lambda ()
 170          (let ((win (get-buffer-window
 171                      mime/output-buffer-name))
 172                (buf
 173                 (mime::preview-content-info/buffer
 174                  (car mime::preview/content-list)))
 175                )
 176            (if win
 177                (delete-window win)
 178              )
 179            (mime-viewer/kill-buffer)
 180            (pop-to-buffer
 181             (let ((name (buffer-name buf)))
 182               (string-match "show-" name)
 183               (substring name (match-end 0))
 184               ))
 185            )))
 186     (mime/show-message-mode
 187      . (lambda ()
 188          (set-window-configuration
 189           mime/show-mode-old-window-configuration)
 190          (let ((mother mime/mother-buffer))
 191            (kill-buffer
 192             (mime::preview-content-info/buffer
 193              (car mime::preview/content-list)))
 194            (mime-viewer/kill-buffer)
 195            (pop-to-buffer mother)
 196            (goto-char (point-min))
 197            (mime-viewer/up-content)
 198            )))
 199     ))
 200
 201 (defvar mime-viewer/decoding-mode "play" "MIME body decoding mode")
 202
 203
 204 ;;; @ data structure
 205 ;;;
 206
 207 ;;; @@ content-info
 208 ;;;
 209
 210 (defun mime::make-content-info (beg end ctype params encoding children)
 211   (vector beg end ctype params encoding children)
 212   )
 213
 214 (defun mime::content-info/point-min (cinfo)
 215   (elt cinfo 0)
 216   )
 217
 218 (defun mime::content-info/point-max (cinfo)
 219   (elt cinfo 1)
 220   )
 221
 222 (defun mime::content-info/type (cinfo)
 223   (elt cinfo 2)
 224   )
 225
 226 (defun mime::content-info/parameters (cinfo)
 227   (elt cinfo 3)
 228   )
 229
 230 (defun mime::content-info/encoding (cinfo)
 231   (elt cinfo 4)
 232   )
 233
 234 (defun mime::content-info/children (cinfo)
 235   (elt cinfo 5)
 236   )
 237
 238 ;;; @@ preview-content-info
 239 ;;;
 240
 241 (defun mime::make-preview-content-info (beg end buf cinfo)
 242   (vector beg end buf cinfo)
 243   )
 244
 245 (defun mime::preview-content-info/point-min (pcinfo)
 246   (elt pcinfo 0)
 247   )
 248
 249 (defun mime::preview-content-info/point-max (pcinfo)
 250   (elt pcinfo 1)
 251   )
 252
 253 (defun mime::preview-content-info/buffer (pcinfo)
 254   (elt pcinfo 2)
 255   )
 256
 257 (defun mime::preview-content-info/content-info (pcinfo)
 258   (elt pcinfo 3)
 259   )
 260
 261
 262 ;;; @ buffer local variables
 263 ;;;
 264
 265 (defvar mime::article/content-info)
 266 (defvar mime::article/preview-buffer)
 267
 268 (defvar mime::preview/content-list nil)
 269 (defvar mime::preview/original-major-mode nil)
 270
 271
 272 ;;; @ parser
 273 ;;;
 274
 275 (defun mime-viewer/parse-message ()
 276   (make-variable-buffer-local 'mime::article/content-info)
 277   (setq mime::article/content-info (mime-viewer/parse))
 278   (let ((ret (mime-viewer/make-preview-buffer)))
 279     (make-variable-buffer-local 'mime::article/preview-buffer)
 280     (setq mime::article/preview-buffer (car ret))
 281     ret))
 282
 283 (defun mime-viewer/parse ()
 284   (save-excursion
 285     (save-restriction
 286       (let ((ctl (progn
 287                    (goto-char (point-min))
 288                    (mime/Content-Type)
 289                    ))
 290             (encoding (progn
 291                         (goto-char (point-min))
 292                         (mime/Content-Transfer-Encoding)
 293                         ))
 294             )
 295         (let ((ctype (car ctl))
 296               (params (cdr ctl))
 297               )
 298           (if (stringp ctype)
 299               (setq ctype (downcase ctype))
 300             )
 301           (if (stringp encoding)
 302               (setq encoding (downcase encoding))
 303             )
 304           (let ((boundary (assoc "boundary" params)))
 305             (search-forward "\n\n" nil t)
 306             (cond (boundary
 307                    (setq boundary
 308                          (message/strip-quoted-string (cdr boundary)))
 309                    (mime-viewer/parse-multipart
 310                     (match-end 0)
 311                     (progn
 312                       (search-forward (concat "--" boundary "--\n") nil t)
 313                       (match-beginning 0)
 314                       )
 315                      boundary ctype params encoding)
 316                    )
 317                   ((string= ctype "message/rfc822")
 318                    (mime::make-content-info
 319                     (point-min) (point-max)
 320                     ctype params encoding
 321                     (save-excursion
 322                       (save-restriction
 323                         (narrow-to-region (match-end 0) (point-max))
 324                         (list (mime-viewer/parse))
 325                         ))
 326                     )
 327                    )
 328                   (t
 329                    (mime::make-content-info (point-min) (point-max)
 330                                             ctype params encoding nil)
 331                    ))
 332             ))))))
 333
 334 (defun mime-viewer/parse-multipart (beg end boundary ctype params encoding)
 335   (let ((sep (concat "^--" boundary "$"))
 336         cb ce ct ret ncb children)
 337     (save-excursion
 338       (save-restriction
 339         (narrow-to-region beg end)
 340         (goto-char (point-min))
 341         (search-forward (concat "--" boundary "\n") nil t)
 342         (setq cb (match-end 0))
 343         (while (re-search-forward sep nil t)
 344           (setq ce (match-beginning 0))
 345           (setq ncb (match-end 0))
 346           (save-excursion
 347             (save-restriction
 348               (narrow-to-region cb ce)
 349               (setq ret (mime-viewer/parse))
 350               ))
 351           (setq children (nconc children (list ret)))
 352           (goto-char (mime::content-info/point-max ret))
 353           (search-forward (concat "--" boundary "\n") nil t)
 354           (goto-char (setq cb (match-end 0)))
 355           )
 356         (setq ce (point-max))
 357         (save-excursion
 358           (save-restriction
 359             (narrow-to-region cb ce)
 360             (setq ret (mime-viewer/parse))
 361             ))
 362         (setq children (nconc children (list ret)))
 363         ))
 364     (setq beg (point-min))
 365     (goto-char beg)
 366     (mime::make-content-info beg end ctype params encoding children)
 367     ))
 368
 369 (defun mime/Content-Type ()
 370   (save-excursion
 371     (save-restriction
 372       (if (and (re-search-forward "^Content-Type:[ \t]*" nil t)
 373                  (progn
 374                    (narrow-to-region
 375                     (point)
 376                     (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t)
 377                          (match-end 0))
 378                     )
 379                    (goto-char (point-min))
 380                    (re-search-forward mime/content-type-subtype-regexp nil t)
 381                    ))
 382             (let ((ctype
 383                    (downcase
 384                     (buffer-substring (match-beginning 0) (match-end 0))
 385                     ))
 386                   dest attribute value)
 387               (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t)
 388                           (re-search-forward mime/token-regexp nil t)
 389                           )
 390                 (setq attribute
 391                       (downcase
 392                        (buffer-substring (match-beginning 0) (match-end 0))
 393                        ))
 394                 (if (and (re-search-forward "=[ \t\n]*" nil t)
 395                          (re-search-forward mime/content-parameter-value-regexp
 396                                             nil t)
 397                          )
 398                     (setq dest
 399                           (put-alist attribute
 400                                      (message/strip-quoted-string
 401                                       (buffer-substring (match-beginning 0)
 402                                                         (match-end 0)))
 403                                      dest))
 404                   )
 405                 )
 406               (cons ctype dest)
 407               )))))
 408
 409 (defun mime/Content-Transfer-Encoding (&optional default-encoding)
 410   (save-excursion
 411     (save-restriction
 412       (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t)
 413                (re-search-forward mime/token-regexp nil t)
 414                )
 415           (downcase (buffer-substring (match-beginning 0) (match-end 0)))
 416         default-encoding)
 417       )))
 418
 419 (defun mime/get-subject (param)
 420   (save-excursion
 421     (save-restriction
 422       (let (ret)
 423         (or (and (setq ret (assoc "name" param))
 424                  (message/strip-quoted-string (cdr ret))
 425                  )
 426             (and (setq ret (assoc "x-name" param))
 427                  (message/strip-quoted-string (cdr ret))
 428                  )
 429             (progn
 430               (narrow-to-region (point-min)
 431                                 (or (and (search-forward "\n\n" nil t)
 432                                          (match-beginning 0)
 433                                          )
 434                                     (point-max)))
 435               (or
 436                (message/get-field-body "Content-Description")
 437                (message/get-field-body "Subject")
 438                ))
 439             ""))
 440       )))
 441
 442 (defun mime/get-name (param)
 443   (replace-as-filename (mime/get-subject param))
 444   )
 445
 446 (defun mime-viewer/make-preview-buffer (&optional buf cinfo obuf)
 447   (let ((the-buf (current-buffer)) pcl dest)
 448     (setq buf
 449           (if (null buf)
 450               (current-buffer)
 451             (get-buffer buf)
 452             ))
 453     (if (null cinfo)
 454         (progn
 455           (switch-to-buffer buf)
 456           (setq cinfo mime::article/content-info)
 457           ))
 458     (if (null obuf)
 459         (setq obuf (concat "*Preview-" (buffer-name buf) "*"))
 460       )
 461     (setq pcl (mime::make-flat-content-list cinfo))
 462     (if (get-buffer obuf)
 463         (kill-buffer obuf)
 464       )
 465     (setq dest
 466           (mapcar
 467            (function
 468             (lambda (cell)
 469               (let ((beg (mime::content-info/point-min cell))
 470                     (end (mime::content-info/point-max cell))
 471                     (ctype (mime::content-info/type cell))
 472                     (params (mime::content-info/parameters cell))
 473                     cnum e nb ne subj str)
 474                 (setq cnum (mime::get-point-content-number beg cinfo))
 475                 (switch-to-buffer buf)
 476                 (setq e
 477                       (if (not
 478                            (member
 479                             ctype
 480                             mime-viewer/default-showing-Content-Type-list))
 481                           (save-excursion
 482                             (save-restriction
 483                               (goto-char beg)
 484                               (search-forward "\n\n" nil t)
 485                               (match-end 0)
 486                               ))
 487                         end))
 488                 (if (> e (point-max))
 489                     (setq e (point-max))
 490                   )
 491                 (setq str (buffer-substring beg e))
 492                 (switch-to-buffer obuf)
 493                 (setq nb (point))
 494                 (insert str)
 495                 (setq ne (point))
 496                 (prog1
 497                     (save-excursion
 498                       (save-restriction
 499                         (narrow-to-region nb ne)
 500                         (mime/decode-message-header)
 501                         (setq subj (mime/get-subject params))
 502                         (let ((f
 503                                (cdr
 504                                 (assoc ctype
 505                                        mime-viewer/content-filter-alist))))
 506                           (if (and f (fboundp f))
 507                               (funcall f ctype params)
 508                             ))
 509                         (funcall mime-viewer/content-header-filter-function
 510                                  cnum cinfo)
 511                         (goto-char nb)
 512                         (funcall mime-viewer/content-subject-function
 513                                  cnum subj ctype params)
 514                         (setq ne (point-max))
 515                         (mime::make-preview-content-info nb (- ne 1)
 516                                                          buf cell)
 517                         ))
 518                   (goto-char ne)
 519                   )
 520                 ))) pcl))
 521     (set-buffer-modified-p nil)
 522     (setq buffer-read-only t)
 523     (switch-to-buffer the-buf)
 524     (list obuf dest)
 525     ))
 526
 527
 528 ;;; @ content information
 529 ;;;
 530
 531 (defun mime::get-point-content-number (p &optional cinfo)
 532   (if (null cinfo)
 533       (setq cinfo mime::article/content-info)
 534     )
 535   (let ((b (mime::content-info/point-min cinfo))
 536         (e (mime::content-info/point-max cinfo))
 537         (c (mime::content-info/children cinfo))
 538         )
 539     (if (and (<= b p)(<= p e))
 540         (or (let (co ret (sn 0))
 541               (catch 'tag
 542                 (while c
 543                   (setq co (car c))
 544                   (setq ret (mime::get-point-content-number p co))
 545                   (cond ((eq ret t) (throw 'tag (list sn)))
 546                         (ret (throw 'tag (cons sn ret)))
 547                         )
 548                   (setq c (cdr c))
 549                   (setq sn (+ sn 1))
 550                   )))
 551             t))))
 552
 553 (defun mime::article/get-content-region (cn &optional cinfo)
 554   (if (null cinfo)
 555       (setq cinfo mime::article/content-info)
 556     )
 557   (if (eq cn t)
 558       cinfo
 559     (let ((sn (car cn)))
 560       (if (null sn)
 561           cinfo
 562         (let ((rc (nth sn (mime::content-info/children cinfo))))
 563           (if rc
 564               (mime::article/get-content-region (cdr cn) rc)
 565             ))
 566         ))))
 567
 568 (defun mime::make-flat-content-list (&optional cinfo)
 569   (if (null cinfo)
 570       (setq cinfo mime::article/content-info)
 571     )
 572   (let ((dest (list cinfo))
 573         (rcl (mime::content-info/children cinfo))
 574         )
 575     (while rcl
 576       (setq dest (nconc dest (mime::make-flat-content-list (car rcl))))
 577       (setq rcl (cdr rcl))
 578       )
 579     dest))
 580
 581 (defun mime::point-preview-content (p &optional pcl)
 582   (if (null pcl)
 583       (setq pcl mime::preview/content-list)
 584     )
 585   (catch 'tag
 586     (let ((r pcl) cell)
 587       (while r
 588         (setq cell (car r))
 589         (if (and (<= (mime::preview-content-info/point-min cell) p)
 590                  (<= p (mime::preview-content-info/point-max cell))
 591                  )
 592             (throw 'tag cell)
 593           )
 594         (setq r (cdr r))
 595         ))
 596     (car (last pcl))
 597     ))
 598
 599
 600 ;;; @ decoder
 601 ;;;
 602
 603 (defun mime/Quoted-Printable-decode-region (beg end)
 604   (interactive "*r")
 605   (save-excursion
 606     (save-restriction
 607       (narrow-to-region beg end)
 608       (goto-char (point-min))
 609       (while (re-search-forward "=\n" nil t)
 610         (replace-match "")
 611         )
 612       (goto-char (point-min))
 613       (let (b e str)
 614         (while (re-search-forward mime/Quoted-Printable-octet-regexp nil t)
 615           (setq b (match-beginning 0))
 616           (setq e (match-end 0))
 617           (setq str (buffer-substring b e))
 618           (delete-region b e)
 619           (insert (mime/Quoted-Printable-decode-string str))
 620           ))
 621       )))
 622
 623 (defun mime/Base64-decode-region (beg end)
 624   (interactive "*r")
 625   (save-excursion
 626     (save-restriction
 627       (narrow-to-region beg end)
 628       (goto-char (point-min))
 629       (while (search-forward "\n" nil t)
 630         (replace-match "")
 631         )
 632       (let ((str (buffer-substring (point-min)(point-max))))
 633         (delete-region (point-min)(point-max))
 634         (insert (mime/base64-decode-string str))
 635         ))))
 636
 637 (defun mime/make-method-args (cal format)
 638   (mapcar (function
 639            (lambda (arg)
 640              (if (stringp arg)
 641                  arg
 642                (let ((ret (cdr (assoc (eval arg) cal))))
 643                  (if ret
 644                      ret
 645                    "")
 646                  ))
 647              ))
 648           format))
 649
 650 (defun mime/start-external-method-region (beg end cal)
 651   (save-excursion
 652     (save-restriction
 653       (narrow-to-region beg end)
 654       (goto-char beg)
 655       (let ((method (cdr (assoc 'method cal)))
 656             (name (mime/get-name cal))
 657             )
 658         (if method
 659             (let ((file (make-temp-name
 660                          (expand-file-name "TM" mime/tmp-dir)))
 661                   b args)
 662               (if (nth 1 method)
 663                   (setq b beg)
 664                 (search-forward "\n\n" nil t)
 665                 (setq b (match-end 0))
 666                 )
 667               (goto-char b)
 668               (write-region b end file)
 669               (setq cal (put-alist
 670                          'name (replace-as-filename name) cal))
 671               (setq cal (put-alist 'file file cal))
 672               (setq args (nconc
 673                           (list (car method)
 674                                 mime/output-buffer-name (car method)
 675                                 )
 676                           (mime/make-method-args cal (cdr (cdr method)))
 677                           ))
 678               (apply (function start-process) args)
 679               (mime/show-output-buffer)
 680               ))
 681         ))))
 682
 683 (defun mime/decode-message/partial-region (beg end cal)
 684   (goto-char beg)
 685   (let* ((root-dir (expand-file-name
 686                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 687          (id (cdr (assoc "id" cal)))
 688          (number (cdr (assoc "number" cal)))
 689          (total (cdr (assoc "total" cal)))
 690          (the-buf (current-buffer))
 691          file
 692          (mother mime::article/preview-buffer))
 693     (if (not (file-exists-p root-dir))
 694         (make-directory root-dir)
 695       )
 696     (setq id (replace-as-filename id))
 697     (setq root-dir (concat root-dir "/" id))
 698     (if (not (file-exists-p root-dir))
 699         (make-directory root-dir)
 700       )
 701     (setq file (concat root-dir "/FULL"))
 702     (if (not (file-exists-p file))
 703         (progn
 704           (re-search-forward "^$")
 705           (goto-char (+ (match-end 0) 1))
 706           (setq file (concat root-dir "/" number))
 707           (write-region (point) (point-max) file)
 708           (if (get-buffer "*MIME-temp*")
 709               (kill-buffer "*MIME-temp*")
 710             )
 711           (switch-to-buffer "*MIME-temp*")
 712           (let ((i 1)
 713                 (max (string-to-int total))
 714                 )
 715             (catch 'tag
 716               (while (<= i max)
 717                 (setq file (concat root-dir "/" (int-to-string i)))
 718                 (if (not (file-exists-p file))
 719                     (progn
 720                       (switch-to-buffer the-buf)
 721                       (throw 'tag nil)
 722                       ))
 723                 (insert-file-contents file)
 724                 (goto-char (point-max))
 725                 (setq i (+ i 1))
 726                 )
 727               (delete-other-windows)
 728               (write-file (concat root-dir "/FULL"))
 729               (setq major-mode 'mime/show-message-mode)
 730               (mime/viewer-mode mother)
 731               (pop-to-buffer (current-buffer))
 732               ))
 733           )
 734       (progn
 735         (delete-other-windows)
 736         (find-file file)
 737         (setq major-mode 'mime/show-message-mode)
 738         (mime/viewer-mode mother)
 739         (pop-to-buffer (current-buffer))
 740         ))
 741     ))
 742
 743 (defun mime/get-content-decoding-alist (al)
 744   (get-unified-alist mime/content-decoding-condition al)
 745   )
 746
 747 (defun mime::article/decode-content-region (cinfo)
 748   (interactive "*r")
 749   (let ((beg (mime::content-info/point-min cinfo))
 750         (end (mime::content-info/point-max cinfo))
 751         (ctype (mime::content-info/type cinfo))
 752         (params (mime::content-info/parameters cinfo))
 753         (encoding (mime::content-info/encoding cinfo))
 754         )
 755     (if ctype
 756         (let (method cal ret)
 757           (setq cal (append (list (cons 'type ctype)
 758                                   (cons 'encoding encoding)
 759                                   (cons 'major-mode major-mode)
 760                                   )
 761                             params))
 762           (if mime-viewer/decoding-mode
 763               (setq cal (cons
 764                          (cons 'mode mime-viewer/decoding-mode)
 765                          cal))
 766             )
 767           (setq ret (mime/get-content-decoding-alist cal))
 768           (setq method (cdr (assoc 'method ret)))
 769           (cond ((and (symbolp method)
 770                       (fboundp method))
 771                  (funcall method beg end ret)
 772                  )
 773                 ((and (listp method)(stringp (car method)))
 774                  (mime/start-external-method-region beg end ret)
 775                  )
 776                 (t (mime/show-output-buffer
 777                     "No method are specified for %s\n" ctype)
 778                    ))
 779           ))
 780     ))
 781
 782 (defun mime/show-output-buffer (&rest forms)
 783   (let ((the-buf (current-buffer)))
 784     (if (null (get-buffer-window mime/output-buffer-name))
 785         (split-window-vertically (/ (* (window-height) 3) 4))
 786       )
 787     (pop-to-buffer mime/output-buffer-name)
 788     (goto-char (point-max))
 789     (if forms
 790         (insert (apply (function format) forms))
 791       )
 792     (pop-to-buffer the-buf)
 793     ))
 794
 795
 796 ;;; @ content filter
 797 ;;;
 798
 799 (defun mime-viewer/filter-text/plain (ctype params)
 800   (save-excursion
 801     (save-restriction
 802       (let ((charset (cdr (assoc "charset" params)))
 803             (encoding
 804              (save-excursion
 805                (save-restriction
 806                  (goto-char (point-min))
 807                  (narrow-to-region (point-min)
 808                                    (or (and (search-forward "\n\n" nil t)
 809                                             (match-beginning 0))
 810                                        (point-max)))
 811                  (goto-char (point-min))
 812                  (mime/Content-Transfer-Encoding "7bit")
 813                  )))
 814             (beg (point-min)) (end (point-max))
 815             )
 816         (goto-char (point-min))
 817         (if (search-forward "\n\n" nil t)
 818             (setq beg (match-end 0))
 819           )
 820         (if (cond ((string= encoding "quoted-printable")
 821                    (mime/Quoted-Printable-decode-region beg end)
 822                    t)
 823                   ((string= encoding "base64")
 824                    (mime/Base64-decode-region beg end)
 825                    t))
 826             (mime/code-convert-region-to-emacs beg (point-max) charset)
 827           )
 828         ))))
 829
 830
 831 ;;; @ MIME viewer mode
 832 ;;;
 833
 834 (defvar mime/viewer-mode-map nil)
 835 (if (null mime/viewer-mode-map)
 836     (progn
 837       (setq mime/viewer-mode-map (make-keymap))
 838       (suppress-keymap mime/viewer-mode-map)
 839       (define-key mime/viewer-mode-map
 840         "u"        (function mime-viewer/up-content))
 841       (define-key mime/viewer-mode-map
 842         "p"        (function mime-viewer/previous-content))
 843       (define-key mime/viewer-mode-map
 844         "n"        (function mime-viewer/next-content))
 845       (define-key mime/viewer-mode-map
 846         " "        (function mime-viewer/scroll-up-content))
 847       (define-key mime/viewer-mode-map
 848         "\M- "     (function mime-viewer/scroll-down-content))
 849       (define-key mime/viewer-mode-map
 850         "\177"     (function mime-viewer/scroll-down-content))
 851       (define-key mime/viewer-mode-map
 852         "\C-m"     (function mime-viewer/next-line-content))
 853       (define-key mime/viewer-mode-map
 854         "\C-\M-m"  (function mime-viewer/previous-line-content))
 855       (define-key mime/viewer-mode-map
 856         "v"        (function mime-viewer/play-content))
 857       (define-key mime/viewer-mode-map
 858         "e"        (function mime-viewer/extract-content))
 859       (define-key mime/viewer-mode-map
 860         "\C-c\C-p" (function mime-viewer/print-content))
 861       (define-key mime/viewer-mode-map
 862         "q"        (function mime-viewer/quit))
 863       (define-key mime/viewer-mode-map
 864         "\C-c\C-x" (function mime-viewer/kill-buffer))
 865       ))
 866
 867 (defun mime/viewer-mode (&optional mother)
 868   "Major mode for viewing MIME message.
 869
 870 u       Move to upper content
 871 p       Move to previous content
 872 n       Move to next content
 873 SPC     Scroll up
 874 M-SPC   Scroll down
 875 DEL     Scroll down
 876 RET     Move to next line
 877 M-RET   Move to previous line
 878 v       Decode the content as `play mode'
 879 e       Decode the content as `extract mode'
 880 C-c C-p Decode the content as `print mode'
 881 q       Quit
 882 "
 883   (interactive)
 884   (let ((buf (get-buffer mime/output-buffer-name))
 885         (the-buf (current-buffer))
 886         )
 887     (if buf
 888         (progn
 889           (switch-to-buffer buf)
 890           (erase-buffer)
 891           (switch-to-buffer the-buf)
 892           )))
 893   (let ((ret (mime-viewer/parse-message))
 894         (mode major-mode))
 895     (switch-to-buffer (car ret))
 896     (setq major-mode 'mime/viewer-mode)
 897     (setq mode-name "MIME-View")
 898     (make-variable-buffer-local 'mime::preview/original-major-mode)
 899     (setq mime::preview/original-major-mode
 900           (if mother
 901               (progn
 902                 (make-variable-buffer-local
 903                  'mime/show-mode-old-window-configuration)
 904                 (setq mime/show-mode-old-window-configuration
 905                       (current-window-configuration))
 906                 (make-variable-buffer-local 'mime/mother-buffer)
 907                 (setq mime/mother-buffer mother)
 908                 'mime/show-message-mode)
 909             mode))
 910     (use-local-map mime/viewer-mode-map)
 911     (make-variable-buffer-local 'mime::preview/content-list)
 912     (setq mime::preview/content-list (nth 1 ret))
 913     (goto-char
 914      (let ((ce (mime::preview-content-info/point-max
 915                 (car mime::preview/content-list)
 916                 ))
 917            e)
 918        (goto-char (point-min))
 919        (search-forward "\n\n" nil t)
 920        (setq e (match-end 0))
 921        (if (<= e ce)
 922            e
 923          ce)))
 924     (run-hooks 'mime/viewer-mode-hook)
 925     ))
 926
 927 (defun mime::preview/decode-content ()
 928   (interactive)
 929   (let ((pc (mime::point-preview-content (point))))
 930     (if pc
 931         (let ((the-buf (current-buffer)))
 932           (switch-to-buffer (mime::preview-content-info/buffer pc))
 933           (mime::article/decode-content-region
 934            (mime::preview-content-info/content-info pc))
 935           (if (eq (current-buffer)
 936                   (mime::preview-content-info/buffer pc))
 937               (switch-to-buffer the-buf)
 938             )
 939           ))))
 940
 941 (defun mime-viewer/play-content ()
 942   (interactive)
 943   (let ((mime-viewer/decoding-mode "play"))
 944     (mime::preview/decode-content)
 945     ))
 946
 947 (defun mime-viewer/extract-content ()
 948   (interactive)
 949   (let ((mime-viewer/decoding-mode "extract"))
 950     (mime::preview/decode-content)
 951     ))
 952
 953 (defun mime-viewer/print-content ()
 954   (interactive)
 955   (let ((mime-viewer/decoding-mode "print"))
 956     (mime::preview/decode-content)
 957     ))
 958
 959 (defun mime-viewer/up-content ()
 960   (interactive)
 961   (let ((pc (mime::point-preview-content (point))) cinfo
 962         (the-buf (current-buffer))
 963         cn r)
 964     (switch-to-buffer (mime::preview-content-info/buffer pc))
 965     (setq cinfo (mime::preview-content-info/content-info pc))
 966     (setq cn (mime::get-point-content-number
 967               (mime::content-info/point-min cinfo)))
 968     (if (eq cn t)
 969         (mime-viewer/quit the-buf
 970                           (mime::preview-content-info/buffer pc)
 971                           )
 972       (setq r (mime::article/get-content-region (butlast cn)))
 973       (switch-to-buffer the-buf)
 974       (catch 'tag
 975         (let ((rpcl mime::preview/content-list) cell)
 976           (while rpcl
 977             (setq cell (car rpcl))
 978             (if (eq r (mime::preview-content-info/content-info cell))
 979                 (progn
 980                   (goto-char (mime::preview-content-info/point-min cell))
 981                   (throw 'tag nil)
 982                   ))
 983             (setq rpcl (cdr rpcl))
 984             )))
 985       )))
 986
 987 (defun mime-viewer/previous-content ()
 988   (interactive)
 989   (let* ((pcl mime::preview/content-list)
 990          (p (point))
 991          (i (- (length pcl) 1))
 992          beg)
 993     (catch 'tag
 994       (while (>= i 0)
 995         (setq beg (mime::preview-content-info/point-min (nth i pcl)))
 996         (if (> p beg)
 997             (throw 'tag (goto-char beg))
 998           )
 999         (setq i (- i 1))
1000         ))
1001     ))
1002
1003 (defun mime-viewer/next-content ()
1004   (interactive)
1005   (let ((pcl mime::preview/content-list)
1006         (p (point))
1007         beg)
1008     (catch 'tag
1009       (while pcl
1010         (setq beg (mime::preview-content-info/point-min (car pcl)))
1011         (if (< p beg)
1012             (throw 'tag (goto-char beg))
1013           )
1014         (setq pcl (cdr pcl))
1015         ))
1016     ))
1017
1018 (defun mime-viewer/scroll-up-content (&optional h)
1019   (interactive)
1020   (if (null h)
1021       (setq h (- (window-height) 1))
1022     )
1023   (let ((pcl mime::preview/content-list)
1024         (p (point))
1025         np beg)
1026     (setq np
1027           (or (catch 'tag
1028                 (while pcl
1029                   (setq beg (mime::preview-content-info/point-min (car pcl)))
1030                   (if (< p beg)
1031                       (throw 'tag beg)
1032                     )
1033                   (setq pcl (cdr pcl))
1034                   ))
1035               (point-max)))
1036     (forward-line h)
1037     (if (> (point) np)
1038         (goto-char np)
1039       )))
1040
1041 (defun mime-viewer/scroll-down-content (&optional h)
1042   (interactive)
1043   (if (null h)
1044       (setq h (- (window-height) 1))
1045     )
1046   (let ((pcl mime::preview/content-list)
1047         (p (point))
1048         pp beg)
1049     (setq pp
1050           (or (let ((i (- (length pcl) 1)))
1051                 (catch 'tag
1052                   (while (> i 0)
1053                     (setq beg (mime::preview-content-info/point-min
1054                                (nth i pcl)))
1055                     (if (> p beg)
1056                         (throw 'tag beg)
1057                       )
1058                     (setq i (- i 1))
1059                     )))
1060               (point-min)))
1061     (forward-line (- h))
1062     (if (< (point) pp)
1063         (goto-char pp)
1064       )))
1065
1066 (defun mime-viewer/next-line-content ()
1067   (interactive)
1068   (mime-viewer/scroll-up-content 1)
1069   )
1070
1071 (defun mime-viewer/previous-line-content ()
1072   (interactive)
1073   (mime-viewer/scroll-down-content 1)
1074   )
1075
1076 (defun mime-viewer/quit (&optional the-buf buf)
1077   (interactive)
1078   (if (null the-buf)
1079       (setq the-buf (current-buffer))
1080     )
1081   (if (null buf)
1082       (setq buf (mime::preview-content-info/buffer
1083                  (mime::point-preview-content (point))))
1084     )
1085   (let ((r (progn
1086              (switch-to-buffer buf)
1087              (assoc major-mode mime-viewer/quitting-method-alist)
1088              )))
1089     (if r
1090         (progn
1091           (switch-to-buffer the-buf)
1092           (funcall (cdr r))
1093           ))
1094     ))
1095
1096 (defun mime-viewer/kill-buffer ()
1097   (interactive)
1098   (kill-buffer (current-buffer))
1099   )
1100
1101 (fset 'mime/view-mode 'mime/viewer-mode)
1102
1103 (run-hooks 'tm-view-load-hook)