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