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

use `m' and `u' for selecting/unselecting items

This commit is contained in:
eknauel 2005-05-17 09:56:11 +00:00
parent 0a2c373bc0
commit f649bb93cc
1 changed files with 107 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12,6 +12,8 @@
;;If the given path does not exist you will not be able to navigate! ;;If the given path does not exist you will not be able to navigate!
(define key-m 109)
(define key-u 117)
(define-record-type browse-dir-list-res-obj browse-dir-list-res-obj (define-record-type browse-dir-list-res-obj browse-dir-list-res-obj
(make-browse-dir-list-res-obj pos-y (make-browse-dir-list-res-obj pos-y
@ -192,127 +194,96 @@
(key (key-pressed-message-key message)) (key (key-pressed-message-key message))
(c-x-pressed (browse-dir-list-res-obj-c-x-pressed model))) (c-x-pressed (browse-dir-list-res-obj-c-x-pressed model)))
(if c-x-pressed (cond
(cond
;;Ctrl+x s -> Auswahl ;; user pressed 'm' --- mark current entry
((= key 115) ((= key key-m)
(let* ((marked-items (browse-dir-list-res-obj-marked-items model)) (let* ((marked-items (browse-dir-list-res-obj-marked-items model))
(res-marked-items (browse-dir-list-res-obj-res-marked-items (res-marked-items (browse-dir-list-res-obj-res-marked-items
model)) model))
(actual-pos (browse-dir-list-res-obj-pos-y model)) (actual-pos (browse-dir-list-res-obj-pos-y model))
(all-items (browse-dir-list-res-obj-file-list model))) (all-items (browse-dir-list-res-obj-file-list model)))
(if (<= actual-pos 2) (if (<= actual-pos 2)
model model
(let ((actual-item (list-ref all-items (- actual-pos 3))) (let ((actual-item (list-ref all-items (- actual-pos 3)))
(actual-res-item #f)) (actual-res-item #f))
(begin (begin
(if (not (equal? (cwd) "/")) (if (not (string=? (cwd) "/"))
(set! actual-res-item (string-append (cwd) "/" actual-item)) (set! actual-res-item (string-append (cwd) "/" actual-item))
(set! actual-res-item (string-append "/" actual-item))) (set! actual-res-item (string-append "/" actual-item)))
(if (member actual-res-item marked-items) (if (member actual-res-item marked-items)
model model
(let* ((new-res-marked-items (append res-marked-items (let* ((new-res-marked-items (append res-marked-items
(list (list
actual-res-item))) actual-res-item)))
(new-marked-items (append marked-items (new-marked-items (append marked-items
(list actual-item))) (list actual-item)))
(new-model (make-browse-dir-list-res-obj (new-model (make-browse-dir-list-res-obj
(browse-dir-list-res-obj-pos-y model) (browse-dir-list-res-obj-pos-y model)
(browse-dir-list-res-obj-pos-x model) (browse-dir-list-res-obj-pos-x model)
(browse-dir-list-res-obj-file-list (browse-dir-list-res-obj-file-list
model) model)
(browse-dir-list-res-obj-result-text (browse-dir-list-res-obj-result-text
model) model)
(browse-dir-list-res-obj-working-directory (browse-dir-list-res-obj-working-directory
model) model)
(browse-dir-list-res-obj-width model) (browse-dir-list-res-obj-width model)
(browse-dir-list-res-obj-initial-wd (browse-dir-list-res-obj-initial-wd
model) model)
new-marked-items new-marked-items
new-res-marked-items new-res-marked-items
#f))) #f)))
new-model))))))) new-model)))))))
;;Ctrl+x u -> unselect ;; user pressed 'u' --- unmark current entry
((= key 117) ((= key key-u)
(let* ((marked-items (browse-dir-list-res-obj-marked-items model)) (let* ((marked-items (browse-dir-list-res-obj-marked-items model))
(res-marked-items (browse-dir-list-res-obj-res-marked-items (res-marked-items (browse-dir-list-res-obj-res-marked-items
model)) model))
(actual-pos (browse-dir-list-res-obj-pos-y model)) (actual-pos (browse-dir-list-res-obj-pos-y model))
(all-items (browse-dir-list-res-obj-file-list model))) (all-items (browse-dir-list-res-obj-file-list model)))
(if (<= actual-pos 2) (if (<= actual-pos 2)
model model
(let* ((actual-item (list-ref all-items (- actual-pos 3))) (let* ((actual-item (list-ref all-items (- actual-pos 3)))
(actual-res-item (string-append (cwd) "/" actual-item)) (actual-res-item (string-append (cwd) "/" actual-item))
(rest (member actual-item marked-items)) (rest (member actual-item marked-items))
(res-rest (member actual-res-item res-marked-items))) (res-rest (member actual-res-item res-marked-items)))
(if (not res-rest) (if (not res-rest)
model model
(let* ((after-item (length rest)) (let* ((after-item (length rest))
(all-items (length marked-items)) (all-items (length marked-items))
(before-item (sublist marked-items (before-item (sublist marked-items
0 0
(- all-items (- all-items
after-item ))) after-item )))
(new-marked-items (append before-item (new-marked-items (append before-item
(list-tail rest 1))) (list-tail rest 1)))
(after-res-item (length res-rest)) (after-res-item (length res-rest))
(all-res-items (length res-marked-items)) (all-res-items (length res-marked-items))
(before-res-item (sublist res-marked-items (before-res-item (sublist res-marked-items
0 0
(- all-res-items (- all-res-items
after-res-item))) after-res-item)))
(new-res-marked-items (append before-res-item (new-res-marked-items (append before-res-item
(list-tail res-rest (list-tail res-rest
1))) 1)))
(new-model (make-browse-dir-list-res-obj (new-model (make-browse-dir-list-res-obj
(browse-dir-list-res-obj-pos-y model) (browse-dir-list-res-obj-pos-y model)
(browse-dir-list-res-obj-pos-x model) (browse-dir-list-res-obj-pos-x model)
(browse-dir-list-res-obj-file-list (browse-dir-list-res-obj-file-list
model) model)
(browse-dir-list-res-obj-result-text (browse-dir-list-res-obj-result-text
model) model)
(browse-dir-list-res-obj-working-directory (browse-dir-list-res-obj-working-directory
model) model)
(browse-dir-list-res-obj-width model) (browse-dir-list-res-obj-width model)
(browse-dir-list-res-obj-initial-wd (browse-dir-list-res-obj-initial-wd
model) model)
new-marked-items new-marked-items
new-res-marked-items new-res-marked-items
#f))) #f)))
new-model)))))) new-model))))))
(else
(make-browse-dir-list-res-obj
(browse-dir-list-res-obj-pos-y model)
(browse-dir-list-res-obj-pos-x model)
(browse-dir-list-res-obj-file-list model)
(browse-dir-list-res-obj-result-text model)
(browse-dir-list-res-obj-working-directory
model)
(browse-dir-list-res-obj-width model)
(browse-dir-list-res-obj-initial-wd model)
(browse-dir-list-res-obj-marked-items model)
(browse-dir-list-res-obj-res-marked-items
model)
(not c-x-pressed))))
(cond
;;c-x
((= key 24)
(make-browse-dir-list-res-obj
(browse-dir-list-res-obj-pos-y model)
(browse-dir-list-res-obj-pos-x model)
(browse-dir-list-res-obj-file-list model)
(browse-dir-list-res-obj-result-text model)
(browse-dir-list-res-obj-working-directory
model)
(browse-dir-list-res-obj-width model)
(browse-dir-list-res-obj-initial-wd model)
(browse-dir-list-res-obj-marked-items model)
(browse-dir-list-res-obj-res-marked-items
model)
(not c-x-pressed)))
((= key key-up) ((= key key-up)
(let ((posy (browse-dir-list-res-obj-pos-y model))) (let ((posy (browse-dir-list-res-obj-pos-y model)))
(if (<= posy 2) (if (<= posy 2)
@ -354,13 +325,27 @@
model) model)
#f))) #f)))
new-model)))) new-model))))
((= key 10) ((= key 10)
(selected-browse-dir-list model)) (selected-browse-dir-list model))
(else model))))) ;; user pressed C-x
((= key 24)
(make-browse-dir-list-res-obj
(browse-dir-list-res-obj-pos-y model)
(browse-dir-list-res-obj-pos-x model)
(browse-dir-list-res-obj-file-list model)
(browse-dir-list-res-obj-result-text model)
(browse-dir-list-res-obj-working-directory
model)
(browse-dir-list-res-obj-width model)
(browse-dir-list-res-obj-initial-wd model)
(browse-dir-list-res-obj-marked-items model)
(browse-dir-list-res-obj-res-marked-items
model)
(not c-x-pressed)))
(else model))))
((restore-message? message) ((restore-message? message)