aebuild.tcl

It s a tool designed to extract as much information as possible from Bluetooth devices without the r

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::bool" --
 # 
 #  Convert 'val' to AE 'bool(«val»)'.
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::bool {val} {
    if {$val} {
	set val 1
    } else {
	set val 0
    }
    
    return [tclAE::build::coercion [tclAE::build::hexd $val] bool]
}

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::TEXT" --
 #  
 #  Convert $txt to “TEXT”.
 #  If there are curly quotes in $txt, output in raw hex, coerced to TEXT
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::TEXT {txt} {
   if {$txt == ""} {
     return "[tclAE::build::coercion {} TEXT]"
   }
   if {[regexp {[\u0000-\u001f\u201c\u201d]} $txt]} {
     binary scan $txt H* hexd
     return "[tclAE::build::coercion [tclAE::build::hexd $hexd] TEXT]"
   }
   return "\u201c${txt}\u201d"
}

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::alis" --
 # 
 #  Convert 'path' to an alis(«...»).
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::alis {path} {
    return [tclAE::coerceData TEXT $path alis]
}

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::fss" --
 # 
 #  Convert 'path' to an 'fss '(«...»).
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::fss {path} {
    return [tclAE::coerceData TEXT $path fss]
}

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::path" --
 # 
 #  Convert 'path' to an alis(«...») or a furl(“...”), depending on OS.
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::path {path} {
    global tcl_platform
    
    # For some inexplicable reason, Apple decided that aliases
    # cannot refer to non-existent files on Mac OS X, so 
    # we create a CFURL instead
    if {$tcl_platform(platform) == "unix" && $tcl_platform(os) == "Darwin"} {
	return "furl([tclAE::build::TEXT $path])"
    } else {
	return [tclAE::coerceData TEXT $path alis]
    }
}

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::ident" --
 # 
 #  Dummy proc for rebuilding AEGizmos strings from parsed lists
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::enum {enum} {
    return [tclAE::build::protect $enum]
}


proc tclAE::build::name {name} {
    return "form:'name', seld:[tclAE::build::TEXT $name]"
}

proc tclAE::build::filename {name} {
    global tcl_platform
    if {$tcl_platform(platform) == "unix" && $tcl_platform(os) == "Darwin"} {
	set name [tclAE::getHFSPath $name]
    } 
    return "obj{want:type('file'), from:'null'(), [tclAE::build::name $name] } "
}

proc tclAE::build::winByName {name} {
    return "obj{want:type('cwin'), from:'null'(), [tclAE::build::name $name]}"
}

proc tclAE::build::winByPos {absPos} {
    return "obj{want:type('cwin'), from:'null'(), [tclAE::build::absPos $absPos]}"
}

proc tclAE::build::lineRange {absPos1 absPos2} {
    set lineObj1 "obj{want:type('clin'), from:'ccnt'(), [tclAE::build::absPos $absPos1]}"
    set lineObj2 "obj{want:type('clin'), from:'ccnt'(), [tclAE::build::absPos $absPos2]}"
    return "form:'rang', seld:rang{star:$lineObj1, stop:$lineObj2}"
}

proc tclAE::build::charRange {absPos1 absPos2} {
    set charObj1 "obj{want:type('cha '), from:'ccnt'(), [tclAE::build::absPos $absPos1]}"
    set charObj2 "obj{want:type('cha '), from:'ccnt'(), [tclAE::build::absPos $absPos2]}"
    return "form:'rang', seld:rang{star:$charObj1, stop:$charObj2}"
}

proc tclAE::build::absPos {posName} {
    #
    # Use '1' or 'first' to specify first position
    # and '-1' or 'last' to specify last position.
    #
    if {$posName == "first"} { 
	set posName 1 
    } elseif {$posName == "last"} { 
	set posName -1 
    }
    if {[is::Integer $posName]} {
	return "form:indx, seld:long($posName)"
    } else {
	error "tclAE::build::absPos: bad argument"
    }
}

proc tclAE::build::nullObject {} { 
    return "'null'()" 
}

proc tclAE::build::objectType {type} { 
	return "type($type)" 
}

proc tclAE::build::nameObject {type name {from ""}} 	{
    if {$from == ""} {
	set from [tclAE::build::nullObject]
    } 
    return "obj \{ \
      form:name, \
      want:[tclAE::build::objectType $type], \
      seld:$name, \
      from:$from \
    \}" 
}

proc tclAE::build::indexObject {type ind {from ""}} {
    if {$from == ""} {
	set from [tclAE::build::nullObject]
    } 
    return "obj \{ \
      form:indx, \
      want:[tclAE::build::objectType $type], \
      seld:$ind, \
      from:$from \
    \}" 
}

proc tclAE::build::everyObject {type {from ""}} {
    return [tclAE::build::indexObject $type "abso('all ')" $from]
}

proc tclAE::build::rangeObject {type absPos1 absPos2 {from ""}} {
    if {$from == ""} {
	set from [tclAE::build::nullObject]
    } 
    set type [tclAE::build::objectType $type]
    
    set obj1 "obj{                      \
	want:$type,                     \
	from:'ccnt'(),                  \
	[tclAE::build::absPos $absPos1] \
    }"
    set obj2 "obj{                      \
	want:$type,                     \
	from:'ccnt'(),                  \
	[tclAE::build::absPos $absPos2] \
    }"
    return "obj {     \
      form:rang,      \
      want:$type,     \
      seld:rang{      \
	star:$obj1,   \
	stop:$obj2    \
      },              \
      from:$from      \
    }" 
}

proc tclAE::build::propertyObject {prop {object ""}} { 
    if {[string length $object] == 0} {
	set object [tclAE::build::nullObject]
    } 
    
    return "obj \{\
      form:prop, \
      want:[tclAE::build::objectType prop], \
      seld:[tclAE::build::objectType $prop], \
      from:$object \
    \}" 
}

proc tclAE::build::propertyListObject {props {object ""}} { 
    if {[string length $object] == 0} {
	set object [tclAE::build::nullObject]
    } 
    
    return "obj \{\
      form:prop, \
      want:[tclAE::build::objectType prop], \
      seld:[tclAE::build::List $props -as objectType], \
      from:$object \
    \}" 
}

# ◊◊◊◊ Utilities ◊◊◊◊ #

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::startupDisk" --
 # 
 #  The name of the Startup Disk (as sometimes returned by the Finder)
 # -------------------------------------------------------------------------
 ##
proc tclAE::build::startupDisk {} {
    return [tclAE::build::objectProperty 'MACS' pnam \
      "obj \{want:type(prop), from:'null'(), \
      form:prop, seld:type(sdsk)\}" \
    ]	
}

## 
 # -------------------------------------------------------------------------
 # 
 # "tclAE::build::userName" --
 # 
 #  Return the default user name. The Mac's owner name,
 #  which is in String Resource ID -16096, is inaccesible to Tcl 
 #  (at least until Tcl 8 is implemented).
 #  
 #  Try different mechanisms for determining the user name.
 #  
 # -------------------------------------------------------------------------
 ##
if {([info exists alpha::platform] && ${alpha::platform} != "alpha") || 
	($tcl_platform(platform) == "unix" && $tcl_platform(os) == "Darwin")} {
    ;proc tclAE::build::userName {} {
	global env
	
	# better to use tcl_platform(user)?
	return $env(USER)
    }
} else {
    ;proc tclAE::build::userName {} {
	return [text::fromPstring [resource read "STR " -16096]]
    }
}    

# Build a Folder object from its name
proc tclAE::build::foldername {name} {
    global tcl_platform
    if {$tcl_platform(platform) == "unix" && $tcl_platform(os) == "Darwin"} {
	set name [tclAE::getHFSPath $name]
    } 
    return "obj{want:type('cfol'), from:'null'(), [tclAE::build::name $name] } "
}