home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / plplot / plplot_2 / drivers / tk / plserver.t < prev    next >
Encoding:
Text File  |  1994-07-01  |  6.2 KB  |  248 lines
  1. # $Id: plserver.tcl,v 1.18 1994/07/01 20:39:17 mjl Exp $
  2. # $Log: plserver.tcl,v $
  3. # Revision 1.18  1994/07/01  20:39:17  mjl
  4. # Moved "standard" initialization code to proc plstdwin in pltools.tcl,
  5. # so it can be used by the demos.
  6. #
  7. # Revision 1.17  1994/06/23  22:34:57  mjl
  8. # Removed an unnecessary "update".
  9. #
  10. # Revision 1.16  1994/06/16  19:08:22  mjl
  11. # exit_app proc simplified -- some of its previous tasks have been absorbed
  12. # into the redefined exit proc.
  13. #
  14. # Revision 1.15  1994/06/09  20:16:28  mjl
  15. # Moved the key_filter proc to plwidget.tcl, since it is better put there.
  16. # Some cleaning up also.
  17. #
  18.  
  19. #----------------------------------------------------------------------------
  20. # PLPLOT TK/TCL graphics renderer menu procs
  21. # Maurice LeBrun
  22. # 26-Apr-1993
  23. # IFS, University of Texas at Austin
  24. #
  25. # This file includes the main initialization, cleanup, and communication
  26. # procs.  Those dealing with the plframe widget and "megawidget" are kept
  27. # elsewhere.
  28. #----------------------------------------------------------------------------
  29.  
  30. #----------------------------------------------------------------------------
  31. # plserver_init
  32. # Create the main window, menus, etc.
  33. #----------------------------------------------------------------------------
  34.  
  35. proc plserver_init {} {
  36.  
  37. # Set up toplevel
  38.  
  39.     plstdwin .
  40.  
  41. # Create the window for the menu bar
  42.  
  43.     frame .menu -relief raised -borderwidth 1
  44.     pack append . .menu {top fillx}
  45.  
  46. #------------
  47. # File menu
  48. #------------
  49.  
  50.     menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
  51.     menu .menu.file.m
  52.  
  53. #    .menu.file.m add command \
  54. #    -label "Open" \
  55. #    -command {null_command "Open"} \
  56. #    -underline 0
  57.  
  58.     .menu.file.m add command \
  59.     -label "About..." \
  60.     -command about \
  61.     -underline 0
  62.  
  63. #    if { ! [ info exists child ] } then {
  64. #    .menu.file.m add command \
  65. #        -label "Launch client..." \
  66. #        -command {null_command "Launch client..."} \
  67. #        -underline 0
  68. #    }
  69.  
  70.     .menu.file.m add separator
  71.  
  72.     .menu.file.m add command \
  73.     -label "Exit" \
  74.     -command {exit_app} \
  75.     -underline 0
  76.  
  77.     bind . <Control-x> {exit_app}
  78.  
  79.     pack append .menu .menu.file {left}
  80.  
  81. #--------------
  82. # Debug menu
  83. #--------------
  84.  
  85.     if {[info exists debug_on]} then {
  86.     menubutton .menu.debug -text "Debug" -menu .menu.debug.m -underline 0
  87.     menu .menu.debug.m
  88.  
  89.     .menu.debug.m add command \
  90.         -label "Execute TCL command" \
  91.         -command evalCmd \
  92.         -underline 0
  93.  
  94.     pack append .menu .menu.debug {left}
  95.     }
  96.  
  97. #--------------
  98. # Help menu
  99. #--------------
  100.  
  101.     menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
  102.     menu .menu.help.m
  103.  
  104.     .menu.help.m add command \
  105.     -label "On Tcl/TK..." \
  106.     -command help_tcltk \
  107.     -underline 3
  108.  
  109.     .menu.help.m add command \
  110.     -label "On GUI..." \
  111.     -command help_gui \
  112.     -underline 3
  113.  
  114.     .menu.help.m add command \
  115.     -label "On Keys..." \
  116.     -command help_keys \
  117.     -underline 3
  118.  
  119.     pack append .menu .menu.help {right}
  120.  
  121. # Set up for keyboard-based menu traversal
  122.  
  123.     tk_menuBar .menu .menu.file .menu.help
  124.     tk_bindForTraversal . .menu
  125.  
  126.     focus default .
  127.  
  128. # Set up initial link to client.
  129.  
  130.     plserver_link_init
  131. }
  132.  
  133. #----------------------------------------------------------------------------
  134. # exit_app
  135. #
  136. # Destroys main window and does any other cleanup necessary.
  137. # Eventually this will have to be completely redone to handle multiple
  138. # client widgets.
  139. #----------------------------------------------------------------------------
  140.  
  141. proc exit_app {} {
  142.     global client
  143.  
  144.     if { [ info exists client ] } then {
  145.     client_cmd $client "unset server"
  146.     }
  147.     after 1 exit
  148. }
  149.  
  150. #----------------------------------------------------------------------------
  151. # client_cmd
  152. #
  153. # Send string to client.  Does it in the background and catches errors
  154. # (if client is busy it won't respond).
  155. #
  156. # The first "after 1" ensures the command is issued in the server's
  157. # background, so that we always continue processing events.  This is
  158. # important for handshaking and for good performance.
  159. #
  160. # The second "after 1" (or the dp_RDO if Tcl-DP rpc is used) ensures that
  161. # the client process doesn't try to send a reply.  Also good for
  162. # performance but also prevents the client from timing out if the server
  163. # exits before it can reply.
  164. #----------------------------------------------------------------------------
  165.  
  166. proc client_cmd {client msg} {
  167.     global dp
  168.  
  169.     if { $dp } then {
  170.     after 1 catch [list "dp_RDO [list $client] $msg"]
  171.     } else {
  172.     after 1 catch [list "send [list $client] after 1 $msg"]
  173.     }
  174. }
  175.  
  176. #----------------------------------------------------------------------------
  177. # plserver_link_init
  178. #
  179. # Set up initial link to client.
  180. #----------------------------------------------------------------------------
  181.  
  182. proc plserver_link_init {} {
  183.     global dp client
  184.  
  185.     if { $dp } then {
  186.     global client_host client_port server_host server_port
  187.  
  188.     if { ! [ info exists client_host ] } then {
  189.         set client_host localhost
  190.     }
  191.  
  192.     set server_host [host_id]
  193.     set server_port [dp_MakeRPCServer]
  194.     set client [dp_MakeRPCClient $client_host $client_port]
  195.  
  196.     dp_RDO [list $client] set server_host $server_host
  197.     dp_RDO [list $client] set server_port $server_port
  198.     dp_RDO [list $client] set client [list $client]
  199.  
  200.     } else {
  201.     global client_name server_name
  202.  
  203.     set server_name [winfo name .]
  204.     set client $client_name
  205.  
  206.     send $client "set server_name [list $server_name]"
  207.     send $client "set client [list $client]"
  208.     }
  209. }
  210.  
  211. #----------------------------------------------------------------------------
  212. # plserver_start
  213. #
  214. # Startup proc when client is run independently.
  215. #----------------------------------------------------------------------------
  216.  
  217. proc plserver_start {{use_dp 0}} {
  218.     global dp client
  219.  
  220.     plserver_init
  221.  
  222.     set dp $use_dp
  223.  
  224.     if { $dp } then {
  225.     global client_host client_port server_host server_port
  226.  
  227.     set server_host [host_id]
  228.     set server_port [dp_MakeRPCServer]
  229.  
  230.     puts stderr "Please start client with flags: "
  231.     puts stderr "  -server_host $server_host -server_port $server_port"
  232.  
  233.     wait_until {[info exists client_port]}
  234.     set client "[dp_MakeRPCClient $client_host $client_port]"
  235.     dp_RDO [list $client] set client [list $client]
  236.  
  237.     } else {
  238.     global client_name server_name
  239.  
  240.     puts stderr "Please start client with flags: "
  241.     puts stderr "  -server_name $server_name"
  242.     tkwait variable client_name
  243.  
  244.     set client $client_name
  245.     send $client "set client [list $client]"
  246.     }
  247. }
  248.