tm-play.el

   1 ;;;
   2 ;;; tm-play.el --- decoder for tm-view.el
   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 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   9 ;;; Created: 1995/9/26 (separated from tm-view.el)
  10 ;;; Version:
  11 ;;;     $Id: tm-play.el,v 7.5 1995/12/07 08:01:31 morioka Exp $
  12 ;;; Keywords: mail, news, MIME, multimedia
  13 ;;;
  14 ;;; This file is part of tm (Tools for MIME).
  15 ;;;
  16 ;;; This program is free software; you can redistribute it and/or
  17 ;;; modify it under the terms of the GNU General Public License as
  18 ;;; published by the Free Software Foundation; either version 2, or
  19 ;;; (at your option) any later version.
  20 ;;;
  21 ;;; This program is distributed in the hope that it will be useful,
  22 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  24 ;;; General Public License for more details.
  25 ;;;
  26 ;;; You should have received a copy of the GNU General Public License
  27 ;;; along with This program.  If not, write to the Free Software
  28 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  29 ;;;
  30 ;;; Code:
  31
  32 (require 'tm-view)
  33
  34
  35 ;;; @ content decoder
  36 ;;;
  37
  38 (defvar mime-preview/after-decoded-position nil)
  39
  40 (defun mime-preview/decode-content ()
  41   (interactive)
  42   (let ((pc (mime::point-preview-content (point))))
  43     (if pc
  44         (let ((the-buf (current-buffer)))
  45           (setq mime-preview/after-decoded-position (point))
  46           (set-buffer (mime::preview-content-info/buffer pc))
  47           (mime-article/decode-content
  48            (mime::preview-content-info/content-info pc))
  49           (if (eq (current-buffer)
  50                   (mime::preview-content-info/buffer pc))
  51               (progn
  52                 (set-buffer the-buf)
  53                 (goto-char mime-preview/after-decoded-position)
  54                 ))
  55           ))))
  56
  57
  58 (defun mime-article/decode-content (cinfo)
  59   (let ((beg (mime::content-info/point-min cinfo))
  60         (end (mime::content-info/point-max cinfo))
  61         (ctype (mime::content-info/type cinfo))
  62         (params (mime::content-info/parameters cinfo))
  63         (encoding (mime::content-info/encoding cinfo))
  64         )
  65     (if ctype
  66         (let (method cal ret)
  67           (setq cal (append (list (cons 'type ctype)
  68                                   (cons 'encoding encoding)
  69                                   (cons 'major-mode major-mode)
  70                                   )
  71                             params))
  72           (if mime-viewer/decoding-mode
  73               (setq cal (cons
  74                          (cons 'mode mime-viewer/decoding-mode)
  75                          cal))
  76             )
  77           (setq ret (mime/get-content-decoding-alist cal))
  78           (setq method (cdr (assoc 'method ret)))
  79           (cond ((and (symbolp method)
  80                       (fboundp method))
  81                  (funcall method beg end ret)
  82                  )
  83                 ((and (listp method)(stringp (car method)))
  84                  (mime-article/start-external-method-region beg end ret)
  85                  )
  86                 (t
  87                  (mime-article/show-output-buffer
  88                   "No method are specified for %s\n" ctype)
  89                  ))
  90           ))
  91     ))
  92
  93 (defun mime/get-content-decoding-alist (al)
  94   (get-unified-alist mime/content-decoding-condition al)
  95   )
  96
  97
  98 ;;; @ external decoder
  99 ;;;
 100
 101 (defun mime-article/start-external-method-region (beg end cal)
 102   (save-excursion
 103     (save-restriction
 104       (narrow-to-region beg end)
 105       (goto-char beg)
 106       (let ((method (cdr (assoc 'method cal)))
 107             (name (mime-article/get-name cal))
 108             )
 109         (if method
 110             (let ((file (make-temp-name
 111                          (expand-file-name "TM" mime/tmp-dir)))
 112                   b args)
 113               (if (nth 1 method)
 114                   (setq b beg)
 115                 (setq b
 116                       (if (re-search-forward "^$" nil t)
 117                           (1+ (match-end 0))
 118                         (point-min)
 119                         ))
 120                 )
 121               (goto-char b)
 122               (write-region b end file)
 123               (setq cal (put-alist
 124                          'name (replace-as-filename name) cal))
 125               (setq cal (put-alist 'file file cal))
 126               (setq args (nconc
 127                           (list (car method)
 128                                 mime/output-buffer-name (car method)
 129                                 )
 130                           (mime-article/make-method-args cal
 131                                                          (cdr (cdr method)))
 132                           ))
 133               (apply (function start-process) args)
 134               (mime-article/show-output-buffer)
 135               ))
 136         ))))
 137
 138 (defun mime-article/make-method-args (cal format)
 139   (mapcar (function
 140            (lambda (arg)
 141              (if (stringp arg)
 142                  arg
 143                (let ((ret (cdr (assoc (eval arg) cal))))
 144                  (if ret
 145                      ret
 146                    "")
 147                  ))
 148              ))
 149           format))
 150
 151 (defun mime-article/show-output-buffer (&rest forms)
 152   (let ((the-win (selected-window))
 153         (win (get-buffer-window mime/output-buffer-name))
 154         )
 155     (if (null win)
 156         (progn
 157           (setq win (split-window-vertically (/ (* (window-height) 3) 4)))
 158           (set-window-buffer win mime/output-buffer-name)
 159           ))
 160     (select-window win)
 161     (goto-char (point-max))
 162     (if forms
 163         (insert (apply (function format) forms))
 164       )
 165     (select-window the-win)
 166     ))
 167
 168
 169 ;;; @ file name
 170 ;;;
 171
 172 (defvar mime-viewer/file-name-char-regexp "[A-Za-z0-9+_-]")
 173
 174 (defvar mime-viewer/file-name-regexp-1
 175   (concat mime-viewer/file-name-char-regexp "+\\."
 176           mime-viewer/file-name-char-regexp "+"))
 177
 178 (defvar mime-viewer/file-name-regexp-2
 179   (concat (regexp-* mime-viewer/file-name-char-regexp)
 180           "\\(\\." mime-viewer/file-name-char-regexp "+\\)*"))
 181
 182 (defun mime-article/get-name (param)
 183   (let ((str (mime-viewer/get-subject param)))
 184     (if (string-match " " str)
 185         (if (or (string-match mime-viewer/file-name-regexp-1 str)
 186                 (string-match mime-viewer/file-name-regexp-2 str))
 187             (substring str (match-beginning 0)(match-end 0))
 188           )
 189       (replace-as-filename str)
 190       )))
 191
 192
 193 ;;; @ mail/news message
 194 ;;;
 195
 196 (defun mime-viewer/quitting-method-for-mime/show-message-mode ()
 197   (let ((mother mime::preview/mother-buffer)
 198         (win-conf mime::preview/original-window-configuration)
 199         )
 200     (kill-buffer
 201      (mime::preview-content-info/buffer (car mime::preview/content-list)))
 202     (mime-viewer/kill-buffer)
 203     (set-window-configuration win-conf)
 204     (pop-to-buffer mother)
 205     ;;(goto-char (point-min))
 206     ;;(mime-viewer/up-content)
 207     ))
 208
 209 (defun mime-article/view-message/rfc822 (beg end cal)
 210   (let* ((cnum (mime-article/point-content-number beg))
 211          (cur-buf (current-buffer))
 212          (new-name (format "%s-%s" (buffer-name) cnum))
 213          (mother mime::article/preview-buffer)
 214          (code-converter
 215           (or (cdr (assq major-mode mime-viewer/code-converter-alist))
 216               'mime-viewer/default-code-convert-region))
 217          str)
 218     (setq str (buffer-substring beg end))
 219     (switch-to-buffer new-name)
 220     (erase-buffer)
 221     (insert str)
 222     (goto-char (point-min))
 223     (if (re-search-forward "^\n" nil t)
 224         (delete-region (point-min) (match-end 0))
 225       )
 226     (setq major-mode 'mime/show-message-mode)
 227     (setq mime::article/code-converter code-converter)
 228     (mime/viewer-mode mother)
 229     ))
 230
 231
 232 ;;; @ message/partial
 233 ;;;
 234
 235 (defvar mime-article/coding-system-alist
 236   (and (boundp 'MULE)
 237        '((mh-show-mode . *noconv*)
 238          (t            . *ctext*)
 239          )))
 240
 241 (defvar mime-article/kanji-code-alist
 242   (and (boundp 'NEMACS)
 243        '((mh-show-mode . nil)
 244          (t            . 2)
 245          )))
 246
 247 (defun mime-article/decode-message/partial (beg end cal)
 248   (goto-char beg)
 249   (let* ((root-dir (expand-file-name
 250                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 251          (id (cdr (assoc "id" cal)))
 252          (number (cdr (assoc "number" cal)))
 253          (total (cdr (assoc "total" cal)))
 254          (the-buf (current-buffer))
 255          file
 256          (mother mime::article/preview-buffer)
 257          (win-conf (save-excursion
 258                      (set-buffer mother)
 259                      mime::preview/original-window-configuration))
 260          )
 261     (if (not (file-exists-p root-dir))
 262         (make-directory root-dir)
 263       )
 264     (setq id (replace-as-filename id))
 265     (setq root-dir (concat root-dir "/" id))
 266     (if (not (file-exists-p root-dir))
 267         (make-directory root-dir)
 268       )
 269     (setq file (concat root-dir "/FULL"))
 270     (if (not (file-exists-p file))
 271         (progn
 272           (re-search-forward "^$")
 273           (goto-char (1+ (match-end 0)))
 274           (setq file (concat root-dir "/" number))
 275           (let ((file-coding-system
 276                  (cdr
 277                   (or (assq major-mode mime-article/coding-system-alist)
 278                       (assq t mime-article/coding-system-alist)
 279                       )))
 280                 (kanji-fileio-code
 281                  (cdr
 282                   (or (assq major-mode mime-article/kanji-code-alist)
 283                       (assq t mime-article/kanji-code-alist)
 284                       )))
 285                 )
 286             (write-region (point) (point-max) file)
 287             )
 288           (if (get-buffer "*MIME-temp*")
 289               (kill-buffer "*MIME-temp*")
 290             )
 291           (switch-to-buffer "*MIME-temp*")
 292           (let ((i 1)
 293                 (max (string-to-int total))
 294                 (file-coding-system-for-read (if (boundp 'MULE)
 295                                                  *noconv*))
 296                 kanji-fileio-code)
 297             (catch 'tag
 298               (while (<= i max)
 299                 (setq file (concat root-dir "/" (int-to-string i)))
 300                 (if (not (file-exists-p file))
 301                     (progn
 302                       (switch-to-buffer the-buf)
 303                       (throw 'tag nil)
 304                       ))
 305                 (insert-file-contents file)
 306                 (goto-char (point-max))
 307                 (setq i (1+ i))
 308                 )
 309               ;;(delete-other-windows)
 310               (let ((buf (current-buffer)))
 311                 (write-file (concat root-dir "/FULL"))
 312                 (set-window-configuration win-conf)
 313                 (let ((win (get-buffer-window mother)))
 314                   (if win
 315                       (select-window win)
 316                     ))
 317                 (set-window-buffer (selected-window) buf)
 318                 ;;(set-window-buffer buf)
 319                 (setq major-mode 'mime/show-message-mode)
 320                 )
 321               (mime/viewer-mode mother)
 322               (pop-to-buffer (current-buffer))
 323               ))
 324           )
 325       (progn
 326         ;;(delete-other-windows)
 327         (set-window-configuration win-conf)
 328         (select-window (get-buffer-window mother))
 329         (let ((file-coding-system-for-read
 330                (if (boundp 'MULE) *noconv*))
 331               kanji-fileio-code)
 332           (find-file file)
 333           )
 334         (setq major-mode 'mime/show-message-mode)
 335         (mime/viewer-mode mother)
 336         ;;(pop-to-buffer (current-buffer))
 337         ))
 338     ))
 339
 340
 341 ;;; @ rot13-47
 342 ;;;
 343
 344 (defun mime-article/decode-caesar (beg end cal)
 345   (let* ((cnum (mime-article/point-content-number beg))
 346          (cur-buf (current-buffer))
 347          (new-name (format "%s-%s" (buffer-name) cnum))
 348          (mother mime::article/preview-buffer)
 349          (charset (cdr (assoc "charset" cal)))
 350          (encoding (cdr (assoc "encoding" cal)))
 351          (mode major-mode)
 352          str)
 353     (setq str (buffer-substring beg end))
 354     (switch-to-buffer new-name)
 355     (setq buffer-read-only nil)
 356     (erase-buffer)
 357     (insert str)
 358     (goto-char (point-min))
 359     (if (re-search-forward "^\n" nil t)
 360         (delete-region (point-min) (match-end 0))
 361       )
 362     (let ((m (assq mode mime-viewer/code-converter-alist)))
 363       (if (and m (fboundp (setq m (cdr m))))
 364           (funcall m (point-min) (point-max) charset encoding)
 365         (mime-viewer/default-code-convert-region (point-min) (point-max)
 366                                                  charset encoding)
 367         ))
 368     (save-excursion
 369       (set-mark (point-min))
 370       (goto-char (point-max))
 371       (tm:caesar-region)
 372       )
 373     (view-mode)
 374     ))
 375
 376
 377 ;;; @ end
 378 ;;;
 379
 380 (provide 'tm-play)