diff options
Diffstat (limited to 'pd/src/u_main.tk')
-rw-r--r-- | pd/src/u_main.tk | 359 |
1 files changed, 244 insertions, 115 deletions
diff --git a/pd/src/u_main.tk b/pd/src/u_main.tk index a19b0951..da17b720 100644 --- a/pd/src/u_main.tk +++ b/pd/src/u_main.tk @@ -12,10 +12,6 @@ set pd_nt 0 # a new dialogbox was inserted, named: # "pdtk_iemgui_dialog -- dialog window for iem guis" # -# there are 2 new features: 1.) line-delete-protection in edit-menue -# -# 2.) there are all iem-guis in a seperated put-gui-menue -# # all this changes are labeled with #######iemlib########## if {$pd_nt == 1} { @@ -108,10 +104,9 @@ set untitled_number 1 set untitled_directory [pwd] set saveas_client doggy set pd_opendir $untitled_directory -############iemlib################## -# need it to know, if new or open file -set iem_new_open_flag "open" -############iemlib################## +set pd_undoaction no +set pd_redoaction no +set pd_undocanvas no ################ utility functions ######################### @@ -152,11 +147,6 @@ proc pdtk_fixwindowmenu {} { proc menu_new {} { global untitled_number global untitled_directory -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "new" -############iemlib################## pd [concat pd filename Untitled-$untitled_number $untitled_directory \;] pd { #N canvas; @@ -170,11 +160,6 @@ proc menu_new {} { proc menu_open {} { global pd_opendir global pd_nt -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "open" -############iemlib################## # workaround -- initialdir doesn't work on MACOSX yet --- if {$pd_nt == 2} { @@ -258,11 +243,6 @@ set help_directory $pd_guidir/doc proc menu_documentation {} { global help_directory global pd_nt -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "open" -############iemlib################## if {$pd_nt == 2} { cd $help_directory @@ -301,11 +281,6 @@ proc menu_documentation {} { proc menu_doc_open {subdir basename} { global pd_guidir -############iemlib################## - global iem_new_open_flag - - set iem_new_open_flag "open" -############iemlib################## set dirname $pd_guidir/$subdir @@ -367,6 +342,24 @@ proc menu_close {name} { pd [concat $name menuclose \;] } +proc menu_undo {name} { + global pd_undoaction + global pd_redoaction + global pd_undocanvas + if {$name == $pd_undocanvas && $pd_undoaction != "no"} { + pd [concat $name undo \;] + } +} + +proc menu_redo {name} { + global pd_undoaction + global pd_redoaction + global pd_undocanvas + if {$name == $pd_undocanvas && $pd_redoaction != "no"} { + pd [concat $name redo \;] + } +} + proc menu_cut {name} { pd [concat $name cut \;] } @@ -452,12 +445,12 @@ proc menu_hslider {name accel} { pd [concat $name hslider $accel \;] } -proc menu_hdial {name accel} { - pd [concat $name hdial $accel \;] +proc menu_hradio {name accel} { + pd [concat $name hradio $accel \;] } -proc menu_vdial {name accel} { - pd [concat $name vdial $accel \;] +proc menu_vradio {name accel} { + pd [concat $name vradio $accel \;] } proc menu_vumeter {name accel} { @@ -468,11 +461,38 @@ proc menu_mycnv {name accel} { pd [concat $name mycnv $accel \;] } -proc menu_protectmode {name} { - pd [concat $name protectmode 0 \;] +############iemlib################## + +# correct edit menu, enabling or disabling undo/redo +# LATER also cut/copy/paste +proc menu_fixeditmenu {name} { + global pd_undoaction + global pd_redoaction + global pd_undocanvas +# puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction] + if {$name == $pd_undocanvas && $pd_undoaction != "no"} { + $name.m.edit.m entryconfigure "Undo*" -state normal \ + -label [concat "Undo " $pd_undoaction] + } else { + $name.m.edit.m entryconfigure "Undo*" -state disabled -label "Undo" + } + if {$name == $pd_undocanvas && $pd_redoaction != "no"} { + $name.m.edit.m entryconfigure "Redo" -state normal + } else { + $name.m.edit.m entryconfigure "Redo" -state disabled + } } -############iemlib################## +# message from Pd to update the currently available undo/redo action +proc pdtk_undomenu {name undoaction redoaction} { + global pd_undoaction + global pd_redoaction + global pd_undocanvas +# puts stderr [concat pdtk_undomenu $name $undoaction $redoaction] + set pd_undocanvas $name + set pd_undoaction $undoaction + set pd_redoaction $redoaction +} proc menu_windowparent {name} { pd [concat $name findparent \;] @@ -557,9 +577,8 @@ proc menu_findobject {canvas} { ############# pdtk_canvas_new -- create a new canvas ############### -proc pdtk_canvas_new {name width height geometry} { +proc pdtk_canvas_new {name width height geometry editable} { global pd_opendir - global iem_new_open_flag toplevel $name frame $name.m -relief raised -bd 2 @@ -580,7 +599,6 @@ proc pdtk_canvas_new {name width height geometry} { pack $name.c -side left -expand 1 -fill both wm minsize $name 1 1 wm geometry $name $geometry - # the file menu menubutton $name.m.file -text File -menu $name.m.file.m @@ -619,8 +637,15 @@ proc pdtk_canvas_new {name width height geometry} { # the edit menu menubutton $name.m.edit -text Edit -menu $name.m.edit.m pack $name.m.edit -side left - menu $name.m.edit.m + menu $name.m.edit.m -postcommand [concat menu_fixeditmenu $name] + $name.m.edit.m add command -label Undo -command [concat menu_undo $name] \ + -accelerator "Ctrl+z" + + $name.m.edit.m add command -label Redo -command [concat menu_redo $name] \ + -accelerator "Ctrl+Z" + + $name.m.edit.m add separator $name.m.edit.m add command -label Cut -command [concat menu_cut $name] \ -accelerator "Ctrl+x" @@ -661,16 +686,8 @@ proc pdtk_canvas_new {name width height geometry} { -command [concat menu_editmode $name] \ -accelerator "Ctrl+e" - - - $name.m.edit.m add checkbutton -label "Protect" \ - -indicatoron true -selectcolor grey85 \ - -command [concat menu_protectmode $name] \ - -accelerator "Ctrl+r" - - if { $iem_new_open_flag == "open" } { + if { $editable == 0 } { $name.m.edit.m entryconfigure "Edit mode" -indicatoron false } - $name.m.edit.m entryconfigure "Protect" -indicatoron false ############iemlib################## @@ -721,12 +738,12 @@ proc pdtk_canvas_new {name width height geometry} { -command [concat menu_hslider $name 0] \ -accelerator "Alt+h" - $name.m.put.m add command -label Vdial \ - -command [concat menu_vdial $name 0] \ + $name.m.put.m add command -label Vradio \ + -command [concat menu_vradio $name 0] \ -accelerator "Alt+d" - $name.m.put.m add command -label Hdial \ - -command [concat menu_hdial $name 0] \ + $name.m.put.m add command -label Hradio \ + -command [concat menu_hradio $name 0] \ -accelerator "Alt+i" $name.m.put.m add command -label VU \ @@ -824,7 +841,8 @@ proc pdtk_canvas_new {name width height geometry} { bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1} bind $name.c <Alt-Key> {pdtk_canvas_altkey %W %K %A} # bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]} - bind $name.c <Key> {pdtk_canvas_key %W %K %A} + bind $name.c <Key> {pdtk_canvas_key %W %K %A 0} + bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1} bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A} bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0} bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4} @@ -937,7 +955,7 @@ proc pdtk_canvas_mouseup {name x y b} { pdtk_canvas_checkgeometry [canvastosym $name] } -proc pdtk_canvas_key {name key iso} { +proc pdtk_canvas_key {name key iso shift} { # puts stderr [concat down key= $key iso= $iso] # .controls.switches.meterbutton configure -text $key # HACK for MAC OSX -- backspace seems different; I don't understand why. @@ -955,9 +973,9 @@ proc pdtk_canvas_key {name key iso} { } if {$iso != ""} { scan $iso %c keynum - pd [canvastosym $name] key 1 $keynum \; + pd [canvastosym $name] key 1 $keynum $shift\; } else { - pd [canvastosym $name] key 1 $key \; + pd [canvastosym $name] key 1 $key $shift\; } } @@ -980,8 +998,8 @@ proc pdtk_canvas_altkey {name key iso} { if {$key == "n" || $key == "N"} {menu_numbox $topname 1} if {$key == "v" || $key == "V"} {menu_vslider $topname 1} if {$key == "h" || $key == "H"} {menu_hslider $topname 1} - if {$key == "i" || $key == "I"} {menu_hdial $topname 1} - if {$key == "d" || $key == "D"} {menu_vdial $topname 1} + if {$key == "i" || $key == "I"} {menu_hradio $topname 1} + if {$key == "d" || $key == "D"} {menu_vradio $topname 1} if {$key == "u" || $key == "U"} {menu_vumeter $topname 1} if {$key == "c" || $key == "C"} {menu_mycnv $topname 1} ############iemlib################## @@ -1001,6 +1019,9 @@ proc pdtk_canvas_ctrlkey {name key shift} { if {$key == "s" || $key == "S"} { if {$shift == 1} {menu_saveas $topname} else {menu_save $topname} } + if {$key == "z" || $key == "Z"} { + if {$shift == 1} {menu_redo $topname} else {menu_undo $topname} + } if {$key == "w" || $key == "W"} {menu_close $topname} if {$key == "p" || $key == "P"} {menu_print $topname} if {$key == "x" || $key == "X"} {menu_cut $topname} @@ -1019,9 +1040,6 @@ proc pdtk_canvas_ctrlkey {name key shift} { if {$key == "slash"} {menu_audio 1} if {$key == "period"} {menu_audio 0} if {$key == "e" || $key == "E"} {menu_editmode $topname} -############iemlib################## - if {$key == "r" || $key == "R"} {menu_protectmode $topname} -############iemlib################## } proc pdtk_canvas_motion {name x y mods} { @@ -1155,13 +1173,65 @@ proc pdtk_canvas_dofont {name initsize} { ############ pdtk_gatom_dialog -- run a gatom dialog ######### -set gatomwidth 0 -set gatomlo 0 -set gatomhi 0 +# see graph_apply, etc., for comments about handling variable names here... + +proc gatom_escape {sym} { + if {[string length $sym] == 0} { + set ret "-" +# puts stderr [concat escape1 $sym $ret] + } else { + if {[string equal -length 1 $sym "-"]} { + set ret [string replace $sym 0 0 "--"] +# puts stderr [concat escape $sym $ret] + } else { + set ret $sym +# puts stderr [concat escape $sym "no change"] + } + } + concat $ret +} + +proc gatom_unescape {sym} { + if {[string equal -length 1 $sym "-"]} { + set ret [string replace $sym 0 0 ""] +# puts stderr [concat unescape $sym $ret] + } else { + set ret $sym +# puts stderr [concat unescape $sym "no change"] + } + concat $ret +} + +proc dogatom_apply {id} { + set vid [string trimleft $id .] + + set var_gatomwidth [concat gatomwidth_$vid] + global $var_gatomwidth + set var_gatomlo [concat gatomlo_$vid] + global $var_gatomlo + set var_gatomhi [concat gatomhi_$vid] + global $var_gatomhi + set var_gatomwherelabel [concat gatomwherelabel_$vid] + global $var_gatomwherelabel + set var_gatomlabel [concat gatomlabel_$vid] + global $var_gatomlabel + set var_gatomsymfrom [concat gatomsymfrom_$vid] + global $var_gatomsymfrom + set var_gatomsymto [concat gatomsymto_$vid] + global $var_gatomsymto + +# set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;] + + set cmd [concat $id param \ + [eval concat $$var_gatomwidth] \ + [eval concat $$var_gatomlo] \ + [eval concat $$var_gatomhi] \ + [eval gatom_escape $$var_gatomlabel] \ + [eval concat $$var_gatomwherelabel] \ + [eval gatom_escape $$var_gatomsymfrom] \ + [eval gatom_escape $$var_gatomsymto] \ + \;] -proc dogatom_apply {name} { - global gatomwidth gatomlo gatomhi - set cmd [concat $name param $gatomwidth $gatomlo $gatomhi \;] # puts stderr $cmd pd $cmd } @@ -1177,50 +1247,117 @@ proc dogatom_ok {name} { dogatom_cancel $name } -proc pdtk_gatom_dialog {name initwidth initlo inithi} { - - global gatomwidth gatomlo gatomhi - set gatomwidth $initwidth - set gatomlo $initlo - set gatomhi $inithi - - toplevel $name - wm title $name {Atom} - wm protocol $name WM_DELETE_WINDOW [concat dogatom_cancel $name] +proc pdtk_gatom_dialog {id initwidth initlo inithi \ + wherelabel label symfrom symto} { - frame $name.buttonframe - pack $name.buttonframe -side bottom -fill x -pady 2m - button $name.buttonframe.cancel -text {Cancel}\ - -command "dogatom_cancel $name" - button $name.buttonframe.ok -text {Apply}\ - -command "dogatom_apply $name" - pack $name.buttonframe.cancel -side left -expand 1 - pack $name.buttonframe.ok -side left -expand 1 - - frame $name.paramhi - pack $name.paramhi -side bottom - label $name.paramhi.entryname -text "upper limit" - entry $name.paramhi.entry -textvariable gatomhi -width 8 - pack $name.paramhi.entryname $name.paramhi.entry -side left + set vid [string trimleft $id .] + + set var_gatomwidth [concat gatomwidth_$vid] + global $var_gatomwidth + set var_gatomlo [concat gatomlo_$vid] + global $var_gatomlo + set var_gatomhi [concat gatomhi_$vid] + global $var_gatomhi + set var_gatomwherelabel [concat gatomwherelabel_$vid] + global $var_gatomwherelabel + set var_gatomlabel [concat gatomlabel_$vid] + global $var_gatomlabel + set var_gatomsymfrom [concat gatomsymfrom_$vid] + global $var_gatomsymfrom + set var_gatomsymto [concat gatomsymto_$vid] + global $var_gatomsymto + + set $var_gatomwidth $initwidth + set $var_gatomlo $initlo + set $var_gatomhi $inithi + set $var_gatomwherelabel $wherelabel + set $var_gatomlabel [gatom_unescape $label] + set $var_gatomsymfrom [gatom_unescape $symfrom] + set $var_gatomsymto [gatom_unescape $symto] + + toplevel $id + wm title $id {Atom} + wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id] + + frame $id.buttonframe + pack $id.buttonframe -side bottom -fill x -pady 2m + button $id.buttonframe.cancel -text {Cancel}\ + -command "dogatom_cancel $id" + button $id.buttonframe.apply -text {Apply}\ + -command "dogatom_apply $id" + button $id.buttonframe.ok -text {OK}\ + -command "dogatom_ok $id" + pack $id.buttonframe.cancel -side left -expand 1 + pack $id.buttonframe.apply -side left -expand 1 + pack $id.buttonframe.ok -side left -expand 1 + + frame $id.paramsymto + pack $id.paramsymto -side bottom + label $id.paramsymto.entryname -text {send symbol} + entry $id.paramsymto.entry -textvariable $var_gatomsymto -width 20 + pack $id.paramsymto.entryname $id.paramsymto.entry -side left + + frame $id.paramsymfrom + pack $id.paramsymfrom -side bottom + label $id.paramsymfrom.entryname -text {receive symbol} + entry $id.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 20 + pack $id.paramsymfrom.entryname $id.paramsymfrom.entry -side left + + frame $id.radio + pack $id.radio -side bottom + label $id.radio.label -text {show label on:} + frame $id.radio.l + frame $id.radio.r + pack $id.radio.label -side top + pack $id.radio.l $id.radio.r -side left + radiobutton $id.radio.l.radio0 -value 0 \ + -variable $var_gatomwherelabel \ + -text "left" + radiobutton $id.radio.l.radio1 -value 1 \ + -variable $var_gatomwherelabel \ + -text "right" + radiobutton $id.radio.r.radio2 -value 2 \ + -variable $var_gatomwherelabel \ + -text "top" + radiobutton $id.radio.r.radio3 -value 3 \ + -variable $var_gatomwherelabel \ + -text "bottom" + pack $id.radio.l.radio0 $id.radio.l.radio1 -side top -anchor w + pack $id.radio.r.radio2 $id.radio.r.radio3 -side top -anchor w + + + frame $id.paramlabel + pack $id.paramlabel -side bottom + label $id.paramlabel.entryname -text label + entry $id.paramlabel.entry -textvariable $var_gatomlabel -width 20 + pack $id.paramlabel.entryname $id.paramlabel.entry -side left + + frame $id.paramhi + pack $id.paramhi -side bottom + label $id.paramhi.entryname -text "upper limit" + entry $id.paramhi.entry -textvariable $var_gatomhi -width 8 + pack $id.paramhi.entryname $id.paramhi.entry -side left + + frame $id.paramlo + pack $id.paramlo -side bottom + label $id.paramlo.entryname -text "lower limit" + entry $id.paramlo.entry -textvariable $var_gatomlo -width 8 + pack $id.paramlo.entryname $id.paramlo.entry -side left + + frame $id.params + pack $id.params -side bottom + label $id.params.entryname -text width + entry $id.params.entry -textvariable $var_gatomwidth -width 4 + pack $id.params.entryname $id.params.entry -side left - frame $name.paramlo - pack $name.paramlo -side bottom - label $name.paramlo.entryname -text "lower limit" - entry $name.paramlo.entry -textvariable gatomlo -width 8 - pack $name.paramlo.entryname $name.paramlo.entry -side left - frame $name.params - pack $name.params -side bottom - label $name.params.entryname -text width - entry $name.params.entry -textvariable gatomwidth -width 4 - pack $name.params.entryname $name.params.entry -side left - bind $name.paramhi.entry <KeyPress-Return> [concat dogatom_ok $name] - bind $name.paramlo.entry <KeyPress-Return> [concat dogatom_ok $name] - bind $name.params.entry <KeyPress-Return> [concat dogatom_ok $name] - $name.params.entry select from 0 - $name.params.entry select adjust end - focus $name.params.entry + bind $id.paramhi.entry <KeyPress-Return> [concat dogatom_ok $id] + bind $id.paramlo.entry <KeyPress-Return> [concat dogatom_ok $id] + bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id] + $id.params.entry select from 0 + $id.params.entry select adjust end + focus $id.params.entry } ############ pdtk_canvas_popup -- popup menu for canvas ######### @@ -2340,14 +2477,6 @@ proc pdtk_canvas_editval {name value} { $name.m.edit.m entryconfigure "Edit mode" -indicatoron false } } - -proc pdtk_canvas_protectval {name value} { - if { $value } { - $name.m.edit.m entryconfigure "Protect" -indicatoron true - } else { - $name.m.edit.m entryconfigure "Protect" -indicatoron false - } -} #####################iemlib####################### ############ pdtk_text_new -- create a new text object #2########### |