emacsからタイムアウト付きでプロセスを呼び出す。

なかなかうまく行かない。

• with-timeoutはprocessの呼び出しに対応していない。
• sleep-forは渡した秒数だけ待たないこともある。(原因不明)
  • (sleep-for 3)が0.1xxx秒で終わってしまうことも

今のところはこのような感じ。(一応目的にあった振る舞いはするようになった)

code

(defvar spscwt-hooked-process nil)
(defvar spscwt-wait-milliseconds 100)
(defvar spscwt-warn-ignore nil)

(defun spscwt-warn (buf warn-message)
  (with-current-buffer buf
    (goto-char (point-min))
    (insert ";;-\"" warn-message "\"-;;\n\n")
    (message warn-message)))

(defun spscwt-run-p ()
  (and spscwt-hooked-process
       (eq 'run (process-status spscwt-hooked-process))))

(defun spscwt-process-yet-run-then-kill (buf command)
  (when (spscwt-run-p)
    (unless spscwt-warn-ignore
      (spscwt-warn buf (format "give up: %s" command)))
    (kill-process spscwt-hooked-process)))

(defun spscwt-sleep-for (sec &optional millisec)
  ;;(sleep-for sec millisec)  ;;なぜかsleep-forを使うとsleepしない時がある。
  (call-process-shell-command (format "sleep %d" sec)))


(defun start-process-shell-command-with-timeout
  (sec name buffer command &rest args)
  "start process with time-out. this function return called-process.
if BUFFER value is nil, then this function using gensym-buffer, 
this buffer will be killed when called-process ends"
  (let ((buffer* (or buffer (format "%s" (gensym)))))
    (unwind-protect
	(condition-case err
	    (prog1 (setq spscwt-hooked-process 
			 (apply 'start-process-shell-command name buffer* command args))
	      (sleep-for 0 spscwt-wait-milliseconds) ;;waits a bit
	      (when (spscwt-run-p)
		(spscwt-sleep-for sec)
		(spscwt-process-yet-run-then-kill buffer* command)))
	  (quit (when (spscwt-run-p) 
		  (spscwt-process-yet-run-then-kill buffer* command))))
      (when (and (null buffer) (get-buffer buffer*))
	(kill-buffer buffer*)))))


(defun shell-command-with-timeout (wait-sec command &optional output-buffer)
  "using `start-process-shell-command-with-timeout' (spscwt-hooked-process)"
  (lexical-let ((buf (or output-buffer "*Shell Command Output*")))
    (when (get-buffer buf)
      (with-current-buffer buf (erase-buffer)))
    (set-process-sentinel
     (start-process-shell-command-with-timeout wait-sec buf buf command)
     (lambda (&rest args)
       (set-window-start (display-buffer buf) 1))))
  (process-exit-status spscwt-hooked-process))

e.g.

(shell-command-with-timeout 1 "find / -name foo")

*Shell Command Output*bufferに以下のような結果が出力。

/usr/share/doc/m4/examples/foo
;;-"give up: find / -name foo"-;;

point-minを読んでいるのに、bufferの上部に表示されない理由も分からない。(うまくいくものもある)