#!/bin/sh
:;exec /usr/local/bin/stk -f "$0" "$@"
;;;;
;;;; A simple STk browser 
;;;;
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;; 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.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date:  3-Aug-1993 17:33
;;;; Last file update:  3-Sep-1999 19:12 (eg)

(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)