
# <20221227.1804.50>

########################## The Tree button ############################
# tcl/tk for windows does not support the cascade needed do do the tree
# So, we put the code only in the unix version
#
proc buildTree {wf inst} {
  global glob
  menubutton $wf.dir_but -takefocus 0 -menu \
      $wf.dir_but.m -direction right\
      {*}[getImage -bitmap tree @$glob(lib_fr)/bitmaps/tree.bit]
  bind $wf.dir_but <Motion> {+
    if {$::tk::Priv(postedMb) == "%W"} {
      set ::tk::Priv(menuActivated) 1
    }
  }
  balloonhelp_for $wf.dir_but \
      {[_b "Directory tree scan." ]}

  menu $wf.dir_but.m \
      -tearoff false -postcommand  "CdMenuCreate \
      ${inst} \$glob($inst,pwd) \
      $wf.dir_but.m 1"
  # -font $glob(gui,GuiFont) 
  grid $wf.dir_but     -row 1 -sticky ew -column 0

}

# The cascade menu. Does NOT work on windows.

proc CdMenuCreate { inst curdir menuwid level } {
  global glob config
  #puts "CdMenuCreate curdir: \'$curdir\'"
  if { [string range $curdir 0 1] == "//" } {
    set curdir [string range $curdir 1 end]
  }
  if { [IsVFS $curdir] } {
    set curdir /
  }
  set r [catch {cd $curdir} outp]
  if {$r != 0} {
    $menuwid delete 0 end
    if { [IsVFS $curdir] } {
      $menuwid add command -label [_ "Not implemented for VFS"]
    } else {
      $menuwid add command -label $outp
    }
    return ""
  }
  set r [catch {pwd} curdir]
  if {$r} {
    $menuwid delete 0 end
    $menuwid add command -label $curdir
    return ""
  }
  # glob needs an && function to pick up hidden && d (or hidden && -hidden)
  set r [catch {glob  -nocomplain */} outp]
  if {$r} {
    $menuwid delete 0 end
    $menuwid add command -label $outp
    return ""
  }
  if {$config(fileshow,all)} {
    set r [catch {glob -type {hidden d} -nocomplain *} outp2]
    if {$r} {
      $menuwid delete 0 end
      $menuwid add command -label $outp
      return ""
    }
    foreach d $outp2 {
      lappend outp $d/
    }
  }
  set menulist [lsort $outp]
  if {!$config(fileshow,all)} {
    set menulist [linsert $menulist 0 ..]
  }
  $menuwid delete 0 end
  if { $level == 1 } { 
    $menuwid add command -label / -command "CdMenuCommand $inst /"
  }

  foreach dir $menulist {
    #puts "Adding cdmenucommand $curdir/$dir"
    $menuwid add command -label $dir -command \
	"CdMenuCommand $inst [list $curdir/$dir]"
  }

  bind $menuwid <Map> \
      "CdMenuCreateCasc $inst [list $curdir] %W $level [list $menulist]"
  bind $menuwid <Unmap> { %W.0 unpost }
}

proc CdMenuCreateCasc { inst curdir menuwid level menulist } {
  global glob config
  #puts "CdMenuCreateCasc curdir: \'$curdir\'"
  set n 0
  if {[winfo exists $menuwid.0]} {
    destroy $menuwid.0
  }
  menu $menuwid.0 -tearoff false
  # -font $glob(gui,GuiFont)

  if {$level == 1} {
    if {[winfo exists $menuwid.0.$n]} {
      destroy $menuwid.0.$n
    }
    menu $menuwid.0.$n -tearoff false -postcommand\
	"CdMenuCreate $inst / $menuwid.0.$n [expr $level+1]"
    $menuwid.0 add cascade -menu $menuwid.0.$n
    #-font $glob(gui,GuiFont)
    incr n
  }
  foreach dir $menulist {
    if {[winfo exists $menuwid.0.$n]} {
      destroy $menuwid.0.$n
    }
    menu $menuwid.0.$n -tearoff 0 -postcommand\
	"CdMenuCreate $inst [list $curdir/$dir] $menuwid.0.$n [expr $level+1]"
    $menuwid.0 add cascade -menu $menuwid.0.$n
    # -font $glob(gui,GuiFont)
    incr n
  }
  $menuwid.0 post [expr \
		       [winfo rootx $menuwid] + \
		       [winfo width $menuwid] - \
		       26] [winfo rooty $menuwid]
}

proc CdMenuCommand { inst dir } {
  global glob config
  #puts "CdMenuCommand dir \'$dir\'"
  destroy $glob(win,$inst).dirmenu_frame.dir_but.m
  menu $glob(win,$inst).dirmenu_frame.dir_but.m -tearoff false \
      -postcommand \
      "eval CdMenuCreate $inst \[list \$glob($inst,pwd)\] \
      $glob(win,$inst).dirmenu_frame.dir_but.m 1"
  # -font $glob(gui,GuiFont)
  #update idletasks
  DoProtCmd "NewPwd $inst [list $dir] ; UpdateWindow $inst"
}
################################# End of Tree menu create #############
#
