tm-view.el

   1 ;;;
   2 ;;; tm-view.el --- interactive MIME viewer for GNU Emacs
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author:   MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Keywords: mail, news, MIME, multimedia
   9 ;;;
  10 ;;; This file is part of tm (Tools for MIME).
  11 ;;;
  12
  13 (require 'tl-str)
  14 (require 'tl-list)
  15 (require 'tl-atype)
  16 (require 'tl-misc)
  17 (require 'tl-822)
  18 (require 'mel)
  19 (require 'tm-ew-d)
  20 (require 'tm-def)
  21 (require 'tm-parse)
  22
  23
  24 ;;; @ version
  25 ;;;
  26
  27 (defconst mime-viewer/RCS-ID
  28   "$Id: tm-view.el,v 7.24 1995/11/14 06:14:37 morioka Exp $")
  29
  30 (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID))
  31 (defconst mime/viewer-version mime-viewer/version)
  32
  33
  34 ;;; @ variables
  35 ;;;
  36
  37 (defvar mime/content-decoding-condition
  38   '(((type . "text/plain")
  39      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name))
  40     ;;((type . "text/x-latex")
  41     ;; (method "tm-latex" nil 'file 'type 'encoding 'mode 'name))
  42     ((type . "text/x-rot13-47")
  43      (method . mime-article/decode-caesar))
  44
  45     ((type . "audio/basic")
  46      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
  47
  48     ((type . "image/gif")
  49      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  50     ((type . "image/jpeg")
  51      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  52     ((type . "image/tiff")
  53      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  54     ((type . "image/x-tiff")
  55      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  56     ((type . "image/x-xbm")
  57      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  58     ((type . "image/x-pic")
  59      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
  60
  61     ((type . "video/mpeg")
  62      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
  63
  64     ((type . "application/octet-stream")
  65      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name))
  66
  67     ;;((type . "message/external-body")
  68     ;; (method "xterm" nil
  69     ;;         "-e" "showexternal"
  70     ;;         'file '"access-type" '"name" '"site" '"directory"))
  71     ((type . "message/rfc822")
  72      (method . mime-article/view-message/rfc822))
  73     ((type . "message/partial")
  74      (method . mime-article/decode-message/partial))
  75
  76     ((method "metamail" t
  77              "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play"))
  78     ((method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
  79      (mode . "extract"))
  80     ))
  81
  82 (defvar mime-viewer/childrens-header-showing-Content-Type-list
  83   '("message/rfc822" "message/news"))
  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/pgp"
  90     "application/x-selection" "application/x-comment"))
  91
  92 (defvar mime-viewer/content-subject-omitting-Content-Type-list
  93   '("application/x-selection"))
  94
  95 (defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode"))
  96
  97 (defvar mime-viewer/ignored-field-list
  98   '("Received" "Return-Path" "Replied" "Errors-To"
  99     "Lines" "Sender" "Path" "Nntp-Posting-Host"
 100     "Content-Type" "Precedence" "X-Face"
 101     "Status" "X-VM-.*")
 102   "All fields that match this list will be hidden in MIME preview buffer.
 103 Each elements are regexp of field-name. [tm-view.el]")
 104
 105 (defvar mime-viewer/ignored-field-regexp
 106   (apply (function regexp-or) mime-viewer/ignored-field-list))
 107
 108 (defvar mime-viewer/announcement-for-message/partial
 109   (if (and (>= emacs-major-version 19) window-system)
 110       "\
 111 \[[ This is message/partial style split message. ]]
 112 \[[ Please press `v' key in this buffer          ]]
 113 \[[ or click here by mouse button-2.             ]]"
 114     "\
 115 \[[ This is message/partial style split message. ]]
 116 \[[ Please press `v' key in this buffer.         ]]"
 117     ))
 118
 119
 120 ;;; @@ predicate functions
 121 ;;;
 122
 123 (defun mime-viewer/header-visible-p (rcnum cinfo &optional ctype)
 124   (or (null rcnum)
 125       (progn
 126         (setq ctype
 127               (mime::content-info/type
 128                (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)
 129                ))
 130         (member ctype mime-viewer/childrens-header-showing-Content-Type-list)
 131         )))
 132
 133 (defun mime-viewer/body-visible-p (rcnum cinfo &optional ctype)
 134   (let (ccinfo)
 135     (or ctype
 136         (setq ctype
 137               (mime::content-info/type
 138                (setq ccinfo (mime-article/rcnum-to-cinfo rcnum 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/rcnum-to-cinfo rcnum 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   (rcnum cinfo ctype params subj)
 159   (save-restriction
 160     (narrow-to-region (point)(point))
 161     (insert
 162      (let ((access-type (assoc "access-type" params))
 163            (num (or (assoc-value "x-part-number" params)
 164                     (if (consp rcnum)
 165                         (mapconcat (function
 166                                     (lambda (num)
 167                                       (format "%s" (1+ num))
 168                                       ))
 169                                    (reverse rcnum) ".")
 170                       "0"))
 171                 ))
 172        (if access-type
 173            (let ((server (assoc "server" params)))
 174              (setq access-type (cdr access-type))
 175              (if server
 176                  (format "[%s %s ([%s] %s)]\n" num subj
 177                          access-type (cdr server))
 178                (let ((site (assoc-value "site" params))
 179                      (dir (assoc-value "directory" params))
 180                      )
 181                  (format "[%s %s ([%s] %s:%s)]\n" num subj
 182                          access-type site dir)
 183                  )))
 184          (format "[%s %s (%s)]\n" num subj ctype)
 185          )))
 186     (tm:add-button (point-min)(1- (point-max))
 187                    (function mime-viewer/play-content))
 188     ))
 189
 190 (defun mime-viewer/default-content-subject-function
 191   (rcnum cinfo ctype params subj)
 192   (if (and (consp rcnum)
 193            (not (member
 194                  ctype
 195                  mime-viewer/content-subject-omitting-Content-Type-list))
 196            )
 197       (mime-viewer/insert-content-subject
 198        rcnum cinfo ctype params subj)
 199     ))
 200
 201 (defvar mime-viewer/content-subject-function
 202   (function mime-viewer/default-content-subject-function))
 203
 204
 205 ;;; @@ content header filter
 206 ;;;
 207
 208 (defun mime-viewer/default-content-header-filter ()
 209   (goto-char (point-min))
 210   (while (and (re-search-forward mime-viewer/ignored-field-regexp nil t)
 211               (progn
 212                 (delete-region
 213                  (match-beginning 0)
 214                  (save-excursion
 215                    (and
 216                     (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 217                     (match-beginning 0)
 218                     )))
 219                 t)))
 220   (mime/decode-message-header)
 221   )
 222
 223 (defvar mime-viewer/content-header-filter-alist nil)
 224
 225
 226 ;;; @@ content filter
 227 ;;;
 228
 229 (defvar mime-viewer/content-filter-alist
 230   '(("text/plain"      . mime-viewer/filter-text/plain)
 231     ("application/pgp" . mime-viewer/filter-text/plain)
 232     (nil . mime-viewer/filter-text/plain)))
 233
 234 (defun mime-viewer/default-content-filter (rcnum cinfo ctype params subj)
 235   )
 236
 237
 238 ;;; @@ content separator
 239 ;;;
 240
 241 (defun mime-viewer/default-content-separator (rcnum cinfo ctype params subj)
 242   (if (and (not (mime-viewer/header-visible-p rcnum cinfo ctype))
 243            (not (mime-viewer/body-visible-p rcnum cinfo ctype))
 244            )
 245       (progn
 246         (goto-char (point-max))
 247         (insert "\n")
 248         )))
 249
 250
 251 ;;; @@ buffer local variables
 252 ;;;
 253
 254 (defvar mime/show-mode-old-window-configuration nil)
 255 (defvar mime::preview/mother-buffer nil)
 256
 257 (defvar mime::article/content-info nil)
 258 (defvar mime::article/preview-buffer nil)
 259
 260 (defvar mime::preview/article-buffer nil)
 261 (defvar mime::preview/content-list nil)
 262 (defvar mime::preview/original-major-mode nil)
 263
 264
 265 ;;; @@ quitting method
 266 ;;;
 267
 268 (defvar mime-viewer/quitting-method-alist
 269   '((mime/show-message-mode
 270      . mime-viewer/quitting-method-for-mime/show-message-mode)))
 271
 272 (defvar mime-viewer/over-to-previous-method-alist nil)
 273 (defvar mime-viewer/over-to-next-method-alist nil)
 274
 275
 276 ;;; @@ X-Face
 277 ;;;
 278
 279 ;; hack from Gnus 5.0.4.
 280
 281 (defvar mime-viewer/x-face-command
 282   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
 283   "String to be executed to display an X-Face field.
 284 The command will be executed in a sub-shell asynchronously.
 285 The compressed face will be piped to this command.")
 286
 287 (defun mime-viewer/x-face-function ()
 288   "Function to display X-Face field. You can redefine to customize."
 289   ;; 1995/10/12 (c.f. tm-eng:130)
 290   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 291   (save-restriction
 292     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 293     ;; end
 294     (goto-char (point-min))
 295     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 296         (let ((beg (match-end 0))
 297               (end (rfc822/field-end))
 298               )
 299           (call-process-region beg end "sh" nil 0 nil
 300                                "-c" mime-viewer/x-face-command)
 301           ))))
 302
 303
 304 ;;; @ data structures
 305 ;;;
 306
 307 ;;; @@ preview-content-info
 308 ;;;
 309
 310 (define-structure mime::preview-content-info
 311   point-min point-max buffer content-info)
 312
 313
 314 ;;; @ buffer setup
 315 ;;;
 316
 317 (defun mime-viewer/setup-buffer (&optional ctl encoding ibuf obuf)
 318   (if ibuf
 319       (progn
 320         (get-buffer ibuf)
 321         (set-buffer ibuf)
 322         ))
 323   (make-variable-buffer-local 'mime::article/content-info)
 324   (setq mime::article/content-info (mime/parse-message ctl encoding))
 325   (let ((ret (mime-viewer/make-preview-buffer obuf)))
 326     (make-variable-buffer-local 'mime::article/preview-buffer)
 327     (setq mime::article/preview-buffer (car ret))
 328     ret))
 329
 330 (defun mime-viewer/make-preview-buffer (&optional obuf)
 331   (let ((cinfo mime::article/content-info)
 332         (the-buf (current-buffer))
 333         (mode major-mode)
 334         pcl dest)
 335     (or obuf
 336         (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))
 337         )
 338     (setq pcl (mime/flatten-content-info cinfo))
 339     (let ((bf (get-buffer obuf)))
 340       (if bf
 341           (progn
 342             (set-buffer obuf)
 343             (setq buffer-read-only nil)
 344             (erase-buffer)
 345             )
 346         (setq bf (get-buffer-create obuf))
 347         (set-buffer obuf)
 348         ))
 349     (make-variable-buffer-local 'mime::preview/article-buffer)
 350     (setq mime::preview/article-buffer the-buf)
 351     (make-variable-buffer-local 'mime::preview/original-major-mode)
 352     (setq mime::preview/original-major-mode mode)
 353     (setq major-mode 'mime/viewer-mode)
 354     (setq mode-name "MIME-View")
 355     (setq dest
 356           (mapcar
 357            (function
 358             (lambda (content)
 359               (mime-viewer/display-content content cinfo the-buf obuf)
 360               ))
 361            pcl))
 362     (set-buffer-modified-p nil)
 363     (setq buffer-read-only t)
 364     (set-buffer the-buf)
 365     (list obuf dest)
 366     ))
 367
 368 (defun mime-viewer/display-content (content cinfo ibuf obuf)
 369   (let* ((beg (mime::content-info/point-min content))
 370          (end (mime::content-info/point-max content))
 371          (ctype (mime::content-info/type content))
 372          (params (mime::content-info/parameters content))
 373          (encoding (mime::content-info/encoding content))
 374          (rcnum (mime::content-info/rcnum content))
 375          he e nb ne subj)
 376     (set-buffer ibuf)
 377     (goto-char beg)
 378     (setq he (if (re-search-forward "^$" nil t)
 379                  (1+ (match-end 0))
 380                end))
 381     (if (> he end)
 382         (setq he end)
 383       )
 384     (save-restriction
 385       (narrow-to-region beg end)
 386       (setq subj
 387             (mime-eword/decode-string
 388              (mime-viewer/get-subject params encoding)))
 389       )
 390     (set-buffer obuf)
 391     (setq nb (point))
 392     (narrow-to-region nb nb)
 393     (funcall mime-viewer/content-subject-function
 394              rcnum cinfo ctype params subj)
 395     (set-buffer ibuf)
 396     (if (mime-viewer/header-visible-p rcnum cinfo ctype)
 397         (mime-viewer/display-header beg he obuf)
 398       )
 399     (cond ((mime-viewer/body-visible-p rcnum cinfo ctype)
 400            (mime-viewer/display-body he end obuf
 401                                      rcnum cinfo ctype params subj encoding)
 402            )
 403           ((equal ctype "message/partial")
 404            (mime-viewer/display-message/partial obuf)
 405            )
 406           ((and (null rcnum)
 407                 (null (mime::content-info/children cinfo))
 408                 )
 409            (set-buffer obuf)
 410            (goto-char (point-max))
 411            (mime-viewer/insert-content-subject rcnum cinfo ctype params subj)
 412            )
 413           (t (set-buffer obuf))
 414           )
 415     (mime-viewer/default-content-separator rcnum cinfo ctype params subj)
 416     (prog1
 417         (progn
 418           (setq ne (point-max))
 419           (widen)
 420           (mime::preview-content-info/create nb (1- ne) ibuf content)
 421           )
 422       (goto-char ne)
 423       )))
 424
 425 (defun mime-viewer/display-header (beg end obuf)
 426   (let ((str (buffer-substring beg end))
 427         (f (assq major-mode mime-viewer/content-header-filter-alist))
 428         )
 429     (save-excursion
 430       (set-buffer obuf)
 431       (save-restriction
 432         (narrow-to-region (point)(point))
 433         (insert str)
 434         (if (and f (setq f (cdr f)))
 435             (funcall f)
 436           (mime-viewer/default-content-header-filter)
 437           )
 438         (run-hooks 'mime-viewer/content-header-filter-hook)
 439         ))))
 440
 441 (defun mime-viewer/display-body (beg end obuf
 442                                      rcnum cinfo ctype params subj encoding)
 443   (let ((str (buffer-substring beg end))
 444         be)
 445     (set-buffer obuf)
 446     (save-restriction
 447       (setq be (point-max))
 448       (narrow-to-region be be)
 449       (insert str)
 450       (let ((f (assoc-value ctype mime-viewer/content-filter-alist)))
 451         (if (and f (fboundp f))
 452             (funcall f ctype params encoding)
 453           (mime-viewer/default-content-filter rcnum cinfo ctype params subj)
 454           ))
 455       )))
 456
 457 (defun mime-viewer/display-message/partial (obuf)
 458   (set-buffer obuf)
 459   (save-restriction
 460     (goto-char (point-max))
 461     (if (not (search-backward "\n\n" nil t))
 462         (insert "\n")
 463       )
 464     (let ((be (point-max)))
 465       (narrow-to-region be be)
 466       (insert mime-viewer/announcement-for-message/partial)
 467       (tm:add-button (point-min)(point-max)
 468                      (function mime-viewer/play-content))
 469       )))
 470
 471 (defun mime-viewer/get-subject (param &optional encoding)
 472   (if (member (or encoding
 473                   (cdr (assq 'encoding param))
 474                   )
 475               mime-viewer/uuencode-encoding-name-list)
 476       (save-excursion
 477         (or (if (re-search-forward "^begin [0-9]+ " nil t)
 478                 (if (looking-at ".+$")
 479                     (buffer-substring (match-beginning 0)(match-end 0))
 480                   ))
 481             ""))
 482     (let (ret)
 483       (or (and (setq ret (assoc "name" param))
 484                (rfc822/strip-quoted-string (cdr ret))
 485                )
 486           (and (setq ret (assoc "x-name" param))
 487                (rfc822/strip-quoted-string (cdr ret))
 488                )
 489
 490           (save-excursion
 491             (save-restriction
 492               (goto-char (point-min))
 493               (narrow-to-region (point-min)
 494                                 (or (and (search-forward "\n\n" nil t)
 495                                          (match-beginning 0)
 496                                          )
 497                                     (point-max)))
 498               (or
 499                (rfc822/get-field-body "Content-Description")
 500                (rfc822/get-field-body "Subject")
 501                )))
 502           ""))
 503     ))
 504
 505
 506 ;;; @ content information
 507 ;;;
 508
 509 (defun mime-article/point-content-number (p &optional cinfo)
 510   (or cinfo
 511       (setq cinfo mime::article/content-info)
 512       )
 513   (let ((b (mime::content-info/point-min cinfo))
 514         (e (mime::content-info/point-max cinfo))
 515         (c (mime::content-info/children cinfo))
 516         )
 517     (if (and (<= b p)(<= p e))
 518         (or (let (co ret (sn 0))
 519               (catch 'tag
 520                 (while c
 521                   (setq co (car c))
 522                   (setq ret (mime-article/point-content-number p co))
 523                   (cond ((eq ret t) (throw 'tag (list sn)))
 524                         (ret (throw 'tag (cons sn ret)))
 525                         )
 526                   (setq c (cdr c))
 527                   (setq sn (1+ sn))
 528                   )))
 529             t))))
 530
 531 (defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo)
 532   (or cinfo
 533       (setq cinfo mime::article/content-info)
 534       )
 535   (some-element
 536    (function
 537     (lambda (ci)
 538       (equal (mime::content-info/rcnum ci) rcnum)
 539       ))
 540    (mime/flatten-content-info cinfo)
 541    ))
 542
 543 (defun mime-article/cnum-to-cinfo (cn &optional cinfo)
 544   (or cinfo
 545       (setq cinfo mime::article/content-info)
 546       )
 547   (if (eq cn t)
 548       cinfo
 549     (let ((sn (car cn)))
 550       (if (null sn)
 551           cinfo
 552         (let ((rc (nth sn (mime::content-info/children cinfo))))
 553           (if rc
 554               (mime-article/cnum-to-cinfo (cdr cn) rc)
 555             ))
 556         ))))
 557
 558 (defun mime/flatten-content-info (&optional cinfo)
 559   (or cinfo
 560       (setq cinfo mime::article/content-info)
 561       )
 562   (let ((dest (list cinfo))
 563         (rcl (mime::content-info/children cinfo))
 564         )
 565     (while rcl
 566       (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
 567       (setq rcl (cdr rcl))
 568       )
 569     dest))
 570
 571 (defun mime::point-preview-content (p &optional pcl)
 572   (or pcl
 573       (setq pcl mime::preview/content-list)
 574       )
 575   (catch 'tag
 576     (let ((r pcl) cell)
 577       (while r
 578         (setq cell (car r))
 579         (if (and (<= (mime::preview-content-info/point-min cell) p)
 580                  (<= p (mime::preview-content-info/point-max cell))
 581                  )
 582             (throw 'tag cell)
 583           )
 584         (setq r (cdr r))
 585         ))
 586     (car (last pcl))
 587     ))
 588
 589
 590 ;;; @ content filter
 591 ;;;
 592
 593 (defvar mime-viewer/code-converter-alist
 594   '((mime/show-message-mode . mime/code-convert-region-to-emacs))
 595   )
 596
 597 (defun mime-viewer/default-code-convert-region
 598   (beg end charset &optional encoding)
 599   (if (member encoding '("quoted-printable" "base64"))
 600       (mime/code-convert-region-to-emacs beg (point-max) charset)
 601     ))
 602
 603 (defun mime-preview/decode-text-region (beg end charset encoding)
 604   (mime/decode-region encoding beg end)
 605   (let* ((mode mime::preview/original-major-mode)
 606          (m (assq mode mime-viewer/code-converter-alist))
 607          )
 608     (if (and m (fboundp (setq m (cdr m))))
 609         (funcall m beg (point-max) charset encoding)
 610       (mime-viewer/default-code-convert-region
 611        beg (point-max) charset encoding)
 612       )))
 613
 614 (defun mime-viewer/filter-text/plain (ctype params encoding)
 615   (let ((charset (cdr (assoc "charset" params)))
 616         (beg (point-min)) (end (point-max))
 617         )
 618     (mime-preview/decode-text-region beg end charset encoding)
 619     )
 620   (goto-char (point-max))
 621   (if (not (eq (char-after (1- (point))) ?\n))
 622       (insert "\n")
 623     )
 624   (if browse-url-browser-function
 625       (progn
 626         (goto-char (point-min))
 627         (while (re-search-forward tm:URL-regexp nil t)
 628           (tm:add-button (match-beginning 0)(match-end 0)
 629                          (function tm:browse-url))
 630           )))
 631   (run-hooks 'mime-viewer/plain-text-preview-hook)
 632   )
 633
 634
 635 ;;; @ MIME viewer mode
 636 ;;;
 637
 638 (defvar mime/viewer-mode-map nil)
 639 (if (null mime/viewer-mode-map)
 640     (progn
 641       (setq mime/viewer-mode-map (make-keymap))
 642       (suppress-keymap mime/viewer-mode-map)
 643       (define-key mime/viewer-mode-map
 644         "u"        (function mime-viewer/up-content))
 645       (define-key mime/viewer-mode-map
 646         "p"        (function mime-viewer/previous-content))
 647       (define-key mime/viewer-mode-map
 648         "n"        (function mime-viewer/next-content))
 649       (define-key mime/viewer-mode-map
 650         " "        (function mime-viewer/scroll-up-content))
 651       (define-key mime/viewer-mode-map
 652         "\M- "     (function mime-viewer/scroll-down-content))
 653       (define-key mime/viewer-mode-map
 654         "\177"     (function mime-viewer/scroll-down-content))
 655       (define-key mime/viewer-mode-map
 656         "\C-m"     (function mime-viewer/next-line-content))
 657       (define-key mime/viewer-mode-map
 658         "\C-\M-m"  (function mime-viewer/previous-line-content))
 659       (define-key mime/viewer-mode-map
 660         "v"        (function mime-viewer/play-content))
 661       (define-key mime/viewer-mode-map
 662         "e"        (function mime-viewer/extract-content))
 663       (define-key mime/viewer-mode-map
 664         "\C-c\C-p" (function mime-viewer/print-content))
 665       (define-key mime/viewer-mode-map
 666         "f"        (function mime-viewer/display-x-face))
 667       (define-key mime/viewer-mode-map
 668         "q"        (function mime-viewer/quit))
 669       (define-key mime/viewer-mode-map
 670         "\C-c\C-x" (function mime-viewer/kill-buffer))
 671       (if mouse-button-2
 672           (define-key mime/viewer-mode-map
 673             mouse-button-2 (function tm:button-dispatcher))
 674         )
 675       ))
 676
 677 (defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf)
 678   "Major mode for viewing MIME message.
 679
 680 Here is a list of the standard keys for mime/viewer-mode.
 681
 682 key             feature
 683 ---             -------
 684
 685 u               Move to upper content
 686 p               Move to previous content
 687 n               Move to next content
 688 SPC             Scroll up or move to next content
 689 M-SPC           Scroll down or move to previous content
 690 DEL             Scroll down or move to previous content
 691 RET             Move to next line
 692 M-RET           Move to previous line
 693 v               Decode current content as `play mode'
 694 e               Decode current content as `extract mode'
 695 C-c C-p         Decode current content as `print mode'
 696 f               Display X-Face
 697 q               Quit
 698 button-2        Move to point under the mouse cursor
 699                 and decode current content as `play mode'
 700
 701
 702 Here are all the commands with their current binding,
 703 listed in key order:
 704
 705 \\{mime/viewer-mode-map}
 706 "
 707   (interactive)
 708   (let ((buf (get-buffer mime/output-buffer-name)))
 709     (if buf
 710         (save-excursion
 711           (set-buffer buf)
 712           (erase-buffer)
 713           )))
 714   (let ((ret (mime-viewer/setup-buffer ctl encoding ibuf obuf)))
 715     (prog1
 716         (switch-to-buffer (car ret))
 717       (if mother
 718           (progn
 719             (make-variable-buffer-local
 720              'mime/show-mode-old-window-configuration)
 721             (setq mime/show-mode-old-window-configuration
 722                   (current-window-configuration))
 723             (make-variable-buffer-local 'mime::preview/mother-buffer)
 724             (setq mime::preview/mother-buffer mother)
 725             ))
 726       (use-local-map mime/viewer-mode-map)
 727       (make-variable-buffer-local 'mime::preview/content-list)
 728       (setq mime::preview/content-list (nth 1 ret))
 729       (goto-char
 730        (let ((ce (mime::preview-content-info/point-max
 731                   (car mime::preview/content-list)
 732                   ))
 733              e)
 734          (goto-char (point-min))
 735          (search-forward "\n\n" nil t)
 736          (setq e (match-end 0))
 737          (if (<= e ce)
 738              e
 739            ce)))
 740       (run-hooks 'mime/viewer-mode-hook)
 741       )))
 742
 743 (defun mime-preview/point-content-number (point)
 744   (save-window-excursion
 745     (let ((pc (mime::point-preview-content (point)))
 746           cinfo)
 747       (switch-to-buffer (mime::preview-content-info/buffer pc))
 748       (setq cinfo (mime::preview-content-info/content-info pc))
 749       (mime-article/point-content-number (mime::content-info/point-min cinfo))
 750       )))
 751
 752 (defun mime-preview/cinfo-to-pcinfo (cinfo)
 753   (let ((rpcl mime::preview/content-list) cell)
 754     (catch 'tag
 755       (while rpcl
 756         (setq cell (car rpcl))
 757         (if (eq cinfo (mime::preview-content-info/content-info cell))
 758             (throw 'tag cell)
 759           )
 760         (setq rpcl (cdr rpcl))
 761         ))))
 762
 763 (autoload 'mime-preview/decode-content "tm-play")
 764
 765 (defvar mime-viewer/decoding-mode "play" "MIME body decoding mode")
 766
 767 (defun mime-viewer/play-content ()
 768   (interactive)
 769   (let ((mime-viewer/decoding-mode "play"))
 770     (mime-preview/decode-content)
 771     ))
 772
 773 (defun mime-viewer/extract-content ()
 774   (interactive)
 775   (let ((mime-viewer/decoding-mode "extract"))
 776     (mime-preview/decode-content)
 777     ))
 778
 779 (defun mime-viewer/print-content ()
 780   (interactive)
 781   (let ((mime-viewer/decoding-mode "print"))
 782     (mime-preview/decode-content)
 783     ))
 784
 785 (defun mime-viewer/display-x-face ()
 786   (interactive)
 787   (save-window-excursion
 788     (set-buffer mime::preview/article-buffer)
 789     (mime-viewer/x-face-function)
 790     ))
 791
 792 (defun mime-viewer/up-content ()
 793   (interactive)
 794   (let ((pc (mime::point-preview-content (point))) cinfo
 795         (the-buf (current-buffer))
 796         rcnum r)
 797     (switch-to-buffer (mime::preview-content-info/buffer pc))
 798     (setq cinfo (mime::preview-content-info/content-info pc))
 799     (setq rcnum (mime::content-info/rcnum cinfo))
 800     (if (null rcnum)
 801         (mime-viewer/quit the-buf
 802                           (mime::preview-content-info/buffer pc)
 803                           )
 804       (setq r (mime-article/rcnum-to-cinfo (cdr rcnum)))
 805       (switch-to-buffer the-buf)
 806       (catch 'tag
 807         (let ((rpcl mime::preview/content-list) cell)
 808           (while rpcl
 809             (setq cell (car rpcl))
 810             (if (eq r (mime::preview-content-info/content-info cell))
 811                 (progn
 812                   (goto-char (mime::preview-content-info/point-min cell))
 813                   (throw 'tag nil)
 814                   ))
 815             (setq rpcl (cdr rpcl))
 816             )))
 817       )))
 818
 819 (defun mime-viewer/previous-content ()
 820   (interactive)
 821   (let* ((pcl mime::preview/content-list)
 822          (p (point))
 823          (i (- (length pcl) 1))
 824          beg)
 825     (catch 'tag
 826       (while (>= i 0)
 827         (setq beg (mime::preview-content-info/point-min (nth i pcl)))
 828         (if (> p beg)
 829             (throw 'tag (goto-char beg))
 830           )
 831         (setq i (- i 1))
 832         )
 833       (let ((f (assq mime::preview/original-major-mode
 834                      mime-viewer/over-to-previous-method-alist)))
 835         (if f
 836             (funcall (cdr f))
 837           ))
 838       )
 839     ))
 840
 841 (defun mime-viewer/next-content ()
 842   (interactive)
 843   (let ((pcl mime::preview/content-list)
 844         (p (point))
 845         beg)
 846     (catch 'tag
 847       (while pcl
 848         (setq beg (mime::preview-content-info/point-min (car pcl)))
 849         (if (< p beg)
 850             (throw 'tag (goto-char beg))
 851           )
 852         (setq pcl (cdr pcl))
 853         )
 854       (let ((f (assq mime::preview/original-major-mode
 855                      mime-viewer/over-to-next-method-alist)))
 856         (if f
 857             (funcall (cdr f))
 858           ))
 859       )
 860     ))
 861
 862 (defun mime-viewer/scroll-up-content (&optional h)
 863   (interactive)
 864   (or h
 865       (setq h (- (window-height) 1))
 866       )
 867   (let ((pcl mime::preview/content-list)
 868         (p (point))
 869         np beg)
 870     (setq np
 871           (or (catch 'tag
 872                 (while pcl
 873                   (setq beg (mime::preview-content-info/point-min (car pcl)))
 874                   (if (< p beg)
 875                       (throw 'tag beg)
 876                     )
 877                   (setq pcl (cdr pcl))
 878                   ))
 879               (point-max)))
 880     (forward-line h)
 881     (if (> (point) np)
 882         (goto-char np)
 883       )
 884     ;;(show-subtree)
 885     ))
 886
 887 (defun mime-viewer/scroll-down-content (&optional h)
 888   (interactive)
 889   (or h
 890       (setq h (- (window-height) 1))
 891       )
 892   (let ((pcl mime::preview/content-list)
 893         (p (point))
 894         pp beg)
 895     (setq pp
 896           (or (let ((i (- (length pcl) 1)))
 897                 (catch 'tag
 898                   (while (> i 0)
 899                     (setq beg (mime::preview-content-info/point-min
 900                                (nth i pcl)))
 901                     (if (> p beg)
 902                         (throw 'tag beg)
 903                       )
 904                     (setq i (- i 1))
 905                     )))
 906               (point-min)))
 907     (forward-line (- h))
 908     (if (< (point) pp)
 909         (goto-char pp)
 910       )))
 911
 912 (defun mime-viewer/next-line-content ()
 913   (interactive)
 914   (mime-viewer/scroll-up-content 1)
 915   )
 916
 917 (defun mime-viewer/previous-line-content ()
 918   (interactive)
 919   (mime-viewer/scroll-down-content 1)
 920   )
 921
 922 (defun mime-viewer/quit (&optional the-buf buf)
 923   (interactive)
 924   (or the-buf
 925       (setq the-buf (current-buffer))
 926       )
 927   (or buf
 928       (setq buf (mime::preview-content-info/buffer
 929                  (mime::point-preview-content (point))))
 930       )
 931   (let ((r (progn
 932              (switch-to-buffer buf)
 933              (assq major-mode mime-viewer/quitting-method-alist)
 934              )))
 935     (if r
 936         (progn
 937           (switch-to-buffer the-buf)
 938           (funcall (cdr r))
 939           ))
 940     ))
 941
 942 (defun mime-viewer/kill-buffer ()
 943   (interactive)
 944   (kill-buffer (current-buffer))
 945   )
 946
 947
 948 ;;; @ end
 949 ;;;
 950
 951 (provide 'tm-view)
 952
 953 (run-hooks 'tm-view-load-hook)