[Mew-dist 12803] Re: mew-ext.el access-type url operation change by message header CT

Kazu Yamamoto ( 山本和彦 ) kazu at example.com
2000年 4月 12日 (水) 12:03:05 JST


二宮さん、

From: Ninomiya Hideyuki <nin at example.com>
Subject: [Mew-dist 12727] mew-ext.el access-type url operation change by message header CT

> Message/External-Body で access-type: url の場合、message header の
> CT に依ってそれを扱うプログラムを変更するというのをやってみました。

とてもよくなりましたね。

以下のように直してみました。b31 に対する差分になっています。

(1) first, second, third は Emacs の標準の関数ではないので、nth を使うべき
(2) インデントがおかしいところを直した
(3) すでに Mew で同様機能を持った関数(mew-assoc-match2)があるので、そちら
    を使った
(4) 関数や変数の名前が少し長いので、短くした
(5) mew-ext-url-alist のシンタックスは難しいので、vars.el から vars2.el
   に移した。また、シンタックスを意識してプログラミングしなくて済むように、
   補助マクロを定義した。

同じロジックになるよう書き直しましたが、試していません。試してもらえる
と幸いです。

--かず
-------------- next part --------------
Index: mew-ext.el
===================================================================
RCS file: /usr/home/kazu/cvsroot/Mew/mew/mew-ext.el,v
retrieving revision 1.48
retrieving revision 1.49
diff -c -r1.48 -r1.49
*** mew-ext.el	2000/03/09 09:03:29	1.48
--- mew-ext.el	2000/04/12 03:05:36	1.49
***************
*** 42,48 ****
      ("tftp"        . mew-ext-tftp)
      ("anon-ftp"    . mew-ext-anon-ftp)
      ("mail-server" . mew-ext-mail-server)
!     ("url"         . mew-ext-url))) ;; RFC2017
  
  (defmacro mew-ext-get-func (acc-type)
    (` (cdr (mew-assoc-match (, acc-type) mew-ext-switch 0))))
--- 42,48 ----
      ("tftp"        . mew-ext-tftp)
      ("anon-ftp"    . mew-ext-anon-ftp)
      ("mail-server" . mew-ext-mail-server)
!     ("url"         . mew-ext-url))) ;; RFC 2017
  
  (defmacro mew-ext-get-func (acc-type)
    (` (cdr (mew-assoc-match (, acc-type) mew-ext-switch 0))))
***************
*** 367,376 ****
  
  (defun mew-ext-mail-server (begin end params execute)
    (mew-elet
!    (let ((server (mew-syntax-get-param params "server"))
! 	 (subject (mew-syntax-get-param params "subject"))
! 	 (size (mew-syntax-get-param params "size"))
! 	 (start nil))
       (mew-erase-buffer)
       (insert " #     #    #      ###   #\n"
  	     " ##   ##   # #      #    #\n"
--- 367,377 ----
  
  (defun mew-ext-mail-server (begin end params execute)
    (mew-elet
!    (let* ((server (mew-syntax-get-param params "server"))
! 	  (subject (mew-syntax-get-param params "subject"))
! 	  (size (mew-syntax-get-param params "size"))
! 	  (syntax (mew-ext-decode-message-header begin end))
! 	  (start (mew-syntax-get-begin syntax)))
       (mew-erase-buffer)
       (insert " #     #    #      ###   #\n"
  	     " ##   ##   # #      #    #\n"
***************
*** 383,397 ****
       (insert "You can get the message by e-mail\n\n")
       (mew-insert "Server:\t\t%s\n" server)
       (mew-insert "Size:\t%s bytes\n" size)
-      (save-excursion
-        (set-buffer (mew-current-get 'cache))
-        (save-restriction
- 	 (narrow-to-region begin end)
- 	 (goto-char (point-min))
- 	 ;; find a phantom body (in RFC1521)
- 	 (re-search-forward "^$" nil t)
- 	 (forward-line)
- 	 (setq start (point))))
       ;; pickd up source from 'mew-send
       (if (null execute)
  	 (insert "\nTo send this mail, type "
--- 384,389 ----
***************
*** 402,412 ****
         (insert-buffer-substring (mew-current-get 'cache) start end)
         (mew-draft-make-message)))))
  
  (defun mew-ext-url (begin end params execute)
    (mew-elet
!    (let ((url (mew-syntax-get-param params "url"))
! 	 (size (mew-syntax-get-param params "size"))
! 	 (process-connection-type mew-connection-type1))
       (mew-erase-buffer)
       (insert "#     # ######  #\n"
  	     "#     # #     # #\n"
--- 394,424 ----
         (insert-buffer-substring (mew-current-get 'cache) start end)
         (mew-draft-make-message)))))
  
+ (defun mew-ext-decode-message-header (begin end)
+   (let (syntax start)
+     (save-excursion
+       (set-buffer (mew-current-get 'cache))
+       (save-restriction
+ 	(narrow-to-region begin end)
+ 	(goto-char (point-min))
+ 	(setq syntax (mew-decode-mime-header))
+ 	(setq start (point)))
+       (mew-syntax-set-key syntax 'phantom)
+       (mew-syntax-set-begin syntax start)
+       (mew-syntax-set-end syntax end)
+       syntax)))
+ 
  (defun mew-ext-url (begin end params execute)
    (mew-elet
!    (let* ((url (mew-syntax-get-param params "url"))
! 	  (size (mew-syntax-get-param params "size"))
! 	  (process-connection-type mew-connection-type1)
! 	  (syntax (mew-ext-decode-message-header begin end))
! 	  (mct (car (mew-syntax-get-ct syntax)))
! 	  (prog-list (mew-ext-url-by-ct mct))
! 	  (doc (mew-ext-url-get-doc prog-list))
! 	  (prog (mew-ext-url-get-prog prog-list))
! 	  (args (mew-ext-url-get-args prog-list)))
       (mew-erase-buffer)
       (insert "#     # ######  #\n"
  	     "#     # #     # #\n"
***************
*** 417,444 ****
  	     " #####  #     # #######\n"
  	     "\n\n")
       (mew-insert "URL:\t\t%s\n" url)
       (mew-insert "Size:\t%s bytes\n" size)
!      (insert (format "Browser:\t%s\n"
! 		     (cond ((and (symbolp mew-ext-prog-url)
! 				 (fboundp mew-ext-prog-url))
! 			    (symbol-name mew-ext-prog-url))
! 			   ((stringp mew-ext-prog-url) mew-ext-prog-url)
! 			   (t "none"))))
       (if (null execute)
! 	 (insert "\nTo show this URL, type "
  		 (substitute-command-keys
  		  "'\\<mew-summary-mode-map>\\[mew-summary-execute-external]'."))
         (cond
! 	((and (symbolp mew-ext-prog-url) (fboundp mew-ext-prog-url))
! 	 (funcall mew-ext-prog-url url))
! 	((equal mew-ext-prog-url "w3")
! 	 (require 'w3)
! 	 (w3-fetch-other-frame url))
! 	(t
  	 (apply (function start-process)
! 		(format "*mew %s*" mew-ext-prog-url)
! 		mew-buffer-tmp mew-ext-prog-url 
! 		(append mew-ext-prog-url-args (list url)))))))))
  
  ;;
  ;; include
--- 429,465 ----
  	     " #####  #     # #######\n"
  	     "\n\n")
       (mew-insert "URL:\t\t%s\n" url)
+      (mew-insert "Content-Type:\t%s\n" mct)
       (mew-insert "Size:\t%s bytes\n" size)
!      (mew-insert "Operation:\t%s\n" (or doc "not defined"))
       (if (null execute)
! 	 (insert "\nTo operate this URL, type "
  		 (substitute-command-keys
  		  "'\\<mew-summary-mode-map>\\[mew-summary-execute-external]'."))
         (cond
! 	((and (symbolp prog) (fboundp prog))
! 	 (message (format "Call function: (%s %s %s)" prog args url))
! 	 (funcall prog args url))
! 	((stringp prog)
! 	 (setq args (append args (list url)))
! 	 (message (format "Running command: %s"
! 			  (mapconcat
! 			   (function append)(append (list prog) args) " ")))
  	 (apply (function start-process)
! 		(format "*mew %s*" prog) mew-buffer-tmp prog args))
! 	(t (message "Program list error.")))))))
! 
! ;;; mew-ext-url sub function
! 
! (defun mew-ext-url-show-by-w3 (dummy url)
!   (require 'w3)
!   (w3-fetch-other-frame url))
! 
! (defun mew-ext-url-fetch-by-w3 (dummy url)
!   (require 'w3)
!   (w3-fetch url))
! 
! ;;; sub function end
  
  ;;
  ;; include
Index: mew-vars.el
===================================================================
RCS file: /usr/home/kazu/cvsroot/Mew/mew/mew-vars.el,v
retrieving revision 1.250
retrieving revision 1.251
diff -c -r1.250 -r1.251
*** mew-vars.el	2000/04/11 13:20:04	1.250
--- mew-vars.el	2000/04/12 03:05:36	1.251
***************
*** 1601,1619 ****
  ;;; External-body
  ;;;
  
- (defvar mew-ext-prog-url "netscape")
- (defvar mew-ext-prog-url-args '("-install"))
- 
- ;; If you want to use w3.el instead of "netscape", put the 
- ;; following in .emacs.
- ;;(setq mew-ext-prog-url "w3")
- ;;(setq mew-ext-prog-url-args nil)
- 
- ;; If you want to use lynx instead of "netscape", put the 
- ;; following in .emacs.
- ;;(setq mew-ext-prog-url "kterm")
- ;;(setq mew-ext-prog-url-args '("-e" "lynx" "-color"))
- 
  (defvar mew-ext-anon-ftp-method 'ftp
    "A method to get the message body for access-type=anon-ftp.
  If 'ftp is specified, ange-ftp or efs is used. If 'http is specified,
--- 1601,1606 ----
Index: mew-vars2.el
===================================================================
RCS file: /usr/home/kazu/cvsroot/Mew/mew/mew-vars2.el,v
retrieving revision 1.7
diff -c -r1.7 mew-vars2.el
*** mew-vars2.el	2000/04/11 04:44:13	1.7
--- mew-vars2.el	2000/04/12 03:11:18
***************
*** 652,657 ****
--- 652,699 ----
  (defmacro mew-markdb-func-sanity (mark)
    (` (nth 7 (mew-markdb-by-mark (, mark)))))
  
+ 
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;
+ ;;; External-body
+ ;;;
+ 
+ (defvar mew-ext-url-alist
+   '(("^application/" "Fetch by w3" mew-ext-url-fetch-by-w3 nil)
+     (t		     "Browse by netscape" "netscape" ("-install")))
+   "*Alist of (REGEXP DOC PROGRAM ARGS-LIST) to define
+ an appropriate method for a content-type in external-body. Note
+ this phantom body is defined RFC 2017.
+ 
+ If REGEXP is 't', every content-type is matched to the list.
+ If PROGRAM is a string, it is considered an external program.
+ If PROGRAM is a symbol, the lisp function whose name is PROGRAM is called.
+ 
+ 'mew-ext-url-show-by-w3' and 'mew-ext-url-fetch-by-w3' are pre-defined
+ as lisp function.
+ 
+ If you want to use \"w3.el\" instead of \"netscape\", put the 
+ following in .emacs.
+ 	(setq mew-ext-url-alist
+               '((t (\"Browse by w3\" mew-ext-url-show-by-w3 nil))))
+ If you want to use \"lynx\" instead of \"netscape\", put the 
+ following in .emacs.
+         (setq mew-ext-url-alist
+               '((t (\"Browse by lynx\" \"kterm\" (\"-e\" \"lynx\" \"-color\")))))
+ ")
+ 
+ (defmacro mew-ext-url-by-ct (ct)
+   (` (mew-assoc-match2 (, ct) mew-ext-url-alist 0)))
+ 
+ (defmacro mew-ext-url-get-doc (prog-list)
+   (` (nth 1 (, prog-list))))
+ 
+ (defmacro mew-ext-url-get-prog (prog-list)
+   (` (nth 2 (, prog-list))))
+ 
+ (defmacro mew-ext-url-get-args (prog-list)
+   (` (nth 3 (, prog-list))))
+ 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Config-alist


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