Posted to tcl by iobates at Sun Aug 09 22:00:14 GMT 2026view raw
- package require Tk
-
- wm title . "FileMan"
-
- set frame [ttk::frame .f -padding "3 3 12 12"]
- grid $frame -column 0 -row 0 -sticky nsew
-
- set flist [tk::listbox .f.lb -listvariable lst -width 50 -height 10]
- grid $flist -column 1 -row 1 -sticky we
-
- grid [ttk::button .f.ebtn -text "Prepare" -command prep] -column 1 -row 2 -sticky we
-
- set clist [tk::listbox .f.cl -listvariable clst -width 50 -height 10]
- grid $clist -column 2 -row 1 -sticky we
- grid [ttk::button .f.cbtn -text "Commit" -command commit] -column 2 -row 2 -sticky we
-
-
- proc commit {} {
- foreach item $::clst {
- puts [eval $item]
- }
- set ::clst [list ]
- }
-
- set clst [list ]
-
- proc prep {} {
- set fil [$::flist curselection]
- toplevel .w
- wm title .w "Info Box"
- ttk::label .w.lbl -text "Choose what this file is"
- ttk::button .w.tv -text "Tv" -command {
- $clist insert end {*}[format "{exec media -t s -f \"%s\"}" [lindex $lst [$::flist curselection]]]
- if {[winfo exists .w]} {
- destroy .w
- }
- }
- ttk::button .w.mov -text "Movie" -command {
- $clist insert end {*}[format "{exec media -t m -f \"%s\"}" [lindex $lst [$::flist curselection]]]
- if {[winfo exists .w]} {
- destroy .w
- }
- }
- ttk::button .w.b -text "Book" -command {
- $clist insert end {*}[format "{exec media -t b -f \"%s\"}" [lindex $lst [$::flist curselection]]]
- if {[winfo exists .w]} {
- destroy .w
- }
- }
- ttk::button .w.d -text "test" -command {
- $clist insert end {*}[format "{exec media -t d -f \"%s\"}" [lindex $lst [$::flist curselection]]]
- if {[winfo exists .w]} {
- destroy .w
- }
- }
- pack .w.tv .w.mov .w.b .w.d
-
- }
-
- proc sort.comp.mtime {a b} {
- set ta [file mtime $a]
- set tb [file mtime $b]
- string compare $a $b
- }
-
-
- proc with-n-days {} {
- set l [list]
- set f [glob -directory /mnt/seed/finished/ *]
- set t [clock scan "-2 days" -base [clock seconds]]
- foreach fl $f {
- if { $t < [file mtime $fl] } {
- lappend l $fl
- }
- }
- set ::lst l
- }
-
-
- proc show-files {} {
- set f [glob -directory /mnt/seed/finished/ *]
- set ::lst $f
- }
-
- proc every {ms cmd} {
- {*}$cmd
- after $ms [list after idle [namespace code [info level 0]]]
- }
-
- bind . <Control-q> {exit}
-
- every 5000 show-files
-
Add a comment