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

Use select-line in process-viewer 

part of darcs patch Sun Sep 18 20:06:01 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 16:30:23 +00:00
parent 5846cc311e
commit 21d45c8b56
6 changed files with 66 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/network-viewer.scm
View File

@ -11,7 +11,7 @@
(case message
((paint)
(lambda (self win buffer have-focus?)
(paint-select-line-at select-line 5 5 win buffer have-focus?)))
(paint-select-line-at select-line 5 5 win)))
((key-press)
(lambda (self key control-x-pressed?)
(select-line-handle-key-press! select-line key)

3
scheme/nuit-engine.scm
View File

@ -821,8 +821,7 @@
(display-completed-line completed-line
(+ 2 new-cursor-pos))))
#f))
((or (select-list-navigation-key? key)
(select-list-marking-key? key))
((select-list-key? key)
(let ((new-select-list
(select-list-handle-key-press select-list key)))
(paint-completion-select-list

12
scheme/nuit-packages.scm
View File

@ -161,6 +161,7 @@
layout
utils
select-list
select-line
tty-debug)
(files process))
@ -320,6 +321,8 @@
(export make-select-list
select-list?
make-unmarked-element
make-marked-element
make-unmarked-text-element
make-marked-text-element
element?
@ -335,8 +338,7 @@
select-list-get-marked
select-list-selected-entry
select-list-navigation-key?
select-list-marking-key?
select-list-key?
make-get-selection-as-ref-method))
@ -358,13 +360,15 @@
select-line-handle-key-press!
paint-select-line
paint-select-line-at
select-line-selected-entry))
select-line-selected-entry
select-line-key?))
(define-structure select-line select-line-interface
(open scheme
define-record-types
signals
layout
tty-debug
ncurses)
(files select-line))

52
scheme/process.scm
View File

@ -3,18 +3,14 @@
(every process-info? thing)))
(define (make-header-line width)
(cut-to-size
width
(string-append
(right-align-string 5 "PID")
" "
(right-align-string 5 "PPID")
" "
(left-align-string 8 "USER")
" "
(right-align-string 5 "TIME")
" "
(left-align-string 40 "COMMAND"))))
(make-select-line
(list
(right-align-string 6 "PID ")
(right-align-string 6 "PPID ")
(left-align-string 9 "USER ")
(right-align-string 6 "TIME ")
"COMMAND")
width))
(define (layout-process width p)
(cut-to-size
@ -28,18 +24,19 @@
" "
(right-align-string 5 (number->string (process-info-time p)))
" "
(left-align-string 40 (string-append
(left-align-string 100 (string-append
(process-info-executable p)
" "
(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))))
(make-select-list
(map
(lambda (p)
(make-unmarked-text-element p #t (layout-process num-cols p)))
(make-unmarked-text-element p #t (layout-process num-cols p)))
processes)
num-lines)))
@ -53,14 +50,13 @@
(define-option 'ps 'refresh-key (char->ascii #\g))
(define (make-pps-viewer processes buffer)
(let ((processes processes)
(select-list
(make-process-selection-list
(result-buffer-num-cols buffer)
;; we need one line for the header
(- (result-buffer-num-lines buffer) 1)
processes))
(header (make-header-line (result-buffer-num-cols buffer))))
(let* ((processes processes)
(header-line (make-header-line (result-buffer-num-cols buffer)))
(select-list
(make-process-selection-list
(result-buffer-num-cols buffer)
(result-buffer-num-lines buffer)
processes)))
(define sorting-keys
(map
@ -100,7 +96,7 @@
((paint)
(lambda (self win buffer have-focus?)
(mvwaddstr win 0 0 header)
(paint-select-line-at header-line 0 0 win)
(paint-selection-list-at
select-list 0 1 win buffer have-focus?)))
@ -138,10 +134,14 @@
((= key (config 'ps 'refresh-key))
(set-processes! (pps))
self)
(else
((select-list-key? key)
(set! select-list
(select-list-handle-key-press select-list key))
self))))
self)
((select-line-key? key)
(select-line-handle-key-press! header-line key)
self)
(else self))))
((get-selection-as-text) get-selection-as-text)

27
scheme/select-line.scm
View File

@ -20,14 +20,19 @@
(define (element-text x) x)
(define-record-type select-line :select-line
(really-make-select-line elements cursor-index num-cols)
(really-make-select-line elements cursor-index num-cols width)
select-line?
(elements select-line-elements)
(cursor-index select-line-cursor-index set-select-line-cursor-index!)
(num-cols select-line-num-cols))
(num-cols select-line-num-cols)
(width select-line-width))
(define (make-select-line elements)
(really-make-select-line elements 0 (length elements)))
(define (make-select-line elements width)
(really-make-select-line elements 0 (length elements) width))
(define (select-line-key? key)
(or (= key key-right)
(= key key-left)))
(define (select-line-handle-key-press! select-line key)
(cond
@ -48,10 +53,10 @@
(if (< old-col (- (select-line-num-cols select-line) 1))
(set-select-line-cursor-index! select-line (+ old-col 1)))))
(define (paint-select-line select-line win result-buffer have-focus?)
(paint-select-line-at select-line 0 0 win result-buffer have-focus?))
(define (paint-select-line select-line win)
(paint-select-line-at select-line 0 0 win))
(define (paint-select-line-at select-line x y win result-buffer have-focus?)
(define (paint-select-line-at select-line x y win)
(let ((cursor-col (select-line-cursor-index select-line)))
(let lp ((elts (select-line-elements select-line))
(i 0)
@ -59,13 +64,17 @@
(cond ((null? elts)
(values))
((= i cursor-col)
(let ((text (element-text (car elts))))
(let ((text (cut-to-size (- (select-line-width select-line)
x)
(element-text (car elts)))))
(wattron win (A-REVERSE))
(mvwaddstr win y x text)
(wattrset win (A-NORMAL))
(lp (cdr elts) (+ i 1) (+ x (string-length text)))))
(else
(let ((text (element-text (car elts))))
(let ((text (cut-to-size (- (select-line-width select-line)
x)
(element-text (car elts)))))
(mvwaddstr win y x text)
(lp (cdr elts) (+ i 1) (+ x (string-length text)))))))))

14
scheme/select-list.scm
View File

@ -10,11 +10,17 @@
(lambda (r)
`(element ,(element-marked? r) ,(element-value r))))
(define (make-unmarked-element value markable? painter)
(make-element markable? #f value painter))
(define (make-marked-element value markable? painter)
(make-element markable? #t value painter))
(define (make-unmarked-text-element value markable? text)
(make-element markable? #f value (make-text-painter text)))
(make-unmarked-element value markable? (make-text-painter text)))
(define (make-marked-text-element value markable? text)
(make-element markable? #t value (make-text-painter text)))
(make-marked-element value markable? (make-text-painter text)))
(define-record-type select-list :select-list
(really-make-select-list elements view-index cursor-index num-lines)
@ -56,6 +62,10 @@
(define (select-list-marking-key? key)
(or (= key key-m) (= key key-u)))
(define (select-list-key? key)
(or (select-list-navigation-key? key)
(select-list-marking-key? key)))
(define (mark/unmark-current-line-maker mark)
(lambda (select-list)
(let* ((index (select-list-cursor-index select-list))