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