commander-s/scheme/find.scm

;;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))