76 lines
2.2 KiB
Scheme
76 lines
2.2 KiB
Scheme
;;directory-files
|
|
;;---------------
|
|
|
|
;;Basically the result-object of this command is only a wrapper for a
|
|
;;"browse-dir-list"-object. The messages are simply handed over
|
|
|
|
|
|
|
|
(define-record-type dirfiles-res-obj dirfiles-res-obj
|
|
(make-dirfiles-res-obj browse-obj)
|
|
dirfiles-res-obj?
|
|
(browse-obj dirfiles-res-obj-browse-obj))
|
|
|
|
|
|
|
|
(define dir-files-receiver
|
|
(lambda (message)
|
|
(cond
|
|
((next-command-message? message)
|
|
(let* ((width (next-command-message-width message))
|
|
(browse-next-command-message
|
|
(make-next-command-message "browse-dir-list"
|
|
'("(directory-files)" "(cwd)")
|
|
width)))
|
|
|
|
(make-dirfiles-res-obj (browse-dir-list-receiver
|
|
browse-next-command-message))))
|
|
((print-message? message)
|
|
(let* ((model (print-message-object message))
|
|
(width (print-message-width message))
|
|
(browser (dirfiles-res-obj-browse-obj model))
|
|
(browse-print-message
|
|
(make-print-message "browse-dir-list"
|
|
browser
|
|
width)))
|
|
(browse-dir-list-receiver browse-print-message)))
|
|
((key-pressed-message? message)
|
|
(let* ((model (key-pressed-message-result-model message))
|
|
(key (key-pressed-message-key message))
|
|
(browser (dirfiles-res-obj-browse-obj model))
|
|
(browse-key-message
|
|
(make-key-pressed-message "browse-dir-list"
|
|
browser
|
|
key)))
|
|
(make-dirfiles-res-obj (browse-dir-list-receiver
|
|
browse-key-message))))
|
|
|
|
((restore-message? message)
|
|
(let* ((model (restore-message-object message))
|
|
(browser (dirfiles-res-obj-browse-obj model))
|
|
(browse-restore-message
|
|
(make-restore-message "browse-dir-list"
|
|
browser)))
|
|
(browse-dir-list-receiver browse-restore-message)))
|
|
((selection-message? message)
|
|
(let* ((model (selection-message-object message))
|
|
(browser (dirfiles-res-obj-browse-obj model))
|
|
(browse-sel-message
|
|
(make-selection-message "browse-dir-list"
|
|
browser)))
|
|
(browse-dir-list-receiver browse-sel-message)))
|
|
)))
|
|
|
|
|
|
|
|
(define dir-files-rec1
|
|
(make-receiver "directory-files" dir-files-receiver))
|
|
|
|
(set! receivers (cons dir-files-rec1 receivers))
|
|
|
|
(define dir-files-rec2
|
|
(make-receiver "ls" dir-files-receiver))
|
|
|
|
(set! receivers (cons dir-files-rec2 receivers))
|
|
|