[PD-cvs] pd/src desire.tk,1.1.2.600.2.244,1.1.2.600.2.245

[Mathieu Bouchard]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3120

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
added ::server_pid and abort_server


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.244
retrieving revision 1.1.2.600.2.245
diff -C2 -d -r1.1.2.600.2.244 -r1.1.2.600.2.245
*** desire.tk	18 Jul 2007 15:57:44 -0000	1.1.2.600.2.244
--- desire.tk	20 Jul 2007 00:47:33 -0000	1.1.2.600.2.245
***************
*** 880,883 ****
--- 880,884 ----
  }
  
+ set server_pid 0
  proc poll_gdb {} {
  	global gdb
***************
*** 888,892 ****
  		regsub {^\(gdb\) ?} $line {} line
  		if {[regexp {^\[Thread debug} $line]} {continue}
! 		if {[regexp {^\[New Thread} $line]} {continue}
  		if {[regexp {^Reading symbols from} $line]} {continue}
  		if {[regexp {^Using host libthread_db} $line]} {continue}
--- 889,899 ----
  		regsub {^\(gdb\) ?} $line {} line
  		if {[regexp {^\[Thread debug} $line]} {continue}
! 		if {[regexp {^\[New Thread.*LWP (\d+)} $line dummy pid]} {
! 			if {!$::server_pid} {
! 				set ::server_pid $pid
! 				post "server pid=$pid"
! 				continue
! 			}
! 		}
  		if {[regexp {^Reading symbols from} $line]} {continue}
  		if {[regexp {^Using host libthread_db} $line]} {continue}
***************
*** 1060,1063 ****
--- 1067,1075 ----
  }
  
+ def Client abort_server {} {
+ 	set answer [tk_messageBox -message "Do you really wish to abort?" -type yesno -icon question]
+ 	switch -- $answer {yes {exec kill -ABRT $::server_pid}}
+ }
+ 
  def Client server_prefs {} {ServerPrefsDialog new_as pdrc}
  def Client client_prefs {} {ClientPrefsDialog new_as ddrc}
***************
*** 1084,1088 ****
  	server_prefs client_prefs send_message {}
  	audio_on audio_off {}
! 	quit}
      $self populate_menu help {
  	about documentation class_browser do_what_i_mean {}
--- 1096,1100 ----
  	server_prefs client_prefs send_message {}
  	audio_on audio_off {}
! 	abort_server quit}
      $self populate_menu help {
  	about documentation class_browser do_what_i_mean {}
***************
*** 1427,1431 ****
      if {$filename != ""} {[$self widget] postscript -file $filename}
  }
! def Canvas quit {} {global main; $main quit}
  
  proc wonder {} {tk_messageBox -message [say ask_cool] -type yesno -icon question}
--- 1439,1444 ----
      if {$filename != ""} {[$self widget] postscript -file $filename}
  }
! def Canvas quit {}         {$::main quit}
! def Canvas abort_server {} {$::main abort_server}
  
  proc wonder {} {tk_messageBox -message [say ask_cool] -type yesno -icon question}
***************
*** 2100,2104 ****
      #removed Paths after send_message
      foreach x {file edit find view put window help} {menu $m.$x -tearoff $::pd_tearoff}
!     $self populate_menu file {new_file open_file {} send_message {} close save save_as print {} quit}
      $self populate_menu edit {undo redo {} cut copy paste duplicate select_all subpatcherize {} text_editor tidy_up {}}
      $self populate_menu find {find find_again find_last_error}
--- 2113,2117 ----
      #removed Paths after send_message
      foreach x {file edit find view put window help} {menu $m.$x -tearoff $::pd_tearoff}
!     $self populate_menu file {new_file open_file {} send_message {} close save save_as print {} abort_server quit}
      $self populate_menu edit {undo redo {} cut copy paste duplicate select_all subpatcherize {} text_editor tidy_up {}}
      $self populate_menu find {find find_again find_last_error}