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)
(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))

2
scheme/inspector.scm
View File

@ -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)))

4
scheme/job-viewer.scm
View File

@ -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

2
scheme/nuit-engine.scm
View File

@ -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))

4
scheme/nuit-packages.scm
View File

@ -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

2
scheme/process.scm
View File

@ -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)))

36
scheme/select-list.scm
View File

@ -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)

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

@ -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))))