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.4 1995/12/06 12:45:52 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          str)
 215     (setq str (buffer-substring beg end))
 216     (switch-to-buffer new-name)
 217     (erase-buffer)
 218     (insert str)
 219     (goto-char (point-min))
 220     (if (re-search-forward "^\n" nil t)
 221         (delete-region (point-min) (match-end 0))
 222       )
 223     (setq major-mode 'mime/show-message-mode)
 224     (mime/viewer-mode mother)
 225     ))
 226
 227
 228 ;;; @ message/partial
 229 ;;;
 230
 231 (defvar mime-article/coding-system-alist
 232   (and (boundp 'MULE)
 233        '((mh-show-mode . *noconv*)
 234          (t            . *ctext*)
 235          )))
 236
 237 (defvar mime-article/kanji-code-alist
 238   (and (boundp 'NEMACS)
 239        '((mh-show-mode . nil)
 240          (t            . 2)
 241          )))
 242
 243 (defun mime-article/decode-message/partial (beg end cal)
 244   (goto-char beg)
 245   (let* ((root-dir (expand-file-name
 246                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 247          (id (cdr (assoc "id" cal)))
 248          (number (cdr (assoc "number" cal)))
 249          (total (cdr (assoc "total" cal)))
 250          (the-buf (current-buffer))
 251          file
 252          (mother mime::article/preview-buffer)
 253          (win-conf (save-excursion
 254                      (set-buffer mother)
 255                      mime::preview/original-window-configuration))
 256          )
 257     (if (not (file-exists-p root-dir))
 258         (make-directory root-dir)
 259       )
 260     (setq id (replace-as-filename id))
 261     (setq root-dir (concat root-dir "/" id))
 262     (if (not (file-exists-p root-dir))
 263         (make-directory root-dir)
 264       )
 265     (setq file (concat root-dir "/FULL"))
 266     (if (not (file-exists-p file))
 267         (progn
 268           (re-search-forward "^$")
 269           (goto-char (1+ (match-end 0)))
 270           (setq file (concat root-dir "/" number))
 271           (let ((file-coding-system
 272                  (cdr
 273                   (or (assq major-mode mime-article/coding-system-alist)
 274                       (assq t mime-article/coding-system-alist)
 275                       )))
 276                 (kanji-fileio-code
 277                  (cdr
 278                   (or (assq major-mode mime-article/kanji-code-alist)
 279                       (assq t mime-article/kanji-code-alist)
 280                       )))
 281                 )
 282             (write-region (point) (point-max) file)
 283             )
 284           (if (get-buffer "*MIME-temp*")
 285               (kill-buffer "*MIME-temp*")
 286             )
 287           (switch-to-buffer "*MIME-temp*")
 288           (let ((i 1)
 289                 (max (string-to-int total))
 290                 (file-coding-system-for-read (if (boundp 'MULE)
 291                                                  *noconv*))
 292                 kanji-fileio-code)
 293             (catch 'tag
 294               (while (<= i max)
 295                 (setq file (concat root-dir "/" (int-to-string i)))
 296                 (if (not (file-exists-p file))
 297                     (progn
 298                       (switch-to-buffer the-buf)
 299                       (throw 'tag nil)
 300                       ))
 301                 (insert-file-contents file)
 302                 (goto-char (point-max))
 303                 (setq i (1+ i))
 304                 )
 305               ;;(delete-other-windows)
 306               (let ((buf (current-buffer)))
 307                 (write-file (concat root-dir "/FULL"))
 308                 (set-window-configuration win-conf)
 309                 (let ((win (get-buffer-window mother)))
 310                   (if win
 311                       (select-window win)
 312                     ))
 313                 (set-window-buffer (selected-window) buf)
 314                 ;;(set-window-buffer buf)
 315                 (setq major-mode 'mime/show-message-mode)
 316                 )
 317               (mime/viewer-mode mother)
 318               (pop-to-buffer (current-buffer))
 319               ))
 320           )
 321       (progn
 322         ;;(delete-other-windows)
 323         (set-window-configuration win-conf)
 324         (select-window (get-buffer-window mother))
 325         (let ((file-coding-system-for-read
 326                (if (boundp 'MULE) *noconv*))
 327               kanji-fileio-code)
 328           (find-file file)
 329           )
 330         (setq major-mode 'mime/show-message-mode)
 331         (mime/viewer-mode mother)
 332         ;;(pop-to-buffer (current-buffer))
 333         ))
 334     ))
 335
 336
 337 ;;; @ rot13-47
 338 ;;;
 339
 340 (defun mime-article/decode-caesar (beg end cal)
 341   (let* ((cnum (mime-article/point-content-number beg))
 342          (cur-buf (current-buffer))
 343          (new-name (format "%s-%s" (buffer-name) cnum))
 344          (mother mime::article/preview-buffer)
 345          (charset (cdr (assoc "charset" cal)))
 346          (encoding (cdr (assoc "encoding" cal)))
 347          (mode major-mode)
 348          str)
 349     (setq str (buffer-substring beg end))
 350     (switch-to-buffer new-name)
 351     (setq buffer-read-only nil)
 352     (erase-buffer)
 353     (insert str)
 354     (goto-char (point-min))
 355     (if (re-search-forward "^\n" nil t)
 356         (delete-region (point-min) (match-end 0))
 357       )
 358     (let ((m (assq mode mime-viewer/code-converter-alist)))
 359       (if (and m (fboundp (setq m (cdr m))))
 360           (funcall m (point-min) (point-max) charset encoding)
 361         (mime-viewer/default-code-convert-region (point-min) (point-max)
 362                                                  charset encoding)
 363         ))
 364     (save-excursion
 365       (set-mark (point-min))
 366       (goto-char (point-max))
 367       (tm:caesar-region)
 368       )
 369     (view-mode)
 370     ))
 371
 372
 373 ;;; @ end
 374 ;;;
 375
 376 (provide 'tm-play)