This commit was generated by cvs2svn to compensate for changes in r232,

which included commits to RCS files with non-trunk default branches.

svn path=/trunk/; revision=233

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###########