[PD-cvs] pd/src desire.tk,1.1.2.574,1.1.2.575

Mathieu Bouchard matju at users.sourceforge.net
Mon Nov 20 05:50:14 CET 2006


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
new statusbar; fix for Copy with Tcl 8.5; etc


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.574
retrieving revision 1.1.2.575
diff -C2 -d -r1.1.2.574 -r1.1.2.575
*** desire.tk	20 Nov 2006 03:38:19 -0000	1.1.2.574
--- desire.tk	20 Nov 2006 04:50:10 -0000	1.1.2.575
***************
*** 51,55 ****
  proc which {file} {
  	global env
! 	foreach dir [split $env(PATH) ":"] {
  		if {[file exists $dir/$file]} {return $dir/$file}
  	}
--- 51,55 ----
  proc which {file} {
  	global env
! 	foreach dir [split $::env(PATH) ":"] {
  		if {[file exists $dir/$file]} {return $dir/$file}
  	}
***************
*** 402,406 ****
  }
  
! switch $OS {
    Darwin {set pd_tearoff 0}
    default {set pd_tearoff 1}
--- 402,406 ----
  }
  
! switch $::OS {
    Darwin {set pd_tearoff 0}
    default {set pd_tearoff 1}
***************
*** 418,425 ****
  
  proc guess_lang {} {
-   global env
    set lang C
!   if {[info exist env(LC_ALL)]} {set lang $env(LC_ALL)}
!   if {[info exist env(LANG)]}   {set lang $env(LANG)}
    set lang [lindex [split $lang {[_.]}] 0]
    return $lang
--- 418,424 ----
  
  proc guess_lang {} {
    set lang C
!   if {[info exist ::env(LC_ALL)]} {set lang $::env(LC_ALL)}
!   if {[info exist ::env(LANG)]}   {set lang $::env(LANG)}
    set lang [lindex [split $lang {[_.]}] 0]
    return $lang
***************
*** 446,451 ****
  
  proc can_say {k args} {
!   global text
!   return [info exist text($k)]
  }
  
--- 445,449 ----
  
  proc can_say {k args} {
!   return [info exist ::text($k)]
  }
  
***************
*** 523,527 ****
  
  #!@#$ is this still valid?
! set look(Box:extrapix) [switch $OS {
          osx     {concat 2}
          default {concat 1}}]
--- 521,525 ----
  
  #!@#$ is this still valid?
! set look(Box:extrapix) [switch $::OS {
          osx     {concat 2}
          default {concat 1}}]
***************
*** 562,569 ****
  
  def Client init_binds {} {
-     global OS
      bind . <Control-Key>       {$main ctrlkey %K 0}
      bind . <Control-Shift-Key> {$main ctrlkey %K 1}
!     switch $OS {
        osx {
          bind . <Mod1-Key>       {$main ctrlkey %K 0}
--- 560,566 ----
  
  def Client init_binds {} {
      bind . <Control-Key>       {$main ctrlkey %K 0}
      bind . <Control-Shift-Key> {$main ctrlkey %K 1}
!     switch $::OS {
        osx {
          bind . <Mod1-Key>       {$main ctrlkey %K 0}
***************
*** 592,604 ****
  
  proc pdtk_pd_startup {version apilist midiapilist fontname} {
!     global pd_myversion pd_apilist pd_midiapilist main
!     set pd_myversion $version
!     set pd_apilist $apilist
!     set pd_midiapilist $midiapilist
! #    $main menu_addstd
  }
  
  def Client init_controls {} {
!     global pd_tearoff OS
      menu .mbar
      pack [frame .controls] -side top -fill x
--- 589,599 ----
  
  proc pdtk_pd_startup {version apilist midiapilist fontname} {
!     set ::pd_myversion $version
!     set ::pd_apilist $apilist
!     set ::pd_midiapilist $midiapilist
  }
  
  def Client init_controls {} {
!     global pd_tearoff
      menu .mbar
      pack [frame .controls] -side top -fill x
***************
*** 768,773 ****
  
  proc accel_munge {acc} {
!     global OS
!     switch $OS {
        osx {
          set tmp [string toupper [string map {Ctrl Meta} $acc] end]
--- 763,767 ----
  
  proc accel_munge {acc} {
!     switch $::OS {
        osx {
          set tmp [string toupper [string map {Ctrl Meta} $acc] end]
***************
*** 1377,1381 ****
  
  def Canvas init {mess} {
!     global pd_opendir pd_tearoff OS cmdline history manager window_list
      lappend window_list $self
      set @mapped 0
--- 1371,1375 ----
  
  def Canvas init {mess} {
!     global pd_opendir pd_tearoff cmdline history manager window_list
      lappend window_list $self
      set @mapped 0
***************
*** 1613,1618 ****
  
  def Canvas new_binds {} {
-     global OS
- 
      # mouse buttons
      $self bind <Button>                   click_wrap %x %y %b 0
--- 1607,1610 ----
***************
*** 1624,1628 ****
      $self bind <Alt-Control-Button>       click_wrap %x %y %b 6
      $self bind <Alt-Control-Shift-Button> click_wrap %x %y %b 7
!     switch $OS {
        osx {
          $self bind <Button-2>       click_wrap %x %y %b 8
--- 1616,1620 ----
      $self bind <Alt-Control-Button>       click_wrap %x %y %b 6
      $self bind <Alt-Control-Shift-Button> click_wrap %x %y %b 7
!     switch $::OS {
        osx {
          $self bind <Button-2>       click_wrap %x %y %b 8
***************
*** 1633,1637 ****
        }
      }
!     switch $OS { unix {
  	$self bind <Button-4>       scroll y -1
      	$self bind <Button-5>       scroll y +1
--- 1625,1629 ----
        }
      }
!     switch $::OS { unix {
  	$self bind <Button-4>       scroll y -1
      	$self bind <Button-5>       scroll y +1
***************
*** 1650,1654 ****
      $self bind <Alt-Key>           altkey  %K %A 0
      $self bind <Alt-Shift-Key>     altkey  %K %A 1
!     switch $OS {
        unix {
  	$self bind <Mod1-Key>       altkey %K %A 0
--- 1642,1646 ----
      $self bind <Alt-Key>           altkey  %K %A 0
      $self bind <Alt-Shift-Key>     altkey  %K %A 1
!     switch $::OS {
        unix {
  	$self bind <Mod1-Key>       altkey %K %A 0
***************
*** 1780,1784 ****
  def Canvas new_menubar {} {
      set name .$self
!     global pd_opendir pd_tearoff OS cmdline key accels
      set m $name.m
      menu $m
--- 1772,1776 ----
  def Canvas new_menubar {} {
      set name .$self
!     global pd_opendir pd_tearoff cmdline key accels
      set m $name.m
      menu $m
***************
*** 1829,1835 ****
  # LATER also cut/copy/paste
  def Canvas fix_edit_menu {} {
-     global OS
      set e .$self.m.edit
!     switch $OS {osx {set i 0} default {set i 1}}
      set t [say undo]
      if {[$@history can_undo?]} {
--- 1821,1826 ----
  # LATER also cut/copy/paste
  def Canvas fix_edit_menu {} {
      set e .$self.m.edit
!     switch $::OS {osx {set i 0} default {set i 1}}
      set t [say undo]
      if {[$@history can_undo?]} {
***************
*** 2653,2661 ****
  def StatusBar widget {} {return .$@canvas.stat}
  
! def StatusBar addw {row a b text args} {
  	set f [$self widget]
! 	if {$text!=""} {eval [concat [list pack [label $f.$row.${a}_l -text $text] -side left] $args]}
! 	label $f.$row.$a -width $b -font {courier 9} -background #cccccc -foreground black -anchor w
! 	pack $f.$row.$a -side left
  }
  
--- 2644,2652 ----
  def StatusBar widget {} {return .$@canvas.stat}
  
! def StatusBar addw {a b text args} {
  	set f [$self widget]
! 	if {$text!=""} {eval [concat [list pack [label $f.${a}_l -text $text -font {helvetica -11}] -side left] $args]}
! 	label $f.$a -width $b -font {helvetica -11} -background #cccccc -foreground black -anchor w
! 	pack $f.$a -side left
  }
  
***************
*** 2664,2682 ****
  	set @canvas $canvas
  	set f [$self widget]
! 	frame $f -border 2 -relief ridge
! 	pack [frame $f.1] -fill x -expand yes
! 	pack [frame $f.2] -fill x -expand yes
! 	$self addw 1 pos    15 ""
! 	$self addw 1 what   32 "" -padx 8 -fill x -expand yes
! 	$self addw 1 mode   4  " Mode: "
! 	$self addw 1 action 12  " Action: "
! 	$self addw 1 sel    4  " Sel: "
! 	$self addw 2 focus  12 " Focus: "
! 	#$self addw 2 wto    12 " WireTo: "
  }
  
  def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
  def Canvas action {} {return $@action}
! def Canvas action= {action} {set @action $action} 
  def Canvas zoom {} {return $@zoom}
  
--- 2655,2670 ----
  	set @canvas $canvas
  	set f [$self widget]
! 	frame $f -border 1 -relief ridge
! 	$self addw px     4 ""
! 	$self addw py     4 ""
! 	$self addw what   28 " " -fill x -expand yes
! 	$self addw action 12  " Action: "
! 	$self addw sel    3  " Sel: "
! 	$self addw focus  10 " Focus: "
  }
  
  def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
  def Canvas action {} {return $@action}
! def Canvas action= {action} {set @action $action}
  def Canvas zoom {} {return $@zoom}
  
***************
*** 2699,2710 ****
        }
      }
      if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
!     $f.1.pos    configure -text [format "(%d,%d)" [expr int($x)] [expr int($y)]]
!     $f.1.what   configure -text $t
!     $f.1.mode   configure -text [if {[$@canvas editmode]} {list "Edit"} {list "Run "}]
!     $f.1.action configure -text [$@canvas action]
!     $f.1.sel    configure -text [llength [$@canvas selection]]
!     $f.2.focus  configure -text [$@canvas focus]
!     #$f.2.wto    configure -text [$@canvas wire_to]
  }
  
--- 2687,2699 ----
        }
      }
+     set action [$@canvas action]
+     if {[regexp ^o $action]} {set action [$action class]}
      if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
!     $f.px     configure -text [format "%4d" [expr round($x)]]
!     $f.py     configure -text [format "%4d" [expr round($y)]]
!     $f.what   configure -text $t
!     $f.action configure -text $action
!     $f.sel    configure -text [llength [$@canvas selection]]
!     $f.focus  configure -text [$@canvas focus]
  }
  
***************
*** 5523,5534 ****
  	text .log.1 -width 80 -height 24 -yscrollcommand ".log.2 set" -font $look(View:font)
  	scrollbar .log.2 -command ".log.1 yview"
! 	global tcl_version tk_version pd_myversion tcl_platform OS
! 	.log.1 insert end "DesireData 0.39.A, Tcl $tcl_version, Tk $tk_version\n"
! 	#foreach k [array names tcl_platform] {.log.1 insert end "tcl_platform($k) = $tcl_platform($k)\n"}
  	pack .log.1 -side left -fill both -expand yes
  	pack .log.2 -side left -fill    y -expand no
  	pack .log -fill both -expand yes
  	.log.2 set 0.0 1.0
! 	switch $OS { osx {
  		bind .log.1 <MouseWheel> {
  			.log.1 yview scroll [expr -2-abs(%D)/%D] units
--- 5512,5521 ----
  	text .log.1 -width 80 -height 24 -yscrollcommand ".log.2 set" -font $look(View:font)
  	scrollbar .log.2 -command ".log.1 yview"
! 	.log.1 insert end "DesireData 0.39.A, Tcl $::tcl_version, Tk $::tk_version\n"
  	pack .log.1 -side left -fill both -expand yes
  	pack .log.2 -side left -fill    y -expand no
  	pack .log -fill both -expand yes
  	.log.2 set 0.0 1.0
! 	switch $::OS { osx {
  		bind .log.1 <MouseWheel> {
  			.log.1 yview scroll [expr -2-abs(%D)/%D] units
***************
*** 5705,5709 ****
  		balloon $bb.$name [say $name]
  	}
! 	pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
  	pack [spinbox $bb.scale -width 6 -command "$canvas zooming %d" -state readonly] -side right
  	$bb.scale set [format %d%% [expr int(100*[$@canvas zoom])]]
--- 5692,5696 ----
  		balloon $bb.$name [say $name]
  	}
! 	pack [entry $bb.name -font {helvetica -12} -width 10 -border 0] -side right
  	pack [spinbox $bb.scale -width 6 -command "$canvas zooming %d" -state readonly] -side right
  	$bb.scale set [format %d%% [expr int(100*[$@canvas zoom])]]
***************
*** 7241,7246 ****
  }
  
- HistoryDialog new $history
- 
  #----------------------------------------------------------------
  # Deconstructors
--- 7228,7231 ----
***************
*** 7266,7271 ****
  }
  
! def MessageBox deconstruct {} {philtre [concat [list #X msg  $@x1 $@y1] $@text]}
! def Comment    deconstruct {} {philtre [concat [list #X text $@x1 $@y1] $@text]}
  
  def Box deconstruct {} {
--- 7251,7256 ----
  }
  
! def MessageBox deconstruct {} {concat [list #X msg  $@x1 $@y1] $@text}
! def Comment    deconstruct {} {concat [list #X text $@x1 $@y1] $@text}
  
  def Box deconstruct {} {
***************
*** 7273,7277 ****
  	puts "        <> [array names fields $@pdclass]"
  	if {[array names fields $@pdclass] == ""} {
! 		return [philtre [concat [list #X obj  $@x1 $@y1] $@text]]
  	} {
  		set r {}
--- 7258,7262 ----
  	puts "        <> [array names fields $@pdclass]"
  	if {[array names fields $@pdclass] == ""} {
! 		return [concat [list #X obj  $@x1 $@y1] $@text]
  	} {
  		set r {}
***************
*** 7282,7286 ****
  
  def View deconstruct_to {stream args} {
! 	$stream << [eval [concat [list $self deconstruct] $args]]
  	$stream << ";\n"
  }
--- 7267,7271 ----
  
  def View deconstruct_to {stream args} {
! 	$stream << [philtre [eval [concat [list $self deconstruct] $args]]]
  	$stream << ";\n"
  }
***************
*** 7296,7300 ****
  	foreach child $@children {eval [concat [list $child deconstruct_to $stream]]}
  	foreach wire  $@wires    {eval [concat [list $wire  deconstruct_to $stream]]}
! 	$stream << [eval [concat [list $self deconstruct] $args]]
  	$stream << ";\n"
  }
--- 7281,7285 ----
  	foreach child $@children {eval [concat [list $child deconstruct_to $stream]]}
  	foreach wire  $@wires    {eval [concat [list $wire  deconstruct_to $stream]]}
! 	$stream << [philtre [eval [concat [list $self deconstruct] $args]]]
  	$stream << ";\n"
  }





More information about the Pd-cvs mailing list