69 lines
2.2 KiB
Executable File

:;exec /usr/local/bin/stk -f "$0" "$@"
;;;; A simple STk browser
;;;; Permission to use, copy, modify, distribute,and license this
;;;; software and its documentation for any purpose is hereby granted,
;;;; provided that existing copyright notices are retained in all
;;;; copies and that this notice is included verbatim in any
;;;; distributions. No written agreement, license, or royalty fee is
;;;; required for any of the authorized uses.
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
;;;; This script generates a directory browser, which lists the working
;;;; directory and allows you to open files or subdirectories by
;;;; double-clicking.
;;;; This is a new version of the demo which can be run before STk is installed
;;;; Author: Erick Gallesio []
;;;; Creation date: 3-Aug-1993 17:33
;;;; Last file update: 3-Sep-1999 19:12 (eg)
(require "unix")
;; Create a scrollbar on the right side of the main window and a listbox
;; on the left side.
(frame '.f)
(scrollbar '.f.scroll :command (lambda l (apply .f.list 'yview l)))
(listbox '.f.list :yscroll (lambda l (apply .f.scroll 'set l))
:width 30 :height 20 :font '(Courier -12))
(pack .f.scroll .f.list :side "right" :expand #t :fill "both")
(pack .f :side "top" :fill "both" :expand #t)
(button '.quit :text "Quit" :command (lambda () (exit)))
(pack .quit :fill "x" :side "bottom" :expand #t)
;;; Callback
(define (fill-listbox dir)
(chdir dir)
(.f.list 'delete 0 "end")
(apply .f.list 'insert 0 (sort (glob "*" ".*") string<?)))
(define (edit-file file)
(if (eqv? (os-kind) 'Unix)
(system (string-append "xedit " file "&"))
(system (string-append "notepad " file))))
(define (browse)
(let ((file (string-append (getcwd) "/" (selection 'get))))
((file-is-directory? file) (fill-listbox file))
((file-is-readable? file) (edit-file file))
(else (error "Bad directory or file ~S" file))))))
;; Fill the listbox with a list of all the files (in the given directory or ".")
(fill-listbox (if (> *argc* 0) (car *argv*) (getcwd)))
;; Set binding for "Double-click" on the listbox
(bind .f.list "<Double-Button-1>" browse)