mime-view.el

   1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1994/7/13
   7 ;;      Renamed: 1994/8/31 from tm-body.el
   8 ;;      Renamed: 1997/02/19 from tm-view.el
   9 ;; Version: $Revision: 0.70 $
  10 ;; Keywords: MIME, multimedia, mail, news
  11
  12 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 2, or (at
  17 ;; your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Code:
  30
  31 (require 'cl)
  32 (require 'std11)
  33 (require 'mel)
  34 (require 'eword-decode)
  35 (require 'mime-parse)
  36 (require 'mime-text)
  37
  38
  39 ;;; @ version
  40 ;;;
  41
  42 (defconst mime-view-RCS-ID
  43   "$Id: mime-view.el,v 0.70 1997-03-18 09:42:17 morioka Exp $")
  44
  45 (defconst mime-view-version (get-version-string mime-view-RCS-ID))
  46
  47
  48 ;;; @ variables
  49 ;;;
  50
  51 (defvar mime/content-decoding-condition
  52   '(((type . "text/plain")
  53      (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)
  54      (mode "play" "print")
  55      )
  56     ((type . "text/html")
  57      (method "tm-html" nil 'file 'type 'encoding 'mode 'name)
  58      (mode . "play")
  59      )
  60     ((type . "text/x-rot13-47")
  61      (method . mime-article/decode-caesar)
  62      (mode . "play")
  63      )
  64     ((type . "audio/basic")
  65      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name)
  66      (mode . "play")
  67      )
  68
  69     ((type . "image/jpeg")
  70      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  71      (mode "play" "print")
  72      )
  73     ((type . "image/gif")
  74      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  75      (mode "play" "print")
  76      )
  77     ((type . "image/tiff")
  78      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  79      (mode "play" "print")
  80      )
  81     ((type . "image/x-tiff")
  82      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  83      (mode "play" "print")
  84      )
  85     ((type . "image/x-xbm")
  86      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  87      (mode "play" "print")
  88      )
  89     ((type . "image/x-pic")
  90      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  91      (mode "play" "print")
  92      )
  93     ((type . "image/x-mag")
  94      (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
  95      (mode "play" "print")
  96      )
  97
  98     ((type . "video/mpeg")
  99      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name)
 100      (mode . "play")
 101      )
 102
 103     ((type . "application/postscript")
 104      (method "tm-ps" nil 'file 'type 'encoding 'mode 'name)
 105      (mode "play" "print")
 106      )
 107     ((type . "application/octet-stream")
 108      (method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
 109      (mode "play" "print")
 110      )
 111
 112     ;;((type . "message/external-body")
 113     ;; (method "xterm" nil
 114     ;;         "-e" "showexternal"
 115     ;;         'file '"access-type" '"name" '"site" '"directory"))
 116     ((type . "message/external-body")
 117      ("access-type" . "anon-ftp")
 118      (method . mime-article/decode-message/external-ftp)
 119      )
 120     ((type . "message/rfc822")
 121      (method . mime-article/view-message/rfc822)
 122      (mode . "play")
 123      )
 124     ((type . "message/partial")
 125      (method . mime-article/decode-message/partial)
 126      (mode . "play")
 127      )
 128
 129     ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
 130      (mode . "play")
 131      )
 132     ((method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
 133      (mode . "extract")
 134      )
 135     ))
 136
 137 (defvar mime-view-childrens-header-showing-Content-Type-list
 138   '("message/rfc822" "message/news"))
 139
 140 (defvar mime-view-visible-media-type-list
 141   '("text/plain" nil "text/richtext" "text/enriched"
 142     "text/rfc822-headers"
 143     "text/x-latex" "application/x-latex"
 144     "message/delivery-status"
 145     "application/pgp" "text/x-pgp"
 146     "application/octet-stream"
 147     "application/x-selection" "application/x-comment")
 148   "*List of media-types to be able to display in MIME-View buffer.
 149 Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".")
 150
 151 (defvar mime-view-content-button-visible-ctype-list
 152   '("application/pgp"))
 153
 154 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 155
 156 (defvar mime-view-ignored-field-list
 157   '(".*Received" ".*Path" ".*Id" "References"
 158     "Replied" "Errors-To"
 159     "Lines" "Sender" ".*Host" "Xref"
 160     "Content-Type" "Precedence"
 161     "Status" "X-VM-.*")
 162   "All fields that match this list will be hidden in MIME preview buffer.
 163 Each elements are regexp of field-name. [mime-view.el]")
 164
 165 (defvar mime-view-ignored-field-regexp
 166   (concat "^"
 167           (apply (function regexp-or) mime-view-ignored-field-list)
 168           ":"))
 169
 170 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
 171   "All fields that match this list will be displayed in MIME preview buffer.
 172 Each elements are regexp of field-name.")
 173
 174 (defvar mime-view-redisplay nil)
 175
 176 (defvar mime-view-announcement-for-message/partial
 177   (if (and (>= emacs-major-version 19) window-system)
 178       "\
 179 \[[ This is message/partial style split message. ]]
 180 \[[ Please press `v' key in this buffer          ]]
 181 \[[ or click here by mouse button-2.             ]]"
 182     "\
 183 \[[ This is message/partial style split message. ]]
 184 \[[ Please press `v' key in this buffer.         ]]"
 185     ))
 186
 187
 188 ;;; @@ predicate functions
 189 ;;;
 190
 191 (defun mime-view-header-visible-p (rcnum cinfo)
 192   "Return non-nil if header of current entity is visible."
 193   (or (null rcnum)
 194       (member (mime::content-info/type
 195                (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
 196               mime-view-childrens-header-showing-Content-Type-list)
 197       ))
 198
 199 (defun mime-view-body-visible-p (rcnum cinfo &optional ctype)
 200   (let (ccinfo)
 201     (or ctype
 202         (setq ctype
 203               (mime::content-info/type
 204                (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
 205                ))
 206         )
 207     (and (member ctype mime-view-visible-media-type-list)
 208          (if (string-equal ctype "application/octet-stream")
 209              (progn
 210                (or ccinfo
 211                    (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
 212                    )
 213                (member (mime::content-info/encoding ccinfo)
 214                        '(nil "7bit" "8bit"))
 215                )
 216            t))
 217     ))
 218
 219
 220 ;;; @@ entity button
 221 ;;;
 222
 223 (defun mime-view-insert-entity-button (rcnum cinfo ctype params subj encoding)
 224   "Insert entity-button."
 225   (save-restriction
 226     (narrow-to-region (point)(point))
 227     (let ((access-type (assoc "access-type" params))
 228           (num (or (cdr (assoc "x-part-number" params))
 229                    (if (consp rcnum)
 230                        (mapconcat (function
 231                                    (lambda (num)
 232                                      (format "%s" (1+ num))
 233                                      ))
 234                                   (reverse rcnum) ".")
 235                      "0"))
 236                ))
 237       (cond (access-type
 238              (let ((server (assoc "server" params)))
 239                (setq access-type (cdr access-type))
 240                (if server
 241                    (insert (format "[%s %s ([%s] %s)]\n" num subj
 242                                    access-type (cdr server)))
 243                  (let ((site (cdr (assoc "site" params)))
 244                        (dir (cdr (assoc "directory" params)))
 245                        )
 246                    (insert (format "[%s %s ([%s] %s:%s)]\n" num subj
 247                                    access-type site dir))
 248                    )))
 249              )
 250             (t
 251              (let ((charset (cdr (assoc "charset" params))))
 252                (insert (concat "[" num " " subj))
 253                (let ((rest
 254                       (concat " <" ctype
 255                               (if charset
 256                                   (concat "; " charset)
 257                                 (if encoding (concat " (" encoding ")"))
 258                                 )
 259                               ">]\n")))
 260                  (if (>= (+ (current-column)(length rest))(window-width))
 261                      (insert "\n\t")
 262                    )
 263                  (insert rest)
 264                  ))))
 265       )
 266     (mime-add-button (point-min)(1- (point-max))
 267                      (function mime-view-play-current-entity))
 268     ))
 269
 270 (defun mime-view-entity-button-function
 271   (rcnum cinfo ctype params subj encoding)
 272   "Insert entity button conditionally.
 273 Please redefine this function if you want to change default setting."
 274   (or (null rcnum)
 275       (string= ctype "application/x-selection")
 276       (and (string= ctype "application/octet-stream")
 277            (string= (mime::content-info/type
 278                      (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
 279                     "multipart/encrypted"))
 280       (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding)
 281       ))
 282
 283
 284 ;;; @@ content header filter
 285 ;;;
 286
 287 (defsubst mime-view-cut-header ()
 288   (goto-char (point-min))
 289   (while (re-search-forward mime-view-ignored-field-regexp nil t)
 290     (let* ((beg (match-beginning 0))
 291            (end (match-end 0))
 292            (name (buffer-substring beg end))
 293            )
 294       (or (member-if (function
 295                       (lambda (regexp)
 296                         (string-match regexp name)
 297                         )) mime-view-visible-field-list)
 298           (delete-region beg
 299                          (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 300                              (match-beginning 0)
 301                            (point-max)))
 302           ))))
 303
 304 (defun mime-view-default-content-header-filter ()
 305   (mime-view-cut-header)
 306   (eword-decode-header)
 307   )
 308
 309 (defvar mime-view-content-header-filter-alist nil)
 310
 311
 312 ;;; @@ content filter
 313 ;;;
 314
 315 (defvar mime-view-content-filter-alist
 316   '(("text/enriched" . mime-preview/filter-for-text/enriched)
 317     ("text/richtext" . mime-preview/filter-for-text/richtext)
 318     (t . mime-preview/filter-for-text/plain)
 319     ))
 320
 321
 322 ;;; @@ entity separator
 323 ;;;
 324
 325 (defun mime-view-entity-separator-function (rcnum cinfo ctype params subj)
 326   "Insert entity separator conditionally.
 327 Please redefine this function if you want to change default setting."
 328   (or (mime-view-header-visible-p rcnum cinfo)
 329       (mime-view-body-visible-p rcnum cinfo ctype)
 330       (progn
 331         (goto-char (point-max))
 332         (insert "\n")
 333         )))
 334
 335
 336 ;;; @@ buffer local variables
 337 ;;;
 338
 339 ;;; @@@ in raw buffer
 340 ;;;
 341
 342 (make-variable-buffer-local 'mime::article/content-info)
 343
 344 (defvar mime::article/preview-buffer nil)
 345 (make-variable-buffer-local 'mime::article/preview-buffer)
 346
 347
 348 ;;; @@@ in view buffer
 349 ;;;
 350
 351 (make-variable-buffer-local 'mime::preview/mother-buffer)
 352 (make-variable-buffer-local 'mime::preview/content-list)
 353
 354 (defvar mime::preview/article-buffer nil)
 355 (make-variable-buffer-local 'mime::preview/article-buffer)
 356
 357 (make-variable-buffer-local 'mime::preview/original-major-mode)
 358 (make-variable-buffer-local 'mime::preview/original-window-configuration)
 359
 360
 361 ;;; @@ quitting method
 362 ;;;
 363
 364 (defvar mime-view-quitting-method-alist
 365   '((mime-show-message-mode
 366      . mime-view-quitting-method-for-mime-show-message-mode))
 367   "Alist of major-mode vs. quitting-method of mime-view.")
 368
 369 (defvar mime-view-over-to-previous-method-alist nil)
 370 (defvar mime-view-over-to-next-method-alist nil)
 371
 372 (defvar mime-view-show-summary-method nil
 373   "Alist of major-mode vs. show-summary-method.")
 374
 375
 376 ;;; @@ following method
 377 ;;;
 378
 379 (defvar mime-view-following-method-alist nil
 380   "Alist of major-mode vs. following-method of mime-view.")
 381
 382 (defvar mime-view-following-required-fields-list
 383   '("From"))
 384
 385
 386 ;;; @@ X-Face
 387 ;;;
 388
 389 ;; hack from Gnus 5.0.4.
 390
 391 (defvar mime-view-x-face-to-pbm-command
 392   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
 393
 394 (defvar mime-view-x-face-command
 395   (concat mime-view-x-face-to-pbm-command
 396           " | xv -quit -")
 397   "String to be executed to display an X-Face field.
 398 The command will be executed in a sub-shell asynchronously.
 399 The compressed face will be piped to this command.")
 400
 401 (defun mime-view-x-face-function ()
 402   "Function to display X-Face field. You can redefine to customize."
 403   ;; 1995/10/12 (c.f. tm-eng:130)
 404   ;;    fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
 405   (save-restriction
 406     (narrow-to-region (point-min) (re-search-forward "^$" nil t))
 407     ;; end
 408     (goto-char (point-min))
 409     (if (re-search-forward "^X-Face:[ \t]*" nil t)
 410         (let ((beg (match-end 0))
 411               (end (std11-field-end))
 412               )
 413           (call-process-region beg end "sh" nil 0 nil
 414                                "-c" mime-view-x-face-command)
 415           ))))
 416
 417
 418 ;;; @@ utility
 419 ;;;
 420
 421 (defun mime-preview/get-original-major-mode ()
 422   (if mime::preview/mother-buffer
 423       (save-excursion
 424         (set-buffer mime::preview/mother-buffer)
 425         (mime-preview/get-original-major-mode)
 426         )
 427     mime::preview/original-major-mode))
 428
 429
 430 ;;; @ data structures
 431 ;;;
 432
 433 ;;; @@ preview-content-info
 434 ;;;
 435
 436 (define-structure mime::preview-content-info
 437   point-min point-max buffer content-info)
 438
 439
 440 ;;; @ buffer setup
 441 ;;;
 442
 443 (defun mime-view-setup-buffer (&optional ctl encoding ibuf obuf)
 444   (if ibuf
 445       (progn
 446         (get-buffer ibuf)
 447         (set-buffer ibuf)
 448         ))
 449   (or mime-view-redisplay
 450       (setq mime::article/content-info (mime-parse-message ctl encoding))
 451       )
 452   (let ((ret (mime-view-make-preview-buffer obuf)))
 453     (setq mime::article/preview-buffer (car ret))
 454     ret))
 455
 456 (defun mime-view-make-preview-buffer (&optional obuf)
 457   (let* ((cinfo mime::article/content-info)
 458          (pcl (mime/flatten-content-info cinfo))
 459          (dest (make-list (length pcl) nil))
 460          (the-buf (current-buffer))
 461          (mode major-mode)
 462          )
 463     (or obuf
 464         (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
 465     (set-buffer (get-buffer-create obuf))
 466     (setq buffer-read-only nil)
 467     (widen)
 468     (erase-buffer)
 469     (setq mime::preview/article-buffer the-buf)
 470     (setq mime::preview/original-major-mode mode)
 471     (setq major-mode 'mime-view-mode)
 472     (setq mode-name "MIME-View")
 473     (let ((drest dest))
 474       (while pcl
 475         (setcar drest
 476                 (mime-view-display-entity (car pcl) cinfo the-buf obuf))
 477         (setq pcl (cdr pcl)
 478               drest (cdr drest))
 479         ))
 480     (set-buffer-modified-p nil)
 481     (setq buffer-read-only t)
 482     (set-buffer the-buf)
 483     (list obuf dest)
 484     ))
 485
 486 (defun mime-view-display-entity (content cinfo ibuf obuf)
 487   "Display entity from content-info CONTENT."
 488   (let* ((beg (mime::content-info/point-min content))
 489          (end (mime::content-info/point-max content))
 490          (ctype (mime::content-info/type content))
 491          (params (mime::content-info/parameters content))
 492          (encoding (mime::content-info/encoding content))
 493          (rcnum (mime::content-info/rcnum content))
 494          he e nb ne subj)
 495     (set-buffer ibuf)
 496     (goto-char beg)
 497     (setq he (if (re-search-forward "^$" nil t)
 498                  (1+ (match-end 0))
 499                end))
 500     (if (> he end)
 501         (setq he end)
 502       )
 503     (save-restriction
 504       (narrow-to-region beg end)
 505       (setq subj
 506             (eword-decode-string
 507              (mime-article/get-subject params encoding)))
 508       )
 509     (set-buffer obuf)
 510     (setq nb (point))
 511     (narrow-to-region nb nb)
 512     (mime-view-entity-button-function rcnum cinfo ctype params subj encoding)
 513     (if (mime-view-header-visible-p rcnum cinfo)
 514         (mime-preview/display-header beg he)
 515       )
 516     (if (and (null rcnum)
 517              (member
 518               ctype mime-view-content-button-visible-ctype-list))
 519         (save-excursion
 520           (goto-char (point-max))
 521           (mime-view-insert-entity-button
 522            rcnum cinfo ctype params subj encoding)
 523           ))
 524     (cond ((mime-view-body-visible-p rcnum cinfo ctype)
 525            (mime-preview/display-body he end
 526                                       rcnum cinfo ctype params subj encoding)
 527            )
 528           ((equal ctype "message/partial")
 529            (mime-preview/display-message/partial)
 530            )
 531           ((and (null rcnum)
 532                 (null (mime::content-info/children cinfo))
 533                 )
 534            (goto-char (point-max))
 535            (mime-view-insert-entity-button
 536             rcnum cinfo ctype params subj encoding)
 537            ))
 538     (mime-view-entity-separator-function rcnum cinfo ctype params subj)
 539     (prog1
 540         (progn
 541           (setq ne (point-max))
 542           (widen)
 543           (put-text-property nb ne 'mime-view-raw-buffer ibuf)
 544           (put-text-property nb ne 'mime-view-cinfo content)
 545           (mime::preview-content-info/create nb (1- ne) ibuf content)
 546           )
 547       (goto-char ne)
 548       )))
 549
 550 (defun mime-preview/display-header (beg end)
 551   (save-restriction
 552     (narrow-to-region (point)(point))
 553     (insert-buffer-substring mime::preview/article-buffer beg end)
 554     (let ((f (cdr (assq mime::preview/original-major-mode
 555                         mime-view-content-header-filter-alist))))
 556       (if (functionp f)
 557           (funcall f)
 558         (mime-view-default-content-header-filter)
 559         ))
 560     (run-hooks 'mime-view-content-header-filter-hook)
 561     ))
 562
 563 (defun mime-preview/display-body (beg end
 564                                       rcnum cinfo ctype params subj encoding)
 565   (save-restriction
 566     (narrow-to-region (point-max)(point-max))
 567     (insert-buffer-substring mime::preview/article-buffer beg end)
 568     (let ((f (cdr (or (assoc ctype mime-view-content-filter-alist)
 569                       (assq t mime-view-content-filter-alist)))))
 570       (and (functionp f)
 571            (funcall f ctype params encoding)
 572            )
 573       )))
 574
 575 (defun mime-preview/display-message/partial ()
 576   (save-restriction
 577     (goto-char (point-max))
 578     (if (not (search-backward "\n\n" nil t))
 579         (insert "\n")
 580       )
 581     (let ((be (point-max)))
 582       (narrow-to-region be be)
 583       (insert mime-view-announcement-for-message/partial)
 584       (mime-add-button (point-min)(point-max)
 585                        (function mime-view-play-current-entity))
 586       )))
 587
 588 (defun mime-article/get-uu-filename (param &optional encoding)
 589   (if (member (or encoding
 590                   (cdr (assq 'encoding param))
 591                   )
 592               mime-view-uuencode-encoding-name-list)
 593       (save-excursion
 594         (or (if (re-search-forward "^begin [0-9]+ " nil t)
 595                 (if (looking-at ".+$")
 596                     (buffer-substring (match-beginning 0)(match-end 0))
 597                   ))
 598             ""))
 599     ))
 600
 601 (defun mime-article/get-subject (param &optional encoding)
 602   (or (std11-find-field-body '("Content-Description" "Subject"))
 603       (let (ret)
 604         (if (or (and (setq ret (mime/Content-Disposition))
 605                      (setq ret (assoc "filename" (cdr ret)))
 606                      )
 607                 (setq ret (assoc "name" param))
 608                 (setq ret (assoc "x-name" param))
 609                 )
 610             (std11-strip-quoted-string (cdr ret))
 611           ))
 612       (mime-article/get-uu-filename param encoding)
 613       ""))
 614
 615
 616 ;;; @ content information
 617 ;;;
 618
 619 (defun mime-article/point-content-number (p &optional cinfo)
 620   (or cinfo
 621       (setq cinfo mime::article/content-info)
 622       )
 623   (let ((b (mime::content-info/point-min cinfo))
 624         (e (mime::content-info/point-max cinfo))
 625         (c (mime::content-info/children cinfo))
 626         )
 627     (if (and (<= b p)(<= p e))
 628         (or (let (co ret (sn 0))
 629               (catch 'tag
 630                 (while c
 631                   (setq co (car c))
 632                   (setq ret (mime-article/point-content-number p co))
 633                   (cond ((eq ret t) (throw 'tag (list sn)))
 634                         (ret (throw 'tag (cons sn ret)))
 635                         )
 636                   (setq c (cdr c))
 637                   (setq sn (1+ sn))
 638                   )))
 639             t))))
 640
 641 (defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo)
 642   (or cinfo
 643       (setq cinfo mime::article/content-info)
 644       )
 645   (find-if (function
 646             (lambda (ci)
 647               (equal (mime::content-info/rcnum ci) rcnum)
 648               ))
 649            (mime/flatten-content-info cinfo)
 650            ))
 651
 652 (defun mime-article/cnum-to-cinfo (cn &optional cinfo)
 653   (or cinfo
 654       (setq cinfo mime::article/content-info)
 655       )
 656   (if (eq cn t)
 657       cinfo
 658     (let ((sn (car cn)))
 659       (if (null sn)
 660           cinfo
 661         (let ((rc (nth sn (mime::content-info/children cinfo))))
 662           (if rc
 663               (mime-article/cnum-to-cinfo (cdr cn) rc)
 664             ))
 665         ))))
 666
 667 (defun mime/flatten-content-info (&optional cinfo)
 668   (or cinfo
 669       (setq cinfo mime::article/content-info)
 670       )
 671   (let ((dest (list cinfo))
 672         (rcl (mime::content-info/children cinfo))
 673         )
 674     (while rcl
 675       (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
 676       (setq rcl (cdr rcl))
 677       )
 678     dest))
 679
 680
 681 ;;; @ MIME viewer mode
 682 ;;;
 683
 684 (defconst mime-view-menu-title "MIME-View")
 685 (defconst mime-view-menu-list
 686   '((up          "Move to upper content"      mime-view-move-to-upper)
 687     (previous    "Move to previous content"   mime-view-move-to-previous)
 688     (next        "Move to next content"       mime-view-move-to-next)
 689     (scroll-down "Scroll to previous content" mime-view-scroll-down-entity)
 690     (scroll-up   "Scroll to next content"     mime-view-scroll-up-entity)
 691     (play        "Play Content"               mime-view-play-current-entity)
 692     (extract     "Extract Content"            mime-view-extract-current-entity)
 693     (print       "Print"                      mime-view-print-current-entity)
 694     (x-face      "Show X Face"                mime-view-display-x-face)
 695     )
 696   "Menu for MIME Viewer")
 697
 698 (cond (running-xemacs
 699        (defvar mime-view-xemacs-popup-menu
 700          (cons mime-view-menu-title
 701                (mapcar (function
 702                         (lambda (item)
 703                           (vector (nth 1 item)(nth 2 item) t)
 704                           ))
 705                        mime-view-menu-list)))
 706        (defun mime-view-xemacs-popup-menu (event)
 707          "Popup the menu in the MIME Viewer buffer"
 708          (interactive "e")
 709          (select-window (event-window event))
 710          (set-buffer (event-buffer event))
 711          (popup-menu 'mime-view-xemacs-popup-menu))
 712        (defvar mouse-button-2 'button2)
 713        )
 714       (t
 715        (defvar mouse-button-2 [mouse-2])
 716        ))
 717
 718 (defun mime-view-define-keymap (&optional default)
 719   (let ((mime-view-mode-map (if (keymapp default)
 720                                 (copy-keymap default)
 721                               (make-sparse-keymap)
 722                               )))
 723     (define-key mime-view-mode-map
 724       "u"        (function mime-view-move-to-upper))
 725     (define-key mime-view-mode-map
 726       "p"        (function mime-view-move-to-previous))
 727     (define-key mime-view-mode-map
 728       "n"        (function mime-view-move-to-next))
 729     (define-key mime-view-mode-map
 730       "\e\t"     (function mime-view-move-to-previous))
 731     (define-key mime-view-mode-map
 732       "\t"       (function mime-view-move-to-next))
 733     (define-key mime-view-mode-map
 734       " "        (function mime-view-scroll-up-entity))
 735     (define-key mime-view-mode-map
 736       "\M- "     (function mime-view-scroll-down-entity))
 737     (define-key mime-view-mode-map
 738       "\177"     (function mime-view-scroll-down-entity))
 739     (define-key mime-view-mode-map
 740       "\C-m"     (function mime-view-next-line-content))
 741     (define-key mime-view-mode-map
 742       "\C-\M-m"  (function mime-view-previous-line-content))
 743     (define-key mime-view-mode-map
 744       "v"        (function mime-view-play-current-entity))
 745     (define-key mime-view-mode-map
 746       "e"        (function mime-view-extract-current-entity))
 747     (define-key mime-view-mode-map
 748       "\C-c\C-p" (function mime-view-print-current-entity))
 749     (define-key mime-view-mode-map
 750       "a"        (function mime-view-follow-current-entity))
 751     (define-key mime-view-mode-map
 752       "q"        (function mime-view-quit))
 753     (define-key mime-view-mode-map
 754       "h"        (function mime-view-show-summary))
 755     (define-key mime-view-mode-map
 756       "\C-c\C-x" (function mime-view-kill-buffer))
 757     (define-key mime-view-mode-map
 758       "<"        (function beginning-of-buffer))
 759     (define-key mime-view-mode-map
 760       ">"        (function end-of-buffer))
 761     (define-key mime-view-mode-map
 762       "?"        (function describe-mode))
 763     (if (functionp default)
 764         (setq mime-view-mode-map
 765               (append mime-view-mode-map (list (cons t default)))
 766               ))
 767     (if mouse-button-2
 768         (define-key mime-view-mode-map
 769           mouse-button-2 (function mime-button-dispatcher))
 770       )
 771     (cond (running-xemacs
 772            (define-key mime-view-mode-map
 773              mouse-button-3 (function mime-view-xemacs-popup-menu))
 774            )
 775           ((>= emacs-major-version 19)
 776            (define-key mime-view-mode-map [menu-bar mime-view]
 777              (cons mime-view-menu-title
 778                    (make-sparse-keymap mime-view-menu-title)))
 779            (mapcar (function
 780                     (lambda (item)
 781                       (define-key mime-view-mode-map
 782                         (vector 'menu-bar 'mime-view (car item))
 783                         (cons (nth 1 item)(nth 2 item))
 784                         )
 785                       ))
 786                    (reverse mime-view-menu-list)
 787                    )
 788            ))
 789     (use-local-map mime-view-mode-map)
 790     (run-hooks 'mime-view-define-keymap-hook)
 791     ))
 792
 793 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
 794                                  default-keymap-or-function)
 795   "Major mode for viewing MIME message.
 796
 797 Here is a list of the standard keys for mime-view-mode.
 798
 799 key             feature
 800 ---             -------
 801
 802 u               Move to upper content
 803 p or M-TAB      Move to previous content
 804 n or TAB        Move to next content
 805 SPC             Scroll up or move to next content
 806 M-SPC or DEL    Scroll down or move to previous content
 807 RET             Move to next line
 808 M-RET           Move to previous line
 809 v               Decode current content as `play mode'
 810 e               Decode current content as `extract mode'
 811 C-c C-p         Decode current content as `print mode'
 812 a               Followup to current content.
 813 x               Display X-Face
 814 q               Quit
 815 button-2        Move to point under the mouse cursor
 816                 and decode current content as `play mode'
 817 "
 818   (interactive)
 819   (let ((buf (get-buffer mime/output-buffer-name)))
 820     (if buf
 821         (save-excursion
 822           (set-buffer buf)
 823           (erase-buffer)
 824           )))
 825   (let ((ret (mime-view-setup-buffer ctl encoding ibuf obuf))
 826         (win-conf (current-window-configuration))
 827         )
 828     (prog1
 829         (switch-to-buffer (car ret))
 830       (setq mime::preview/original-window-configuration win-conf)
 831       (if mother
 832           (progn
 833             (setq mime::preview/mother-buffer mother)
 834             ))
 835       (mime-view-define-keymap default-keymap-or-function)
 836       (setq mime::preview/content-list (nth 1 ret))
 837       (let ((point (next-single-property-change (point-min) 'mime-view-cinfo)))
 838         (if point
 839             (goto-char point)
 840           (goto-char (point-min))
 841           (search-forward "\n\n" nil t)
 842           ))
 843       (run-hooks 'mime-view-mode-hook)
 844       )))
 845
 846 (autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t)
 847
 848 (defun mime-view-extract-current-entity ()
 849   "Extract current entity into file (maybe).
 850 It decodes current entity to call internal or external method as
 851 \"extract\" mode.  The method is selected from variable
 852 `mime/content-decoding-condition'."
 853   (interactive)
 854   (mime-view-play-current-entity "extract")
 855   )
 856
 857 (defun mime-view-print-current-entity ()
 858   "Print current entity (maybe).
 859 It decodes current entity to call internal or external method as
 860 \"print\" mode.  The method is selected from variable
 861 `mime/content-decoding-condition'."
 862   (interactive)
 863   (mime-view-play-current-entity "print")
 864   )
 865
 866 (defun mime-view-follow-current-entity ()
 867   "Write follow message to current entity.
 868 It calls following-method selected from variable
 869 `mime-view-following-method-alist'."
 870   (interactive)
 871   (let ((root-cinfo (get-text-property (point-min) 'mime-view-cinfo))
 872         cinfo)
 873     (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo)))
 874       (backward-char)
 875       )
 876     (let* ((p-beg (previous-single-property-change (point) 'mime-view-cinfo))
 877            p-end
 878            (rcnum (mime::content-info/rcnum cinfo))
 879            (len (length rcnum))
 880            rc)
 881       (cond ((null p-beg)
 882              (setq p-beg
 883                    (if (eq (next-single-property-change (point-min)
 884                                                         'mime-view-cinfo)
 885                            (point))
 886                        (point)
 887                      (point-min)))
 888              )
 889             ((eq (next-single-property-change p-beg 'mime-view-cinfo)
 890                  (point))
 891              (setq p-beg (point))
 892              ))
 893       (setq p-end (next-single-property-change p-beg 'mime-view-cinfo))
 894       (cond ((null p-end)
 895              (setq p-end (point-max))
 896              )
 897             ((null rcnum)
 898              (setq p-end (point-max))
 899              )
 900             (t
 901              (save-excursion
 902                (goto-char p-end)
 903                (catch 'tag
 904                  (let (e)
 905                    (while (setq e
 906                                 (next-single-property-change
 907                                  (point) 'mime-view-cinfo))
 908                      (goto-char e)
 909                      (let ((rc (mime::content-info/rcnum
 910                                 (get-text-property (point)
 911                                                    'mime-view-cinfo))))
 912                        (or (equal rcnum (nthcdr (- (length rc) len) rc))
 913                            (throw 'tag nil)
 914                            ))
 915                      (setq p-end e)
 916                      ))
 917                  (setq p-end (point-max))
 918                  ))
 919              ))
 920       (let* ((mode (mime-preview/get-original-major-mode))
 921              (new-name (format "%s-%s" (buffer-name) (reverse rcnum)))
 922              new-buf
 923              (the-buf (current-buffer))
 924              (a-buf mime::preview/article-buffer)
 925              fields)
 926         (save-excursion
 927           (set-buffer (setq new-buf (get-buffer-create new-name)))
 928           (erase-buffer)
 929           (insert-buffer-substring the-buf p-beg p-end)
 930           (goto-char (point-min))
 931           (if (mime-view-header-visible-p rcnum root-cinfo)
 932               (delete-region (goto-char (point-min))
 933                              (if (re-search-forward "^$" nil t)
 934                                  (match-end 0)
 935                                (point-min)))
 936             )
 937           (goto-char (point-min))
 938           (insert "\n")
 939           (goto-char (point-min))
 940           (let ((rcnum (mime::content-info/rcnum cinfo)) ci str)
 941             (while (progn
 942                      (setq str
 943                            (save-excursion
 944                              (set-buffer a-buf)
 945                              (setq ci (mime-article/rcnum-to-cinfo rcnum))
 946                              (save-restriction
 947                                (narrow-to-region
 948                                 (mime::content-info/point-min ci)
 949                                 (mime::content-info/point-max ci)
 950                                 )
 951                                (std11-header-string-except
 952                                 (concat "^"
 953                                         (apply (function regexp-or) fields)
 954                                         ":") ""))))
 955                      (if (string= (mime::content-info/type ci)
 956                                   "message/rfc822")
 957                          nil
 958                        (if str
 959                            (insert str)
 960                          )
 961                        rcnum))
 962               (setq fields (std11-collect-field-names)
 963                     rcnum (cdr rcnum))
 964               )
 965             )
 966           (let ((rest mime-view-following-required-fields-list))
 967             (while rest
 968               (let ((field-name (car rest)))
 969                 (or (std11-field-body field-name)
 970                     (insert
 971                      (format
 972                       (concat field-name
 973                               ": "
 974                               (save-excursion
 975                                 (set-buffer the-buf)
 976                                 (set-buffer mime::preview/mother-buffer)
 977                                 (set-buffer mime::preview/article-buffer)
 978                                 (std11-field-body field-name)
 979                                 )
 980                               "\n")))
 981                     ))
 982               (setq rest (cdr rest))
 983               ))
 984           (eword-decode-header)
 985           )
 986         (let ((f (cdr (assq mode mime-view-following-method-alist))))
 987           (if (functionp f)
 988               (funcall f new-buf)
 989             (message
 990              (format
 991               "Sorry, following method for %s is not implemented yet."
 992               mode))
 993             ))
 994         ))))
 995
 996 (defun mime-view-display-x-face ()
 997   (interactive)
 998   (save-window-excursion
 999     (set-buffer mime::preview/article-buffer)
1000     (mime-view-x-face-function)
1001     ))
1002
1003 (defun mime-view-move-to-upper ()
1004   "Move to upper entity.
1005 If there is no upper entity, call function `mime-view-quit'."
1006   (interactive)
1007   (let (cinfo)
1008     (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo)))
1009       (backward-char)
1010       )
1011     (let ((r (mime-article/rcnum-to-cinfo
1012               (cdr (mime::content-info/rcnum cinfo))
1013               (get-text-property 1 'mime-view-cinfo)))
1014           point)
1015       (catch 'tag
1016         (while (setq point (previous-single-property-change
1017                             (point) 'mime-view-cinfo))
1018           (goto-char point)
1019           (if (eq r (get-text-property (point) 'mime-view-cinfo))
1020               (throw 'tag t)
1021             )
1022           )
1023         (mime-view-quit)
1024         ))))
1025
1026 (defun mime-view-move-to-previous ()
1027   "Move to previous entity.
1028 If there is no previous entity, it calls function registered in
1029 variable `mime-view-over-to-previous-method-alist'."
1030   (interactive)
1031   (while (null (get-text-property (point) 'mime-view-cinfo))
1032     (backward-char)
1033     )
1034   (let ((point (previous-single-property-change (point) 'mime-view-cinfo)))
1035     (if point
1036         (goto-char point)
1037       (let ((f (assq mime::preview/original-major-mode
1038                      mime-view-over-to-previous-method-alist)))
1039         (if f
1040             (funcall (cdr f))
1041           ))
1042       )))
1043
1044 (defun mime-view-move-to-next ()
1045   "Move to next entity.
1046 If there is no previous entity, it calls function registered in
1047 variable `mime-view-over-to-next-method-alist'."
1048   (interactive)
1049   (let ((point (next-single-property-change (point) 'mime-view-cinfo)))
1050     (if point
1051         (goto-char point)
1052       (let ((f (assq mime::preview/original-major-mode
1053                      mime-view-over-to-next-method-alist)))
1054         (if f
1055             (funcall (cdr f))
1056           ))
1057       )))
1058
1059 (defun mime-view-scroll-up-entity (&optional h)
1060   "Scroll up current entity.
1061 If reached to (point-max), it calls function registered in variable
1062 `mime-view-over-to-next-method-alist'."
1063   (interactive)
1064   (or h
1065       (setq h (1- (window-height)))
1066       )
1067   (if (= (point) (point-max))
1068       (let ((f (assq mime::preview/original-major-mode
1069                      mime-view-over-to-next-method-alist)))
1070         (if f
1071             (funcall (cdr f))
1072           ))
1073     (let ((point
1074            (or (next-single-property-change (point) 'mime-view-cinfo)
1075                (point-max))))
1076       (forward-line h)
1077       (if (> (point) point)
1078           (goto-char point)
1079         )
1080       )))
1081
1082 (defun mime-view-scroll-down-entity (&optional h)
1083   "Scroll down current entity.
1084 If reached to (point-min), it calls function registered in variable
1085 `mime-view-over-to-previous-method-alist'."
1086   (interactive)
1087   (or h
1088       (setq h (1- (window-height)))
1089       )
1090   (if (= (point) (point-min))
1091       (let ((f (assq mime::preview/original-major-mode
1092                      mime-view-over-to-previous-method-alist)))
1093         (if f
1094             (funcall (cdr f))
1095           ))
1096     (let (point)
1097       (save-excursion
1098         (catch 'tag
1099           (while (> (point) 1)
1100             (if (setq point
1101                       (previous-single-property-change (point)
1102                                                        'mime-view-cinfo))
1103                 (throw 'tag t)
1104               )
1105             (backward-char)
1106             )
1107           (setq point (point-min))
1108           ))
1109       (forward-line (- h))
1110       (if (< (point) point)
1111           (goto-char point)
1112         ))))
1113
1114 (defun mime-view-next-line-content ()
1115   (interactive)
1116   (mime-view-scroll-up-entity 1)
1117   )
1118
1119 (defun mime-view-previous-line-content ()
1120   (interactive)
1121   (mime-view-scroll-down-entity 1)
1122   )
1123
1124 (defun mime-view-quit ()
1125   "Quit from MIME-View buffer.
1126 It calls function registered in variable
1127 `mime-view-quitting-method-alist'."
1128   (interactive)
1129   (let ((r (assq mime::preview/original-major-mode
1130                  mime-view-quitting-method-alist)))
1131     (if r
1132         (funcall (cdr r))
1133       )))
1134
1135 (defun mime-view-show-summary ()
1136   "Show summary.
1137 It calls function registered in variable
1138 `mime-view-show-summary-method'."
1139   (interactive)
1140   (let ((r (assq mime::preview/original-major-mode
1141                  mime-view-show-summary-method)))
1142     (if r
1143         (funcall (cdr r))
1144       )))
1145
1146 (defun mime-view-kill-buffer ()
1147   (interactive)
1148   (kill-buffer (current-buffer))
1149   )
1150
1151
1152 ;;; @ end
1153 ;;;
1154
1155 (provide 'mime-view)
1156
1157 (run-hooks 'mime-view-load-hook)
1158
1159 ;;; mime-view.el ends here