Add prosjekt-run-async-shell-command

[sohailsomani]

Hey,

This adds a new function prosjekt-run-async-shell-command which allows you to run a process in the background and get notified if it succeeds or fails. As a bonus, if you use popwin, you get a nice popup as shown here http://screencast.com/t/45ClkqNR02D0

It's kind of like M-x compile but for non-compilation commands. I use it for etags, so:

  (prosjekt-run-async-shell-command "Generating TAGS"
                                    "del /s /q TAGS && dir /s /b *.h* *.c* | etags --append -"
                                    (lambda ()
                                      (setf tags-file-name (concat prsj-proj-dir "/TAGS")))))

---
 prosjekt/prosjekt.el | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

diff --git a/prosjekt/prosjekt.el b/prosjekt/prosjekt.el
index e859c70..f39bfdc 100644
--- a/prosjekt/prosjekt.el
+++ b/prosjekt/prosjekt.el
@@ -446,6 +446,43 @@ This will initialize the entry if needed."
     (read-string "Command: ")))
   (prsj-run-tool cmd))

+(defun prsj-display-process-status (description process)
+  (message "%s... Process status: %S" 
+           description 
+           (process-status process)))
+
+(defun prosjekt-run-async-shell-command (description command &optional on-success on-error)
+  "Run an arbitrary shell command asynchronously. Calls 0-ary
+  functions on-success and on-error when appropriate"
+  (let ((cwd default-directory)
+        (project-name (cdr (assoc "name" prsj-proj)))
+        (process-buffer "*prosjekt-async-command*"))
+    (unwind-protect
+        (progn
+          (cd prsj-proj-dir)
+          (let ((process (start-process-shell-command project-name
+                                                      process-buffer
+                                                      command)))
+            (prsj-display-process-status description process)
+            (run-with-timer 1 nil
+                            'prsj-check-process-status 
+                            description process on-success on-error)))
+      (cd cwd))))
+
+(defun prsj-check-process-status (description process on-success on-error)
+  (prsj-display-process-status description process)
+  (case (process-status process)
+    (exit (if (eql 0 (process-exit-status process))
+              (progn (and on-success (funcall on-success))
+                     (message "%s: Success!" description)
+                     (kill-buffer (process-buffer process)))
+            (and on-error (funcall on-error))
+            (message "%s: Failed!" description)
+            (display-buffer (process-buffer process))))
+    (run (run-with-timer 1 nil 
+                         'prsj-check-process-status 
+                         description process on-success on-error))))              
+
 (defun prsj-bind-shell-command (key command keymap)
   "Bind KEY to execute the shell command COMMAND in KEYMAP."
   (lexical-let ((command command))
-- 
1.7.11.msysgit.1

[abingham]

I like this in principle, and I'll be happy to include it. But I want to keep the "core" of prosjekt as small and understandable as is practical. This is for my benefit and for general code maintenance purposes. What if I packaged this as an add-on? I'm thinking of something a "contrib" directory that comes with prosjekt, full of stuff like this. Functionality like this should fit nicely in the tools/keybindings system. Let me know how that sounds.

[sohailsomani]

That makes perfect sense. And yes, I agree that it fits very nicely with the tools/keybindings (though I haven't tried it with that myself)

[abingham]

@kingcheez I created an "ext" directory and put this code in ext/async-shell-command.el. If you want to add copyright, more/other documentation, or if I just screwed something up, just push the changes my way.