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!
(define key-m 109)
(define key-u 117)
(define-record-type browse-dir-list-res-obj browse-dir-list-res-obj
(make-browse-dir-list-res-obj pos-y
@ -192,127 +194,96 @@
(key (key-pressed-message-key message))
(c-x-pressed (browse-dir-list-res-obj-c-x-pressed model)))
(if c-x-pressed
(cond
;;Ctrl+x s -> Auswahl
((= key 115)
(let* ((marked-items (browse-dir-list-res-obj-marked-items model))
(res-marked-items (browse-dir-list-res-obj-res-marked-items
model))
(actual-pos (browse-dir-list-res-obj-pos-y model))
(all-items (browse-dir-list-res-obj-file-list model)))
(if (<= actual-pos 2)
model
(let ((actual-item (list-ref all-items (- actual-pos 3)))
(actual-res-item #f))
(begin
(if (not (equal? (cwd) "/"))
(set! actual-res-item (string-append (cwd) "/" actual-item))
(set! actual-res-item (string-append "/" actual-item)))
(if (member actual-res-item marked-items)
model
(let* ((new-res-marked-items (append res-marked-items
(list
actual-res-item)))
(new-marked-items (append marked-items
(list actual-item)))
(new-model (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)
new-marked-items
new-res-marked-items
#f)))
(cond
;; user pressed 'm' --- mark current entry
((= key key-m)
(let* ((marked-items (browse-dir-list-res-obj-marked-items model))
(res-marked-items (browse-dir-list-res-obj-res-marked-items
model))
(actual-pos (browse-dir-list-res-obj-pos-y model))
(all-items (browse-dir-list-res-obj-file-list model)))
(if (<= actual-pos 2)
model
(let ((actual-item (list-ref all-items (- actual-pos 3)))
(actual-res-item #f))
(begin
(if (not (string=? (cwd) "/"))
(set! actual-res-item (string-append (cwd) "/" actual-item))
(set! actual-res-item (string-append "/" actual-item)))
(if (member actual-res-item marked-items)
model
(let* ((new-res-marked-items (append res-marked-items
(list
actual-res-item)))
(new-marked-items (append marked-items
(list actual-item)))
(new-model (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)
new-marked-items
new-res-marked-items
#f)))
new-model)))))))
;;Ctrl+x u -> unselect
((= key 117)
(let* ((marked-items (browse-dir-list-res-obj-marked-items model))
(res-marked-items (browse-dir-list-res-obj-res-marked-items
model))
(actual-pos (browse-dir-list-res-obj-pos-y model))
(all-items (browse-dir-list-res-obj-file-list model)))
(if (<= actual-pos 2)
model
(let* ((actual-item (list-ref all-items (- actual-pos 3)))
(actual-res-item (string-append (cwd) "/" actual-item))
(rest (member actual-item marked-items))
(res-rest (member actual-res-item res-marked-items)))
(if (not res-rest)
model
(let* ((after-item (length rest))
(all-items (length marked-items))
(before-item (sublist marked-items
0
(- all-items
after-item )))
(new-marked-items (append before-item
(list-tail rest 1)))
(after-res-item (length res-rest))
(all-res-items (length res-marked-items))
(before-res-item (sublist res-marked-items
0
(- all-res-items
after-res-item)))
(new-res-marked-items (append before-res-item
(list-tail res-rest
1)))
(new-model (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)
new-marked-items
new-res-marked-items
#f)))
;; user pressed 'u' --- unmark current entry
((= key key-u)
(let* ((marked-items (browse-dir-list-res-obj-marked-items model))
(res-marked-items (browse-dir-list-res-obj-res-marked-items
model))
(actual-pos (browse-dir-list-res-obj-pos-y model))
(all-items (browse-dir-list-res-obj-file-list model)))
(if (<= actual-pos 2)
model
(let* ((actual-item (list-ref all-items (- actual-pos 3)))
(actual-res-item (string-append (cwd) "/" actual-item))
(rest (member actual-item marked-items))
(res-rest (member actual-res-item res-marked-items)))
(if (not res-rest)
model
(let* ((after-item (length rest))
(all-items (length marked-items))
(before-item (sublist marked-items
0
(- all-items
after-item )))
(new-marked-items (append before-item
(list-tail rest 1)))
(after-res-item (length res-rest))
(all-res-items (length res-marked-items))
(before-res-item (sublist res-marked-items
0
(- all-res-items
after-res-item)))
(new-res-marked-items (append before-res-item
(list-tail res-rest
1)))
(new-model (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)
new-marked-items
new-res-marked-items
#f)))
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)
(let ((posy (browse-dir-list-res-obj-pos-y model)))
(if (<= posy 2)
@ -354,13 +325,27 @@
model)
#f)))
new-model))))
((= key 10)
(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)