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 (case message
((paint) ((paint)
(lambda (self win buffer have-focus?) (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) ((key-press)
(lambda (self key control-x-pressed?) (lambda (self key control-x-pressed?)
(select-line-handle-key-press! select-line key) (select-line-handle-key-press! select-line key)

3
scheme/nuit-engine.scm
View File

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

12
scheme/nuit-packages.scm
View File

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

52
scheme/process.scm
View File

@ -3,18 +3,14 @@
(every process-info? thing))) (every process-info? thing)))
(define (make-header-line width) (define (make-header-line width)
(cut-to-size (make-select-line
width (list
(string-append (right-align-string 6 "PID ")
(right-align-string 5 "PID") (right-align-string 6 "PPID ")
" " (left-align-string 9 "USER ")
(right-align-string 5 "PPID") (right-align-string 6 "TIME ")
" " "COMMAND")
(left-align-string 8 "USER") width))
" "
(right-align-string 5 "TIME")
" "
(left-align-string 40 "COMMAND"))))
(define (layout-process width p) (define (layout-process width p)
(cut-to-size (cut-to-size
@ -28,18 +24,19 @@
" " " "
(right-align-string 5 (number->string (process-info-time p))) (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) (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
(map (map
(lambda (p) (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) processes)
num-lines))) num-lines)))
@ -53,14 +50,13 @@
(define-option 'ps 'refresh-key (char->ascii #\g)) (define-option 'ps 'refresh-key (char->ascii #\g))
(define (make-pps-viewer processes buffer) (define (make-pps-viewer processes buffer)
(let ((processes processes) (let* ((processes processes)
(select-list (header-line (make-header-line (result-buffer-num-cols buffer)))
(make-process-selection-list (select-list
(result-buffer-num-cols buffer) (make-process-selection-list
;; we need one line for the header (result-buffer-num-cols buffer)
(- (result-buffer-num-lines buffer) 1) (result-buffer-num-lines buffer)
processes)) processes)))
(header (make-header-line (result-buffer-num-cols buffer))))
(define sorting-keys (define sorting-keys
(map (map
@ -100,7 +96,7 @@
((paint) ((paint)
(lambda (self win buffer have-focus?) (lambda (self win buffer have-focus?)
(mvwaddstr win 0 0 header) (paint-select-line-at header-line 0 0 win)
(paint-selection-list-at (paint-selection-list-at
select-list 0 1 win buffer have-focus?))) select-list 0 1 win buffer have-focus?)))
@ -138,10 +134,14 @@
((= key (config 'ps 'refresh-key)) ((= key (config 'ps 'refresh-key))
(set-processes! (pps)) (set-processes! (pps))
self) self)
(else ((select-list-key? key)
(set! select-list (set! select-list
(select-list-handle-key-press select-list key)) (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) ((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 (element-text x) x)
(define-record-type select-line :select-line (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? select-line?
(elements select-line-elements) (elements select-line-elements)
(cursor-index select-line-cursor-index set-select-line-cursor-index!) (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) (define (make-select-line elements width)
(really-make-select-line elements 0 (length elements))) (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) (define (select-line-handle-key-press! select-line key)
(cond (cond
@ -48,10 +53,10 @@
(if (< old-col (- (select-line-num-cols select-line) 1)) (if (< old-col (- (select-line-num-cols select-line) 1))
(set-select-line-cursor-index! select-line (+ old-col 1))))) (set-select-line-cursor-index! select-line (+ old-col 1)))))
(define (paint-select-line select-line win result-buffer have-focus?) (define (paint-select-line select-line win)
(paint-select-line-at select-line 0 0 win result-buffer have-focus?)) (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 ((cursor-col (select-line-cursor-index select-line)))
(let lp ((elts (select-line-elements select-line)) (let lp ((elts (select-line-elements select-line))
(i 0) (i 0)
@ -59,13 +64,17 @@
(cond ((null? elts) (cond ((null? elts)
(values)) (values))
((= i cursor-col) ((= 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)) (wattron win (A-REVERSE))
(mvwaddstr win y x text) (mvwaddstr win y x text)
(wattrset win (A-NORMAL)) (wattrset win (A-NORMAL))
(lp (cdr elts) (+ i 1) (+ x (string-length text))))) (lp (cdr elts) (+ i 1) (+ x (string-length text)))))
(else (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) (mvwaddstr win y x text)
(lp (cdr elts) (+ i 1) (+ x (string-length text))))))))) (lp (cdr elts) (+ i 1) (+ x (string-length text)))))))))

14
scheme/select-list.scm
View File

@ -10,11 +10,17 @@
(lambda (r) (lambda (r)
`(element ,(element-marked? r) ,(element-value 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) (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) (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 (define-record-type select-list :select-list
(really-make-select-list elements view-index cursor-index num-lines) (really-make-select-list elements view-index cursor-index num-lines)
@ -56,6 +62,10 @@
(define (select-list-marking-key? key) (define (select-list-marking-key? key)
(or (= key key-m) (= key key-u))) (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) (define (mark/unmark-current-line-maker mark)
(lambda (select-list) (lambda (select-list)
(let* ((index (select-list-cursor-index select-list)) (let* ((index (select-list-cursor-index select-list))