scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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>
This commit is contained in:
mainzelm 2005-10-11 15:45:14 +00:00
parent d51eb49139
commit c5ae699585
1 changed files with 46 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
scheme/job-viewer.scm
View File

@ -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))