** Directory entry megawidget **

[bll] 2017-9-20 This widget keeps the native directory name and the normalized directory name separate so that
the native name is displayed and the normalized name is used in the `-textvariable` variable.

It was my intention to have this support Mac OS X localization (with an external helper program), but
it's turning out to be a real problem getting the Mac OS X localized names.

Ideally, I would like a `file normalize -keepsymlinks` function so that the entered path stays 
intact on re-display.  But hopefully that won't be a major problem.

======
#!/usr/bin/tclsh
#
# Copyright 2017 Brad Lanam Walnut Creek CA
#

package require Tcl 8.5-
package require Tk

# direntry is a directory entry widget
#   it will always display the native directory name,
#   but will return the normalized directory name.
proc ::direntry { nm args } {
  direntryclass new $nm {*}$args
  return $nm
}

namespace eval direntry {
  variable vars

  proc handler { entry args } {
    $entry {*}$args
  }

  proc display { d } {
    variable vars

    set d [file nativename $d]
    return $d
  }
}

::oo::class create direntryclass {
  constructor { nm args } {
    my variable vars

    set vars(entry.disp) {}

    set vars(widget) [ttk::entry $nm]
    $vars(widget) configure -textvariable [self]::vars(entry.disp)
    set vars(entry) ${nm}_direntry
    rename $vars(widget) ::$vars(entry)
    interp alias {} $vars(widget) {} ::direntry::handler [self]
    set nm $vars(widget)
    uplevel 2 [list $nm configure {*}$args]

    bind $vars(widget) <Destroy> [list [self] destruct]
    bind $vars(widget) <Map> [list [self] startdisptrace]
  }

  method destruct { } {
    my variable vars
    interp alias {} $vars(widget) {}
    my _stoptexttrace
    my _stopdisptrace
    [self] destroy
  }

  method startdisptrace { args } {
    my variable vars

    trace add variable vars(entry.disp) write [list [self] updtextvar]
  }

  method _stopdisptrace { } {
    my variable vars

    trace remove variable vars(entry.disp) write [list [self] updtextvar]
  }

  method _starttexttrace { args } {
    my variable vars

    set k -textvariable
    if { [info exists vars($k)] && [info exists $vars($k)] } {
      trace add variable $vars($k) write [list [self] settextvar]
    }
  }

  method _stoptexttrace { } {
    my variable vars

    set k -textvariable
    if { [info exists vars($k)] && [info exists $vars($k)] } {
      trace remove variable $vars($k) write [list [self] settextvar]
    }
  }

  method get { } {
    my variable vars

    if { [info exists vars(-textvariable)] &&
        [info exists $vars(-textvariable)] } {
      set rv [set $vars(-textvariable)]
    }
  }

  method settextvar { args } {
    my variable vars

    my _stopdisptrace
    set vars(entry.disp) [::direntry::display [set $vars(-textvariable)]]
    my startdisptrace
  }

  method updtextvar { args } {
    my variable vars

    if { [info exists vars(-textvariable)] } {
      my _stoptexttrace
      set $vars(-textvariable) [file normalize $vars(entry.disp)]
      my _starttexttrace
    }
  }

  method unknown { args } {
    my variable vars

    set nm $vars(entry)
    return [uplevel 2 [list $nm {*}$args]]
  }

  method cget { key } {
    my variable vars

    set rv {}
    if { $key eq "-textvariable" } {
      if { [info exists vars($key)] } {
        set rv $vars($key)
      }
    } else {
      set rv [$vars(entry) cget $key]
    }
    return $rv
  }

  method configure { args } {
    my variable vars

    foreach {k v} $args {
      if { $k eq "-textvariable" } {
        set fqv {}
        if { [string match {::*} $v] } {
          set fqv $v
        }
        if { $fqv eq {} } {
          set fqv [uplevel 2 [list namespace which -variable $v]]
          if { $fqv eq {} } {
            set ns [uplevel 2 [list namespace current]]
            set fqv $ns$v
            if { [string match ::::* $fqv] } {
              set fqv [string range $fqv 2 end]
            }
          }
        }
        if { [info exists vars($k)] && $vars($k) ne $fqv } {
          my _stoptexttrace
        }
        set vars($k) $fqv
        if { ! [info exists $vars($k)] } {
          set $vars($k) {}
        }
        my settextvar
        my _starttexttrace
      } else {
        set nm $vars(entry)
        uplevel 2 [list $nm configure $k $v]
      }
    }
    return -code ok
  }
}

package provide direntry 1.0
======

<<categories>>Widget | Megawidget