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

Fix handling of "..", introduce "."

This commit is contained in:
mainzelm 2006-04-07 07:18:53 +00:00
parent ef642752af
commit 9321a0e8cf
1 changed files with 15 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
scheme/browse-directory-list.scm
View File

@ -146,13 +146,18 @@
(define (make-file-select-list fsobjects parent-dir num-lines num-cols)
(let ((parent-dir-len (string-length parent-dir)))
(make-select-list
(cons (make-unmarked-text-element 'parent-dir #f " ..")
(map (lambda (fs-object)
(make-unmarked-text-element
fs-object #t (layout-fsobject parent-dir-len
fs-object num-cols)))
fsobjects))
num-lines)))
(cons (make-unmarked-text-element (file-name->fs-object ".")
#t " .")
(cons (make-unmarked-text-element
(file-name->fs-object "..")
#t " ..")
(map (lambda (fs-object)
(make-unmarked-text-element
fs-object #t (layout-fsobject parent-dir-len
fs-object num-cols)))
fsobjects)))
num-lines
(if (null? fsobjects) 1 2))))
;;; lacks some coolness
(define (abbrev-path path length)
@ -210,7 +215,7 @@
(make-fsobjects-viewer (directory-files)
buffer
(cwd))))
(define (make-fsobjects-viewer fs-objects buffer . maybe-parent)
(let-optionals maybe-parent
((working-dir (find-common-parent
@ -226,13 +231,7 @@
(select-line (make-file-select-line)))
(define (handle-return-key self selected-entry num-lines)
(cond
((eq? selected-entry 'parent-dir)
(let* ((maybe-parent (file-name-directory working-dir))
(parent (if (string=? maybe-parent "") "/" maybe-parent)))
(make-browser-for-dir parent buffer)))
(else
(let ((fi (fs-object-info selected-entry)))
(let ((fi (fs-object-info selected-entry)))
(if (and fi (file-info-directory? fi))
(with-errno-handler
((errno packet)
@ -242,7 +241,7 @@
self))
(make-browser-for-dir (fs-object-complete-path selected-entry)
buffer))
self)))))
self)))
(define (set-fs-objects! new-fs-objects)
(set! fs-objects new-fs-objects)