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

cd.scm? Har har

This commit is contained in:
eknauel 2005-05-30 19:22:33 +00:00
parent 74d61ec7eb
commit 46cdd67321
1 changed files with 0 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
scheme/cd.scm
View File

@ -1,85 +0,0 @@
;;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 (message-result-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 (message-result-object 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 (message-result-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 (message-result-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))