« back to all changes in this revision
Viewing changes to mew-mime.el
- browse files at revision 15
- compare with another revision
- download diff
- download tarball
- view history from revision 15
- Committer: Bazaar Package Importer
- Author(s): Tatsuya Kinoshita
- Date: 2008-04-24 00:28:17 UTC
- mfrom: (1.1.12 upstream)
- Revision ID: james.westby@ubuntu.com-20080424002817-68vgq5lfqr8z0795
Tags: 6.0.51~0.20080421-1
New upstream release. (CVS trunk on 2008-04-21)
- files added:
- bin/cmew
- files removed:
- mew-md5.el
- files modified:
- 00changes
added
removed
mew-mime.el
11
11
12
12
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13
13
;;;
14
;;; Configuration subroutines
15
;;;
16
17
(defun mew-progspec-get-prog (def)
18
(cond
19
((stringp def) def)
20
((and (listp def) (stringp (car def))) (car def))))
21
22
(defun mew-progspec-get-args (def)
23
(if (listp def) (nth 1 def)))
24
25
(defun mew-progspec-get-async (def)
26
(cond
27
((stringp def) t)
28
((listp def) (nth 2 def))))
29
30
(defun mew-progsec-args-convert (args arg)
31
(let (converted ret)
32
(setq ret (mapcar (lambda (x)
33
(if (not (string-match "%s" x))
34
x
35
(setq converted t)
36
(format x arg)))
37
args))
38
(unless converted (setq ret (append ret (list arg))))
39
ret))
40
41
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42
;;;
14
43
;;; Start and call process
15
44
;;;
16
45
36
65
;; file's suffix or something.
37
66
;; The time when the launcher is finished is not the time when
38
67
;; the application is finished. So, we can't delete the temporary
39
;; file here. Hoping that the file will be deleted when Mew is
68
;; file here. Hoping that the file will be deleted when Mew is
40
69
;; finished.
41
70
(if mew-delete-temp-file (mew-delete-file file))
42
71
(setq mew-process-file-alist (delq al mew-process-file-alist)))))
222
251
" # # # # # #######\n"
223
252
"\n\n")
224
253
(mew-insert "Size:\t\t%d bytes\n" (mew-region-bytes begin end cache))
225
(mew-insert "Browser:\t%s\n" (if (stringp mew-prog-text/html-ext)
226
mew-prog-text/html-ext
227
"none"))
254
(mew-insert "Browser:\t%s\n" (or (mew-progspec-get-prog mew-prog-text/html-ext) "none"))
228
255
(insert "\n")
229
256
(mew-mime-part-messages t)))
230
257
254
281
(defun mew-mime-markup-language-ext (program cache begin end params tag form)
255
282
;; called in Message buffer
256
283
(when (> end begin)
257
(let ((file (format form (mew-make-temp-name)))
258
orig args wcs esqp)
259
(if (listp program) (mew-set '(program orig nil) program))
284
(let* ((file (format form (mew-make-temp-name)))
285
(prog (mew-progspec-get-prog program))
286
(args (mew-progsec-args-convert (mew-progspec-get-args program) file))
287
wcs)
260
288
(save-excursion
261
289
(message "Displaying %s..." tag)
262
290
(set-buffer cache)
263
;; converting "%s"
264
(while orig
265
(if (string-match "%s" (car orig))
266
(progn
267
(setq args (cons (format (car orig) file) args))
268
(setq esqp t))
269
(setq args (cons (car orig) args)))
270
(setq orig (cdr orig)))
271
(unless esqp (setq args (cons file args)))
272
(setq args (nreverse args))
273
291
;; charset check
274
292
(setq wcs (mew-text/html-detect-cs begin end))
275
293
;; note that application/xml may have the charset parameter
278
296
(mew-syntax-get-param params "charset"))))
279
297
(unless (mew-coding-system-p wcs)
280
298
(setq wcs mew-cs-text-for-write))
281
(mew-frwlet
282
mew-cs-dummy wcs
283
(write-region begin end file nil 'no-msg)
284
(apply 'mew-start-process-disp program nil program args))
299
(mew-frwlet mew-cs-dummy wcs
300
(write-region begin end file nil 'no-msg)
301
(apply 'mew-start-process-disp prog nil prog args))
285
302
(message "Displaying %s...done" tag)))))
286
303
287
304
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
309
326
" # # # # #######\n"
310
327
"\n\n")
311
328
(mew-insert "Size:\t\t%d bytes\n" (mew-region-bytes begin end cache))
312
(mew-insert "Browser:\t%s\n" (if (stringp mew-prog-text/xml-ext)
313
mew-prog-text/xml-ext
314
"none"))
329
(mew-insert "Browser:\t%s\n" (or (mew-progspec-get-prog mew-prog-text/xml-ext) "none"))
315
330
(insert "\n")
316
331
(mew-mime-part-messages t)))
317
332
343
358
" # # # # #######\n"
344
359
"\n\n")
345
360
(mew-insert "Size:\t\t%d bytes\n" (mew-region-bytes begin end cache))
346
(mew-insert "Browser:\t%s\n" (if (stringp mew-prog-application/xml-ext)
347
mew-prog-application/xml-ext
348
"none"))
361
(mew-insert "Browser:\t%s\n" (or (mew-progspec-get-prog mew-prog-application/xml-ext) "none"))
349
362
(insert "\n")
350
363
(mew-mime-part-messages t)))
351
364
387
400
(mew-mime-image-ext file)))
388
401
389
402
(defun mew-mime-image-ext (file)
390
(let ((program mew-prog-image/*-ext)
391
args)
392
(if (listp program)
393
(mew-set '(program args nil) program))
394
(mew-mime-start-process program args file)))
403
(let* ((spec mew-prog-image/*-ext)
404
(prog (mew-progspec-get-prog spec))
405
(args (mew-progspec-get-args spec)))
406
(mew-mime-start-process prog args file)))
395
407
396
408
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
397
409
;;;
417
429
(insert-buffer-substring cache hbeg hend)
418
430
(mew-header-arrange (point-min) (point-max))
419
431
(cond
420
;; Displaying the text/plain body or the first part of
432
;; Displaying the text/plain body or the first part of
421
433
;; top level multipart if it is text/plain.
422
434
;; see also mew-syntax-singlepart
423
435
((mew-syntax-singlepart-p body)
512
524
(write-region begin end file1 nil 'no-msg)))
513
525
(setq file2 (mew-make-temp-name))
514
526
(if (eq prog mew-prog-application/msword)
515
(mew-frwlet
516
'utf-8 mew-cs-dummy
517
(if mew-use-old-wvhtml
518
(call-process prog nil nil nil file1 file2)
519
(call-process prog nil nil nil
520
"--charset=utf-8"
521
(concat "--targetdir=" (file-name-directory file2))
522
file1
523
(file-name-nondirectory file2)))
524
(let ((buffer-file-coding-system)) ;; to prevent the side effect
525
(mew-insert-file-contents file2)))
527
(mew-frwlet 'utf-8 mew-cs-dummy
528
(if mew-use-old-wvhtml
529
(call-process prog nil nil nil file1 file2)
530
(call-process prog nil nil nil
531
"--charset=utf-8"
532
(concat "--targetdir=" (file-name-directory file2))
533
file1
534
(file-name-nondirectory file2)))
535
(let ((buffer-file-coding-system)) ;; to prevent the side effect
536
(mew-insert-file-contents file2)))
526
537
(if (eq prog mew-prog-application/rtf)
527
(mew-frwlet
528
'shift_jis mew-cs-dummy
529
(call-process prog nil (current-buffer) nil file1))
530
(mew-frwlet
531
'utf-8 mew-cs-dummy
532
(call-process prog nil (current-buffer) nil file1))))
538
(mew-frwlet 'shift_jis mew-cs-dummy
539
(call-process prog nil (current-buffer) nil file1))
540
(mew-frwlet 'utf-8 mew-cs-dummy
541
(call-process prog nil (current-buffer) nil file1))))
533
542
(mew-delete-file file1)
534
543
(mew-delete-file file2)
535
544
(save-excursion
572
581
(call-process mew-prog-tnef file t nil "--verbose" "-C" dir)
573
582
(mew-delete-file file))))
574
583
584
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585
;;;
586
;;; Executing external commands
587
;;;
588
589
(defun mew-summary-ask-ct (ct fname)
590
(let (pt fl)
591
(cond
592
(fname
593
(setq ct (or (mew-ctdb-ct (mew-ctdb-by-file fname))
594
(mew-content-type (mew-sinfo-get-case))))
595
(setq pt "Type for %s (%s): ")
596
(setq fl fname))
597
(t
598
(setq pt "Type %s(%s): ")
599
(setq fl "")))
600
(mew-input-type pt fl ct mew-mime-content-type-list)))
601
602
(defun mew-summary-execute-external (&optional ask-command)
603
"Execute an external command according to Content-Type:.
604
If this command is executed on the entire message, the first part
605
is chosen as a target.
606
607
If Content-Type of the target part is Application/Octet-Stream,
608
Content-Type is automatically asked. And if it has both
609
internal and external visualization mechanisms, you are asked
610
which you want to use.
611
612
If executed with '\\[universal-argument]', you can specify a
613
command to be executed.
614
615
See 'mew-mime-content-type' to know how actions can be defined."
616
(interactive "P")
617
(mew-summary-msg-or-part
618
(let* ((fld (mew-summary-folder-name))
619
(msg (mew-summary-message-number2))
620
(nums (mew-syntax-nums))
621
(cache (mew-cache-hit fld msg 'must-hit))
622
(syntax (mew-cache-decode-syntax cache))
623
(stx (mew-syntax-get-entry syntax nums))
624
(ctl (mew-syntax-get-ct stx))
625
(ct (mew-syntax-get-value ctl 'cap))
626
(win (selected-window))
627
begin end params cdpl fname program options async was-apo erase-p
628
pro-opt ent1 ent2)
629
(when (and (string= ct mew-ct-msg)
630
(or (not ask-command)
631
(not (y-or-n-p "Save the entire message (y) or the first part (n)? "))))
632
(setq stx (mew-syntax-get-part stx))
633
(if (mew-syntax-multipart-p stx)
634
(setq stx (mew-syntax-get-part stx)))
635
(setq ctl (mew-syntax-get-ct stx))
636
(setq ct (mew-syntax-get-value ctl 'cap)))
637
(setq begin (mew-syntax-get-begin stx))
638
(setq end (mew-syntax-get-end stx))
639
(setq params (mew-syntax-get-params ctl))
640
(setq cdpl (mew-syntax-get-cdp stx))
641
(setq fname (mew-syntax-get-filename cdpl ctl))
642
(when (or (string= ct mew-ct-apo)
643
(eq (mew-ctdb-prog (mew-ctdb-by-ct ct))
644
'mew-mime-application/octet-stream))
645
(setq ct (mew-summary-ask-ct ct fname))
646
(setq was-apo t))
647
(if (not ask-command)
648
(setq program (mew-ctdb-prog (mew-ctdb-by-ct ct)))
649
(setq pro-opt (mew-input-command mew-default-external-program))
650
(setq program (car pro-opt))
651
(setq options (cdr pro-opt)))
652
;; prog
653
;; func => called for both
654
;; (prog ...)
655
;; (nil prog) == prog
656
;; (nil (prog...)) == (prog...)
657
;; (nil func) != func
658
;; (func func) => need to select
659
;; (func prog) => need to select
660
;; (func (prog ...)) => need to select
661
(cond
662
((stringp program)
663
(setq async t))
664
((symbolp program)
665
(setq erase-p t))
666
((listp program)
667
(setq ent1 (nth 0 program))
668
(setq ent2 (nth 1 program))
669
(cond
670
((stringp ent1)
671
(mew-set '(program options async) program))
672
((null ent1)
673
(cond
674
((stringp ent2)
675
(setq program ent2)
676
(setq async t))
677
((listp ent2)
678
(mew-set '(program options async) ent2))
679
(t ;; symbol
680
(setq program ent2))))
681
(t ;; symbol
682
(if (and was-apo
683
(y-or-n-p "Internal (y) or External (n)? "))
684
(progn
685
(setq erase-p t)
686
(setq program ent1))
687
(setq program ent2))
688
(cond
689
((stringp program)
690
(setq async t))
691
((listp program)
692
(mew-set '(program options async) program)))))))
693
(mew-summary-toggle-disp-msg 'on)
694
(mew-window-configure 'message)
695
(if erase-p (mew-erase-buffer))
696
;; message buffer
697
(unwind-protect
698
(mew-elet
699
(cond
700
((stringp program)
701
(mew-summary-execute-program
702
program ct ctl cache begin end params fname options async))
703
((symbolp program)
704
(mew-summary-execute-symbol
705
program ct ctl cache begin end params fname was-apo)))
706
(mew-summary-display-postscript 'no-hook))
707
(select-window win)))))
708
709
(defun mew-summary-execute-symbol (program ct ctl cache begin end params fname was-apo)
710
(cond
711
((not (fboundp program))
712
(message "%s is not implemented" (symbol-name program)))
713
((eq program mew-prog-rfc822)
714
(message "%s cannot be executed" mew-prog-rfc822))
715
((or (mew-ct-imagep ct) (mew-ct-modelp ct))
716
(funcall program cache begin end params fname ct))
717
(t
718
(let ((mew-use-text/html t)
719
(mbuf (current-buffer))
720
tbuf)
721
(if (and was-apo (mew-ct-textp ct)) ;; decode-broken?
722
(with-temp-buffer
723
(insert-buffer-substring cache begin end)
724
(mew-cs-decode-region (point-min) (point-max) mew-cs-autoconv)
725
(setq tbuf (current-buffer))
726
(setq begin (point-min))
727
(setq end (point-max))
728
(set-buffer mbuf)
729
(funcall program tbuf begin end params))
730
(funcall program cache begin end params))))))
731
732
;;; external
733
(defun mew-summary-execute-program (program ct ctl cache begin end params fname options async)
734
(if (not (mew-which-exec program))
735
(message "%s does not exist" program)
736
(let ((file (mew-make-temp-name fname))
737
wcs)
738
(save-excursion
739
(set-buffer cache)
740
;; NEVER use call-process-region for privacy reasons
741
(cond
742
((not (mew-ct-linebasep ct))
743
(setq wcs mew-cs-binary))
744
((not (mew-ct-textp ct))
745
(setq wcs mew-cs-text-for-write))
746
(t
747
(cond
748
((or (string= mew-ct-htm ct) (string= mew-ct-xml ct))
749
(setq wcs (mew-text/html-detect-cs begin end))
750
(unless (mew-coding-system-p wcs)
751
(setq wcs (mew-charset-to-cs
752
(mew-syntax-get-param ctl "charset")))))
753
(t
754
(setq wcs (mew-charset-to-cs
755
(mew-syntax-get-param ctl "charset")))))
756
(unless (mew-coding-system-p wcs)
757
(setq wcs (if mew-decode-broken
758
(mew-charset-to-cs
759
(mew-charset-guess-region
760
begin end))
761
mew-cs-text-for-write)))))
762
(mew-frwlet mew-cs-dummy wcs
763
(write-region begin end file nil 'no-msg))
764
(if async
765
(mew-mime-start-process program options file)
766
(mew-mime-call-process program options file))))))
767
575
768
(provide 'mew-mime)
576
769
577
770
;;; Copyright Notice:
578
771
579
;; Copyright (C) 1997-2007 Mew developing team.
772
;; Copyright (C) 1997-2008 Mew developing team.
580
773
;; All rights reserved.
581
774
582
775
;; Redistribution and use in source and binary forms, with or without
583
776
;; modification, are permitted provided that the following conditions
584
777
;; are met:
585
;;
778
;;
586
779
;; 1. Redistributions of source code must retain the above copyright
587
780
;; notice, this list of conditions and the following disclaimer.
588
781
;; 2. Redistributions in binary form must reproduce the above copyright
591
784
;; 3. Neither the name of the team nor the names of its contributors
592
785
;; may be used to endorse or promote products derived from this software
593
786
;; without specific prior written permission.
594
;;
787
;;
595
788
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
596
789
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
597
790
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
Loggerhead is a web-based interface for Breezy
Version: 2.0.1