[mew-win32 4533] Re: NTEmacs で start-process, call-process が無限再帰する

Hayashi Masahiro ( 林 雅博 ) mhayashi1120 at example.com
2009年 2月 11日 (水) 14:54:58 JST


林です。

ちゃんと理解しないでパッチを送ってしまいました。
先日のパッチだと mew-win32 が require される前に advice が付けられたと
きにはやはり無限再帰してしまうみたいです。
また、call-process の optional 指定なども誤ったままで動作しませんでした。

mew のソースには advice を使っているところはないので NG かもしれませんが、
advice を使った形に書き直してみました。また、目的からすると
call-process-region も必要な気がしたのでついでに書き足しています。

NTEmacs で bat ファイルや shell script などを call-process,
start-process してみたところ、動作してくれています。

# Mew でやることじゃない気がします。
# info か wiki にでも書いておくことでしょうか。


Index: mew-win32.el
===================================================================
RCS file: /cvsmew/mew/mew-win32.el,v
retrieving revision 1.67
diff -u -r1.67 mew-win32.el
--- mew-win32.el	21 Jan 2009 05:55:00 -0000	1.67
+++ mew-win32.el	11 Feb 2009 05:47:23 -0000
@@ -59,34 +59,42 @@
   (require 'mw32script)
   (mw32script-init))
  ((condition-case nil
-      (require 'mw32script)
+      (progn
+	(require 'mw32script)
+	(load "mw32misc"))
     (file-error nil)) ;; NTEmacs
   (mw32script-make-pathext-regexp)
-  (defalias 'call-process-original 'call-process)
-  (defun call-process (PROGRAM INFILE BUFFER DISPLAY &rest PROGRAM-ARGS)
-    (let (prog sargs)
-      (setq prog (mw32script-openp PROGRAM))
-      (unless prog
-	(setq prog (mew-which-exec PROGRAM))
-	(setq sargs (mw32script-resolve-script prog)))
-      (if sargs
-	  (apply 'call-process-original
-		 (car sargs) INFILE BUFFER DISPLAY
-		 prog PROGRAM-ARGS)
-	(apply 'call-process-original
-	       PROGRAM INFILE BUFFER DISPLAY PROGRAM-ARGS))))
-  (defalias 'start-process-original 'start-process)
-  (defun start-process (NAME BUFFER PROGRAM &rest PROGRAM-ARGS)
-    (let (prog sargs)
-      (setq prog (mw32script-openp PROGRAM))
-      (unless prog
-	(setq prog (mew-which-exec PROGRAM))
-	(setq sargs (mw32script-resolve-script prog)))
-      (if sargs
-	  (apply 'start-process-original
-		 NAME BUFFER (car sargs) prog PROGRAM-ARGS)
-	(apply 'start-process-original
-	       NAME BUFFER PROGRAM PROGRAM-ARGS))))))
+  (defun mew-w32-argument-editing-function (program args)
+    (let ((default-process-argument-editing-function 'identity)
+	  (process-argument-editing-alist nil)
+	  prog sargs)
+      (setq prog (mw32script-openp program))
+      (if (and (null prog)
+	       (setq prog (mew-which-exec program))
+	       (setq sargs (mw32script-argument-editing-function (list prog))))
+	  (cons (car sargs) (cons prog args))
+	(cons program args))))
+  (defadvice call-process 
+    (before mew-w32-call-process 
+	    (program &optional infile buffer display &rest args)
+	    activate)
+    (let ((sargs (mew-w32-argument-editing-function program args)))
+      (setq program (car sargs)
+	    args (cdr sargs))))
+  (defadvice call-process-region
+    (before mew-w32-call-process-region 
+	    (start end program &optional infile buffer display &rest args)
+	    activate)
+    (let ((sargs (mew-w32-argument-editing-function program args)))
+      (setq program (car sargs)
+	    args (cdr sargs))))
+  (defadvice start-process 
+    (before mew-w32-start-process
+	    (name buffer program &rest program-args)
+	    activate)
+    (let ((sargs (mew-w32-argument-editing-function program program-args)))
+      (setq program (car sargs)
+	    program-args (cdr sargs))))))
 
 ;; printing
 (defun mew-w32-print-buffer ()



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