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

Sorting for processes 

part of darcs patch Sat Sep 17 19:21:17 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 08:58:43 +00:00
parent 2ba820f63a
commit 44c95c43e5
2 changed files with 56 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
scheme/nuit-packages.scm
View File

@ -146,7 +146,12 @@
srfi-13 srfi-13
formats formats
signals signals
ascii
sorting
srfi-8
srfi-26
configuration
focus-table focus-table
ncurses ncurses
pps pps

55
scheme/process.scm
View File

@ -43,6 +43,13 @@
processes) processes)
num-lines))) num-lines)))
(define-option 'ps 'sort-user-up-key (char->ascii #\u))
(define-option 'ps 'sort-user-down-key (char->ascii #\U))
(define-option 'ps 'sort-pid-up-key (char->ascii #\p))
(define-option 'ps 'sort-pid-down-key (char->ascii #\P))
(define-option 'ps 'sort-time-up-key (char->ascii #\t))
(define-option 'ps 'sort-time-down-key (char->ascii #\T))
(define (make-pps-viewer processes buffer) (define (make-pps-viewer processes buffer)
(let ((processes processes) (let ((processes processes)
(select-list (select-list
@ -52,6 +59,24 @@
processes)) processes))
(header (make-header-line (result-buffer-num-cols buffer)))) (header (make-header-line (result-buffer-num-cols buffer))))
(define sorting-keys
(map
(cut config 'ps <>)
(list 'sort-time-up-key
'sort-time-down-key
'sort-user-up-key
'sort-user-down-key
'sort-pid-up-key
'sort-pid-down-key)))
(define (set-processes! new-processes)
(set! processes new-processes)
(set! select-list
(make-process-selection-list
(result-buffer-num-cols buffer)
(- (result-buffer-num-lines buffer) 1)
new-processes)))
(define (get-selection-as-text self for-scheme-mode? focus-object-table) (define (get-selection-as-text self for-scheme-mode? focus-object-table)
(let* ((marked (select-list-get-marked select-list))) (let* ((marked (select-list-get-marked select-list)))
(cond (cond
@ -68,7 +93,6 @@
(map process-info-pid marked))))))) (map process-info-pid marked)))))))
(lambda (message) (lambda (message)
(case message (case message
((paint) ((paint)
@ -79,9 +103,32 @@
((key-press) ((key-press)
(lambda (self key control-x-pressed?) (lambda (self key control-x-pressed?)
(set! select-list (cond
(select-list-handle-key-press select-list key)) ((member key sorting-keys)
self)) (receive (compare select)
(cond
((= key (config 'ps 'sort-time-up-key))
(values < process-info-time))
((= key (config 'ps 'sort-time-down-key))
(values > process-info-time))
((= key (config 'ps 'sort-user-up-key))
(values string<? process-info-logname))
((= key (config 'ps 'sort-user-down-key))
(values string>? process-info-logname))
((= key (config 'ps 'sort-pid-up-key))
(values < process-info-pid))
((= key (config 'ps 'sort-pid-down-key))
(values > process-info-pid)))
(set-processes!
(list-sort
(lambda (p1 p2)
(compare (select p1) (select p2)))
processes))
self))
(else
(set! select-list
(select-list-handle-key-press select-list key))
self))))
((get-selection-as-text) get-selection-as-text) ((get-selection-as-text) get-selection-as-text)