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