From 5846cc311e7985b8acb12d53aca792bec5bd3883 Mon Sep 17 00:00:00 2001 From: eknauel Date: Tue, 27 Sep 2005 16:29:34 +0000 Subject: [PATCH] select-list's element now have a painter instead of atext, make-(un)marked-text-element provides the old functionality Sun Sep 18 19:13:55 EEST 2005 Martin Gasbichler --- scheme/browse-directory-list.scm | 4 ++-- scheme/inspector.scm | 2 +- scheme/job-viewer.scm | 4 ++-- scheme/nuit-engine.scm | 2 +- scheme/nuit-packages.scm | 4 ++-- scheme/process.scm | 2 +- scheme/select-list.scm | 36 +++++++++++++++++++------------- scheme/user-group-info.scm | 30 +++++++++++++------------- 8 files changed, 45 insertions(+), 39 deletions(-) diff --git a/scheme/browse-directory-list.scm b/scheme/browse-directory-list.scm index 546185f..ffe66c7 100644 --- a/scheme/browse-directory-list.scm +++ b/scheme/browse-directory-list.scm @@ -91,9 +91,9 @@ (define (make-file-select-list fsobjects parent-dir num-lines num-cols) (let ((parent-dir-len (string-length parent-dir))) (make-select-list - (cons (make-unmarked-element 'parent-dir #f " ..") + (cons (make-unmarked-text-element 'parent-dir #f " ..") (map (lambda (fs-object) - (make-unmarked-element + (make-unmarked-text-element fs-object #t (layout-fsobject parent-dir-len fs-object num-cols))) fsobjects)) diff --git a/scheme/inspector.scm b/scheme/inspector.scm index aa01aa8..52c89e9 100644 --- a/scheme/inspector.scm +++ b/scheme/inspector.scm @@ -4,7 +4,7 @@ (let ((menu (prepare-menu focus-obj))) (make-select-list (map (lambda (e) - (make-unmarked-element + (make-unmarked-text-element (cdr e) #t (layout-menu-entry num-cols e))) menu) num-lines))) diff --git a/scheme/job-viewer.scm b/scheme/job-viewer.scm index 92a8427..5531907 100644 --- a/scheme/job-viewer.scm +++ b/scheme/job-viewer.scm @@ -67,7 +67,7 @@ (select-list (make-select-list (map (lambda (job) - (make-unmarked-element + (make-unmarked-text-element job #t (format-job job num-cols))) jobs) (- (result-buffer-num-lines buffer) 2)))) @@ -186,7 +186,7 @@ (make-select-list (map (lambda (args) - (make-unmarked-element + (make-unmarked-text-element (car args) #f (cut-to-size num-cols diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index ba0b134..5d032c9 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -737,7 +737,7 @@ (define (completions->select-list completions num-lines) (debug-message "possible completions " completions) (make-select-list - (map (lambda (s) (make-unmarked-element s #f s)) + (map (lambda (s) (make-unmarked-text-element s #f s)) completions) num-lines)) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 4331d82..a326ca0 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -320,8 +320,8 @@ (export make-select-list select-list? - make-unmarked-element - make-marked-element + make-unmarked-text-element + make-marked-text-element element? select-list-handle-key-press diff --git a/scheme/process.scm b/scheme/process.scm index 653d3a8..e5a1b38 100644 --- a/scheme/process.scm +++ b/scheme/process.scm @@ -39,7 +39,7 @@ (make-select-list (map (lambda (p) - (make-unmarked-element p #t (layout-process num-cols p))) + (make-unmarked-text-element p #t (layout-process num-cols p))) processes) num-lines))) diff --git a/scheme/select-list.scm b/scheme/select-list.scm index 7047490..1c7fbbc 100644 --- a/scheme/select-list.scm +++ b/scheme/select-list.scm @@ -1,20 +1,20 @@ (define-record-type element :element - (make-element markable? marked? value text) + (make-element markable? marked? value painter) element? (markable? element-markable?) (marked? element-marked?) (value element-value) - (text element-text)) + (painter element-painter)) (define-record-discloser :element (lambda (r) - `(element ,(element-marked? r) ,(element-text r)))) + `(element ,(element-marked? r) ,(element-value r)))) -(define (make-unmarked-element value markable? text) - (make-element markable? #f value text)) +(define (make-unmarked-text-element value markable? text) + (make-element markable? #f value (make-text-painter text))) -(define (make-marked-element value markable? text) - (make-element markable? #t value text)) +(define (make-marked-text-element value markable? text) + (make-element markable? #t value (make-text-painter text))) (define-record-type select-list :select-list (really-make-select-list elements view-index cursor-index num-lines) @@ -72,7 +72,7 @@ mark (element-marked? el)) (element-value el) - (element-text el)) + (element-painter el)) result))) '() (zip elements (iota (length elements)))) (select-list-view-index select-list) @@ -139,6 +139,16 @@ (select-list-view-index select-list)) (+ 1 num-lines))) +(define (make-text-painter text) + (lambda (win x y at-cursor? marked?) + (if at-cursor? + (wattron win (A-REVERSE))) + (if marked? + (wattron win (A-BOLD))) + (mvwaddstr win y x text) + (if (or at-cursor? marked?) + (wattrset win (A-NORMAL))))) + (define (paint-selection-list select-list win result-buffer have-focus?) (paint-selection-list-at select-list 0 0 win result-buffer have-focus?)) @@ -153,17 +163,13 @@ ((null? elts) (values)) ((= i cursor-index) - (wattron win (A-REVERSE)) - (mvwaddstr win y x (element-text (car elts))) - (wattrset win (A-NORMAL)) + ((element-painter (car elts)) win x y #t (element-marked? (car elts))) (lp (cdr elts) (+ y 1) (+ i 1))) ((element-marked? (car elts)) - (wattron win (A-BOLD)) - (mvwaddstr win y x (element-text (car elts))) - (wattrset win (A-NORMAL)) + ((element-painter (car elts)) win x y #f #t) (lp (cdr elts) (+ y 1) (+ i 1))) (else - (mvwaddstr win y x (element-text (car elts))) + ((element-painter (car elts)) win x y #f #f) (lp (cdr elts) (+ y 1) (+ i 1))))))) (define (select-list-get-marked select-list) diff --git a/scheme/user-group-info.scm b/scheme/user-group-info.scm index 909438d..e59a516 100644 --- a/scheme/user-group-info.scm +++ b/scheme/user-group-info.scm @@ -118,28 +118,28 @@ (define (make-id-output-select-list ido num-lines) (make-select-list - `(,(make-unmarked-element + `(,(make-unmarked-text-element (cons 'uid (string->number (id-output-uid ido))) #t (string-append "UID: " (id-output-uid ido))) - ,(make-unmarked-element + ,(make-unmarked-text-element (cons 'user (id-output-name ido)) #t (string-append "Name: " (id-output-name ido))) - ,(make-unmarked-element + ,(make-unmarked-text-element (cons 'gid (string->number (id-output-gid ido))) #t (string-append "GID: " (id-output-gid ido))) - ,(make-unmarked-element + ,(make-unmarked-text-element (cons 'group (id-output-group ido)) #t (string-append "GID: " (id-output-group ido))) - ,(make-unmarked-element + ,(make-unmarked-text-element 'text #f "Groups:") @@ -150,7 +150,7 @@ (gname (if (pair? group) (cdr group) ""))) - (make-unmarked-element + (make-unmarked-text-element (cons 'gid (string->number gid)) #t (string-append " " gid " " gname)))) @@ -248,17 +248,17 @@ (define (make-gi-select-list gi num-lines) (make-select-list - `(,(make-unmarked-element 'name + `(,(make-unmarked-text-element 'name #t (string-append "Name: " (group-info:name gi))) - ,(make-unmarked-element 'gid + ,(make-unmarked-text-element 'gid #t (string-append "GID: " (number->string (group-info:gid gi)))) - ,(make-unmarked-element 'text + ,(make-unmarked-text-element 'text #f "Members:") ,@(map (lambda (user) - (make-unmarked-element (cons 'member user) + (make-unmarked-text-element (cons 'member user) #t (string-append " " user))) (group-info:members gi))) @@ -266,22 +266,22 @@ (define (make-ui-select-list ui num-lines) (make-select-list - (list (make-unmarked-element (user-info:name ui) + (list (make-unmarked-text-element (user-info:name ui) #t (string-append "Name: " (user-info:name ui))) - (make-unmarked-element 'uid + (make-unmarked-text-element 'uid #t (string-append "UID: " (number->string (user-info:uid ui)))) - (make-unmarked-element 'gid + (make-unmarked-text-element 'gid #t (string-append "GID: " (number->string (user-info:gid ui)))) - (make-unmarked-element 'home-dir + (make-unmarked-text-element 'home-dir #t (string-append "Home: " (user-info:home-dir ui))) - (make-unmarked-element 'shell + (make-unmarked-text-element 'shell #t (string-append "Shell: " (user-info:shell ui))))