tm-view.el

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