mc/tk/mc.tcl

# Midnight Commander Tk code.
# Copyright (C) 1995, 1996, 1997 Miguel de Icaza
#
#
#   Todo:
#     Fix the internal viewer
#     Missing commands: mc_file_info, mc_open_with
#     The default buttons have a problem with the new frame around them: 
#     they don't display the focus.
#   
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */

wm iconname . tkmc
wm title    . "Midnight Commander (TK edition)"

#
# Menu routines
#
proc create_top_menu {} {
    global top_menus
    global setup
    set top_menus ""

    frame .mbar -relief raised -bd 2

    pack .mbar -side top -fill x
}

#
# Widget: WMenu
#
proc create_menu {str topmenu} {
    global top_menus
    global setup

    menubutton .mbar.$topmenu -text $str -underline 0 -menu .mbar.$topmenu.menu
    pack .mbar.$topmenu -side left
    menu .mbar.$topmenu.menu -tearoff $setup(tearoff)
    set top_menus "$top_menus $topmenu"
}

proc create_mentry {topmenu entry cmd idx} {
    .mbar.$topmenu.menu add command -label "$entry" -command "$cmd $idx"
}

proc add_separator {topmenu} {
    .mbar.$topmenu.menu add separator
}

#
# Widget: WButton
#
proc newbutton {name cmd text isdef} {
    if $isdef {
	frame $name -relief sunken -bd 1 
	set name "$name.button"
    }
    button $name -text "$text" -command $cmd -justify left
    if $isdef {
	pack $name -padx 1m -pady 1m
    }
}

#
# Widget: WGauge
#
proc newgauge {win} {
    global setup

    canvas $win -height $setup(heightc) -width 250 -relief sunken -border 2
    $win create rectangle 0 0 0 0 -tags gauge -fill black -stipple gray50

    # So that we can tell the C code, which is the gauge size currently
    bind $win <Configure> "x$win %w"
}

# Used to show the gauge information
proc gauge_shown {win} {
    # $win configure -relief sunken -border 2
}

# Used to hide the gauge information.
proc gauge_hidden {win} {
    # $win configure -relief flat -border 0
    $win coords gauge 0 0 0 0
}

#
# Widget: WView
#
proc view_size {cmd w h} {
    global setup

    $cmd dim [expr $w/$setup(widthc)] [expr $h/$setup(heightc)]
}

proc newview {is_panel container winname cmd} {
    global setup 

    # FIXME: The trick to get the window without too much
    # movement/flicker is to use an extra frame, and use the placer
    # like it was done in WInfo.
    if $is_panel {
	set width  [expr [winfo width $container]/$setup(widthc)]
	set height [expr [winfo height $container]/$setup(heightc)]
    }

    frame $winname
    frame $winname.v
    frame $winname.v.status
    eval text $winname.v.view $setup(view_normal) -font $setup(panelfont) 
    
    # Create the tag names for the viewer attributes
    eval $winname.v.view tag configure bold $setup(view_bold)
    eval $winname.v.view tag configure underline $setup(view_underline)
    eval $winname.v.view tag configure mark $setup(view_mark)
    eval $winname.v.view tag configure normal $setup(view_normal)
    
    # Make the status fields
    label $winname.v.status.filename
    label $winname.v.status.column
    label $winname.v.status.size
    label $winname.v.status.flags
    
    pack $winname.v.status.filename -side left
    pack $winname.v.status.column   -anchor w -side left -fill x -expand 1
    pack $winname.v.status.size     -anchor w -side left -fill x -expand 1
    pack $winname.v.status.flags    -anchor w -side left -fill x -expand 1
    
    # Pack the main components
    pack $winname.v.status -side top -fill x
    pack $winname.v.view -side bottom -expand 1 -fill both
    pack $winname.v -expand 1 -fill both
    
    bindtags $winname.v.view "all . $winname.v.view"
    bind $winname.v.view <Configure> "view_size $cmd %w %h"

    if $is_panel {
	$winname.v.view configure -width $width -height $height
	pack $winname
    }
}

proc view_update_info {win fname col size flags} {
    $win.v.status.filename configure -text "File: $fname"
    $win.v.status.column   configure -text "Column: $col"
    $win.v.status.size     configure -text "$size bytes"
    $win.v.status.flags    configure -text "$flags"
}

#
# Hack: remove all the text on the window and then insert
# new lines.  Maybe the newlines
proc cleanview {win} {
    $win delete 1.0 end
    $win insert 1.0 "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
}

#
# Widget: WRadio
#
proc newradio {name} {
    frame $name
    global last_radio 
    set last_radio $name
}

proc radio_item {idx text cmd act} {
     global last_radio
     radiobutton $last_radio.$idx -text "$text" -variable v$last_radio -value $idx -command "$cmd select $idx"
     if $act {
	 $last_radio.$idx select 
     }
     pack $last_radio.$idx -side top -anchor w
}

#
# Widget: Input
#
#

proc entry_save_sel {win} {
    global sel

    if [$win selection present] {
	set sel(pres) 1
	set sel(first) [$win index sel.first]
	set sel(last)  [$win index sel.last]
    } else {
	set sel(pres) 0
    }
}

proc entry_restore_sel {win} {
    global sel

    if $sel(pres) {
	$win selection from $sel(first) 
	$win selection to $sel(last)
    }
}

proc entry_click {win x} {
    global sel
    set p [$win index @$x] 
    x$win mouse $p
    x$win setmark
    set sel(from) $p
}

proc entry_move {win x} {
    global sel
    set p [$win index @$x]
    $win selection from $sel(from) 
    $win selection to $p
    x$win mouse $p
}

proc bind_entry {win} {
    bind $win <1>         "entry_click $win %x"
    bind $win <B1-Motion> "entry_move $win %x"
}

proc newinput {name text} {
    entry $name -relief sunken -background white -foreground black
    $name insert 0 "$text"
    bindtags $name "all . $name "
    bind_entry $name
}

#
# Widget: WCheck
#
proc newcheck {name cmd text act} {
    checkbutton $name -text "$text" -command "$cmd" 
    if $act { $name select }
}

#
# Widget: WInfo
#
# window is the container name and widget name: .left.o2
# container is the container name: .left
#
    proc info_entry {win name text} {
	frame $win.b.finfo.$name
	label $win.b.finfo.$name.label -text "$text"
	label $win.b.finfo.$name.info  
	grid $win.b.finfo.$name.label -row 0 -column 0 -sticky we
	grid $win.b.finfo.$name.info -row 0 -column 1 -sticky w
	grid columnconfigure $win.b.finfo.$name 0 -minsize 100
    }

proc newinfo {container window version} {
    global setup

    set width  [winfo width $container]
    set height [winfo height $container]

    frame $window -width $width -height $height \
	-borderwidth [expr $setup(widthc)/2]

    frame $window.b
    frame $window.b.v
    frame $window.b.finfo -relief groove -borderwidth 2
    frame $window.b.fs -relief groove -borderwidth 2

    label $window.b.v.version -text "  The Midnight Commander $version  " \
	-relief groove
    pack  $window.b.v.version -fill x

    info_entry $window fname    "File:"
    info_entry $window location "Location:"
    info_entry $window mode     "Mode:"
    info_entry $window links    "Links:"
    info_entry $window owner    "Owner:"
    info_entry $window size     "Size:"
    info_entry $window created  "Created:"
    info_entry $window modified "Modified:"
    info_entry $window access   "Access:"

    pack  $window.b.finfo.fname \
	$window.b.finfo.location $window.b.finfo.mode $window.b.finfo.links \
	$window.b.finfo.owner $window.b.finfo.size $window.b.finfo.created \
	$window.b.finfo.modified $window.b.finfo.access \
	-side top -anchor w 

    label $window.b.fs.fsys
    label $window.b.fs.dev
    label $window.b.fs.type

    frame  $window.b.fs.free
    label  $window.b.fs.free.label
    newcanvas $window.b.fs.free.canvas

    pack $window.b.fs.free.label -side left
    pack $window.b.fs.free.canvas -side left

    frame  $window.b.fs.freeino
    label  $window.b.fs.freeino.label
    newcanvas $window.b.fs.freeino.canvas
    pack  $window.b.fs.freeino.label -side left
    pack  $window.b.fs.freeino.canvas -side left

    pack $window.b.fs.fsys \
	$window.b.fs.dev $window.b.fs.type \
	$window.b.fs.free \
	$window.b.fs.freeino -side top -anchor w -padx $setup(widthc)

    pack $window.b.v -side top -anchor w -fill x -expand 1

    pack $window.b.fs -side bottom -anchor w -fill x -expand 1

    pack $window.b.finfo -side top -anchor w \
	-fill x -expand 1

    pack $window.b

    pack $window -fill both -expand 1
#    pack $window.b
    place $window.b -in $window -relx 0 -rely 0 -relheight 1 -relwidth 1
}

proc info_bar {win percent} {
    global setup
    set w [winfo width $win]
    set s [expr (100-$percent)*$w/100]
    
    $win coords bar 0 0 $s 50
#    puts stderr "Width: $w $s\n\r"
}

proc info_none {win} {
    $win coords bar 0 0 0 0
    
}

proc newcanvas {win} {
    global setup
    canvas $win -height $setup(heightc) -relief sunken -border 2
    $win create rectangle 0 0 0 0 -tags bar -fill black -stipple gray50
}

proc infotext {win text} {
    $win configure -text $text
}

proc xinfotext {win text} {
    $win.info configure -text $text
}
    # w containes the window name *and* the .b frame (like: .left.o2.b)
    # FIXME: We should also display the rdev information
proc info_update {w
                  fname dev ino 
		  mode mode_oct 
		  links owner group 
                  have_blocks blocks 
		  size 
		  have_rdev rdev rdev2
		  create modify access
		  fsys dev type 
		  have_space avail percent total
		  have_ino   nfree inoperc inotot} {

    # 
    # Set all the text information
    # 
    xinfotext $w.finfo.fname    "$fname"
    xinfotext $w.finfo.location "${dev}h:${ino}h"
    xinfotext $w.finfo.mode     "$mode ($mode_oct)"
    xinfotext $w.finfo.links    "$links"
    xinfotext $w.finfo.owner    "$owner/$group"
    if $have_blocks {
	xinfotext $w.finfo.size     "$size ($blocks blocks)"
    } else {
	xinfotext $w.finfo.size     "$size"
    }
    xinfotext $w.finfo.created  "$create"
    xinfotext $w.finfo.modified "$modify"
    xinfotext $w.finfo.access   "$access"
   
    infotext $w.fs.fsys "Filesystem:\t$fsys"
    infotext $w.fs.dev  "Device:\t\t$dev"
    infotext $w.fs.type "Type:\t\t$type"
    if $have_space {
	infotext $w.fs.free.label \
	   "Free Space $avail ($percent%) of $total"
	info_bar $w.fs.free.canvas $percent
    } else {
	infotext $w.fs.free.label "No space information"
	info_none $w.fs.free.canvas
    }
    if $have_ino {
	infotext $w.fs.freeino.label \
	   "Free inodes $nfree ($inoperc%) of $inotot"
	info_bar $w.fs.freeino.canvas $inoperc
    } else {
	infotext $w.fs.freeino.label "No inode information"
	info_none $w.fs.freeino.canvas
    }
}

#
#  Widget: listbox
#
proc listbox_sel {win item} {
    $win selection clear 0 end
    $win selection set $item
    $win see $item
}

#
# Widget: WPanel
#
proc panel_select {w pos cback} {
    $w.m.p.panel tag add selected $pos.0 "$pos.0 lineend"
    $w.m.p.panel see $pos.0
    $cback top [$w.m.p.panel index @0,0]
}

proc panel_scroll {win cback args} {
    eval "$win yview $args"
    $cback top [$win index @0,0]
}

proc cmd_sort_add {name menu cmd} {
    $menu add command -label $name -command "$cmd sort $name"
}

proc panel_setup {which cmd} {
    global setup

    frame $which
    set m $which.cwd.menu
    menubutton $which.cwd -text "loading..." -bd 1 -relief raised \
	-menu $m -indicatoron 0
    menu $m -tearoff 0
        menu [set mm $m.sort] -tearoff 0
        $m add command -label "Reverse sort order" -command "$cmd reverse"
        $m add cascade -label "Sort" -menu $mm
            cmd_sort_add "Name"  $mm $cmd
            cmd_sort_add "Extension" $mm $cmd
            cmd_sort_add "Size"  $mm $cmd
            cmd_sort_add "Modify Time" $mm $cmd
            cmd_sort_add "Access Time" $mm $cmd
            cmd_sort_add "Change Time" $mm $cmd
            cmd_sort_add "Inode" $mm $cmd
            cmd_sort_add "Type"  $mm $cmd
            cmd_sort_add "Links" $mm $cmd
            cmd_sort_add "NGID"  $mm $cmd
            cmd_sort_add "NUID"  $mm $cmd
            cmd_sort_add "Owner" $mm $cmd
            cmd_sort_add "Group" $mm $cmd
            cmd_sort_add "Unsorted" $mm $cmd

	$m add command -label "Refresh" -command "$cmd refresh"
	$m add separator
    	$m add command -label "Set mask" -command "$cmd setmask"
	$m add command -label "No mask"  -command "$cmd nomask"

    frame $which.m
    label $which.mini
    scrollbar $which.m.scroll -width 3m

    frame $which.m.p -relief sunken -borderwidth 2
        # The sort bar
        if $setup(with_sortbar) {
	    canvas $which.m.p.types \
		    -borderwidth 0\
		    -back $setup(def_back) \
		    -highlightthickness 0 -height 0
	    pack $which.m.p.types  -side top -fill x
	}

        scrollbar $which.m.p.scroll -width 3m -orient horizontal

        # The file listing panel
        text  $which.m.p.panel -width $setup(cols) -yscroll "$which.m.scroll set" \
	    -fore $setup(def_fore) -back $setup(def_back) \
   	    -wrap none -height $setup(lines) -font $setup(panelfont)  \
	    -relief flat -borderwidth 0 -highlightthickness 0 \
	    -xscroll "$which.m.p.scroll set"

        bindtags $which.m.p.panel "all . $which.m.p.panel"

	proc x$which.m.p.panel {x} "$cmd \$x"
	
        pack $which.m.p.panel  -side top  -fill both -expand 1
        pack $which.m.p.scroll -side top  -fill x 
        pack $which.m.p        -side left -fill both -expand 1

    pack $which.m.scroll -side right -fill y
    pack $which.cwd  -side top -anchor w
    pack $which.m    -side top -fill both -expand 1
    pack $which.mini -side top -fill x

    pack $which -fill both -expand 1

    config_colors $which.m.p.panel
}

    #
    # Draging the panels:
    # mc_x and mc_y contains the last positions where the mouse was
    # mc_repeat     contains the id of the after command.
    #
proc panel_cancel_repeat {} {
    global mc_repeat

    after cancel $mc_repeat
    set mc_repeat {}
}

proc panel_drag {w cmd n} {
    global mc_y
    global mc_x
    global mc_repeat

    if {$mc_y >= [winfo height $w]} {
	$w yview scroll 1 units 
    } elseif {$mc_y < 0} {
	$w yview scroll -1 units
    } else {
	return
    }
    $cmd top [$w index @0,0]
    $cmd motion $n [$w index @$mc_x,$mc_y]
    set mc_repeat [after 50 panel_drag $w $cmd $n]
}

    #
    #  This routine passes the size of the text widget back to the C code
    #

proc panel_size {cmd panel w h} {
    global setup

    set setup(real_height) $h
    set setup(real_width)  $w

    if $setup(with_icons) {
	set setup(height) [expr $h-setup(iconheight)]
	set setup(width)  [expr $w-$setup(iconwidth)]
	set setup(lines)  [expr $setup(height)/$setup(heightc)]
	set setup(cols)   [expr $setup(width)/$setup(widthc)]
    } else {
	set setup(height) $h
	set setup(width)  $w
	set setup(lines)  [expr $h/$setup(heightc)]
	set setup(cols)   [expr $w/$setup(widthc)]
    }
    $cmd resize $panel
}

    #
    # Called on the first idle loop to configure the sizes of the thing
    #
proc panel_conf {panel cmd} {
    global setup

    set font [lindex [$panel configure -font] 4]
    set fontinfo [$cmd fontdim $font $panel]

    set setup(heightc) [lindex $fontinfo 0]
    set setup(widthc)  [lindex $fontinfo 1]

    bind $panel <Configure> "panel_size $cmd $panel %w %h"
}

#
# Manage the bar that keeps the sort orders 
#
proc panel_reset_sort_labels {win} {
#    $win.m.p.types delete all
}

proc panel_sort_label_start {win} {
#    $win.m.p.types delete all
}

#
# This right now uses a canvas, creates labels and places them 
# on the canvas.  The button emulation is done with a manual 
# bind.
#

proc panel_add_sort {win text_len text pos end_pos tag} {
    global setup

    if {$setup(with_sortbar) == 0} return

    catch { destroy $win.m.p.types.$pos }
    label $win.m.p.types.$pos -text $text -borderwidth 2 \
	    -font $setup(panelfont) -relief raised

    $win.m.p.types create window $pos 0 -window $win.m.p.types.$pos -anchor nw
    $win.m.p.types configure -height [expr $setup(heightc)+8]
    $win.m.p.types create line $end_pos 1 $end_pos [expr $setup(heightc)-1] -fill gray

    # Simulate the button.
    bind $win.m.p.types.$pos <Button-1> "
        $win.m.p.types.$pos configure -relief sunken
        x$win sort $tag
        after 100 { $win.m.p.types.$pos configure -relief raised }
     "
}

#
# Called back from the action menu
#
proc popup_add_action {filename cmd idx} {
    global setup
    menu [set m .m.action] -tearoff 0
        .m add cascade -foreground $setup(action_foreground) -label "$filename" -menu $m
        $m add command -label "Info"            -command "mc_file_info \"$filename\""
        $m add command -label "Open with..."    -command "mc_open_with \"$filename\""
	$m add separator
	$m add command -label "Copy..."         -command "$cmd invoke %d Copy"
	$m add command -label "Rename, move..." -command "$cmd invoke %d Move"
	$m add command -label "Delete..."       -command "$cmd invoke %d Delete"
	$m add separator 
	$m add command -label "Open"            -command "$cmd invoke %d Open"
	$m add command -label "View"            -command "$cmd invoke %d View"
}

proc start_drag {mode panel_cmd W x y X Y} {
    global drag_mode
    global drag_text

    set drag_mode $mode
    set drag_text [$panel_cmd dragtext [$W index @$x,$y]]
    set drag_text "$mode $drag_text"

    catch {destroy .drag}
    toplevel .drag
    wm overrideredirect .drag 1
    wm withdraw .drag
    label .drag.text -text "$drag_text"
    pack .drag.text
    wm deiconify .drag
    wm geometry .drag +$X+$Y
}

proc drag_test {token} {
    if {[winfo children $token] == ""} {
	label $token.value -text "Zonzo"
	pack $token.value
    }
    $token.value configure -text Hla
    return "caca";
}

proc mc_drag_target {} {
    global DragDrop

    set data $DragDrop(text)
}

proc mc_drag_send {} {
#    puts "drag send"
}

    #
    # Mouse bindings for the panels
    #
proc panel_bind {the_panel panel_cmd} {
    global setup

    set pn "$the_panel.m.p.panel"

    bind $pn <Button-1> "
        $panel_cmd mdown 2  \[%W index @%x,%y]
    "
 
    bind $pn <ButtonRelease-1> "
        panel_cancel_repeat
        $panel_cmd mup 2    \[%W index @%x,%y]"

    bind $pn <Double-1> "
        panel_cancel_repeat
        $panel_cmd double 2 \[%W index @%x,%y]"

    bind $pn <B1-Motion> "
       set mc_x %x
       set mc_y %y
       $panel_cmd motion 2 \[%W index @%x,%y]
    "

    bind $pn <B1-Leave> "
        set mc_x %x
        set mc_y %y
	panel_drag %W $panel_cmd 2
    "

    bind $pn <B1-Enter> panel_cancel_repeat

    if $setup(b2_marks) {
	bind $pn <Button-2> "
            $panel_cmd mdown 1  \[%W index @%x,%y]"

	bind $pn <ButtonRelease-2> "
	    $panel_cmd mup 1    \[%W index @%x,%y]
	    panel_cancel_repeat
	"

	bind $pn <B2-Motion> "
	    set mc_x %x
	    set mc_y %y
	    $panel_cmd motion 1 \[%W index @%x,%y]
	"

	bind $pn <B2-Leave> "
	    set mc_x %x
	    set mc_y %y
	    panel_drag %W $panel_cmd 1
	"
    } else {
	# We have blt
#	blt_drag&drop source $pn config -button 2 -packagecmd drag_test \
#		-selftarget 1
#	blt_drag&drop source $pn handler text dd_send_file
    }

    # Menu popup.
    bind $pn <Button-3> "
	$panel_cmd mdown 2 \[%W index @%x,%y]
	catch {destroy .m}
	menu .m -tearoff 0
	$panel_cmd load \[%W index @%x,%y] %X %Y
	#Buggy Tk8.0
	catch {tk_popup .m %X %Y}
    "

    bind $pn <B2-Enter> panel_cancel_repeat

    $the_panel.m.scroll configure \
        -command "panel_scroll $pn $panel_cmd"
    $the_panel.m.p.scroll configure \
	-command "$pn xview"
    panel_conf $pn $panel_cmd
}

proc panel_info {item} {
    global setup

    return $setup($item)
}

proc panel_mark {tag panel n} {
    config_colors $panel
    $panel tag add $tag "${n}.0" "${n}.0 lineend"
}

# op is add or remove
proc panel_mark_entry {win op line} {
    $win.m.p.panel tag $op marked $line.0 "$line.0 lineend"
}

proc panel_unmark_entry {win line} {
    $win.m.p.panel tag remove selected $line.0 "$line.0 lineend"
}

#
# Misc routines
#

# Configure the panel tags
proc config_colors {which} {
    global setup

    # se -- selected file
    $which tag configure selected -back $setup(panelcolor,selected_back)

    foreach v {marked directory executable regular selected} {
	$which tag configure $v -fore $setup(panelcolor,$v)
    }
    $which tag configure directory -font $setup(paneldir)

    $which tag raise marked
}

proc tclerror {msg} {
 puts stderr "TkError: [$msg]\n\r"
}

#
# FIXME: This is not finished, have to deal with activefore, activeback
# highlight{fore,back}
#
proc error_colors {wins} {
    global setup

    foreach widget $wins {
	catch "$widget configure -foreground $setup(errorfore)"
	catch "$widget configure -background $setup(errorback)"
    }
}

#
#
# Layout routines
#
#
proc layout_midnight {} {
    global one_window
    global wlist

    #puts $wlist
    #
    # we want to make the prompt and the input line sunken
    # so we sunk the frame, and set a borderwidth for it
    # while removing the sunken attribute set by the newinput
    .p.i0 configure -relief flat
    .p configure -relief sunken -borderwidth 2
    pack .p.l5 -side left 
    pack .p.i0 -side left -expand 1 -fill x -anchor e
    pack .n4 -side bottom -fill x
    pack .p -side bottom -fill x

    if $one_window {
	pack .left -side top -side left -fill both -expand 1
	pack .right -side top -side right -fill both -expand 1
    }
}

proc layout_query {} {
    global wlist

#    puts "$wlist"
    set t [llength $wlist]
    if {$t == 2} {
	pack .query.l1 -side top -pady 2m -padx 2m
	pack .query.b0 -side right  -ipadx 2m -padx 4m -pady 2m -expand 1
    } else {
	pack .query.l1  -side top -pady 2m -padx 2m

	for {set b 2} {$b != 1} {incr b} {
	    if {$b == $t} {
		set b 0
	    }
	    pack .query.b$b -side right -ipadx 2m -padx 4m -pady 2m -expand 1
	}
    }
}

proc layout_listbox {} {
    scrollbar .listbox.s -width 3m -command {.listbox.x0 yview}
    .listbox.x0 configure -yscroll {.listbox.s set} 
    pack .listbox.s -fill y -side right
    pack .listbox.x0 -expand 1 -fill both -padx 4m -pady 4m -side left
}

proc layout_quick_confirm {} {
    pack .quick_confirm.c.c1 .quick_confirm.c.c2 .quick_confirm.c.c3 \
	-side top -anchor w
    pack .quick_confirm.b.b0 .quick_confirm.b.b4 -side left -padx 4m -expand 1
    
    pack .quick_confirm.c -side top -pady 4m
    pack .quick_confirm.b -side top -pady 2m
}

proc layout_quick_file_mask {} {
    global wlist
#    puts stderr "$wlist"

    # We add some space
    .quick_file_mask configure -borderwidth 5m

    pack .quick_file_mask.b.b1 .quick_file_mask.b.b2 \
	-side left -expand 1 -padx 4m

    pack .quick_file_mask.l3  -side top -anchor w -expand 1
    pack .quick_file_mask.s.i5 -fill x -expand 1 -anchor w
    pack .quick_file_mask.s.c6 -anchor e -padx 4m -pady 1m
    pack .quick_file_mask.s -expand 1 -fill x -side top

    pack .quick_file_mask.d.l7 -pady 4m
    pack .quick_file_mask.d -side top -anchor w
    pack .quick_file_mask.i4 -expand 1 -fill x -side top

    pack .quick_file_mask.t.c8 .quick_file_mask.t.c0 -side top -anchor e
    catch {pack .quick_file_mask.t.c9 -side top -anchor e}

    pack .quick_file_mask.t -side top -anchor e
    frame .quick_file_mask.space -height 4m
    pack .quick_file_mask.space -side top 
    pack .quick_file_mask.b -fill x -expand 1 -side top
}

proc layout_quick_vfs {} {
    global wlist
#    puts stderr "$wlist"
    pack .quick_vfs.t.l1 -side left
    pack .quick_vfs.t.i2 -side left -expand 1 -fill x -padx 2m
    pack .quick_vfs.t.l3 -side left

    pack .quick_vfs.l.l4 -side top -anchor w
    pack .quick_vfs.l.r5 -side left -anchor w
    pack .quick_vfs.l.i6 -side right -anchor se
    pack .quick_vfs.b.b7 .quick_vfs.b.b0 -padx 4m -side left -expand 1 

    pack .quick_vfs.t -side top -expand 1 -fill x -pady 4m -padx 4m
    pack .quick_vfs.l -side top -expand 1 -fill x -padx 4m
    pack .quick_vfs.b -side top -expand 1 -fill x -padx 4m -pady 4m
}

proc layout_dbits {} { 
    pack .dbits.r1 -anchor w -padx 4m -pady 4m -side top
    pack .dbits.b0 -side top
}

proc layout_chown {} {
    global setup

    pack .chown.b.b8 .chown.b.b0 -side left -padx 4m -expand 1

    # May be invoked with different number of buttons
    # There is already a problem: the cancel button is
    # not close to the ok button, I will have to look into this.
    catch { 
	pack .chown.b.b9 .chown.b.b10 .chown.b.b11 \
	    -side left -padx 4m -expand 1
    }
    label .chown.l.fname -text {File name}
    label .chown.l.owner -text {Owner name}
    label .chown.l.group -text {Group name}
    label .chown.l.size -text {Size}
    label .chown.l.perm -text {Permission}
    
    pack \
	.chown.l.fname .chown.l.l7 \
	.chown.l.owner .chown.l.l6 \
	.chown.l.group .chown.l.l5 \
	.chown.l.size  .chown.l.l4 \
	.chown.l.perm  .chown.l.l3 -side top -anchor w -padx 2m
	
    foreach i {l3 l4 l5 l6 l7} {
	.chown.l.$i configure -fore $setup(high)
    }
    pack .chown.l.l3 .chown.l.l4 .chown.l.l5 .chown.l.l6 .chown.l.l7 \
	-side top -pady 1m -padx 4m -anchor w

    # Configure the listboxes
    scrollbar .chown.f.s -width 3m -command {.chown.f.x2 yview}
    .chown.f.x2 configure -yscroll {.chown.f.s set}
    label .chown.f.l -text {Group name}
    pack .chown.f.l -side top -anchor w
    pack .chown.f.x2 -side left -fill y -expand 1
    pack .chown.f.s -side right -fill y -expand 1

    scrollbar .chown.g.s -width 3m -command {.chown.g.x1 yview}
    .chown.g.x1 configure -yscroll {.chown.g.s set}
    label .chown.g.l -text {User name}
    pack .chown.g.l -side top -anchor w
    pack .chown.g.x1 -side left -fill y -expand 1
    pack .chown.g.s -side right -fill y -expand 1

    .chown.b configure -relief sunken
    pack .chown.b -side bottom -pady 4m -fill x
    pack .chown.g .chown.f -side left -padx 4m -pady 4m -expand 1 -fill y
    pack .chown.l -side right -padx 4m
}

proc layout_chmod {} {
    global wlist
#    puts stderr "$wlist \n\r"
    pack .chmod.c.c5 .chmod.c.c6 .chmod.c.c7 .chmod.c.c8 .chmod.c.c9 \
	.chmod.c.c10 \
	.chmod.c.c11 .chmod.c.c12 .chmod.c.c13 .chmod.c.c14 .chmod.c.c15 \
	.chmod.c.c16 -side top -anchor w

    pack .chmod.b.b17 .chmod.b.b0 -side left -padx 4m -pady 4m -side left
    catch {
	pack .chmod.b.b18 .chmod.b.b19 .chmod.b.b19 .chmod.b.b20 \
	    .chmod.b.b21 -side left -padx 4m -pady 4m -side left
    }

    label .chmod.l.msg -text {Use "t" or Insert to\nmark attributes}
    label .chmod.l.fname -text {Name}
    label .chmod.l.perm   -text {Permission (octal)}
    label .chmod.l.owner  -text {Owner name}
    label .chmod.l.group  -text {Group name}

    pack \
	.chmod.l.fname .chmod.l.l4 \
	.chmod.l.perm  .chmod.l.l1 \
	.chmod.l.owner .chmod.l.l3 \
	.chmod.l.group .chmod.l.l2 .chmod.l.msg -side top -anchor w -padx 2m
    pack .chmod.b -side bottom
    pack .chmod.l -side right -padx 4m -anchor n -pady 4m
    pack .chmod.c -side left -padx 4m -pady 4m
}

proc layout_view {} {
    global wlist

    pack [lindex $wlist 0] -side bottom -fill x
    pack [lindex $wlist 1] -side top -expand 1 -fill both
}

proc layout_replace {} {
    global wlist

    error_colors "$wlist .replace"

    set alist {}
    set plist {}
    set ilist {}

    foreach a $wlist {
	if [regexp ^.replace.p.l $a] {
	    set plabel $a
	} elseif [regexp ^.replace.p $a] {
	    set plist "$plist $a"
	} elseif [regexp ^.replace.a.l $a] {
	    set alabel $a
	} elseif [regexp ^.replace.a $a] {
	    set alist "$alist $a"
	} elseif [regexp ^.replace.i $a] {
	    set ilist "$ilist $a"
	} elseif [regexp ^.replace.b $a] {
	    set abortbutton $a
	} else {
	    set fname $a
	}
    }

#    puts stderr "$wlist\n\r"
#    puts stderr "alist: $alist\n\rplist: $plist\n\rilist: $ilist\n\r"
#    puts stderr "plabel: $plabel\n\rfname: $fname"

    pack $fname -side top -fill x -anchor w -pady 6m -padx 12m
    pack $abortbutton -side bottom -anchor e -padx 8m -pady 4m
    
    eval pack $ilist -side top -anchor w 
    pack .replace.i -padx 10m -pady 2m -anchor w

    pack $plabel -side left -anchor w -padx 10m
    eval pack $plist -side left -anchor e -fill x
    pack .replace.p -side top -fill x -padx 10m
    
    pack $alabel -side left -anchor w -padx 10m
    eval pack $alist -side left -anchor e -fill x
    pack .replace.a -side top -fill x  -padx 10m
}

proc layout_complete {} {
    global wlist

    eval pack $wlist -side top
}

proc layout_opwin {} {
    global wlist
    global setup

    pack .opwin.b.b0 .opwin.b.b14 -side left -expand 1
    pack .opwin.f0.l1 .opwin.f0.l2 -side left -anchor w
    pack .opwin.f1.l3 .opwin.f1.l4 -side left -anchor w

    foreach a {.opwin.2.l11 .opwin.1.l8 .opwin.0.l5} {
	$a configure -width 8
    }
    pack .opwin.2.l11 .opwin.2.g13 -side left -fill x
    pack .opwin.1.l8 .opwin.1.g10  -side left -fill x
    pack .opwin.0.l5 .opwin.0.l6  -side left -fill x

    pack .opwin.b -side bottom -pady 4m -fill x
    pack .opwin.f0 -side top -padx 10m -anchor w
    pack .opwin.f1 -side top -padx 10m -pady 4m -anchor w
    pack .opwin.0 .opwin.1 .opwin.2 -side top -padx 4m
}

proc dummy_layout {name} {
    eval "proc layout_$name {} {
          global wlist
#          puts stderr \"\$wlist \\n\"
          eval pack \$wlist -side top}"
}
#
# the achown commands will have to be rewriten
# to use only widgets and no writing callbacks.
#

foreach i {
    achown tree 
    } {
	dummy_layout $i
    }

proc layout_quick_input {} {
    global wlist

#    puts stderr "$wlist \n\r"
    .quick_input.i1 configure -width 60
    label .quick_input.dummy
    pack .quick_input.b.b2 .quick_input.b.b3 -side left -padx 4m -expand 1
    pack .quick_input.b -side bottom -pady 4m
    pack .quick_input.dummy -side top
    pack .quick_input.l0 -side top -expand 1 -ipadx 2m -ipady 2m
    pack .quick_input.i1 -side bottom -fill x -padx 4m
}

proc create_drop_target {name icon} {
    toplevel .drop-$name

    button .drop-$name.b -text "Drop target"
    pack .drop-$name.b
    wm group .drop-$name .
    wm overrideredirect .drop-$name 1
    wm withdraw .drop-$name
    wm deiconify .drop-$name
    wm geometry .drop-$name +0+0
#    blt_drag&drop target .drop-$name.b handler file mc_drag_target
#    blt_drag&drop target .drop-$name.b handler text mc_drag_target
}

#
# Creates the container
#
proc create_container {container} {
    canvas $container 
    pack $container -fill both -expand 1
}

#
# Removes all of the widgets in a container (.left or .right)
#
proc container_clean {container} {
    set widgets [winfo children $container]

    foreach widget $widgets {
	destroy $widget
    }
}

#
# Setups the binding called after the layout procedure
#
proc bind_setup {win} {
    flush stderr
    bindtags $win {all $win}
    wm protocol $win WM_DELETE_WINDOW "tkmc e scape"
    bind $win <Leave> 
}

proc keyboard_bindings {} {
    # Remove the Tab binding.
    bind all <Tab> {}

    bind all <KeyPress>          "tkmc r %A"

    # Remove the Alt-key binding and put a sensible one instead
    bind all <Alt-KeyPress>      "tkmc a %A"
    bind all <Control-KeyPress> "tkmc c %A"
    bind all <Meta-KeyPress>    "tkmc a %A"

    foreach i {Left Right Up Down End R13 Home F27 F29 Prior \
	       Next F35 Return KP_Enter Delete Insert BackSpace \
	       F1 F2 F3 F4 F5 F6 F7 F8 F9 F10} {
        bind all <Key-$i> "tkmc k %K"
    }
}

# Centers a window based on .
proc center_win {win} {
    global center_toplevels

    wm transient $win [winfo toplevel [winfo parent $win]]

    wm withdraw $win
    update idletasks

    if {$center_toplevels} {
	set ch [winfo reqheight $win]
	set cw [winfo reqwidth $win]
	
	set geo [split [wm geometry .] +x]
	set pw [lindex $geo 0]
	set ph [lindex $geo 1]
	set px [lindex $geo 2]
	set py [lindex $geo 3]
	
	set x [expr $px+(($pw-$cw)/2)]
	set y [expr $py+(($ph-$ch)/2)]
	
	wm geometry $win +$x+$y
    }
    wm deiconify $win
    grab $win
    tkwait visibility $win
}

#
# Busy window handling
#
proc win_busy {w} {
    $w configure -cursor watch
}


#
# Color configurations
#
proc tk_colors {} {
}

proc color_model {} {
}

# gray85 is the background for the new tk4
proc gray_colors {base} {
    global setup
    global have_blt

#
#    set setup(def_back) [tkDarken $base 90]
#    set setup(def_fore) black
#    set setup(selected) [tkDarken $base 110]
#    set setup(marked)   SlateBlue
#    set setup(high)     $setup(def_back)

    if {0} {
	set dark_color [tkDarken $base 90]
	set setup(def_back) [tkDarken $base 110]
	set setup(selected) NavyBlue
	set setup(selected_fg) white
    } else {
	set dark_color $base
	set setup(def_back) #d9d9d9
	set setup(selected) white
	set setup(selected_fg) black
    }
    set setup(def_fore) black
    set setup(high)     yellow

#
# Panel colors:
#
    # Marked files
    set setup(panelcolor,marked)        yellow
    set setup(panelcolor,directory)     blue
    set setup(panelcolor,executable)    red
    set setup(panelcolor,regular)       black
    set setup(panelcolor,selected_back) white
    set setup(panelcolor,selected)      black

# Viewer colors

    set setup(view_bold)      "-fore yellow -back $dark_color"
    set setup(view_underline) "-fore red    -back $dark_color"
    set setup(view_mark)      "-fore cyan   -back $dark_color"
    set setup(view_normal)    "-fore black  -back $dark_color"

# The percentage bars on info:
    set setup(percolor) "blue"

# The sort bar colors
    set setup(sort_fg) $setup(def_fore)
    set setup(sort_bg) $setup(def_back)
    set setup(with_sortbar) 1

    # We use BLT only for drag and drop, if this is not available, 
    # then we use the 2nd button for regular file marking.
    set have_blt 0
    if $have_blt {
	set setup(b2_marks) 0
    } else {
	set setup(b2_marks) 1
    }

# The errors
    set setup(errorfore) white
    set setup(errorback) red

}

proc bisque_colors {} {
    global setup

    set setup(def_back) bisque3
    set setup(def_fore) black
    set setup(selected) bisque2
    set setup(marked)   SlateBlue
    set setup(high)     gray
}

proc sanity_check {} {
    if [catch {bindtags .}] {
	puts stderr "The Midnight Commander requires Tk 4.0 beta 3 or 4\n\r"
	puts stderr "You can get it from: ftp://ftp.smli.com/pub/tcl"
	exit 1
    }
}

#sanity_check

# Until I figure out how to remove specific bindings from a widget
# I remove all of the classes bindings.

#bind Text <Enter> {}
#bind Text <FocusIn> {}

# bind Entry <Enter> {}
# bind Entry <FocusIn> {}

keyboard_bindings 

set setup(tearoff) 0
set setup(action_foreground) blue
set setup(lines) 24
set setup(cols)  40
set setup(with_icons) 0
set setup(widthc) 0
set setup(heightc) 0
set setup(real_width) 0

# Determine Tk version
set beta_4 ![catch tk_bisque]
if $beta_4 { 
    tk_setPalette gray85
    gray_colors gray70
} else {
    bisque_colors 
}

## Some globals
set mc_repeat {}
set mc_x 0
set mc_y 0
set center_toplevels 1
#set center_toplevels 0

# button .testbutton [lindex [.testbutton configure -font] 3]
#set setup(panelfont) lucidasanstypewriter-bold-14
set setup(panelfont) lucidasanstypewriter-14
set setup(paneldir)  lucidasanstypewriter-bold-14
set setup(font)  "-*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"

#
# 
# This variable if set, will make the program load gui.*.tcl files
# instead of the gui.tcl file created during instalaltion.
set use_separate_gui_files 0

if [file exist ~/.mc/tkmc] {source ~/.mc/tkmc}

catch {
#    option add *font $setup(font) userDefault
#    option add *Menu*activeBackground NavyBlue
#    option add *Menu*activeForeground white
#    option add *Menubutton*activeBackground NavyBlue
#    option add *Menubutton*activeForeground white
#    option add *Button*activeBackground NavyBlue
#    option add *Button*activeForeground white
##    set setup(panelfont) $setup(font)
}

proc run_gui_design {root} {
    global components 

    create_workspace $root
    gui_design $root $components
}

source $LIBDIR/gd.tcl

set tk_strictMotif 1
create_top_menu

create_drop_target Hola Zonzo