Commits

Anonymous committed 2623abc

2002-04-26 James LewisMoss <dres@lewismoss.org>

* background.el (background-get-job-name): var holding the func to
use to generate the background buffer id/name.
(background-search-job-space): search buffer list for a buffer
generated from FORM (which includes a %d number field) and return
the first that no longer has a process connected to it.
(background-get-job-name-simple): generate a simple background
buffer name "background-%d"
(format-quote-string): just replace % with %% in string so format
won't be unhappy.
(get-bottom-dir): grab last dir part in string (/usr/foo/bar -> bar)
(background-get-job-name-command): more complex background namer
"BG(<command run>)%d"
(background-get-job-name-command-n-dir): and a more complex
background namer "BG(<last dir name>)(<command run>)%d"
(background): use new background-get-job-name custom var to
generate the background name.

  • Participants
  • Parent commits 0339e9d

Comments (0)

Files changed (2)

+2002-04-26  James LewisMoss  <dres@lewismoss.org>
+
+	* background.el (background-get-job-name): var holding the func to
+	use to generate the background buffer id/name.
+	(background-search-job-space): search buffer list for a buffer
+	generated from FORM (which includes a %d number field) and return
+	the first that no longer has a process connected to it.
+	(background-get-job-name-simple): generate a simple background
+	buffer name "background-%d"
+	(format-quote-string): just replace % with %% in string so format
+	won't be unhappy.
+	(get-bottom-dir): grab last dir part in string (/usr/foo/bar -> bar)
+	(background-get-job-name-command): more complex background namer
+	"BG(<command run>)%d"
+	(background-get-job-name-command-n-dir): and a more complex
+	background namer "BG(<last dir name>)(<command run>)%d"
+	(background): use new background-get-job-name custom var to
+	generate the background name.
+
 2002-01-13  Steve Youngs  <youngs@xemacs.org>
 
 	* package-info.in (provides): Remove 'lpr', it's in 'ps-print'.

File background.el

   :type 'boolean
   :group 'background)
 
+(defcustom background-get-job-name 'background-get-job-name-simple
+  "Function to use to generate the job name (and therefore the buffer name
+of processes run in the background."
+  :type '(choice
+           (function-item :tag "Simple Numbered"
+                          :value background-get-job-name-simple)
+           (function-item :tag "Command based"
+                          :value background-get-job-name-command)
+           (function-item :tag "Command and Directory based"
+                          :value background-get-job-name-command-n-dir)
+           )
+  :group 'background)
+
+
+(defun background-search-job-space (form)
+  (let ((job-number 1)
+        job-name)
+    (while (get-process (setq job-name  (format form job-number)))
+      (setq job-number (1+ job-number)))
+    job-number))
+  
+(defun background-get-job-name-simple (command dir)
+  (let* ((form "background-%d")
+         (job-num (background-search-job-space form)))
+    (format form job-num)))
+
+(defun format-quote-string (str)
+  (replace-in-string str "%" "%%"))
+
+(defun get-bottom-dir (str)
+  (let* ((dasplit (split-string str "\/"))
+         (dalen (length dasplit)))
+    (if (= dalen 2)
+        (elt dasplit (- dalen 1))
+      (if (= (length (elt dasplit (- dalen 1))) 0)
+          (elt dasplit (- dalen 2))
+        (elt dasplit (- dalen 1))))))
+
+(defun background-get-job-name-command (command dir)
+  (let* ((form (concat (format "BG(%s" (format-quote-string command)) ")%d"))
+         (job-num (background-search-job-space form)))
+    (format form job-num)))
+
+(defun background-get-job-name-command-n-dir (command dir)
+  (let* ((form (concat (format "BG(%s)(%s"
+                               (format-quote-string (get-bottom-dir dir))
+                               (format-quote-string command)) ")%d"))
+         (job-num (background-search-job-space form)))
+    (format form job-num)))
+
 ;;;###autoload
 (defun background (command &optional buffer-name)
   "Run COMMAND in the background like csh.  
 Optional second argument BUFFER-NAME is a buffer to insert the output into.
 If omitted, a buffer name is constructed from the command run."
   (interactive "s%% ")
-  (let ((job-number 1)
-        job-name
-	(dir default-directory))
-    (while (get-process (setq job-name (format "background-%d" job-number)))
-      (setq job-number (1+ job-number)))
+  (let* ((dir default-directory)
+         (job-name (if (functionp background-get-job-name)
+                       (apply background-get-job-name (list command dir))
+                     (background-get-job-name-simple (list command dir)))))
     (or buffer-name
 	(setq buffer-name (format "*%s*" job-name)))
     (if background-select (pop-to-buffer buffer-name)
       (comint-mode)
       ;; COND because the proc may have died before the G-B-P is called.
       (cond (proc (set-process-sentinel proc 'background-sentinel)
-		  (message "[%d] %d" job-number (process-id proc))))
+		  (message "%d" (process-id proc))))
       (setq mode-name "Background")
       proc)))
 
-
 (defun background-sentinel (process msg)
   "Called when a background job changes state."
   (let ((ms (match-data))) ; barf