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

Selection-ref for id-output, change semantics of select-list-get-selection, introduce select-list-get-marked 

part of darcs patch Fri Sep 16 12:23:43 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 08:08:15 +00:00
parent 4fce440abc
commit c46282f826
7 changed files with 62 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -205,7 +205,7 @@
(string-join file-names))
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(let* ((marked (select-list-get-selection select-list))
(let* ((marked (select-list-get-marked select-list))
(file-names
(map fs-object-complete-path
(if (null? marked)
@ -217,7 +217,7 @@
file-names)))
(define (get-selection-as-ref self focus-object-table)
(let ((marked (select-list-get-selection select-list))
(let ((marked (select-list-get-marked select-list))
(make-reference (lambda (obj)
(make-focus-object-reference
focus-object-table obj))))

4
scheme/inspector.scm
View File

@ -153,7 +153,7 @@
val)))))
(define (get-selection-as-ref self focus-object-table)
(let ((marked (select-list-get-selection selection-list))
(let ((marked (select-list-get-marked selection-list))
(make-reference (lambda (obj)
(make-focus-object-reference
focus-object-table obj))))
@ -167,7 +167,7 @@
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(if for-scheme-mode?
(let ((marked (select-list-get-selection selection-list)))
(let ((marked (select-list-get-marked selection-list)))
(prepare-selection-for-scheme-mode marked))
""))

2
scheme/job-viewer.scm
View File

@ -78,7 +78,7 @@
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(if for-scheme-mode?
(send self 'get-selection-as-ref focus-object-table)
(let ((marked (select-list-get-selection select-list)))
(let ((marked (select-list-get-marked select-list)))
(if (null? marked)
(number->string
(proc:pid (job-proc (select-list-selected-entry select-list))))

2
scheme/nuit-packages.scm
View File

@ -154,6 +154,7 @@
(open scheme-with-scsh
define-record-types
(subset primitives (record-ref record?))
(subset srfi-13 (string-join))
dirlist-view-plugin
fs-object
@ -300,6 +301,7 @@
paint-selection-list
paint-selection-list-at
select-list-get-selection
select-list-get-marked
select-list-selected-entry
select-list-navigation-key?

2
scheme/process.scm
View File

@ -49,7 +49,7 @@
(header (make-header-line (result-buffer-num-cols buffer))))
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(let* ((marked (select-list-get-selection select-list)))
(let* ((marked (select-list-get-marked select-list)))
(cond
((null? marked)
(number->string

20
scheme/select-list.scm
View File

@ -165,19 +165,31 @@
(mvwaddstr win y x (element-text (car elts)))
(lp (cdr elts) (+ y 1) (+ i 1)))))))
(define (select-list-get-selection select-list)
(define (select-list-get-marked select-list)
(map element-value
(filter element-marked?
(select-list-elements select-list))))
(define (select-list-selected-entry select-list)
(element-value
(list-ref (select-list-elements select-list)
(select-list-cursor-index select-list))))
(select-list-selected-element select-list)))
(define (select-list-selected-element select-list)
(list-ref (select-list-elements select-list)
(select-list-cursor-index select-list)))
(define (select-list-get-selection select-list)
(let ((marked (select-list-get-marked select-list)))
(if (null? marked)
(let ((selected (select-list-selected-element select-list)))
(if (element-markable? selected)
(list (element-value selected))
'()))
marked)))
(define (make-get-selection-as-ref-method select-list)
(lambda (self focus-object-table)
(let ((marked (select-list-get-selection select-list))
(let ((marked (select-list-get-marked select-list))
(make-reference (lambda (obj)
(make-focus-object-reference
focus-object-table obj))))

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

@ -61,7 +61,7 @@
(define (make-id-output-select-list ido num-lines)
(make-select-list
`(,(make-unmarked-element
(cons 'user
(cons 'uid
(string->number
(id-output-uid ido)))
#t
@ -71,13 +71,13 @@
#t
(string-append "Name: " (id-output-name ido)))
,(make-unmarked-element
(cons 'group
(cons 'gid
(string->number
(id-output-gid ido)))
#t
(string-append "GID: " (id-output-gid ido)))
,(make-unmarked-element
(cons 'group
(cons 'group
(id-output-group ido))
#t
(string-append "GID: " (id-output-group ido)))
@ -93,7 +93,7 @@
(cdr group)
"")))
(make-unmarked-element
(cons 'group (string->number gid))
(cons 'gid (string->number gid))
#t
(string-append " " gid " " gname))))
(id-output-groups ido)))
@ -106,6 +106,29 @@
(make-id-output-select-list
ido
(result-buffer-num-lines buffer))))
(define (prepare-selection-for-scheme-mode infos)
(string-append "'" (exp->string (map cdr infos))))
(define (prepare-selection-for-command-mode infos)
(string-join
(map (lambda (type.val)
(case (car type.val)
((user group) (cdr type.val))
((uid gid) (number->string (cdr type.val)))
(else
(error "unknown type in prepare-selection-for-command-mode"
type.val))))
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)))
(lambda (message)
(case message
((paint)
@ -123,16 +146,27 @@
(eq? (car selected) 'user))
(make-user-info-browser
(user-info (cdr selected)) buffer))
((and (pair? selected)
(eq? (car selected) 'uid))
(make-user-info-browser
(user-info (cdr selected)) buffer))
((and (pair? selected)
(eq? (car selected) 'group))
(make-group-info-browser
(group-info (cdr selected)) buffer))
((and (pair? selected)
(eq? (car selected) 'gid))
(make-group-info-browser
(group-info (cdr selected)) buffer))
(else self))))
(else
(set! selection-list
(select-list-handle-key-press
selection-list key))
self))))
((get-selection-as-text)
get-selection-as-text)
(else
(error "unknown message in make-id-output-browser"
message))))))