tm-view.el

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