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

Fix process format

This commit is contained in:
eknauel 2005-05-31 19:31:38 +00:00
parent df065fe14d
commit 49054b8d88
2 changed files with 41 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
scheme/nuit-packages.scm
View File

@ -38,6 +38,9 @@
exp->string exp->string
sublist sublist
fill-up-string
cut-to-size
;; old drawing cruft ;; old drawing cruft
make-result-buffer make-result-buffer
result-buffer? result-buffer?
@ -79,6 +82,7 @@
formats formats
signals signals
ncurses
pps pps
plugin plugin
layout layout

61
scheme/process.scm
View File

@ -2,24 +2,33 @@
(and (proper-list? thing) (and (proper-list? thing)
(every process-info? thing))) (every process-info? thing)))
(define (string-take-max s nchars) (define (make-header-line width)
(if (>= nchars (string-length s)) (cut-to-size
s width
(string-take s nchars))) (string-append
(fill-up-string 5 "PID")
" "
(fill-up-string 5 "PPID")
" "
(fill-up-string 5 "TIME")
" "
(fill-up-string 40 "COMMAND"))))
(define (layout-process width p) (define (layout-process width p)
(string-take-max (cut-to-size
(apply format width
(append (string-append
(list #f "~A ~A ~A ~A '~A ~A'~%") (fill-up-string 5 (number->string (process-info-pid p)))
(map (lambda (s) (s p)) " "
(list process-info-pid (fill-up-string 5 (number->string (process-info-ppid p)))
process-info-ppid " "
process-info-real-uid (fill-up-string 5 (number->string (process-info-time p)))
process-info-%cpu " "
process-info-executable (fill-up-string 40 (string-append
process-info-command-line)))) (process-info-executable p)
width)) " "
(string-join
(process-info-command-line p)))))))
(define (make-process-selection-list num-cols num-lines processes) (define (make-process-selection-list num-cols num-lines processes)
(let ((layout (lambda (p) (layout-process num-cols p)))) (let ((layout (lambda (p) (layout-process num-cols p))))
@ -35,16 +44,20 @@
(select-list (select-list
(make-process-selection-list (make-process-selection-list
(result-buffer-num-cols buffer) (result-buffer-num-cols buffer)
(result-buffer-num-lines buffer) (- (result-buffer-num-lines buffer) 1)
processes))) processes))
(header (make-header-line (result-buffer-num-cols buffer))))
(lambda (message) (lambda (message)
(cond
((eq? message 'paint)
(lambda (self . args)
(apply paint-selection-list
(cons select-list args))))
((eq? message 'key-press) (case message
((paint)
(lambda (self win buffer have-focus?)
(mvwaddstr win 0 0 header)
(paint-selection-list-at
select-list 0 1 win buffer have-focus?)))
((key-press)
(lambda (self key control-x-pressed?) (lambda (self key control-x-pressed?)
(set! select-list (set! select-list
(select-list-handle-key-press select-list key)) (select-list-handle-key-press select-list key))