From 21d45c8b5669e935753f7f0de00a5de4dd157520 Mon Sep 17 00:00:00 2001 From: eknauel Date: Tue, 27 Sep 2005 16:30:23 +0000 Subject: [PATCH] Use select-line in process-viewer part of darcs patch Sun Sep 18 20:06:01 EEST 2005 Martin Gasbichler --- scheme/network-viewer.scm | 2 +- scheme/nuit-engine.scm | 3 +-- scheme/nuit-packages.scm | 12 ++++++--- scheme/process.scm | 52 +++++++++++++++++++-------------------- scheme/select-line.scm | 27 +++++++++++++------- scheme/select-list.scm | 14 +++++++++-- 6 files changed, 66 insertions(+), 44 deletions(-) diff --git a/scheme/network-viewer.scm b/scheme/network-viewer.scm index fcea4d4..e17172b 100644 --- a/scheme/network-viewer.scm +++ b/scheme/network-viewer.scm @@ -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) diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 5d032c9..9c521e6 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -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 diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index a326ca0..94dc1a3 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -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)) diff --git a/scheme/process.scm b/scheme/process.scm index e5a1b38..831b1c0 100644 --- a/scheme/process.scm +++ b/scheme/process.scm @@ -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) diff --git a/scheme/select-line.scm b/scheme/select-line.scm index afa2c6c..45b3160 100644 --- a/scheme/select-line.scm +++ b/scheme/select-line.scm @@ -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))))))))) diff --git a/scheme/select-list.scm b/scheme/select-list.scm index 1c7fbbc..410e0c5 100644 --- a/scheme/select-list.scm +++ b/scheme/select-list.scm @@ -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))