93 lines
2.8 KiB
Scheme
93 lines
2.8 KiB
Scheme
;;find
|
|
;;This extension uses the unix-tool "find". You can only use this command in
|
|
;;if "find" is present in your environment.
|
|
;;This addition uses the capabilities defined in browse-directory-list
|
|
|
|
|
|
|
|
|
|
(define-record-type find-res-obj find-res-obj
|
|
(make-find-res-obj browse-obj)
|
|
find-res-obj?
|
|
(browse-obj find-res-obj-browse-obj))
|
|
|
|
|
|
|
|
(define find-receiver
|
|
(lambda (message)
|
|
(cond
|
|
((next-command-message? message)
|
|
(let* ((width (next-command-message-width message))
|
|
(parameter (next-command-message-parameters message)))
|
|
|
|
(if (null? parameter)
|
|
(let* ((result (list "Forgot parameters!"))
|
|
(text
|
|
(layout-result-standard "Forgot parameters!"
|
|
result width))
|
|
(browse-obj
|
|
(make-browse-list-res-obj 1 1 1 1 result text
|
|
width '() '() #f)))
|
|
(make-find-res-obj browse-obj))
|
|
|
|
(let*
|
|
((parameters (get-param-as-str parameter))
|
|
(result (evaluate
|
|
(string-append "(run/sexps (find" parameters "))")))
|
|
(result-string (map exp->string result))
|
|
(list-str (string-append "'" (exp->string result-string)))
|
|
(browse-next-command-message
|
|
(make-next-command-message "browse-list"
|
|
(cons list-str
|
|
(list "\"/\""))
|
|
width)))
|
|
|
|
(make-find-res-obj (browse-list-receiver
|
|
browse-next-command-message))))))
|
|
((print-message? message)
|
|
(let* ((model (print-message-object message))
|
|
(width (print-message-width message))
|
|
(browser (find-res-obj-browse-obj model))
|
|
(browse-print-message
|
|
(make-print-message "browse-list"
|
|
browser
|
|
width)))
|
|
(browse-list-receiver browse-print-message)))
|
|
((key-pressed-message? message)
|
|
(let* ((model (key-pressed-message-result-model message))
|
|
(key (key-pressed-message-key message))
|
|
(browser (find-res-obj-browse-obj model))
|
|
(browse-key-message
|
|
(make-key-pressed-message "browse-list"
|
|
browser
|
|
key)))
|
|
(make-find-res-obj (browse-list-receiver
|
|
browse-key-message))))
|
|
|
|
((restore-message? message)
|
|
(let* ((model (restore-message-object message))
|
|
(browser (find-res-obj-browse-obj model))
|
|
(browse-restore-message
|
|
(make-restore-message "browse-ist"
|
|
browser)))
|
|
(browse-list-receiver browse-restore-message)))
|
|
((selection-message? message)
|
|
(let* ((model (selection-message-object message))
|
|
(browser (find-res-obj-browse-obj model))
|
|
(browse-sel-message
|
|
(make-selection-message "browse-list"
|
|
browser)))
|
|
(browse-list-receiver browse-sel-message)))
|
|
)))
|
|
|
|
|
|
(define slash-away
|
|
(lambda (path)
|
|
(if (> (string-length path) 0)
|
|
(substring path 1 (string-length path))
|
|
path)))
|
|
|
|
|
|
(define find-rec (make-receiver "find" find-receiver))
|
|
|
|
(set! receivers (cons find-rec receivers)) |