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

New alignment for processes 

part of darcs patch Sat Sep 17 19:46:34 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 08:59:21 +00:00
parent 0280658d1c
commit 60776a8c1d
3 changed files with 29 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
scheme/layout.scm
View File

@ -181,13 +181,24 @@
(mvwaddstr window pos 1 line) (mvwaddstr window pos 1 line)
(loop (+ pos 1))))))))))) (loop (+ pos 1)))))))))))
(define (fill-up-string length string)
(define (left-align-string length string)
(if (> (string-length string) length) (if (> (string-length string) length)
(substring string 0 length) (substring string 0 length)
(string-append (string-append
string (make-string (- length (string-length string)) string (make-string (- length (string-length string))
#\space)))) #\space))))
(define (right-align-string length string)
(if (> (string-length string) length)
(substring string 0 length)
(string-append
(make-string (- length (string-length string))
#\space)
string)))
(define fill-up-string left-align-string)
(define (cut-to-size length string) (define (cut-to-size length string)
(if (> (string-length string) length) (if (> (string-length string) length)
(substring string 0 length) (substring string 0 length)

2
scheme/nuit-packages.scm
View File

@ -48,6 +48,8 @@
sublist sublist
fill-up-string fill-up-string
right-align-string
left-align-string
cut-to-size cut-to-size
;; old drawing cruft ;; old drawing cruft

30
scheme/process.scm
View File

@ -6,34 +6,34 @@
(cut-to-size (cut-to-size
width width
(string-append (string-append
(fill-up-string 5 "PID") (right-align-string 5 "PID")
" " " "
(fill-up-string 5 "PPID") (right-align-string 5 "PPID")
" " " "
(fill-up-string 8 "USER") (left-align-string 8 "USER")
" " " "
(fill-up-string 5 "TIME") (right-align-string 5 "TIME")
" " " "
(fill-up-string 40 "COMMAND")))) (left-align-string 40 "COMMAND"))))
(define (layout-process width p) (define (layout-process width p)
(cut-to-size (cut-to-size
width width
(string-append (string-append
(fill-up-string 5 (number->string (process-info-pid p))) (right-align-string 5 (number->string (process-info-pid p)))
" " " "
(fill-up-string 5 (number->string (process-info-ppid p))) (right-align-string 5 (number->string (process-info-ppid p)))
" " " "
(fill-up-string 8 (process-info-logname p)) (left-align-string 8 (process-info-logname p))
" " " "
(fill-up-string 5 (number->string (process-info-time p))) (right-align-string 5 (number->string (process-info-time p)))
" " " "
(fill-up-string 40 (string-append (left-align-string 40 (string-append
(process-info-executable p) (process-info-executable p)
" " " "
(string-join (string-join
(process-info-command-line p))))))) (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))))
(make-select-list (make-select-list