#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH
;; a small demo a a klone/tk script, all processing is done in klone, results 
;; sent to a sub-process wish
;;(stack-dump-on-error t)
;(sdb t)

(setq args (getopts "USAGE:"
    ("-v" () verbose "verbose operation")
))

(setq tcl-script

wm resizable .
pack propagate . on
listbox .list -yscroll ".scroll set" -width 0 -font fixed
pack .list -side left -fill y
scrollbar .scroll -command ".list yview"
pack .scroll -side right -fill y

bind .list <Double-ButtonPress-1> {
    klone-send execute-browser [selection get]
}
bind .list <Double-ButtonPress-2> {
    puts stderr "an error text on the stderrr" 
}
bind all <Control-c> {destroy .}

)

(defun process-stdin (fd &aux
    text
  )
  (stream-mode fd :blocking ())
  (:= text (read-chars () fd))
  (stream-mode fd :blocking t)
  (catch 'ERROR (PF "%0\n" (kltk:call text)))
)

;;callback
(setq execute-browser:re (regcomp "^(.*)[/]$"))
(defun execute-browser (file)
  (if (regexec execute-browser:re file) (progn ;dir
      ;; kill browser
      (kltk:send "destroy .list; destroy .scroll; destroy .title")
      ;; re-spawn a new one
      (create-browser (regsub execute-browser:re 1))
    )
    ;file
    (regexec {regcomp "[.]gif$"} file)(sh& xv ,file)
    t (sh& xless ,file)
  )
)

(defun main (&aux
  )
  (setq kltk:wish-name "wish")
;;  (kltk:debug t)
  (create-browser (get args 0 "."))
  (kltk:mainloop *standard-input* 'process-stdin)
)

(defun create-browser (dir &aux
    (files-list (list))
    (dir-list (list))
  )
  (setq *current-directory* dir)
  (dolist (entry (directory))
    (if (= 'directory (file-type entry))
      (lappend dir-list entry)
      (lappend files-list entry)
  ))
  (sort files-list compare)
  (sort dir-list compare)
  (insert dir-list 0 "..")
  
  (kltk:call "label .title -text" *current-directory*
    "\npack .title -side top -anchor nw; wm title . " 
    *current-directory*
    (+ "; wm client . {" *hostname* "}")
  )
  (kltk:send tcl-script)
  (if (> 50 (+ (length dir-list) (length files-list)))
    (kltk:send ".list configure -height 0")
    (kltk:send ".list configure -height 50")
  )
  (dolist (entry dir-list)
    (kltk:send ".list insert end" (+ entry "/"))
  )
  (dolist (entry files-list)
    (kltk:send ".list insert end" entry)
  )
  
)

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***