Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-play.el @ 18:d95e72db5c07 r19-15b92

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b92
author cvs
date Mon, 13 Aug 2007 08:49:43 +0200
parents 4b173ad71786
children 859a2309aef8
comparison
equal deleted inserted replaced
17:4579af9d8826 18:d95e72db5c07
1 ;;; tm-play.el --- decoder for tm-view.el 1 ;;; tm-play.el --- decoder for tm-view.el
2 2
3 ;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc.
4 4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Created: 1995/9/26 (separated from tm-view.el) 6 ;; Created: 1995/9/26 (separated from tm-view.el)
7 ;; Version: $Id: tm-play.el,v 1.2 1996/12/22 00:29:41 steve Exp $ 7 ;; Version: $Id: tm-play.el,v 1.3 1997/02/04 02:36:07 steve Exp $
8 ;; Keywords: mail, news, MIME, multimedia 8 ;; Keywords: mail, news, MIME, multimedia
9 9
10 ;; This file is part of tm (Tools for MIME). 10 ;; This file is part of tm (Tools for MIME).
11 11
12 ;; This program is free software; you can redistribute it and/or 12 ;; This program is free software; you can redistribute it and/or
267 267
268 ;;; @ message/partial 268 ;;; @ message/partial
269 ;;; 269 ;;;
270 270
271 (defvar mime-article/coding-system-alist 271 (defvar mime-article/coding-system-alist
272 (and (boundp 'MULE) 272 (list (cons 'mh-show-mode *noconv*)
273 '((mh-show-mode . *noconv*) 273 (cons t (mime-charset-to-coding-system default-mime-charset))
274 (t . *ctext*) 274 ))
275 ))) 275
276 276 (cond (running-mule-merged-emacs
277 (defvar mime-article/kanji-code-alist 277 (defun mime-article::write-region (start end file)
278 (and (boundp 'NEMACS) 278 (let ((coding-system-for-write
279 '((mh-show-mode . nil) 279 (cdr
280 (t . 2) 280 (or (assq major-mode mime-article/coding-system-alist)
281 ))) 281 (assq t mime-article/coding-system-alist)
282 ))))
283 (write-region start end file)
284 ))
285 )
286 ((or (boundp 'MULE)
287 running-xemacs-with-mule)
288 (defun mime-article::write-region (start end file)
289 (let ((file-coding-system
290 (cdr
291 (or (assq major-mode mime-article/coding-system-alist)
292 (assq t mime-article/coding-system-alist)
293 ))))
294 (write-region start end file)
295 ))
296 )
297 ((boundp 'NEMACS)
298 (defun mime-article::write-region (start end file)
299 (let ((kanji-fileio-code
300 (cdr
301 (or (assq major-mode mime-article/kanji-code-alist)
302 (assq t mime-article/kanji-code-alist)
303 ))))
304 (write-region start end file)
305 ))
306 )
307 (t
308 (defalias 'mime-article::write-region 'write-region)
309 ))
282 310
283 (defun mime-article/decode-message/partial (beg end cal) 311 (defun mime-article/decode-message/partial (beg end cal)
284 (goto-char beg) 312 (goto-char beg)
285 (let* ((root-dir (expand-file-name 313 (let* ((root-dir (expand-file-name
286 (concat "m-prts-" (user-login-name)) mime/tmp-dir)) 314 (concat "m-prts-" (user-login-name)) mime/tmp-dir))
287 (id (cdr (assoc "id" cal))) 315 (id (cdr (assoc "id" cal)))
288 (number (cdr (assoc "number" cal))) 316 (number (cdr (assoc "number" cal)))
289 (total (cdr (assoc "total" cal))) 317 (total (cdr (assoc "total" cal)))
290 (the-buf (current-buffer))
291 file 318 file
292 (mother mime::article/preview-buffer) 319 (mother mime::article/preview-buffer)
293 (win-conf (save-excursion 320 )
294 (set-buffer mother) 321 (or (file-exists-p root-dir)
295 mime::preview/original-window-configuration))
296 )
297 (if (not (file-exists-p root-dir))
298 (make-directory root-dir) 322 (make-directory root-dir)
299 ) 323 )
300 (setq id (replace-as-filename id)) 324 (setq id (replace-as-filename id))
301 (setq root-dir (concat root-dir "/" id)) 325 (setq root-dir (concat root-dir "/" id))
302 (if (not (file-exists-p root-dir)) 326 (or (file-exists-p root-dir)
303 (make-directory root-dir) 327 (make-directory root-dir)
304 ) 328 )
305 (setq file (concat root-dir "/FULL")) 329 (setq file (concat root-dir "/FULL"))
306 (if (not (file-exists-p file)) 330 (if (file-exists-p file)
307 (progn 331 (let ((full-buf (get-buffer-create "FULL"))
308 (re-search-forward "^$") 332 (pwin (or (get-buffer-window mother)
309 (goto-char (1+ (match-end 0))) 333 (get-largest-window)))
310 (setq file (concat root-dir "/" number)) 334 )
311 (let ((file-coding-system 335 (save-window-excursion
312 (cdr 336 (set-buffer full-buf)
313 (or (assq major-mode mime-article/coding-system-alist) 337 (erase-buffer)
314 (assq t mime-article/coding-system-alist) 338 (as-binary-input-file (insert-file-contents file))
315 ))) 339 (setq major-mode 'mime/show-message-mode)
316 (kanji-fileio-code 340 (mime/viewer-mode mother)
317 (cdr
318 (or (assq major-mode mime-article/kanji-code-alist)
319 (assq t mime-article/kanji-code-alist)
320 )))
321 )
322 (write-region (point) (point-max) file)
323 ) 341 )
324 (if (get-buffer mime/temp-buffer-name) 342 (set-window-buffer pwin
325 (kill-buffer mime/temp-buffer-name) 343 (save-excursion
326 ) 344 (set-buffer full-buf)
327 (switch-to-buffer mime/temp-buffer-name) 345 mime::article/preview-buffer))
328 (let ((i 1) 346 (select-window pwin)
329 (max (string-to-int total)) 347 )
330 (file-coding-system-for-read (if (boundp 'MULE) 348 (re-search-forward "^$")
331 *noconv*)) 349 (goto-char (1+ (match-end 0)))
332 kanji-fileio-code) 350 (setq file (concat root-dir "/" number))
333 (catch 'tag 351 (mime-article::write-region (point) (point-max) file)
334 (while (<= i max) 352 (let ((total-file (concat root-dir "/CT")))
335 (setq file (concat root-dir "/" (int-to-string i))) 353 (setq total
336 (if (not (file-exists-p file)) 354 (if total
337 (progn 355 (progn
338 (switch-to-buffer the-buf) 356 (or (file-exists-p total-file)
339 (throw 'tag nil) 357 (save-excursion
340 )) 358 (set-buffer (find-file-noselect total-file))
341 (insert-file-contents file) 359 (erase-buffer)
342 (goto-char (point-max)) 360 (insert total)
343 (setq i (1+ i)) 361 (save-buffer)
344 ) 362 (kill-buffer (current-buffer))
345 ;;(delete-other-windows) 363 ))
346 (let ((buf (current-buffer))) 364 (string-to-number total)
347 (write-file (concat root-dir "/FULL")) 365 )
348 (set-window-configuration win-conf) 366 (and (file-exists-p total-file)
349 (let ((win (get-buffer-window mother))) 367 (save-excursion
350 (if win 368 (set-buffer (find-file-noselect total-file))
351 (select-window win) 369 (and (re-search-forward "[0-9]+" nil t)
370 (string-to-number
371 (buffer-substring (match-beginning 0)
372 (match-end 0)))
373 )
374 (kill-buffer (current-buffer))
375 ))
376 )))
377 (if (and total (> total 0))
378 (catch 'tag
379 (save-excursion
380 (set-buffer (get-buffer-create mime/temp-buffer-name))
381 (let ((full-buf (current-buffer)))
382 (erase-buffer)
383 (let ((i 1))
384 (while (<= i total)
385 (setq file (concat root-dir "/" (int-to-string i)))
386 (if (not (file-exists-p file))
387 (throw 'tag nil)
388 )
389 (as-binary-input-file (insert-file-contents file))
390 (goto-char (point-max))
391 (setq i (1+ i))
352 )) 392 ))
353 (set-window-buffer (selected-window) buf) 393 (as-binary-output-file (write-file (concat root-dir "/FULL")))
354 ;;(set-window-buffer buf) 394 (let ((i 1))
355 (setq major-mode 'mime/show-message-mode) 395 (while (<= i total)
356 ) 396 (let ((file (format "%s/%d" root-dir i)))
357 (mime/viewer-mode mother) 397 (and (file-exists-p file)
358 (pop-to-buffer (current-buffer)) 398 (delete-file file)
359 ))
360 )
361 (progn
362 ;;(delete-other-windows)
363 (set-window-configuration win-conf)
364 (select-window (or (get-buffer-window mother)
365 (get-buffer-window
366 (save-excursion
367 (set-buffer mother)
368 mime::preview/article-buffer))
369 (get-largest-window)
370 )) 399 ))
371 (as-binary-input-file 400 (setq i (1+ i))
372 (set-buffer (get-buffer-create "FULL")) 401 ))
373 (insert-file-contents file) 402 (let ((file (expand-file-name "CT" root-dir)))
374 ) 403 (and (file-exists-p file)
375 (setq major-mode 'mime/show-message-mode) 404 (delete-file file)
376 (mime/viewer-mode mother) 405 ))
377 ;;(pop-to-buffer (current-buffer)) 406 (save-window-excursion
378 )) 407 (setq major-mode 'mime/show-message-mode)
379 )) 408 (mime/viewer-mode mother)
409 )
410 (let ((pwin (or (get-buffer-window mother)
411 (get-largest-window)
412 ))
413 (pbuf (save-excursion
414 (set-buffer full-buf)
415 mime::article/preview-buffer)))
416 (set-window-buffer pwin pbuf)
417 (select-window pwin)
418 )))))
419 )))
380 420
381 421
382 ;;; @ rot13-47 422 ;;; @ rot13-47
383 ;;; 423 ;;;
384 424