From c5ae6995858612e060400fea95867cdb3fad44c3 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Tue, 11 Oct 2005 15:45:14 +0000
Subject: [PATCH] Some config and features for joblist-viewer

part of darcs patch Sat Sep 24 23:09:58 MST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
---
 scheme/job-viewer.scm | 72 +++++++++++++++++++++++++++----------------
 1 file changed, 46 insertions(+), 26 deletions(-)

diff --git a/scheme/job-viewer.scm b/scheme/job-viewer.scm
index 443d463..62e64a3 100644
--- a/scheme/job-viewer.scm
+++ b/scheme/job-viewer.scm
@@ -1,12 +1,8 @@
-(define key-f (char->ascii #\f))
-(define key-s (char->ascii #\s))
-(define key-g (char->ascii #\g))
-(define key-b (char->ascii #\b))
-
-(define fg-key key-f)
-(define bg-key key-b)
-(define stop-job-key key-s)
-(define refresh-key key-g)
+(define-option 'job 'fg-key (char->ascii #\f))
+(define-option 'job 'bg-key (char->ascii #\b))
+(define-option 'job 'stop-job-key (char->ascii #\s))
+(define-option 'job 'refresh-key (char->ascii #\g))
+(define-option 'job 'kill-job-key (char->ascii #\k))
 
 (define (job-name->string name)
   (let ((port (open-output-string)))
@@ -60,17 +56,24 @@
     " "
     (fill-up-string 6 "STATUS"))))
 
+(define (make-jobs-select-list jobs lines width)
+  (make-select-list
+   (map (lambda (job)
+          (make-unmarked-text-element 
+           job #t (format-job job width)))
+        jobs)
+   lines))
+
+
 (define (make-joblist-viewer jobs buffer)
   (let* ((jobs jobs)
 	 (num-cols (- (result-buffer-num-cols buffer) 1))
 	 (headline (make-joblist-headline num-cols))
 	 (select-list
-	  (make-select-list
-	   (map (lambda (job)
-		  (make-unmarked-text-element 
-		   job #t (format-job job num-cols)))
-		jobs)
-	   (- (result-buffer-num-lines buffer) 2))))
+	  (make-jobs-select-list 
+           jobs 
+           (- (result-buffer-num-lines buffer) 2)
+           (- num-cols 2))))
 
     (define get-selection-as-ref
       (make-get-selection-as-ref-method select-list))
@@ -101,14 +104,21 @@
 	((key-press)
 	 (lambda (self key control-x-pressed?)
            (cond 
-            ((= key fg-key)
-             (continue-job-in-foreground (select-list-selected-entry select-list)))
-            ((= key bg-key)
-             (continue-job-in-background (select-list-selected-entry select-list)))
-            ((= key stop-job-key)
+            ((= key (config 'job 'fg-key))
+             (continue-job-in-foreground 
+              (select-list-selected-entry select-list)))
+            ((= key (config 'job 'bg-key))
+             (continue-job-in-background 
+              (select-list-selected-entry select-list)))
+            ((= key (config 'job 'stop-job-key))
              (stop-job (select-list-selected-entry select-list)))
-            ((= key refresh-key)
-             #f) ;; TODO
+            
+            ((= key (config 'job 'kill-job-key))
+             (signal-job signal/kill
+                         (select-list-selected-entry select-list)))
+            
+            ((= key (config 'job 'refresh-key))
+             (send self 'refresh))
             (else
              (set! select-list
                    (select-list-handle-key-press select-list key))))
@@ -118,6 +128,13 @@
 	
 	((get-selection-as-ref) get-selection-as-ref)
 	
+        ((refresh)
+         (lambda (self)
+           (set! select-list
+                 (make-jobs-select-list
+                  jobs
+                  (- (result-buffer-num-lines buffer) 2)
+                  (- num-cols 2)))))
 	(else 
 	 (error "joblist-viewer unknown message" message))))))
 
@@ -221,18 +238,21 @@
 
     (define (handle-key-press self key control-x-pressed?)
       (cond
-       ((= key fg-key)
+       ((= key (config 'job 'fg-key))
 	(continue-job-in-foreground job)
 	self)
-       ((= key bg-key)
+       ((= key (config 'job 'bg-key))
         (continue-job-in-background job)
 	self)
-       ((= key refresh-key)
+       ((= key (config 'job 'refresh-key))
 	(set! select-list (make-job-select-list job))
 	self)
-       ((= key stop-job-key)
+       ((= key (config 'job 'stop-job-key))
         (stop-job job)
 	self)
+       ((= key (config 'job 'kill-job-key))
+        (signal-job signal/kill job)
+        self)
        ((and (= key 10) 
 	     (procedure? (select-list-selected-entry select-list)))
 	(select-list-selected-entry select-list))