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

get-selection-as-text/ref for user-info records 

part of darcs patch Fri Sep 16 23:55:48 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 08:45:36 +00:00
parent fa5a08ace7
commit f87a5adf01
1 changed files with 61 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -257,13 +257,67 @@
self))))
(else
(error "unknown message in make-group-info-browser" message))))))
(define (value->string val)
(cond ((string? val) val)
((number? val) (number->string val))
((boolean? val) (if val "#t" "#f"))
(else
(error "unknwon value in value->string" val))))
(define (make-user-info-browser ui buffer)
(let ((ui ui)
(buffer buffer)
(selection-list
(make-ui-select-list ui (result-buffer-num-lines buffer))))
(define (user-info-element->value info)
(case info
((gid)
(user-info:gid ui))
((uid)
(user-info:uid ui))
((home-dir)
(user-info:home-dir ui))
((shell)
(user-info:shell ui))
(else ;user name
info)))
(define (prepare-selection-for-command-mode infos)
(string-join
(map value->string
(map user-info-element->value infos))))
(define (prepare-selection-for-scheme-mode infos)
(string-append
"'"
(exp->string
(map user-info-element->value infos))))
(define (get-selection-as-text self for-scheme-mode?
focus-object-table)
(let ((infos
(select-list-get-selection selection-list)))
((if for-scheme-mode?
prepare-selection-for-scheme-mode
prepare-selection-for-command-mode)
infos)))
(define (get-selection-as-ref self focus-object-table)
(let ((infos
(select-list-get-selection selection-list))
(make-reference (lambda (obj)
(make-focus-object-reference
focus-object-table obj))))
(string-append
"(list "
(string-join
(map exp->string
(map make-reference
(map user-info-element->value infos))))
")")))
(lambda (message)
(case message
((paint)
@ -278,6 +332,8 @@
(case selected
((gid)
(make-group-info-browser (group-info (user-info:gid ui)) buffer))
((uid)
self)
((home-dir)
(make-browser-for-dir (user-info:home-dir ui) buffer))
((shell)
@ -290,6 +346,10 @@
(select-list-handle-key-press
selection-list key))
self))))
((get-selection-as-text)
get-selection-as-text)
((get-selection-as-ref)
get-selection-as-ref)
(else
(error "unknown message in make-user-info-browser" message))))))