[Mew-dist 831] Re: External-Body interface

SAKAI Kiyotaka ksakai at example.com
1997年 4月 8日 (火) 17:08:05 JST


>> In article <20023.859983381 at example.com>, Kazu Yamamoto 山本和彦  <kazu at example.com> writes:

>> 個人的な希望としては、
>> 
>> ・例えば FTP なら FTP であることを示す画面だけを表示して、それ以上は何
>> も実行しない。
>> ・画面には、「このキーを押せば FTP を実行するよ」という情報だけも表示
>> しておく。
>> ・表示したキーを押すと、初めて FTP の実行を開始する。
>> 
>> というようになればいいと思います。

> とてもすばらしいので採用したいと思います。ただやる暇がないので、実装して
> もらえればマージします。

とりあえず実装してみました。

使い方は、External-Body があるメールを開いた後、

  M-x mew-mime-external-execute

を実行して下さい。

現在までの known bug としては、" *mew ext*" buffer を共用していること
によるバグで、複数のフレームでメールを読み書きしているときとおかしくな
ることがありますが、この対応はそのうちやります。(最終的には、"*Mew
message*" buffer のように処理すればうまくいくでしょう。)

どなたか、バグ出しをお願いします。
(anoymous ftp と URL に関しては、一応、自分でもテストしてありますけど。)
-- 
酒井 清隆 (E-mail: ksakai at example.com)

-------------- next part --------------
===================================================================
RCS file: RCS/mew-ext.el,v
retrieving revision 1.1
diff -c -r1.1 mew-ext.el
*** mew-ext.el	1997/04/04 08:06:01	1.1
--- mew-ext.el	1997/04/08 08:02:55
***************
*** 307,319 ****
  	(funcall program begin end params))
      ))
  
  (defun mew-ext-ftp (begin end params)
    (let* ((site (mew-syntax-get-member params "site"))
  	 (directory (mew-syntax-get-member params "directory"))
  	 (name (mew-syntax-get-member params "name"))
  	 (size (mew-syntax-get-member params "size"))
! 	 (filepath nil) (localfile nil) (remotefile nil) (getit t)
! 	 (username "") (buffer-read-only nil))
      (if directory
  	(if (string-match ".*/$" directory) ;; xxx Win95???
  	    (setq filepath (concat directory name))
--- 307,329 ----
  	(funcall program begin end params))
      ))
  
+ (defun mew-mime-external-execute ()
+   (interactive)
+   (save-excursion
+     (let ((buf (get-buffer mew-buffer-ext))
+ 	  func)
+       (set-buffer buf)
+       (goto-char (point-min))
+       (setq func (read buf))
+       (funcall func))))
+ 
  (defun mew-ext-ftp (begin end params)
    (let* ((site (mew-syntax-get-member params "site"))
  	 (directory (mew-syntax-get-member params "directory"))
  	 (name (mew-syntax-get-member params "name"))
  	 (size (mew-syntax-get-member params "size"))
! 	 (filepath nil)
! 	 (buffer-read-only nil))
      (if directory
  	(if (string-match ".*/$" directory) ;; xxx Win95???
  	    (setq filepath (concat directory name))
***************
*** 332,354 ****
              (format "SITE:\t%s\n" site)
              (format "FILE:\t%s\n" filepath))
      (if size (insert (format "SIZE:\t%s bytes\n" size)))
!     (if (not (mew-y-or-n-p "Get the message? "))
! 	()
!       (setq username (read-string (format "User name at %s: " site)
! 				  (user-login-name)))
!       (setq remotefile (format "/%s@%s:%s" username site filepath))
!       (setq localfile
! 	    (expand-file-name 
! 	     (read-file-name "Save to: " 
! 			     (format "%s%s" default-directory name))))
!       (if (file-exists-p localfile)
! 	  (if (mew-y-or-n-p (format "The local file exists. Overwrite? "))
! 	      (delete-file localfile)
! 	    (setq getit nil)
! 	    (message "The file wasn't retrieved")))
!       (if getit (mew-ext-copy-file-internal remotefile localfile nil))
!       )
!     ))
  
  (defun mew-ext-tftp (begin end params)
    (message "access-type TFTP is not supported yet")
--- 342,375 ----
              (format "SITE:\t%s\n" site)
              (format "FILE:\t%s\n" filepath))
      (if size (insert (format "SIZE:\t%s bytes\n" size)))
!     (set-buffer (get-buffer-create mew-buffer-ext))
!     (erase-buffer)
!     (insert "mew-ext-ftp-execute\n")
!     (insert (format "\"%s\"\n" site))
!     (insert (format "\"%s\"\n" name))
!     (insert (format "\"%s\"\n" filepath))))
! 
! (defun mew-ext-ftp-execute ()
!   (let (site name filepath localfile username  remotefile url (getit t) buf)
!     (save-excursion
!       (setq buf (get-buffer mew-buffer-ext))
!       (set-buffer buf)
!       (setq site (read buf))
!       (setq name (read buf))
!       (setq filepath(read buf)))
!     (setq username (read-string (format "User name at %s: " site)
! 				(user-login-name)))
!     (setq remotefile (format "/%s@%s:%s" username site filepath))
!     (setq localfile
! 	  (expand-file-name 
! 	   (read-file-name "Save to: " 
! 			   (format "%s%s" default-directory name))))
!     (if (file-exists-p localfile)
! 	(if (mew-y-or-n-p (format "The local file exists. Overwrite? "))
! 	    (delete-file localfile)
! 	  (setq getit nil)
! 	  (message "The file wasn't retrieved")))
!     (if getit (mew-ext-copy-file-internal remotefile localfile nil))))
  
  (defun mew-ext-tftp (begin end params)
    (message "access-type TFTP is not supported yet")
***************
*** 359,366 ****
  	 (directory (mew-syntax-get-member params "directory"))
  	 (name (mew-syntax-get-member params "name"))
  	 (size (mew-syntax-get-member params "size"))
! 	 (getit t) (buffer-read-only nil)
! 	 filepath localfile remotefile url)
      (if directory
  	(if (string-match ".*/$" directory) ;; xxx Win95???
  	    (setq filepath (concat directory name))
--- 380,387 ----
  	 (directory (mew-syntax-get-member params "directory"))
  	 (name (mew-syntax-get-member params "name"))
  	 (size (mew-syntax-get-member params "size"))
! 	 (buffer-read-only nil)
! 	 filepath)
      (if directory
  	(if (string-match ".*/$" directory) ;; xxx Win95???
  	    (setq filepath (concat directory name))
***************
*** 380,411 ****
              (format "SITE:\t%s\n" site)
              (format "FILE:\t%s\n" filepath))
      (if size (insert (format "SIZE:\t%s bytes\n" size)))
!     (if (null (mew-y-or-n-p "Get the message? "))
  	()
!       (setq remotefile (format "/%s@%s:%s" "anonymous" site filepath))
!       (setq url (format "ftp://%s%s" site filepath))
!       (setq localfile
! 	    (expand-file-name 
! 	     (read-file-name "Save to: "
! 			     (format "%s%s" default-directory name))))
!       (if (file-exists-p localfile)
! 	  (if (mew-y-or-n-p (format "The local file exists. Overwrite? "))
! 	      (delete-file localfile)
! 	    (setq getit nil)
! 	    (message "The file wasn't retrieved"))
! 	)
!       (if (not getit)
! 	  ()
! 	(cond
! 	 ((eq mew-ext-anon-ftp-method 'ftp)
! 	  (mew-ext-copy-file-internal remotefile localfile mew-mail-address))
! 	 ((eq mew-ext-anon-ftp-method 'http)
! 	  (require 'w3)
! 	  (w3-fetch url))
! 	 )
! 	)
!       )
!     ))
  
  (defun mew-ext-mail-server (begin end params)
    (let ((server (mew-syntax-get-member params "server"))
--- 401,440 ----
              (format "SITE:\t%s\n" site)
              (format "FILE:\t%s\n" filepath))
      (if size (insert (format "SIZE:\t%s bytes\n" size)))
!     (set-buffer (get-buffer-create mew-buffer-ext))
!     (erase-buffer)
!     (insert "mew-ext-anon-ftp-execute\n")
!     (insert (format "\"%s\"\n" site))
!     (insert (format "\"%s\"\n" name))
!     (insert (format "\"%s\"\n" filepath))))
! 
! (defun mew-ext-anon-ftp-execute ()
!   (let (site name filepath localfile remotefile url (getit t) buf)
!     (save-excursion
!       (setq buf (get-buffer mew-buffer-ext))
!       (set-buffer buf)
!       (setq site (read buf))
!       (setq name (read buf))
!       (setq filepath(read buf)))
!     (setq remotefile (format "/%s@%s:%s" "anonymous" site filepath))
!     (setq url (format "ftp://%s%s" site filepath))
!     (setq localfile
! 	  (expand-file-name 
! 	   (read-file-name "Save to: "
! 			   (format "%s%s" default-directory name))))
!     (if (file-exists-p localfile)
! 	(if (mew-y-or-n-p (format "The local file exists. Overwrite? "))
! 	    (delete-file localfile)
! 	  (setq getit nil)
! 	  (message "The file wasn't retrieved")))
!     (if (not getit)
  	()
!       (cond
!        ((eq mew-ext-anon-ftp-method 'ftp)
! 	(mew-ext-copy-file-internal remotefile localfile mew-mail-address))
!        ((eq mew-ext-anon-ftp-method 'http)
! 	(require 'w3)
! 	(w3-fetch url))))))
  
  (defun mew-ext-mail-server (begin end params)
    (let ((server (mew-syntax-get-member params "server"))
***************
*** 436,451 ****
  	(forward-line 1)
  	(setq start (point))
  	))
      ;; pickd up source from 'mew-send
!     (if (null (mew-y-or-n-p (format "Send a message to %s? " server)))
! 	()
!       (mew-summary-send nil server nil subject)
!       (insert-buffer-substring (mew-current-get 'cache) start end)
!       (mew-draft-make-mime)
!       (if (mew-y-or-n-p "Send this message? ")
! 	  (mew-draft-real-send-letter)
! 	))
!     ))
  
  (defun mew-ext-url (begin end params)
    (let ((url (mew-syntax-get-member params "url"))
--- 465,492 ----
  	(forward-line 1)
  	(setq start (point))
  	))
+     (set-buffer (get-buffer-create mew-buffer-ext))
+     (erase-buffer)
+     (insert "mew-ext-mail-server-execute\n")
+     (insert (format "\"%s\"\n" server))
+     (insert (format "\"%s\"\n" subject))
+     (insert-buffer-substring (mew-current-get 'cache) start end)))
+ 
+ (defun mew-ext-mail-server-execute ()
+   (let (server subject start end buf)
+     (save-excursion
+       (setq buf (get-buffer mew-buffer-ext))
+       (set-buffer buf)
+       (setq server (read buf))
+       (setq subject (read buf))
+       (setq start (point))
+       (setq end (point-max)))
      ;; pickd up source from 'mew-send
!     (mew-summary-send nil server nil subject)
!     (insert-buffer-substring buf start end)
!     (mew-draft-make-mime)
!     (if (mew-y-or-n-p "Send this message? ")
! 	(mew-draft-real-send-letter))))
  
  (defun mew-ext-url (begin end params)
    (let ((url (mew-syntax-get-member params "url"))
***************
*** 466,477 ****
  	    "\n"
  	    (format "URL:\t\t%s\n" url))
      (if size (insert (format "SIZE:\t%s bytes\n" size)))
!     (if (mew-y-or-n-p (format "Gain access to %s ?" url))
! 	(start-process
! 	 (format "*mew %s*" mew-ext-prog-url)
! 	 mew-buffer-tmp mew-ext-prog-url url)
!       )
!     ))
  
  ;;
  ;; include
--- 507,526 ----
  	    "\n"
  	    (format "URL:\t\t%s\n" url))
      (if size (insert (format "SIZE:\t%s bytes\n" size)))
!     (set-buffer (get-buffer-create mew-buffer-ext))
!     (erase-buffer)
!     (insert "mew-ext-url-execute\n")
!     (insert (format "\"%s\"\n" url))))
! 
! (defun mew-ext-url-execute ()
!   (let (url buf)
!     (save-excursion
!       (setq buf (get-buffer mew-buffer-ext))
!       (set-buffer buf)
!       (setq url (read buf)))
!     (start-process
!      (format "*mew %s*" mew-ext-prog-url)
!      mew-buffer-tmp mew-ext-prog-url url)))
  
  ;;
  ;; include


Mew-dist メーリングリストの案内