55 lines
1.5 KiB
Bash
Executable File
55 lines
1.5 KiB
Bash
Executable File
#!/bin/sh
|
|
:;exec /usr/local/bin/stk -f "$0" "$@"
|
|
;;;;
|
|
;;;; A simple STk browser
|
|
;;;;
|
|
;;;; This script generates a directory browser, which lists the working
|
|
;;;; directory and allows you to open files or subdirectories by
|
|
;;;; double-clicking.
|
|
;;;;
|
|
;;;; $Id: browse.stklos 1.4 Tue, 02 Feb 1999 09:04:21 +0100 eg $
|
|
;;;;
|
|
;;;; Author: Erick Gallesio [eg@unice.fr]
|
|
;;;; Creation date: 3-Aug-1993 17:33
|
|
;;;; Last file update: 2-Feb-1999 08:45
|
|
|
|
(require "Tk-classes")
|
|
(require "unix")
|
|
|
|
;;;;
|
|
;;;; Interface
|
|
;;;;
|
|
(define lb (make <Scroll-Listbox> :width 30 :height 20 :font '(Courier -12)))
|
|
(pack lb :fill "both" :side "top" :expand #t)
|
|
|
|
(define quit (make <Button> :text "Quit" :command '(exit)))
|
|
(pack quit :fill "x" :side "bottom" :expand #t)
|
|
|
|
;;;
|
|
;;; Callback
|
|
;;;
|
|
(define (fill-listbox lb dir)
|
|
(chdir dir)
|
|
(delete lb 0 'end)
|
|
(apply insert lb 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)
|
|
(catch
|
|
(let ((file (string-append (getcwd) "/" (selection 'get))))
|
|
(cond
|
|
((file-is-directory? file) (fill-listbox lb 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 lb (if (> *argc* 0) (car *argv*) (getcwd)))
|
|
|
|
;; Set binding for "Double-click" on the listbox
|
|
(bind (listbox-of lb) "<Double-Button-1>" browse)
|