commander-s/scheme/cd.scm

;;cd
;;This command can be used on all platforms because it uses the 
;;scsh-Function "chdir"
;;cd-res-objects are only warppers around browse-directoty-list-res-objects.
;;They only differ in the restore-procedure:
;;Other "directory-browsing-commands" like find or ls restore the old working-directory,
;;the directory that was valid, when they were initially called. cd changes the 
;;current-working-directory permanently.


(define-record-type cd-res-obj cd-res-obj
  (make-cd-res-obj browse-obj)
  cd-res-obj?
  (browse-obj cd-res-obj-browse-obj))
			 
(define cd-receiver
 (lambda (message)
    (cond 
     ((next-command-message? message)
       (let* ((width (next-command-message-width message))
	      (parameters (next-command-message-parameters message)))
	 (if (null? parameters)
	     (let* ((result (list "Forgot path!"))
		    (text
		     (layout-result-standard "Forgot Path!" 
					     result width))
		    (browse-obj
		     (make-browse-dir-list-res-obj 1 1 result text (cwd) 
						   width (cwd) '() '() #f)))
	       (make-cd-res-obj browse-obj))
	     (let ((path (car parameters)))
	       (if (not (file-exists? path))	     
		   (let* ((result (list "Path doesn't exist"))
			  (text
			   (layout-result-standard "Path doesn't exist!" 
						   result width))
			  (browse-obj
			   (make-browse-dir-list-res-obj 1 1 result text (cwd) 
							 width (cwd) '() '() #f)))
		     (make-cd-res-obj browse-obj))
		   (begin
		     (chdir path)
		     (let* ((browse-next-command-message 
			     (make-next-command-message "browse-dir-list"
							'("(directory-files)" "(cwd)")
							width)))
		       (make-cd-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 (cd-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 (cd-res-obj-browse-obj model))
	     (browse-key-message 
	      (make-key-pressed-message "browse-dir-list"
					browser
					key)))
	(make-cd-res-obj (browse-dir-list-receiver
				browse-key-message))))
	     
     ((restore-message? message)
      (let* ((model (restore-message-object message))
	     (browser (cd-res-obj-browse-obj model))
	     (wd (browse-dir-list-res-obj-working-directory browser)))
	(chdir wd)))
     ((selection-message? message)
      (let* ((model (selection-message-object message))
	     (browser (cd-res-obj-browse-obj model))
	     (browse-sel-message
	      (make-selection-message "browse-dir-list"
				      browser)))
	(browse-dir-list-receiver browse-sel-message)))
      )))  

(define cd-rec (make-receiver "cd" cd-receiver))

(set! receivers (cons cd-rec receivers))