#
#  $Id :            $
#  $Name :          $
#  $Source :        $
#
# CE FICHIER INCLUE UNE PARTIE DE LA LIBRAIRIE DE JSTOOLS
# (AVEC NOMBREUSES MODIF) PLUS D'AUTRES PROCEDURES
#
# Copyright 1992-1994 by Jay Sekora.
#

package provide stead 2.0


## te:default_button : A EVITER : bind $w <Return> "$button invoke"
#
# te:default_button button widget... - bind <Return> to default button
#   widget... is one or more widgets that can have the kbd focus
proc te:default_button { button args } {
  foreach w $args {
    bind $w <Return> "$button invoke"
    bind $w <KP_Enter> "$button invoke"
  }
}

## te:cancel_button : bind une série de raccourci sur le bouton d'annulation
#
# diam :
#  à éviter, utiliser plutot la  variable contenant la liste
#  d'annulation stead(cancelBindSequence)
#
# te:cancel_button button widget... - set up bindings for cancel button
#   widget... is one or more widgets that can have the kbd focus
#
proc te:cancel_button { button args } {
    global  stead
    foreach w $args {
        foreach binding $stead(cancelBindSequence) {
            bind $w $binding  "$button  invoke"
        }
    }
}



##  te:longest_match l - longest common initial string in list l
#   used by tab-expansion in filename dialogue box
#
# this needs commenting desperately
#
proc te:longest_match { l } {
    case [llength $l] in {
        {0} { return {} }
        {1} { return [lindex $l 0] }
    }
    set first [lindex $l 0]
    set matchto [expr {[string length $first] - 1}]
    for {set i 1} {$i < [llength $l]} {incr i} {
        set current [lindex $l $i]
        # if they don't match up to matchto, find new matchto
        if { [string compare \
                 [string range $first 0 $matchto] \
                 [string range $current 0 $matchto]] } {
            # loop, decreasing matchto until the strings match that far
            for {} \
                {[string compare \
                    [string range $first 0 $matchto] \
                    [string range $current 0 $matchto]] } \
                {incr matchto -1 } \
                {}                      ;# don't need to do anything in body
        } ;# end if they didn't already match up to matchto
    } ;# end for each element in list
    if {$matchto < 0} then {
        return {}
    } else {
        return [string range $first 0 $matchto]
    }
}

## te:expand_filename f - expand filename prefix as much as possible
#       (for use in file dialogue boxes)
#
# note: if the filename has *, ?, or [...] in it, they will be used
#       as part of the globbing pattern.  i declare this a feature.
#
proc te:expand_filename { f } {
    set expansion [te:longest_match [glob -nocomplain "${f}*"]]
    # modif diam 02/11/98
    if {"x$expansion" == "x"} {return $f}
    # make sure it doesn't already end in "/"
    set expansion [string trimright $expansion "/"]
    if [file isdirectory $expansion] {append expansion "/"}
    return $expansion
}


## xtk_filler parent [args] - returns a filler frame suitable for parent
##                 used as argument to a pack command
#
proc xtk_filler { {parent {}} args} {
    global j_filler

    if {$parent == "."} {set parent ""} ;# so "." doesn't give "..filler0"

    if {[info exists j_filler(count)]} then {
        set j_filler(count) [expr {$j_filler(count) + 1}]
    } else {
        set j_filler(count) 0
    }

    set filler "$parent.filler$j_filler(count)"
    frame $filler -height 10 -width 10
    if {$args != ""} {
        eval $filler configure $args
    }
    return $filler
}

## te:buttonbar w ?options? - make a buttonbar packed in w
# options are:
#   -default (default none)
#   -padx (default 5)
#   -pady (default 5)
#   -orient (default horizontal)
#   -buttons (default {})
# syntax of button list is {{name text command} ... }
#
proc te:buttonbar {w args} {

    Parsarg_fullSpec opt {
        default "(NONE)"
        padx    5
        pady    5
        orient  horizontal
        buttons ""
    }

    set default    $opt(-default)
    set padx       $opt(-padx)
    set pady       $opt(-pady)
    set orient     $opt(-orient)
    set buttons    $opt(-buttons)

    set newframe $w
    if {$orient == "horizontal"} {
        set side right
    } else {
        set side bottom
    }

    frame $newframe
    if {$padx} {
        pack [xtk_filler $newframe -width $padx] -in $newframe -side left
        pack [xtk_filler $newframe -width $padx] -in $newframe -side right
    } 
    if {$pady} {
        pack [xtk_filler $newframe -height $pady] -in $newframe -side top
        pack [xtk_filler $newframe -height $pady] -in $newframe -side bottom
    } 

    foreach i $buttons {
        set name [lindex $i 0]
        set text [lindex $i 1]
        set command [lindex $i 2]
        
        set width [expr {[string length $text] + 1}]
        if {$width < 8} {set width 8}
        
        set button $newframe.$name
        button $button -width $width -text $text -command $command
        set border $newframe.border_$name
        frame $border -relief flat -borderwidth 1
        raise $button
        pack $button -in $border -padx 2 -pady 2
        pack $border -in $newframe -side $side -padx 2
        if [string match $default $name] {
            $border configure -relief sunken
        }
    } 
    return $newframe
}



## te:prompt ?options? - prompt the user for information
# options are:
#   -text (default "Enter a value:"
#   -default (default "")
#   -cancelvalue (default "")
#   -file (default 0)
#   -title (default "Prompt")
# if $file, then the Tab key will do filename completion
#
# Refonte diam 23/08/00
# Reste à virer des verrues de jedit et à simplifier
#
#
proc te:prompt { args } {

    # Je créer un tableau global d'état de meme nom que la proc :
    # tableau global te:promptNEW
    # Attention avec les  points pour créer des widgets avec ce nom:
    #
    # upvar #0 [lindex [info level 0] 0]  data

    set dataName [lindex [info level 0] 0]
    regsub -all -- {[^\w]} $dataName {} dataName

    upvar #0 $dataName  data
    if {[info exists data]} {
        unset data
    }  ;# endif


    global EDITPREFS
    global stead

    Parsarg_fullSpec data   {
        text            {"Enter a value:"}
        default         ""
        cancelvalue     ""
        file            0
        title           Prompt
        parent          .
    }


    # exemple de diam de tk8.3/choosedir.tcl
    # w sera le nom de la top level à créer
    #
    if {[string equal $data(-parent) .]} {
        set w ".$dataName"
    } else {
        set w "$data(-parent).$dataName"
    }

    # On detruit la toplevel si elle existe déja
    if {[winfo exists $w]} {
        destroy $w
    }


    ####################################################################
    # DEBUT de création de la nouvelle toplevel
    #  (voir modele ::tk::dialog::file::Create)
    #

    toplevel $w
    set data(ent) $w.field

    if {[string length $data(-default)] < 40} {
      set width 60
    } else {
      set width [expr [string length $data(-default)] + 1]
    }

    message $w.msg -width 300 -anchor w -text $data(-text)


    entry $data(ent) \
            -relief sunken \
            -width $width \
            -font $EDITPREFS(textfont)

    # La barre contenant les boutons
    set buttonFrame $w.b
    frame $buttonFrame

    # c'est pour du remplissage (à virer en remplacer par des padx... !)
    #
    pack [xtk_filler $buttonFrame -width  5] -in $buttonFrame -side left
    pack [xtk_filler $buttonFrame -width  5] -in $buttonFrame -side right
    pack [xtk_filler $buttonFrame -height 5] -in $buttonFrame -side top
    pack [xtk_filler $buttonFrame -height 5] -in $buttonFrame -side bottom

    set data(result) "UNDEFINED"

    set width 8

    set name ok
    set text OK
    set command "set [set dataName](result) \[$data(ent) get\] "

    set button $buttonFrame.$name
    set data(okBoutton) $button

    button $button -width $width -text $text -command $command
    set border $buttonFrame.border_$name
    frame $border -relief flat -borderwidth 1
    raise $button
    pack $button -in $border -padx 2 -pady 2
    pack $border -in $buttonFrame -side right -padx 2
    if [string match $data(-default) $name] {
         $border configure -relief sunken
    }

    set name cancel
    set text Cancel
    set command [list set [set dataName](result) $data(-cancelvalue) ]


    set button $buttonFrame.$name
    set data(cancelBoutton) $button

    button $button -width $width -text $text -command $command
    set border $buttonFrame.border_$name
    frame $border -relief flat -borderwidth 1
    raise $button
    pack $button -in $border -padx 2 -pady 2
    pack $border -in $buttonFrame -side right -padx 2
    if [string match $data(-default) $name] {
         $border configure -relief sunken
    }

    # Fin de te:buttonbar
    ####################################################################

    pack append $w \
            $w.msg {top fill expand padx 10} \
            $data(ent) {top padx 10 pady 10} \
            $buttonFrame {bottom fillx} \
            [xtk_rule $w -width 200] {bottom fillx}


    $data(ent) delete 0 end
    $data(ent) insert end $data(-default)

    # les bindings
    #
    if $data(-file) {
      bind $data(ent) <Tab> {
        set f [%W get]
        %W delete 0 end
        %W insert end [te:expand_filename $f]
      }
    }

    bind $data(ent) <Return> "xtk_invokeButton $buttonFrame.ok"

    # Quelques binding d'annulation
    foreach binding $stead(cancelBindSequence) {
        bind $data(ent) $binding  "xtk_invokeButton $data(cancelBoutton)"

    }

    # diam 30/11/99 :
    #
    #   A METTRE AU POINT pour que l'entrée soit selectionnee à l'ouverture :
    #       - sans deselectionner le widget text
    #       - Il faut encore que les caracteres tapés efface la selection
    #         sauf si c'est <Right>, <Left> <Top> ou <Down>.
    #
    # A mettre dans une procédure gérant le focusIn de l'entry
    #
    #    if {[string compare [$data(ent) get] ""]} {
    #        $data(ent) selection range 0 end
    #        # $data(ent) icursor end
    #    } else {
    #        $data(ent) selection clear
    #    }
    # Par exemple pour tester :
    #
    # $data(ent) configure -exportselection false
    # bind $data(ent) <FocusIn> {
    #     if {[string compare [$data(ent) get] ""]} {
    #         $data(ent) selection range 0 end
    #         # $data(ent) icursor end
    #     } else {
    #         $data(ent) selection clear
    #     }
    # }


    # prévoir les traces de variable éventuelles ici ainsi
    # que la configuration des widget
    #
    # ...

    # Les bindings de gestion des focus entrant si ce mégawidget contient
    # plusieurs entry : il faut que la derniere entry utilisée recoive
    # de nouveau le focus que cette toplevel recoit le focus
    # Quand cette toplevel réçoit de nouveau le focus, il faut le redonner
    # à sa dernière entry qui avait le focus
    # Exemple de "tk8.3/comdlg.tcl"
    #
    #   bind $w <FocusIn>  [list tkFocusGroup_In  $w %W %d]
    #   bind $w <FocusOut> [list tkFocusGroup_Out $w %W %d]
    #   bind $w <Destroy>  [list tkFocusGroup_Destroy $w %W]


    # FIN de création de la toplevel et de ces widgets
    ####################################################################


    wm transient $w $data(-parent)
    # # # ::tk::PlaceWindow $w widget $data(-parent)
    xtk_placeWindow $w widget $data(-parent)
    wm title $w $data(-title)
    # # ::tk::SetFocusGrab $w $data(ent)
    xtk_setFocusGrab $w $data(ent)
    tkwait variable [set dataName](result)
    # # ::tk::RestoreFocusGrab $w $data(ent) destroy
    xtk_restoreFocusGrab $w $data(ent) destroy

    update

    return $data(result)

}


## te:tclShell --
#
# Permet de lancer un shell TCL.
# On pourra choisir entre différent shell :
#    - Shell (de pist)
#    - tkcon
#
#
proc te:tclShell {} {
    global stead
    set topLevelName ".steadconsole"
    Shell $topLevelName
}

## te:prompt_tcl -- prompt for a tcl command and execute it
# 
# Cette procédure est **à refondre** en exploitant "lib/pist/shell/shell.tcl"
# 
# 
proc te:prompt_tcl {} {

  # ATTENTION : plein de widget sont "hard" codés !!!
  #
  global stead


  if {![winfo exists .main.command]} {
    frame .main.command
    entry .main.command.entry -relief sunken -width 60
    label .main.command.label -text "Tcl Command:"
    pack .main.command.label -in .main.command -side left -fill x
    pack .main.command.entry -in .main.command -side left -fill x
    pack .main.command -in .main -after .main.status -side bottom -fill x

    # binding de la fenetre de commande tcl
    bind .main.command.entry <Return>  {
        # te:execute_entry_command .main.command.entry
        te:prompt_tcl__eval .main.command.entry
        focus $stead(text)
    }
    bind .main.command.entry <FocusIn>  {
        $stead(text) configure -insertwidth 0
        xentry_updateCursorSize %W
    }
    foreach binding  { <Meta-w> <Control-g> }  {
        pack forget .main.command
        focus $stead(text)
        xtext_updateFocusIn $stead(text)
    }
  }
  pack .main.command    -in .main \
                        -after .main.status \
                        -side bottom \
                        -fill x
  focus .main.command.entry
}
## te:prompt_tcl__eval -- execute la commande TCL contenu dans l'entry e
#
# procedure auxiliaire de te:prompt_tcl
#
proc te:prompt_tcl__eval {e} {
    set script [$e get]
    if {"x$script" != "x"} {
         uplevel #0 set tcl_interactive 1
         stead:log -title "TCL" [uplevel #0 $script]
         focus $e
    }
}


## xtk_fsBox -- file selector box
#
# options are:
#   -buttons (default {ok cancel home})
#   -prompt (default "Choose a file")
#   -directory (default ".")
#   -cancelvalue (default "")
#   -fileprompt (default "File:")
#   -title (default "File Selector")
# NOTE: this may do a cd---affects entire app!
#
########################################################################
# Si on souhaite utiliser tk_xxxx
#
#      if { [tk8] } {
#        set types {
#          {{All Files}        *             }
#          {{Text Files}       {.txt}        }
#          {{TCL Scripts}      {.tcl}        }
#        }
#
#        switch -exact -- $prompt {
#          "Save as:" -
#          "Before Printing Save File As" -
#          "Save Selection as:" {set command tk_getSaveFile}
#          "Insert:" -
#          "Load:" -
#          "Open:" -
#          "Source TCL file :" -
#          default {set command tk_getOpenFile}
#
#        }
#
#        set result [$command -title "File Selector - $prompt" -initialdir . \
#                -filetypes $types]
#
#        # on se place dans le nouveau répertoire (généralement souhaitable)
#        catch {cd [file dir $result]}
#
#        return $result
#      }
#
proc xtk_fsBox { args } {

    global j_fs env EDITPREFS

    Parsarg_fullSpec j_fs {
        buttons      {{ok rescan cancel gointo home root}}
        prompt       {"Choose a file"}
        directory    .
        cancelvalue  ""
        fileprompt   "File:"
        title        {"File Selector"}
        parent       .
    }

    set j_fs(-defaultbutton) [lindex $j_fs(-buttons) 0]

    # w sera le nom de la top level à créer
    #
    if {[string equal $j_fs(-parent) .]} {
        set w ".fs"
    } else {
        set w "$j_fs(-parent).fs"
    }
    if [winfo exists $w] {
        destroy $w
    }


    # # if {[lsearch [array names EDITPREFS] {j_fs_fast}] == -1} {
    # #     set EDITPREFS(j_fs_fast) 0      ;# make sure it's defined
    # # }
    # # if {[lsearch [array names EDITPREFS] {scrollbarside}] == -1} {
    # #     set EDITPREFS(scrollbarside) right ;# make sure it's defined
    # # }

    set dir $j_fs(-directory)
    set file ""

    if {![file isdirectory $dir]} {
        set dir .
    }
    cd $dir

    set j_fs(result) $file

    # j_fs(filter) est le filtre pour le browser
    # s'il n'est pas deja defini c'est *

    if {![info exists j_fs(filter)]} {
        set j_fs(filter) "*"
    }

    ####################################################################
    # DEBUT de création de la nouvelle toplevel
    #  (voir modele ::tk::dialog::file::Create)
    #

    toplevel $w
    # pour éviter l'affichage de la toplevel pendant sa contruction
    wm withdraw $w

    label $w.prompt -anchor w -text $j_fs(-prompt)
    label $w.cwd -text [pwd]
    frame $w.list
    listbox $w.list.lb -yscrollcommand "$w.list.sb set" -width 30 -height 20
    scrollbar $w.list.sb -relief flat -command "$w.list.lb yview"

    # frame pour le filtre unix
    frame $w.filter
    menubutton $w.filter.l \
            -text "<= Filter:" \
            -anchor e -menu $w.filter.l.m \
            -relief raised
    entry $w.filter.e -relief sunken
    $w.filter.e insert insert $j_fs(filter)

    frame $w.file
    label $w.file.l -text $j_fs(-fileprompt) -anchor e
    entry $w.file.e -relief sunken

    $w.file.e insert insert $file

    frame $w.b -width 200
    
    button $w.b.rescan \
            -width 8 \
            -text "Rescan" \
            -command [list xtk_fs_button_gointo $w  .]
            
    button $w.b.home \
            -width 8 \
            -text "Home" \
            -command [list xtk_fs_button_gointo $w  $::env(HOME)]
            
    button $w.b.root \
            -width 8 \
            -text "Root" \
            -command [list xtk_fs_button_gointo $w  /]
            
    # # # button $w.b.gointo -width 8 -text "Go into" \
    # # #                   -command "xtk_fs_button_gointo $w"
    button $w.b.gointo \
            -width 8 \
            -text "Go into" \
            -command [list xtk_fs_button_gointo $w [$w.file.e get]]
            
    button $w.b.ok \
            -width 8 \
            -text {OK} \
            -command [list xtk_fs_button_ok $w]
    # # # button $w.b.cancel -width 8 -text {Cancel} \
    # # #                   -command "xtk_fs_button_cancel $w"
    button $w.b.cancel \
            -width 8 \
            -text {Cancel} \
            -command [list xtk_fs_button_cancel $w]


    checkbutton $w.b.fast \
              -text {Show Hidden Files} \
              -relief flat \
              -variable EDITPREFS(j_fs_fast) \
              -command [list xtk_fs_button_fast $w]

    pack append $w.list \
      $w.list.sb "$EDITPREFS(scrollbarside) filly" \
      [xtk_rule $w.list] "$EDITPREFS(scrollbarside) filly" \
      $w.list.lb {left expand fill}
      
    pack append $w.filter \
      $w.filter.l {left pady 10 padx 10} \
      $w.filter.e {left expand pady 10 fillx padx 10} \
      [xtk_filler $w.filter] {left}
      
    pack append $w.file \
      $w.file.l {left pady 10 padx 10} \
      $w.file.e {left expand pady 10 fillx padx 10} \
      [xtk_filler $w.file] {left}

    # now create the buttons the caller requested:
    #    (NEEDS ERROR CHECKING!)
    pack append $w.b \
      [xtk_filler $w.b] {bottom} \
      $w.b.fast {top}
      
    foreach b $j_fs(-buttons) {
      set button $w.b.$b
      set border $w.b.border_$b
      frame $border -borderwidth 1 -relief flat
      raise $button
      pack $button -in $border -padx 2 -pady 2
      pack $border -in $w.b -side bottom -padx 10 -pady 4
    }
    # wider border on default button:
    $w.b.border_$j_fs(-defaultbutton) configure -relief sunken

    pack append $w \
              $w.prompt {top fill} \
              [xtk_rule $w] {top fillx} \
              $w.cwd {top fill} \
              [xtk_rule $w] {top fillx} \
              $w.file {bottom expand fillx} \
              [xtk_rule $w] {bottom fillx} \
              $w.filter {bottom expand fillx} \
              [xtk_rule $w] {bottom fillx} \
              $w.b {right filly} \
              [xtk_rule $w] {right filly} \
              $w.list {top expand fill}


    $w.file.e insert end $j_fs(result)

    ######################################################################
    # Les bindings
    #
    bind $w.file.e   <Key-Return> "xtk_fs_button_ok $w  ; break"
    bind $w.filter.e <Key-Return> "xtk_fs_button_ok $w  ; break"


    bind $w.file.e <Tab> {      ;# expand filename on <Space>
      set fs_priv_file [%W get]
      %W delete 0 end
      %W insert end [te:expand_filename $fs_priv_file]
    }

    # Tab dans l'entry "pattern" fait passer a l'autre entry
    bind $w.filter.e <Tab>   "focus $w.file.e ; break"

    # enter dans l'entree "filter" provoque la mise a jour de la variable 
    # globale j_fs(filter) et a la meme effet que le binding suivant
    #
    bind $w.filter.e <Key-Return> [subst {
        set j_fs(filter) \[$w.filter.e get\]
        xtk_fs_fill_list $w.list.lb \$j_fs(filter)
    }]

    # la sortie de l'entree de filtre provoque la misa a jour de la variable
    # associee globale
    bind $w.filter.e <Leave> "
        set j_fs(filter) \[$w.filter.e get\]
    "

    # bind .fs.file.e <space> { ;# expand filename on <Space>
    #   set f [%W get]
    #   %W delete 0 end
    #   %W insert end [te:expand_filename $f]
    # }

    # bind $w.list.lb <Button-1> "xtk_fs_bind_button1 %W %y"
    # bind $w.list.lb <Double-Button-1> "xtk_fs_bind_doubleButton1 %W %y"
    bind $w.list.lb <Button-1> [list xtk_fs_bind_button1 %W %y]
    bind $w.list.lb <Double-Button-1> [list xtk_fs_bind_doubleButton1 %W %y]

    te:cancel_button $w.b.cancel $w.file.e


    # fill the listbox for the first time
    xtk_fs_fill_list $w.list.lb [$w.filter.e get]

    ######################################################################
    # Voici tout ce qu'il suffit de faire pour gérer un dialogue :

    wm transient $w $j_fs(-parent)

    # # ::tk::PlaceWindow $w widget $j_fs(-parent)
    xtk_placeWindow $w widget $j_fs(-parent)

    wm title $w $j_fs(-title)

    # # ::tk::SetFocusGrab $w $w.file.e
    xtk_setFocusGrab $w $w.file.e

    tkwait variable j_fs(result)
    # # ::tk::RestoreFocusGrab $w $w.file.e destroy
    xtk_restoreFocusGrab $w $w.file.e destroy

    return $j_fs(result)
}

## xtk_fs_button_cancel -- proc auxiliaire du bouton "cancel"
#
# 08/09/00 (diam) pour nettoyer une option -command de xtk_fsBox
#
proc xtk_fs_button_cancel { w } {
    global j_fs
    set j_fs(result) $j_fs(-cancelvalue)
}

## xtk_fs_button_gointo -- proc auxiliaire du bouton "gointo"
#
# 08/09/00 (diam) pour nettoyer une option -command de xtk_fsBox
#
# - w: toplevel du fileselector
# - dir: répertoire de destination. Par défaut l'entry est lue
#
proc xtk_fs_button_gointo {w dir} {

    if {![string length $dir]} {
        # on lit la valeur du répertoire dans l'entry
        set dir [$w.file.e get]
    }

    if {[file isdirectory $dir]} {
        cd $dir
        # refresh directory label
        $w.cwd configure -text [pwd]
        xtk_fs_fill_list $w.list.lb [$w.filter.e get]
        
        # on efface l'entry
        $w.file.e delete 0 end 
      
    } else {
        stead:log -error "\"$dir\" is not a directory."
    }
}

## xtk_fs_button_ok -- PROVISOIRE proc auxiaire
#
# 08/09/00 (diam) pour nettoyer une option -command de xtk_fsBox
#
proc xtk_fs_button_ok { w } {
    global j_fs

    set file [$w.file.e get]

    if {[file isdirectory $file]} {
        cd $file
        # refresh directory label
        $w.cwd configure -text [pwd]

        xtk_fs_fill_list $w.list.lb [$w.filter.e get]
        $w.file.e delete 0 end
    } else {
        cd [file dirname $file]
        set j_fs(result) $file
    }
}

## xtk_fs_button_fast -- PROVISOIRE proc auxiaire
#
# 08/09/00 (diam) pour nettoyer une option -command de xtk_fsBox
#
proc xtk_fs_button_fast { w } {
    xtk_fs_fill_list $w.list.lb [$w.filter.e get]
    update
}
## xtk_fs_bind_button1 -- PROVISOIRE proc auxiaire
#
# select, and insert filename into entry
#
# 08/09/00 (diam) pour nettoyer une option -command de xtk_fsBox
#
proc xtk_fs_bind_button1 { w y} {
     $w selection set [$w nearest $y]

     # bug corrigé le 29/09/2006
     # set fs_priv_file [lindex [selection get] 0]
     set fs_priv_file [selection get]
     # puts "fs_priv_file=$fs_priv_file"
     .fs.file.e delete 0 end
     .fs.file.e insert end $fs_priv_file
}

## xtk_fs_bind_doubleButton1 -- PROVISOIRE proc auxiaire
#
# cd to dir or do default thing
#
# 08/09/00 (diam) pour nettoyer une option -command de xtk_fsBox
#
proc xtk_fs_bind_doubleButton1 { w y } {

    global j_fs
    xtk_fs_bind_button1 $w $y
    xtk_invokeButton .fs.b.$j_fs(-defaultbutton)
}


## xtk_fs_is_in_menu { pattern {m .fs.filter.l.m}} - renvoie un si le pattern
# n'est pas deja dans le menu, 0 s'il y est ou s'il est vide
#
proc xtk_fs_not_in_menu { pattern {m .fs.filter.l.m} } {
    if {"x$pattern" == "x"} {return 0}
    return [catch {$m index $pattern}]
}

## xtk_fs_fill_list lb - fill the listbox with files from CWD
#
proc xtk_fs_fill_list { lb {f "*"} { m .fs.filter.l.m} {fe .fs.filter.e} } {
    global EDITPREFS
    set EDITPREFS(0) 1
    $lb delete 0 end

    # creation du menu des extensions
    if {[winfo exists $m]} {destroy $m}
    menu $m
    # ajout de * au menu des extensions
    $m add command -label {*} \
                  -command " $fe delete 0 end
                  
    $fe insert insert *
    set j_fs(filter) *
    xtk_fs_fill_list .fs.list.lb \[.fs.filter.e get\]"

    # add ".." to go up a level:
    $lb insert end ".."

    # f est le fitre pour les fichiers
    # si f est vide , c'est *
    if {"x$f" == "x" || "x$f" == "x*.*"} {
        set f "*"
    }

    update

    # add all normal (non-dot) files:
    foreach i [lsort [glob -nocomplain *]] {
        if {[file isdirectory $i]} {
            $lb insert end "$i/"
        } else {
            # on scanne l'extension du fichier et on la rajoute le 
            # cas echeant dans le menu d'extensions $m.
            # la commande remplit l'entrie $fe du nom de l'extension
            if {[xtk_fs_not_in_menu [file extension $i] $m]} {
                $m add command -label [file extension $i] \
                -command " $fe delete 0 end
                           $fe insert insert *\[file extension $i\]
                           set j_fs(filter) $i
                           xtk_fs_fill_list .fs.list.lb \[.fs.filter.e get\]"
            } 
            if {[string match $f $i]} {
                $lb insert end $i
            }
        } 
    } 

    # add any dot-files:
    if { $EDITPREFS(j_fs_fast) } {
        foreach i [lsort [glob -nocomplain .*]] {
            if {$i != "." && $i != ".."} {
                if {[file isdirectory $i]} {
                    $lb insert end "$i/"
                } else {
                    # on scanne l'extension du fichier et on la rajoute le 
                    # cas echeant dans le menu d'extensions $m.
                    # la commande remplit l'entrie $fe du nom de l'extension
                    set i1 [string range $i 1 end]
                    if {[xtk_fs_not_in_menu [file extension $i1] $m]} {
                        $m add command -label [file extension $i1] \
                                       -command " $fe delete 0 end
                                       
                        $fe insert insert *\[file extension $i1\]
                        set j_fs(filter) *\[file extension $i1\]
                        
                        xtk_fs_fill_list .fs.list.lb \[.fs.filter.e get\]"
                    }
                    if {[string match .$f $i]} {
                        $lb insert end $i
                    }
                }  
            }
        } 
    } 
}
# ./
# 