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 .$(a)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 .$(a)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"
}
