home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / CorePackages / aebuild.tcl next >
Encoding:
Text File  |  1998-11-21  |  8.7 KB  |  305 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AEBuild - Functions for building AppleEvents 
  4.  #              (modernization of appleEvents.tcl)
  5.  # 
  6.  #  FILE: "aebuild.tcl"
  7.  #                                    created: 2/25/98 {7:37:06 PM} 
  8.  #                                last update: 21/11/98 {10:59:14 pm}
  9.  #                                    version: 1.1b3 
  10.  #  Author: Jonathan Guyer
  11.  #  E-mail: <jguyer@his.com>
  12.  #     www: <http://www.his.com/~jguyer/>
  13.  #  
  14.  # Copyright (c) 1998  Jonathan Guyer
  15.  # 
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # See the file "license.terms" for information on usage and 
  30.  # redistribution of this file, and for a DISCLAIMER OF ALL 
  31.  # WARRANTIES.
  32.  #  
  33.  # ###################################################################
  34.  ##
  35.  
  36. namespace eval aebuild {}
  37.  
  38. ## 
  39.  # -------------------------------------------------------------------------
  40.  # 
  41.  # "aebuild::result" --
  42.  # 
  43.  #  Shorthand routine to get the direct object result of an AEBuild call
  44.  # -------------------------------------------------------------------------
  45.  ##
  46. proc aebuild::result {args} {
  47.     return [aeparse::keywordValue ---- \
  48.         [aeparse::event [eval AEBuild -r $args]] \
  49.     ]
  50. }
  51.  
  52. proc aebuild::objectProperty {process property object} {
  53.     return [aebuild::result $process core getd ---- \
  54.                   [propertyObject $property $object]]
  55. }
  56.  
  57. proc aebuild::coercion {type value} {
  58.     return "'${type}'(${value})"
  59.     # ??? what about coerced records?
  60.     # ??? coerced lists should generate 18 aeBuildSyntaxCoercedList
  61. }
  62.  
  63. ## 
  64.  # -------------------------------------------------------------------------
  65.  # 
  66.  # "aebuild::list" --
  67.  # 
  68.  #  Convert list 'l' to an AE list, i.e., "[l1, l2, l3, ...]".
  69.  #  "-as type" coerces elements to 'type' before joining.  
  70.  #  "-pretyped" 
  71.  # -------------------------------------------------------------------------
  72.  ##
  73. proc aebuild::list {l args} {
  74.     set opts(-as) ""
  75.     getOpts as
  76.     
  77.     if {[string length $opts(-as)] != 0} {
  78.         set out {}
  79.         foreach item $l {
  80.             lappend out [aebuild::$opts(-as) $item]
  81.         }
  82.     } else {
  83.         set out $l
  84.     }
  85.     
  86.     set out [join $out ", "]
  87.     return "\[$out\]"
  88. }
  89.  
  90. ## 
  91.  # -------------------------------------------------------------------------
  92.  # 
  93.  # "aebuild::hexd" --
  94.  # 
  95.  #  Convert 'value' to '«value»'.
  96.  #  value's spaces are stripped and it is left-padded with 0 to even digits.
  97.  # -------------------------------------------------------------------------
  98.  ##
  99. proc aebuild::hexd {value} {
  100.     return "«[aecoerce::hexd $value]»"
  101. }
  102.  
  103. ## 
  104.  # -------------------------------------------------------------------------
  105.  # 
  106.  # "aebuild::bool" --
  107.  # 
  108.  #  Convert 'val' to AE 'bool(«val»)'.
  109.  # -------------------------------------------------------------------------
  110.  ##
  111. proc aebuild::bool {val} {
  112.     if {($val == 1) || ($val == 0)} {
  113.     return [aebuild::coercion "bool" [aebuild::hexd $val]]
  114.     } else {
  115.     error "${val} is not a valid boolean"
  116.     }
  117. }
  118.  
  119. ## 
  120.  # -------------------------------------------------------------------------
  121.  # 
  122.  # "aebuild::TEXT" --
  123.  #  
  124.  #  Convert 'str' to “TEXT”.
  125.  #  Curly quotes in 'str' are converted to straight quotes. 
  126.  # -------------------------------------------------------------------------
  127.  ##
  128. proc aebuild::TEXT {str} {
  129.     regsub -all {([“”])} $str {"} newstr
  130.     return "\“$newstr\”"
  131. }
  132.  
  133. ## 
  134.  # -------------------------------------------------------------------------
  135.  # 
  136.  # "aebuild::alis" --
  137.  # 
  138.  #  Convert 'path' to an alis(«...»).
  139.  # -------------------------------------------------------------------------
  140.  ##
  141. proc aebuild::alis {path} {
  142.     return [aebuild::coercion "alis" \
  143.       [aebuild::hexd [aecoerce::TEXT:alis $path]]]
  144. }
  145.  
  146. # proc aebuild::fss {path} {
  147. #     return [aebuild::coercion "fss " \
  148. #       [aebuild::hexd [aecoerce::TEXT:alis $path]]]
  149. # }
  150.  
  151. proc aebuild::name {name} {
  152.     return "form:'name', seld:[aebuild::TEXT $name]"
  153. }
  154.  
  155. proc aebuild::filename {name} {
  156.     return "obj{want:type('file'), from:'null'(), [aebuild::name $name] } "
  157. }
  158.  
  159. proc aebuild::winByName {name} {
  160.     return "obj{want:type('cwin'), from:'null'(), [aebuild::name $name] } "
  161. }
  162.  
  163. proc aebuild::winByPos {absPos} {
  164.     return "obj{want:type('cwin'), from:'null'(), [aebuild::absPos $absPos] } "
  165. }
  166.  
  167. proc aebuild::lineRange {absPos1 absPos2} {
  168.     set lineObj1 "obj{ want:type('clin'), from:'ccnt'(), [aebuild::absPos $absPos1] }"
  169.     set lineObj2 "obj{ want:type('clin'), from:'ccnt'(), [aebuild::absPos $absPos2] }"
  170.     return "form:'rang', seld:rang{star:$lineObj1, stop:$lineObj2 } "
  171. }
  172.  
  173. proc aebuild::absPos {posName} {
  174. #
  175. # Use '1' or 'first' to specify first position
  176. # and '-1' or 'last' to specify last position.
  177. #
  178.     if {$posName == "first"} { 
  179.         set posName 1 
  180.     } elseif {$posName == "last"} { 
  181.         set posName -1 
  182.     }
  183.     if {$posName >= -1} {
  184.         return "form:indx, seld:long($posName)"
  185.     } else {
  186.         error "aebuild::absPos: bad argument"
  187.     }
  188. }
  189.  
  190. # ◊◊◊◊ Utilities ◊◊◊◊ #
  191.  
  192. ## 
  193.  # -------------------------------------------------------------------------
  194.  # 
  195.  # "aebuild::startupDisk" --
  196.  # 
  197.  #  The name of the Startup Disk (as sometimes returned by the Finder)
  198.  # -------------------------------------------------------------------------
  199.  ##
  200. proc aebuild::startupDisk {} {
  201.     return [aebuild::objectProperty 'MACS' pnam \
  202.           "obj \{want:type(prop), from:'null'(), \
  203.             form:prop, seld:type(sdsk)\}" \
  204.     ]    
  205. }
  206.  
  207. ## 
  208.  # -------------------------------------------------------------------------
  209.  # 
  210.  # "aebuild::OS8userName" --
  211.  # 
  212.  # Get the owner name of the computer from the File Sharing control 
  213.  # panel, 'shcp', which is scriptable as of MacOS 8.x
  214.  #  
  215.  # -------------------------------------------------------------------------
  216.  ##
  217. proc aebuild::OS8userName {} {
  218.     
  219.     # We don't care; just want an error thrown if the File Sharing
  220.     # control panel isn't scriptable
  221.     nameFromAppl shcp
  222.     
  223.     set quitWhenDone [expr ![app::isRunning shcp]]
  224.     
  225.     app::ensureRunning shcp
  226.     
  227.     # tell application "File Sharing" to get owner name
  228.     set userName [aebuild::objectProperty 'shcp' ownn [nullObject]]
  229.     
  230.     # If File Sharing wasn't open before this call, kill it
  231.     if {$quitWhenDone} {
  232.         sendQuitEvent 'shcp'
  233.     } 
  234.     
  235.     return $userName
  236. }
  237.  
  238. ## 
  239.  # -------------------------------------------------------------------------
  240.  # 
  241.  # "aebuild::OS7userName" --
  242.  # 
  243.  # For MacOS 7.x, we use the owner of the preferences folder.
  244.  #  
  245.  # This is not guaranteed to be the same as the Mac's owner, but it's 
  246.  # likely the same and seems preferable to IC's user name, which is almost 
  247.  # never the same.
  248.  #
  249.  # I picked the preference folder because it was easily 
  250.  # specifiable through AppleEvents, because its default ownership 
  251.  # is that of the computer, and because a user would really have to 
  252.  # go out of their way to change it (by either explicitly changing 
  253.  # ownership, or more likely, by clicking 
  254.  # 'Make all currently enclosed folders like this one' 
  255.  # in the startup disk's Sharing window after changing the disk's 
  256.  # ownership. Anyone who does this should be taunted severely.
  257.  # 
  258.  # This will fail if File Sharing is off.
  259.  # -------------------------------------------------------------------------
  260.  ##
  261. proc aebuild::OS7userName {} {
  262.     # tell application "Finder" to get owner of preferences folder
  263.     return [aebuild::objectProperty 'MACS' sown \
  264.         "obj \{want:type(prop), from:'null'(), form:prop, seld:type(pref)\}" \
  265.     ]
  266. }
  267.  
  268. ## 
  269.  # -------------------------------------------------------------------------
  270.  # 
  271.  # "aebuild::userName" --
  272.  # 
  273.  #  Return the default user name. The Mac's owner name,
  274.  #  which is in String Resource ID -16096, is inaccesible to Tcl 
  275.  #  (at least until Tcl 8 is implemented).
  276.  #  
  277.  #  Try different mechanisms for determining the user name.
  278.  #  
  279.  # -------------------------------------------------------------------------
  280.  ##
  281. if {[info tclversion] < 8.0} {
  282. proc aebuild::userName {} {
  283.     
  284.     if {[catch {aebuild::OS8userName} userName]} {
  285.     
  286.     # Above failed, probably because the OS doesn't support
  287.     # scriptable File Sharing.
  288.     
  289.     if {[catch {aebuild::OS7userName} userName]} {
  290.         # Both attempts at a user name failed, so return whatever
  291.         # Internet Config has
  292.         
  293.         set userName [icGetPref RealName]
  294.     }
  295.     }
  296.     
  297.     return $userName
  298. }
  299. } else {
  300.     proc aebuild::userName {} {
  301.     return [text::fromPstring [resource read "STR " -16096]]
  302.     }
  303.     
  304. }
  305.