Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-play.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8d2a9b52c682
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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,1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1994,1995,1996 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.8 1997/03/26 04:34:05 steve Exp $ 7 ;; Version: $Id: tm-play.el,v 1.1.1.1 1996/12/18 22:43:37 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
25 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Code: 27 ;;; Code:
28 28
29 (require 'tm-view) 29 (require 'tm-view)
30
31 (defvar mime-viewer/external-progs "/usr/local/share/tm"
32 "*Directory containing tm external methods.")
33
34 (add-to-list 'exec-path mime-viewer/external-progs)
35
36 (let ((paths (parse-colon-path (getenv "PATH"))))
37 (or (member mime-viewer/external-progs paths)
38 (setenv "PATH"
39 (mapconcat (function identity)
40 (append paths (list mime-viewer/external-progs))
41 path-separator))
42 ))
30 43
31 44
32 ;;; @ content decoder 45 ;;; @ content decoder
33 ;;; 46 ;;;
34 47
267 280
268 ;;; @ message/partial 281 ;;; @ message/partial
269 ;;; 282 ;;;
270 283
271 (defvar mime-article/coding-system-alist 284 (defvar mime-article/coding-system-alist
272 (list (cons 'mh-show-mode *noconv*) 285 (and (boundp 'MULE)
273 (cons t (mime-charset-to-coding-system default-mime-charset)) 286 '((mh-show-mode . *noconv*)
274 )) 287 (t . *ctext*)
275 288 )))
276 (cond ((boundp 'MULE) ; for MULE 2.3 or older 289
277 (defun mime-article::write-region (start end file) 290 (defvar mime-article/kanji-code-alist
278 (let ((file-coding-system 291 (and (boundp 'NEMACS)
279 (cdr 292 '((mh-show-mode . nil)
280 (or (assq major-mode mime-article/coding-system-alist) 293 (t . 2)
281 (assq t mime-article/coding-system-alist) 294 )))
282 ))))
283 (write-region start end file)
284 ))
285 )
286 ((featurep 'mule) ; for Emacs/mule and XEmacs/mule
287 (defun mime-article::write-region (start end file)
288 (let ((coding-system-for-write
289 (cdr
290 (or (assq major-mode mime-article/coding-system-alist)
291 (assq t mime-article/coding-system-alist)
292 ))))
293 (write-region start end file)
294 ))
295 )
296 ((boundp 'NEMACS) ; for NEmacs
297 (defun mime-article::write-region (start end file)
298 (let ((kanji-fileio-code
299 (cdr
300 (or (assq major-mode mime-article/kanji-code-alist)
301 (assq t mime-article/kanji-code-alist)
302 ))))
303 (write-region start end file)
304 ))
305 )
306 (t ; for Emacs 19 or older and XEmacs without mule
307 (defalias 'mime-article::write-region 'write-region)
308 ))
309 295
310 (defun mime-article/decode-message/partial (beg end cal) 296 (defun mime-article/decode-message/partial (beg end cal)
311 (goto-char beg) 297 (goto-char beg)
312 (let* ((root-dir (expand-file-name 298 (let* ((root-dir (expand-file-name
313 (concat "m-prts-" (user-login-name)) mime/tmp-dir)) 299 (concat "m-prts-" (user-login-name)) mime/tmp-dir))
314 (id (cdr (assoc "id" cal))) 300 (id (cdr (assoc "id" cal)))
315 (number (cdr (assoc "number" cal))) 301 (number (cdr (assoc "number" cal)))
316 (total (cdr (assoc "total" cal))) 302 (total (cdr (assoc "total" cal)))
303 (the-buf (current-buffer))
317 file 304 file
318 (mother mime::article/preview-buffer) 305 (mother mime::article/preview-buffer)
319 ) 306 (win-conf (save-excursion
320 (or (file-exists-p root-dir) 307 (set-buffer mother)
308 mime::preview/original-window-configuration))
309 )
310 (if (not (file-exists-p root-dir))
321 (make-directory root-dir) 311 (make-directory root-dir)
322 ) 312 )
323 (setq id (replace-as-filename id)) 313 (setq id (replace-as-filename id))
324 (setq root-dir (concat root-dir "/" id)) 314 (setq root-dir (concat root-dir "/" id))
325 (or (file-exists-p root-dir) 315 (if (not (file-exists-p root-dir))
326 (make-directory root-dir) 316 (make-directory root-dir)
327 ) 317 )
328 (setq file (concat root-dir "/FULL")) 318 (setq file (concat root-dir "/FULL"))
329 (if (file-exists-p file) 319 (if (not (file-exists-p file))
330 (let ((full-buf (get-buffer-create "FULL")) 320 (progn
331 (pwin (or (get-buffer-window mother) 321 (re-search-forward "^$")
332 (get-largest-window))) 322 (goto-char (1+ (match-end 0)))
333 ) 323 (setq file (concat root-dir "/" number))
334 (save-window-excursion 324 (let ((file-coding-system
335 (set-buffer full-buf) 325 (cdr
336 (erase-buffer) 326 (or (assq major-mode mime-article/coding-system-alist)
337 (as-binary-input-file (insert-file-contents file)) 327 (assq t mime-article/coding-system-alist)
338 (setq major-mode 'mime/show-message-mode) 328 )))
339 (mime/viewer-mode mother) 329 (kanji-fileio-code
330 (cdr
331 (or (assq major-mode mime-article/kanji-code-alist)
332 (assq t mime-article/kanji-code-alist)
333 )))
334 )
335 (write-region (point) (point-max) file)
340 ) 336 )
341 (set-window-buffer pwin 337 (if (get-buffer mime/temp-buffer-name)
342 (save-excursion 338 (kill-buffer mime/temp-buffer-name)
343 (set-buffer full-buf) 339 )
344 mime::article/preview-buffer)) 340 (switch-to-buffer mime/temp-buffer-name)
345 (select-window pwin) 341 (let ((i 1)
342 (max (string-to-int total))
343 (file-coding-system-for-read (if (boundp 'MULE)
344 *noconv*))
345 kanji-fileio-code)
346 (catch 'tag
347 (while (<= i max)
348 (setq file (concat root-dir "/" (int-to-string i)))
349 (if (not (file-exists-p file))
350 (progn
351 (switch-to-buffer the-buf)
352 (throw 'tag nil)
353 ))
354 (insert-file-contents file)
355 (goto-char (point-max))
356 (setq i (1+ i))
357 )
358 ;;(delete-other-windows)
359 (let ((buf (current-buffer)))
360 (write-file (concat root-dir "/FULL"))
361 (set-window-configuration win-conf)
362 (let ((win (get-buffer-window mother)))
363 (if win
364 (select-window win)
365 ))
366 (set-window-buffer (selected-window) buf)
367 ;;(set-window-buffer buf)
368 (setq major-mode 'mime/show-message-mode)
369 )
370 (mime/viewer-mode mother)
371 (pop-to-buffer (current-buffer))
372 ))
346 ) 373 )
347 (re-search-forward "^$") 374 (progn
348 (goto-char (1+ (match-end 0))) 375 ;;(delete-other-windows)
349 (setq file (concat root-dir "/" number)) 376 (set-window-configuration win-conf)
350 (mime-article::write-region (point) (point-max) file) 377 (select-window (or (get-buffer-window mother)
351 (let ((total-file (concat root-dir "/CT"))) 378 (get-buffer-window
352 (setq total 379 (save-excursion
353 (if total 380 (set-buffer mother)
354 (progn 381 mime::preview/article-buffer))
355 (or (file-exists-p total-file) 382 (get-largest-window)
356 (save-excursion
357 (set-buffer
358 (get-buffer-create mime/temp-buffer-name))
359 (erase-buffer)
360 (insert total)
361 (write-file total-file)
362 (kill-buffer (current-buffer))
363 ))
364 (string-to-number total)
365 )
366 (and (file-exists-p total-file)
367 (save-excursion
368 (set-buffer (find-file-noselect total-file))
369 (prog1
370 (and (re-search-forward "[0-9]+" nil t)
371 (string-to-number
372 (buffer-substring (match-beginning 0)
373 (match-end 0)))
374 )
375 (kill-buffer (current-buffer))
376 )))
377 )))
378 (if (and total (> total 0))
379 (catch 'tag
380 (save-excursion
381 (set-buffer (get-buffer-create mime/temp-buffer-name))
382 (let ((full-buf (current-buffer)))
383 (erase-buffer)
384 (let ((i 1))
385 (while (<= i total)
386 (setq file (concat root-dir "/" (int-to-string i)))
387 (or (file-exists-p file)
388 (throw 'tag nil)
389 )
390 (as-binary-input-file (insert-file-contents file))
391 (goto-char (point-max))
392 (setq i (1+ i))
393 ))
394 (as-binary-output-file (write-file (concat root-dir "/FULL")))
395 (let ((i 1))
396 (while (<= i total)
397 (let ((file (format "%s/%d" root-dir i)))
398 (and (file-exists-p file)
399 (delete-file file)
400 )) 383 ))
401 (setq i (1+ i)) 384 (as-binary-input-file
402 )) 385 (set-buffer (get-buffer-create "FULL"))
403 (let ((file (expand-file-name "CT" root-dir))) 386 (insert-file-contents file)
404 (and (file-exists-p file) 387 )
405 (delete-file file) 388 (setq major-mode 'mime/show-message-mode)
406 )) 389 (mime/viewer-mode mother)
407 (save-window-excursion 390 ;;(pop-to-buffer (current-buffer))
408 (setq major-mode 'mime/show-message-mode) 391 ))
409 (mime/viewer-mode mother) 392 ))
410 )
411 (let ((pwin (or (get-buffer-window mother)
412 (get-largest-window)
413 ))
414 (pbuf (save-excursion
415 (set-buffer full-buf)
416 mime::article/preview-buffer)))
417 (set-window-buffer pwin pbuf)
418 (select-window pwin)
419 )))))
420 )))
421 393
422 394
423 ;;; @ rot13-47 395 ;;; @ rot13-47
424 ;;; 396 ;;;
425
426 (unless (boundp 'view-mode-map)
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 )
445 397
446 (defun mime-article/decode-caesar (beg end cal) 398 (defun mime-article/decode-caesar (beg end cal)
447 (let* ((cnum (mime-article/point-content-number beg)) 399 (let* ((cnum (mime-article/point-content-number beg))
448 (cur-buf (current-buffer)) 400 (cur-buf (current-buffer))
449 (new-name (format "%s-%s" (buffer-name) cnum)) 401 (new-name (format "%s-%s" (buffer-name) cnum))
451 (charset (cdr (assoc "charset" cal))) 403 (charset (cdr (assoc "charset" cal)))
452 (encoding (cdr (assq 'encoding cal))) 404 (encoding (cdr (assq 'encoding cal)))
453 (mode major-mode) 405 (mode major-mode)
454 str) 406 str)
455 (setq str (buffer-substring beg end)) 407 (setq str (buffer-substring beg end))
456 (let ((pwin (or (get-buffer-window mother) 408 (switch-to-buffer new-name)
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 )
464 (setq buffer-read-only nil) 409 (setq buffer-read-only nil)
465 (erase-buffer) 410 (erase-buffer)
466 (insert str) 411 (insert str)
467 (goto-char (point-min)) 412 (goto-char (point-min))
468 (if (re-search-forward "^\n" nil t) 413 (if (re-search-forward "^\n" nil t)
476 (save-excursion 421 (save-excursion
477 (set-mark (point-min)) 422 (set-mark (point-min))
478 (goto-char (point-max)) 423 (goto-char (point-max))
479 (tm:caesar-region) 424 (tm:caesar-region)
480 ) 425 )
481 (set-buffer-modified-p nil) 426 (view-mode)
482 (mime-view-text/plain-mode)
483 )) 427 ))
484 428
485 429
486 ;;; @ end 430 ;;; @ end
487 ;;; 431 ;;;