;;; Commentary:
-;; Jaap-Henk Hoepman (jhh@xs4all.nl):
+;; Jaap-Henk Hoepman (jhh@xs4all.nl):
;;
;; Added support for delayed destroy of external MIME viewers. All external
;; viewers for mime types in mm-keep-viewer-alive-types will remain active
;; after switching articles or groups, and will only be removed when exiting
;; gnus.
-;;
+;;
;;; Code:
(require 'mail-parse)
(require 'gnus-mailcap)
(require 'mm-bodies)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl)
+ (require 'term))
(eval-and-compile
(autoload 'mm-inline-partial "mm-partial")
when selecting a different article."
:type '(repeat string)
:group 'mime-display)
-
+
(defcustom mm-automatic-display
'("text/plain" "text/enriched" "text/richtext" "text/html"
"text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
:type 'directory
:group 'mime-display)
+(defcustom mm-external-terminal-program "xterm"
+ "The program to start an external terminal."
+ :type 'string
+ :group 'mime-display)
+
;;; Internal variables.
(defvar mm-dissection-list nil)
(throw 'found t))))))
(defun mm-handle-set-external-undisplayer (handle function)
- "Set the undisplayer for this handle; postpone undisplaying of viewers
+ "Set the undisplayer for this handle; postpone undisplaying of viewers
for types in mm-keep-viewer-alive-types."
- (if (mm-keep-viewer-alive-p handle)
- (let ((new-handle (copy-sequence handle)))
- (mm-handle-set-undisplayer new-handle function)
- (mm-handle-set-undisplayer handle nil)
- (push new-handle mm-postponed-undisplay-list))
- (mm-handle-set-undisplayer handle function)))
+ (if (mm-keep-viewer-alive-p handle)
+ (let ((new-handle (copy-sequence handle)))
+ (mm-handle-set-undisplayer new-handle function)
+ (mm-handle-set-undisplayer handle nil)
+ (push new-handle mm-postponed-undisplay-list))
+ (mm-handle-set-undisplayer handle function)))
(defun mm-destroy-postponed-undisplay-list ()
(message "Destroying external MIME viewers")
(let ((mm-dissect-default-type (if (equal subtype "digest")
"message/rfc822"
"text/plain")))
- (add-text-properties 0 (length (car ctl))
- (mm-alist-to-plist (cdr ctl)) (car ctl))
+ (add-text-properties 0 (length (car ctl))
+ (mm-alist-to-plist (cdr ctl)) (car ctl))
;; what really needs to be done here is a way to link a
;; MIME handle back to it's parent MIME handle (in a multilevel
;; MIME article). That would probably require changing
;; the mm-handle API so we simply store the multipart buffert
;; name as a text property of the "multipart/whatever" string.
- (add-text-properties 0 (length (car ctl))
+ (add-text-properties 0 (length (car ctl))
(list 'buffer (mm-copy-to-buffer))
- (car ctl))
- (add-text-properties 0 (length (car ctl))
+ (car ctl))
+ (add-text-properties 0 (length (car ctl))
(list 'from from)
- (car ctl))
+ (car ctl))
(cons (car ctl) (mm-dissect-multipart ctl))))
(t
(mm-dissect-singlepart
(message "Viewing with %s" method)
(cond (needsterm
(unwind-protect
- (start-process "*display*" nil
- "xterm"
- "-e" shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
+ (if window-system
+ (start-process "*display*" nil
+ mm-external-terminal-program
+ "-e" shell-file-name
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
+ (require 'term)
+ (require 'gnus-win)
+ (set-buffer
+ (setq buffer
+ (make-term "display"
+ shell-file-name
+ nil
+ shell-command-switch
+ (mm-mailcap-command
+ method file
+ (mm-handle-type handle)))))
+ (term-mode)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buffer)
+ `(lambda (process state)
+ (if (eq 'exit (process-status process))
+ (gnus-configure-windows
+ ',gnus-current-window-configuration))))
+ (gnus-configure-windows 'display-term))
(mm-handle-set-external-undisplayer handle (cons file buffer)))
(message "Displaying %s..." (format method file))
'external)
((consp object)
(ignore-errors (delete-file (car object)))
(ignore-errors (delete-directory (file-name-directory (car object))))
- (ignore-errors (kill-buffer (cdr object))))
+ (ignore-errors (and (cdr object) (kill-buffer (cdr object)))))
((bufferp object)
(when (buffer-live-p object)
(kill-buffer object)))))
(save-excursion
(if (member (mm-handle-media-supertype handle) '("text" "message"))
(with-temp-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
+ (insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle))
(prog1
(setq spec
(ignore-errors
- ;; Avoid testing `make-glyph' since W3 may define
- ;; a bogus version of it.
+ ;; Avoid testing `make-glyph' since W3 may define
+ ;; a bogus version of it.
(if (fboundp 'create-image)
- (create-image (buffer-string) (intern type) 'data-p)
+ (or
+ (create-image (buffer-string) nil 'data-p)
+ (create-image (buffer-string) (intern type)
+ 'data-p))
(cond
((equal type "xbm")
;; xbm images require special handling, since
(write-region (point-min) (point-max) file)
(make-glyph (list (cons 'x file))))
(ignore-errors
- (delete-file file)))))
+ (delete-file file)))))
(t
(make-glyph
(vector (intern type) :data (buffer-string))))))))
parts))
(defun mm-multiple-handles (handles)
- (and (listp (car handles))
- (> (length handles) 1)))
+ (and (listp (car handles))
+ (> (length handles) 1)))
-(defun mm-merge-handles (handles1 handles2)
+(defun mm-merge-handles (handles1 handles2)
(append
- (if (listp (car handles1))
+ (if (listp (car handles1))
handles1
(list handles1))
(if (listp (car handles2))
projects / elisp / gnus.git- / blobdiff