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

Move HANDLE-RETURN-KEY and HANDLE-KEY-PRESS into MAKE-FSOBJECTS-VIEWER

This commit is contained in:
eknauel 2005-06-01 08:48:37 +00:00
parent 2e5b16437b
commit af61cbb3ae
1 changed files with 30 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -149,39 +149,6 @@
prefix-len) prefix-len)
prefix-len)))))))) prefix-len))))))))
(define (handle-return-key instance selected-entry num-lines)
(cond
((eq? selected-entry 'parent-dir)
(let* ((maybe-parent
(file-name-directory (send instance 'get-working-dir)))
(parent (if (string=? maybe-parent "") "/" maybe-parent)))
(make-browser-for-dir parent (send instance 'get-buffer))))
(else
(let ((fi (fs-object-info selected-entry)))
(if (and fi (file-info-directory? fi))
(with-errno-handler
((errno packet)
(else
(display packet)
(newline)
instance))
(make-browser-for-dir (fs-object-complete-path selected-entry)
(send instance 'get-buffer)))
instance)))))
(define (handle-key-press instance key)
(let ((select-list (send instance 'get-select-list))
(buffer (send instance 'get-buffer)))
(cond
((= key key-return)
(handle-return-key
instance (select-list-selected-entry select-list)
(calculate-number-of-lines buffer)))
(else
(send instance 'set-select-list!
(select-list-handle-key-press select-list key))
instance))))
(define (make-browser-for-dir dir buffer) (define (make-browser-for-dir dir buffer)
(with-cwd dir (with-cwd dir
(make-fsobjects-viewer (directory-files) (make-fsobjects-viewer (directory-files)
@ -200,6 +167,36 @@
(- (result-buffer-num-lines buffer) 2) (- (result-buffer-num-lines buffer) 2)
(result-buffer-num-cols buffer)))) (result-buffer-num-cols buffer))))
(define (handle-return-key self selected-entry num-lines)
(cond
((eq? selected-entry 'parent-dir)
(let* ((maybe-parent (file-name-directory working-dir))
(parent (if (string=? maybe-parent "") "/" maybe-parent)))
(make-browser-for-dir parent buffer)))
(else
(let ((fi (fs-object-info selected-entry)))
(if (and fi (file-info-directory? fi))
(with-errno-handler
((errno packet)
(else
(display packet)
(newline)
self))
(make-browser-for-dir (fs-object-complete-path selected-entry)
buffer))
self)))))
(define (handle-key-press self key)
(cond
((= key key-return)
(handle-return-key
self (select-list-selected-entry select-list)
(calculate-number-of-lines buffer)))
(else
(set! select-list
(select-list-handle-key-press select-list key))
self)))
(lambda (message) (lambda (message)
(cond (cond
((eq? message 'paint) ((eq? message 'paint)
@ -210,22 +207,6 @@
((eq? message 'key-press) ((eq? message 'key-press)
(lambda (self key control-x-pressed?) (lambda (self key control-x-pressed?)
(handle-key-press self key))) (handle-key-press self key)))
((eq? message 'get-select-list)
(lambda (self)
select-list))
((eq? message 'set-select-list!)
(lambda (self new-select-list)
(set! select-list new-select-list)))
((eq? message 'get-buffer)
(lambda (self)
buffer))
((eq? message 'get-working-dir)
(lambda (self)
working-dir))
(else (else
(error "fsobjects-viewer unknown message" message))))))) (error "fsobjects-viewer unknown message" message)))))))