Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-play.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 54cc21c15cbb
children 360340f9fd5f
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
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.1.1.2 1996/12/21 20:50:43 steve Exp $ 7 ;; Version: $Id: tm-play.el,v 1.2 1997/02/15 22:21:29 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
341 (insert-file-contents file) 359 (get-buffer-create mime/temp-buffer-name))
342 (goto-char (point-max)) 360 (erase-buffer)
343 (setq i (1+ i)) 361 (insert total)
344 ) 362 (write-file total-file)
345 ;;(delete-other-windows) 363 (kill-buffer (current-buffer))
346 (let ((buf (current-buffer))) 364 ))
347 (write-file (concat root-dir "/FULL")) 365 (string-to-number total)
348 (set-window-configuration win-conf) 366 )
349 (let ((win (get-buffer-window mother))) 367 (and (file-exists-p total-file)
350 (if win 368 (save-excursion
351 (select-window win) 369 (set-buffer (find-file-noselect total-file))
370 (prog1
371 (and (re-search-forward "[0-9]+" nil t)
372 (string-to-number
373 (buffer-substring (match-beginning 0)
374 (match-end 0)))
375 )
376 (kill-buffer (current-buffer))
377 )))
378 )))
379 (if (and total (> total 0))
380 (catch 'tag
381 (save-excursion
382 (set-buffer (get-buffer-create mime/temp-buffer-name))
383 (let ((full-buf (current-buffer)))
384 (erase-buffer)
385 (let ((i 1))
386 (while (<= i total)
387 (setq file (concat root-dir "/" (int-to-string i)))
388 (or (file-exists-p file)
389 (throw 'tag nil)
390 )
391 (as-binary-input-file (insert-file-contents file))
392 (goto-char (point-max))
393 (setq i (1+ i))
352 )) 394 ))
353 (set-window-buffer (selected-window) buf) 395 (as-binary-output-file (write-file (concat root-dir "/FULL")))
354 ;;(set-window-buffer buf) 396 (let ((i 1))
355 (setq major-mode 'mime/show-message-mode) 397 (while (<= i total)
356 ) 398 (let ((file (format "%s/%d" root-dir i)))
357 (mime/viewer-mode mother) 399 (and (file-exists-p file)
358 (pop-to-buffer (current-buffer)) 400 (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 )) 401 ))
371 (as-binary-input-file 402 (setq i (1+ i))
372 (set-buffer (get-buffer-create "FULL")) 403 ))
373 (insert-file-contents file) 404 (let ((file (expand-file-name "CT" root-dir)))
374 ) 405 (and (file-exists-p file)
375 (setq major-mode 'mime/show-message-mode) 406 (delete-file file)
376 (mime/viewer-mode mother) 407 ))
377 ;;(pop-to-buffer (current-buffer)) 408 (save-window-excursion
378 )) 409 (setq major-mode 'mime/show-message-mode)
379 )) 410 (mime/viewer-mode mother)
411 )
412 (let ((pwin (or (get-buffer-window mother)
413 (get-largest-window)
414 ))
415 (pbuf (save-excursion
416 (set-buffer full-buf)
417 mime::article/preview-buffer)))
418 (set-window-buffer pwin pbuf)
419 (select-window pwin)
420 )))))
421 )))
380 422
381 423
382 ;;; @ rot13-47 424 ;;; @ rot13-47
383 ;;; 425 ;;;
426
427 (require 'view)
428
429 (defconst mime-view-text/plain-mode-map (copy-keymap view-mode-map))
430 (define-key mime-view-text/plain-mode-map
431 "q" (function mime-view-text/plain-exit))
432
433 (defun mime-view-text/plain-mode ()
434 "\\{mime-view-text/plain-mode-map}"
435 (setq buffer-read-only t)
436 (setq major-mode 'mime-view-text/plain-mode)
437 (setq mode-name "MIME-View text/plain")
438 (use-local-map mime-view-text/plain-mode-map)
439 )
440
441 (defun mime-view-text/plain-exit ()
442 (interactive)
443 (kill-buffer (current-buffer))
444 )
384 445
385 (defun mime-article/decode-caesar (beg end cal) 446 (defun mime-article/decode-caesar (beg end cal)
386 (let* ((cnum (mime-article/point-content-number beg)) 447 (let* ((cnum (mime-article/point-content-number beg))
387 (cur-buf (current-buffer)) 448 (cur-buf (current-buffer))
388 (new-name (format "%s-%s" (buffer-name) cnum)) 449 (new-name (format "%s-%s" (buffer-name) cnum))
390 (charset (cdr (assoc "charset" cal))) 451 (charset (cdr (assoc "charset" cal)))
391 (encoding (cdr (assq 'encoding cal))) 452 (encoding (cdr (assq 'encoding cal)))
392 (mode major-mode) 453 (mode major-mode)
393 str) 454 str)
394 (setq str (buffer-substring beg end)) 455 (setq str (buffer-substring beg end))
395 (switch-to-buffer new-name) 456 (let ((pwin (or (get-buffer-window mother)
457 (get-largest-window)))
458 (buf (get-buffer-create new-name))
459 )
460 (set-window-buffer pwin buf)
461 (set-buffer buf)
462 (select-window pwin)
463 )
396 (setq buffer-read-only nil) 464 (setq buffer-read-only nil)
397 (erase-buffer) 465 (erase-buffer)
398 (insert str) 466 (insert str)
399 (goto-char (point-min)) 467 (goto-char (point-min))
400 (if (re-search-forward "^\n" nil t) 468 (if (re-search-forward "^\n" nil t)
408 (save-excursion 476 (save-excursion
409 (set-mark (point-min)) 477 (set-mark (point-min))
410 (goto-char (point-max)) 478 (goto-char (point-max))
411 (tm:caesar-region) 479 (tm:caesar-region)
412 ) 480 )
413 (view-mode) 481 (set-buffer-modified-p nil)
482 (mime-view-text/plain-mode)
414 )) 483 ))
415 484
416 485
417 ;;; @ end 486 ;;; @ end
418 ;;; 487 ;;;