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

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 <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 16:29:34 +00:00
parent a6dfd794a3
commit 5846cc311e
8 changed files with 45 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
scheme/browse-directory-list.scm
View File

@ -91,9 +91,9 @@
(define (make-file-select-list fsobjects parent-dir num-lines num-cols) (define (make-file-select-list fsobjects parent-dir num-lines num-cols)
(let ((parent-dir-len (string-length parent-dir))) (let ((parent-dir-len (string-length parent-dir)))
(make-select-list (make-select-list
(cons (make-unmarked-element 'parent-dir #f " ..") (cons (make-unmarked-text-element 'parent-dir #f " ..")
(map (lambda (fs-object) (map (lambda (fs-object)
(make-unmarked-element (make-unmarked-text-element
fs-object #t (layout-fsobject parent-dir-len fs-object #t (layout-fsobject parent-dir-len
fs-object num-cols))) fs-object num-cols)))
fsobjects)) fsobjects))

2
scheme/inspector.scm
View File

@ -4,7 +4,7 @@
(let ((menu (prepare-menu focus-obj))) (let ((menu (prepare-menu focus-obj)))
(make-select-list (make-select-list
(map (lambda (e) (map (lambda (e)
(make-unmarked-element (make-unmarked-text-element
(cdr e) #t (layout-menu-entry num-cols e))) (cdr e) #t (layout-menu-entry num-cols e)))
menu) menu)
num-lines))) num-lines)))

4
scheme/job-viewer.scm
View File

@ -67,7 +67,7 @@
(select-list (select-list
(make-select-list (make-select-list
(map (lambda (job) (map (lambda (job)
(make-unmarked-element (make-unmarked-text-element
job #t (format-job job num-cols))) job #t (format-job job num-cols)))
jobs) jobs)
(- (result-buffer-num-lines buffer) 2)))) (- (result-buffer-num-lines buffer) 2))))
@ -186,7 +186,7 @@
(make-select-list (make-select-list
(map (map
(lambda (args) (lambda (args)
(make-unmarked-element (make-unmarked-text-element
(car args) #f (car args) #f
(cut-to-size (cut-to-size
num-cols num-cols

2
scheme/nuit-engine.scm
View File

@ -737,7 +737,7 @@
(define (completions->select-list completions num-lines) (define (completions->select-list completions num-lines)
(debug-message "possible completions " completions) (debug-message "possible completions " completions)
(make-select-list (make-select-list
(map (lambda (s) (make-unmarked-element s #f s)) (map (lambda (s) (make-unmarked-text-element s #f s))
completions) completions)
num-lines)) num-lines))

4
scheme/nuit-packages.scm
View File

@ -320,8 +320,8 @@
(export make-select-list (export make-select-list
select-list? select-list?
make-unmarked-element make-unmarked-text-element
make-marked-element make-marked-text-element
element? element?
select-list-handle-key-press select-list-handle-key-press

2
scheme/process.scm
View File

@ -39,7 +39,7 @@
(make-select-list (make-select-list
(map (map
(lambda (p) (lambda (p)
(make-unmarked-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)))

36
scheme/select-list.scm
View File

@ -1,20 +1,20 @@
(define-record-type element :element (define-record-type element :element
(make-element markable? marked? value text) (make-element markable? marked? value painter)
element? element?
(markable? element-markable?) (markable? element-markable?)
(marked? element-marked?) (marked? element-marked?)
(value element-value) (value element-value)
(text element-text)) (painter element-painter))
(define-record-discloser :element (define-record-discloser :element
(lambda (r) (lambda (r)
`(element ,(element-marked? r) ,(element-text r)))) `(element ,(element-marked? r) ,(element-value r))))
(define (make-unmarked-element value markable? text) (define (make-unmarked-text-element value markable? text)
(make-element markable? #f value text)) (make-element markable? #f value (make-text-painter text)))
(define (make-marked-element value markable? text) (define (make-marked-text-element value markable? text)
(make-element markable? #t value text)) (make-element markable? #t value (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)
@ -72,7 +72,7 @@
mark mark
(element-marked? el)) (element-marked? el))
(element-value el) (element-value el)
(element-text el)) (element-painter el))
result))) result)))
'() (zip elements (iota (length elements)))) '() (zip elements (iota (length elements))))
(select-list-view-index select-list) (select-list-view-index select-list)
@ -139,6 +139,16 @@
(select-list-view-index select-list)) (select-list-view-index select-list))
(+ 1 num-lines))) (+ 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?) (define (paint-selection-list select-list win result-buffer have-focus?)
(paint-selection-list-at select-list 0 0 win result-buffer have-focus?)) (paint-selection-list-at select-list 0 0 win result-buffer have-focus?))
@ -153,17 +163,13 @@
((null? elts) ((null? elts)
(values)) (values))
((= i cursor-index) ((= i cursor-index)
(wattron win (A-REVERSE)) ((element-painter (car elts)) win x y #t (element-marked? (car elts)))
(mvwaddstr win y x (element-text (car elts)))
(wattrset win (A-NORMAL))
(lp (cdr elts) (+ y 1) (+ i 1))) (lp (cdr elts) (+ y 1) (+ i 1)))
((element-marked? (car elts)) ((element-marked? (car elts))
(wattron win (A-BOLD)) ((element-painter (car elts)) win x y #f #t)
(mvwaddstr win y x (element-text (car elts)))
(wattrset win (A-NORMAL))
(lp (cdr elts) (+ y 1) (+ i 1))) (lp (cdr elts) (+ y 1) (+ i 1)))
(else (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))))))) (lp (cdr elts) (+ y 1) (+ i 1)))))))
(define (select-list-get-marked select-list) (define (select-list-get-marked select-list)

30
scheme/user-group-info.scm
View File

@ -118,28 +118,28 @@
(define (make-id-output-select-list ido num-lines) (define (make-id-output-select-list ido num-lines)
(make-select-list (make-select-list
`(,(make-unmarked-element `(,(make-unmarked-text-element
(cons 'uid (cons 'uid
(string->number (string->number
(id-output-uid ido))) (id-output-uid ido)))
#t #t
(string-append "UID: " (id-output-uid ido))) (string-append "UID: " (id-output-uid ido)))
,(make-unmarked-element ,(make-unmarked-text-element
(cons 'user (id-output-name ido)) (cons 'user (id-output-name ido))
#t #t
(string-append "Name: " (id-output-name ido))) (string-append "Name: " (id-output-name ido)))
,(make-unmarked-element ,(make-unmarked-text-element
(cons 'gid (cons 'gid
(string->number (string->number
(id-output-gid ido))) (id-output-gid ido)))
#t #t
(string-append "GID: " (id-output-gid ido))) (string-append "GID: " (id-output-gid ido)))
,(make-unmarked-element ,(make-unmarked-text-element
(cons 'group (cons 'group
(id-output-group ido)) (id-output-group ido))
#t #t
(string-append "GID: " (id-output-group ido))) (string-append "GID: " (id-output-group ido)))
,(make-unmarked-element ,(make-unmarked-text-element
'text 'text
#f #f
"Groups:") "Groups:")
@ -150,7 +150,7 @@
(gname (if (pair? group) (gname (if (pair? group)
(cdr group) (cdr group)
""))) "")))
(make-unmarked-element (make-unmarked-text-element
(cons 'gid (string->number gid)) (cons 'gid (string->number gid))
#t #t
(string-append " " gid " " gname)))) (string-append " " gid " " gname))))
@ -248,17 +248,17 @@
(define (make-gi-select-list gi num-lines) (define (make-gi-select-list gi num-lines)
(make-select-list (make-select-list
`(,(make-unmarked-element 'name `(,(make-unmarked-text-element 'name
#t #t
(string-append "Name: " (group-info:name gi))) (string-append "Name: " (group-info:name gi)))
,(make-unmarked-element 'gid ,(make-unmarked-text-element 'gid
#t #t
(string-append "GID: " (number->string (group-info:gid gi)))) (string-append "GID: " (number->string (group-info:gid gi))))
,(make-unmarked-element 'text ,(make-unmarked-text-element 'text
#f #f
"Members:") "Members:")
,@(map (lambda (user) ,@(map (lambda (user)
(make-unmarked-element (cons 'member user) (make-unmarked-text-element (cons 'member user)
#t #t
(string-append " " user))) (string-append " " user)))
(group-info:members gi))) (group-info:members gi)))
@ -266,22 +266,22 @@
(define (make-ui-select-list ui num-lines) (define (make-ui-select-list ui num-lines)
(make-select-list (make-select-list
(list (make-unmarked-element (user-info:name ui) (list (make-unmarked-text-element (user-info:name ui)
#t #t
(string-append "Name: " (user-info:name ui))) (string-append "Name: " (user-info:name ui)))
(make-unmarked-element 'uid (make-unmarked-text-element 'uid
#t #t
(string-append "UID: " (string-append "UID: "
(number->string (user-info:uid ui)))) (number->string (user-info:uid ui))))
(make-unmarked-element 'gid (make-unmarked-text-element 'gid
#t #t
(string-append "GID: " (string-append "GID: "
(number->string (user-info:gid ui)))) (number->string (user-info:gid ui))))
(make-unmarked-element 'home-dir (make-unmarked-text-element 'home-dir
#t #t
(string-append "Home: " (string-append "Home: "
(user-info:home-dir ui))) (user-info:home-dir ui)))
(make-unmarked-element 'shell (make-unmarked-text-element 'shell
#t #t
(string-append "Shell: " (string-append "Shell: "
(user-info:shell ui)))) (user-info:shell ui))))