# System- / machine- / OS-dependent code, to try and keep the rest portable.
#
# $Id: SysDep.tcl 5973 2010-08-29 12:17:40Z jcw $

proc serialNameToDevice {name} {
  #: support some shorthand conventions for naming serial devices
  set map [listSerialPorts]
  if {[dict exists $map $name]} {
    set name [dict get $map $name]
  }
  return $name
}

if {[string match Windows* $::tcl_platform(os)]} {
  package require registry
  
  proc listSerialPorts {} {
    #: returns a key-value list: usb-$serial COM<N>
    # use a spinlock to avoid race conditions if the registry changes halfway
    while 1 {
      set map [RawListSerialPorts]
      if {$map eq [RawListSerialPorts]} {
        return $map
      }
    }
  }
  
  proc RawListSerialPorts {} {
    # 2010-02-21 tested on Win2K and Win7
    # 2010-04-21 improved version, see http://talk.jeelabs.net/topic/208
    set result {}
    set ccs {HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet}
    foreach {type match} {
      Serenum {^FTDIBUS.*_6001.(\w+)}
      usbser  {^USB\B.*\B(.*)$}
    } {
      # ignore registry access errors
      catch {
        set enum "$ccs\\Services\\$type\\Enum"
        set n [registry get $enum Count]
        for {set i 0} {$i < $n} {incr i} {
          set desc [registry get $enum $i]
          if {[regexp $match $desc - serial]} {
            set p [registry get "$ccs\\Enum\\$desc\\Device Parameters" PortName]
            # Log . {usb-$serial Port: $p\
                      Friendly: [registry get "$ccs\\Enum\\$desc" FriendlyName]}
            lappend result usb-$serial $p
          }
        }
      }
    }
    return $result
  }
    
} elseif {[string match Darwin $::tcl_platform(os)]} {
  
  proc listSerialPorts {} {
    #: returns a key-value list: usb-$serial /dev/tty.usbserial-$serial
    # 2010-02-21 tested on Mac OS X 10.6
    set result {}
    foreach path [glob -nocomplain /dev/tty.usbserial-*] {
      set name [regsub {/dev/tty.usbserial-} $path {usb-}]
      lappend result $name $path
    }
    return $result
  }

} elseif {[string match *x $::tcl_platform(os)]} {
  
  proc listSerialPorts {} {
    #: returns a key-value list: usb-$serial /dev/ttyUSB<N>
    # 2010-02-21 tested on Debian 5, Ubuntu 9.10, and Gentoo
    set result {}
    foreach path [glob -nocomplain /sys/bus/usb-serial/devices/*] {
      set info [file dir [file dir [file readlink $path]]]
      set serial [readFile [file dir $path]/$info/serial -nonewline]
      if {$serial ne ""} {
        lappend result usb-$serial /dev/[file tail $path]
      }
    }
    return $result
  }
}