#!/bin/sh
#rmenu  -*- TCL -*- Created: ramsan Dec-1997, Modified: ramsan Dec-1997

# tearoff must be 0

if { $tcl_platform(platform) == "windows" } {
    set RMenuRPriv(MaxNum) 1000
    set RMenuRPriv(MaxNumCol) 15
    set RMenuRPriv(MaxAbsolute) 105
} else {
    set RMenuRPriv(MaxNum) 15
    # not used
    set RMenuRPriv(MaxNumCol) 15 
    set RMenuRPriv(MaxAbsolute) -1
}

proc rmenuconf { rmenu words } {
    global RMenuRPriv GIDDEFAULT

    if { ![info exists RMenuRPriv(upimg)] } {
	set RMenuRPriv(upimg) [image create bitmap -file $GIDDEFAULT/bitmaps/up.xbm \
		-maskfile $GIDDEFAULT/bitmaps/up-msk.xbm \
		-background yellow -foreground black]
    }
    if { ![info exists RMenuRPriv(downimg)] } {
	set RMenuRPriv(downimg) [image create bitmap -file $GIDDEFAULT/bitmaps/down.xbm \
		-maskfile $GIDDEFAULT/bitmaps/down-msk.xbm \
		-background yellow -foreground black]
    }
    if { ![info exists RMenuRPriv(voidimg)] } {
	set RMenuRPriv(voidimg) [image create bitmap -file $GIDDEFAULT/bitmaps/void.xbm]
    }

    $rmenu del 0 end

    if { [llength $words] < [expr $RMenuRPriv(MaxNum)+2] } {
	catch { RMenuDestroy $rmenu }
	bind $rmenu <Destroy> ""
	if { [lsearch [bindtags $rmenu] RMenu] != -1 } {
	    bindtags $rmenu [lrange [bindtags $rmenu] 1 end]
	}
	set counter 0
	foreach i $words {
	    if { [llength $i] == 2 } {
		$rmenu add command -label [lindex $i 0]  -command [lindex $i 1]
	    } else {
		$rmenu add checkbutton -label [lindex $i 0]  -command [lindex $i 1] \
			-onvalue 1 -variable RMenuRPriv($rmenu,check[lindex $i 0])
		set RMenuRPriv($rmenu,check[lindex $i 0]) 1
		if { [lindex $i 2] != "check" } {
		    $rmenu entryconf end -selectcolor [lindex $i 2]
		}
	    }
	    if { [expr $counter%$RMenuRPriv(MaxNumCol)] == 0 } {
		$rmenu entryconf end -columnbreak 1
	    }
	    incr counter
	    if { $RMenuRPriv(MaxAbsolute) > 0 && \
		    $counter >= $RMenuRPriv(MaxAbsolute) } { break }
	}
	update idletasks
	set RMenuRPriv($rmenu,minwidth) [expr [winfo reqwidth $rmenu]+10]
	wm geom $rmenu $RMenuRPriv($rmenu,minwidth)x[winfo reqheight $rmenu]

	return $rmenu
    }

    bind $rmenu <Destroy> "RMenuDestroy $rmenu"

    set RMenuRPriv($rmenu,hasini) 0


    set RMenuRPriv($rmenu,ini) 0
    set RMenuRPriv($rmenu,realend) [llength $words]

    set RMenuRPriv($rmenu,end) $RMenuRPriv(MaxNum)
    bindtags $rmenu "RMenu [bindtags $rmenu]"

    $rmenu add command -image $RMenuRPriv(voidimg)

    for { set i 0 } { $i < $RMenuRPriv($rmenu,end) } { incr i } {
	set elm [lindex $words $i]
	if { [llength $elm] == 2 } {
	    $rmenu add command -label [lindex $elm 0]  -command [lindex $elm 1]
	} else {
	    $rmenu add checkbutton -label [lindex $elm 0]  -command [lindex $elm 1] \
		    -onvalue 1 -variable RMenuRPriv($rmenu,check[lindex $elm 0])
	    set RMenuRPriv($rmenu,check[lindex $elm 0]) 1
	    if { [lindex $elm 2] != "check" } {
		$rmenu entryconf end -selectcolor [lindex $elm 2]
	    }
	}
    }

    $rmenu add command -image $RMenuRPriv(downimg)

    update idletasks
    set RMenuRPriv($rmenu,minwidth) [expr [winfo reqwidth $rmenu]+10]
    wm geom $rmenu $RMenuRPriv($rmenu,minwidth)x[winfo reqheight $rmenu]

    set RMenuRPriv($rmenu,hasend) 1
    set RMenuRPriv($rmenu,waitflag) -1
    set RMenuRPriv($rmenu,words) $words

    return $rmenu

}

bind RMenu <Motion> {
    tkRMenuMotion %W %x %y %s
    break
}

proc tkRMenuPushMover { w } {
    global RMenuRPriv
    if { [$w index active] == 0 } {
	if { $RMenuRPriv($w,hasini) } {
	    RMenuActiveIni $w 0
	}
	$w activate 0
	return -code break
    } elseif { [$w index active] == [expr $RMenuRPriv(MaxNum)+1] } {
	if { $RMenuRPriv($w,hasend) } {
	    RMenuActiveEnd $w 0
	}
	$w activate [expr $RMenuRPriv(MaxNum)+1]
	return -code break
    }
}

bind RMenu <space> {
    tkRMenuPushMover %W
}
bind RMenu <Return> {
    tkRMenuPushMover %W
}

bind RMenu <Up> {
    if { [%W index active] == 0 } {
	if { $RMenuRPriv(%W,hasini) } {
	    RMenuActiveIni %W 0
	}
	%W activate 0
	break
    }
}
bind RMenu <Down> {
    if { [%W index active] == [expr $RMenuRPriv(MaxNum)+1] } {
	if { $RMenuRPriv(%W,hasend) } {
	    RMenuActiveEnd %W 0
	}
	%W activate [expr $RMenuRPriv(MaxNum)+1]
	break
    } 
}

proc tkRMenuMotion {menu x y state} {
    global tkPriv
    if {$menu == $tkPriv(window)} {
	if {[$menu cget -type] == "menubar"} {
	    if {[info exists tkPriv(focus)] && \
		    ([string compare $menu $tkPriv(focus)] != 0)} {
		$menu activate @$x,$y
		RMenuActiveI $menu [$menu index active]
		event generate $menu <<MenuSelect>>
	    }
	} else {
	    $menu activate @$x,$y
	    RMenuActiveI $menu [$menu index active]
	    event generate $menu <<MenuSelect>>
	}
    }
    if {($state & 0x1f00) != 0} {
	$menu postcascade active
    }
}

proc RMenuActiveI { rmenu idx } {
    global RMenuRPriv

    if { ![info exists RMenuRPriv($rmenu,waitflag)] } { return }

    if { $RMenuRPriv($rmenu,waitflag) != -1 && $RMenuRPriv($rmenu,waitflag) != $idx } {
	if { $RMenuRPriv($rmenu,waitflag) == 0 } {
	    after cancel RMenuActiveIni $rmenu 1
	} else {
	    after cancel RMenuActiveEnd $rmenu 1
	}
	set RMenuRPriv($rmenu,waitflag) -1
    } elseif { $RMenuRPriv($rmenu,waitflag) == -1 && $RMenuRPriv($rmenu,hasend) && \
	    $idx == [expr $RMenuRPriv(MaxNum)+1] } {
	set RMenuRPriv($rmenu,waitflag) [expr $RMenuRPriv(MaxNum)+1]
	RMenuActiveEnd $rmenu 1
    } elseif { $RMenuRPriv($rmenu,waitflag) == -1 && $RMenuRPriv($rmenu,hasini) && \
	    $idx == 0 } {
	set RMenuRPriv($rmenu,waitflag) 0
	RMenuActiveIni $rmenu 1
    }
}

proc RMenuActiveEnd { rmenu repeat } {
    global RMenuRPriv

    if { !$RMenuRPriv($rmenu,hasend) } { return }
    set RMenuRPriv($rmenu,hasini) 1
    incr RMenuRPriv($rmenu,end)
    if { $RMenuRPriv($rmenu,end) >= $RMenuRPriv($rmenu,realend) } {
	set RMenuRPriv($rmenu,ini) [expr $RMenuRPriv($rmenu,end)-$RMenuRPriv(MaxNum)]
	set RMenuRPriv($rmenu,hasend) 0
    } else {
	set RMenuRPriv($rmenu,ini) [expr $RMenuRPriv($rmenu,end)-$RMenuRPriv(MaxNum)]
	set RMenuRPriv($rmenu,hasend) 1
    }
    $rmenu del 0 end
    $rmenu add command -image $RMenuRPriv(upimg)
    for { set i $RMenuRPriv($rmenu,ini) } { $i < $RMenuRPriv($rmenu,end) } \
	    { incr i } {
	set elm [lindex $RMenuRPriv($rmenu,words) $i]
	if { [llength $elm] == 2 } {
	    $rmenu add command -label [lindex $elm 0]  -command [lindex $elm 1]
	} else {
	    $rmenu add checkbutton -label [lindex $elm 0]  -command [lindex $elm 1] \
		    -onvalue 1 -variable RMenuRPriv($rmenu,check[lindex $elm 0])
	    set RMenuRPriv($rmenu,check[lindex $elm 0]) 1
	    if { [lindex $elm 2] != "check" } {
		$rmenu entryconf end -selectcolor [lindex $elm 2]
	    }
	}
    }
    if { $RMenuRPriv($rmenu,hasend) } {
	$rmenu add command -image $RMenuRPriv(downimg)
    } else {
	$rmenu add command -image $RMenuRPriv(voidimg)
    }
    update idletasks
    set newwidth [winfo reqwidth $rmenu]
    if { $newwidth > $RMenuRPriv($rmenu,minwidth) } {
	set RMenuRPriv($rmenu,minwidth) [expr $newwidth+10]
    }
    wm geom $rmenu $RMenuRPriv($rmenu,minwidth)x[winfo reqheight $rmenu]

    if { $repeat == 1 } {
	after 50 RMenuActiveEnd $rmenu 1
    }
}

proc RMenuActiveIni { rmenu  repeat } {
    global RMenuRPriv

    if { !$RMenuRPriv($rmenu,hasini) } { return }
    set RMenuRPriv($rmenu,hasend) 1
    incr RMenuRPriv($rmenu,ini) -1

    if { $RMenuRPriv($rmenu,ini) == 0 } {
	set RMenuRPriv($rmenu,end) $RMenuRPriv(MaxNum)
	set RMenuRPriv($rmenu,hasini) 0
    } else {
	set RMenuRPriv($rmenu,end) [expr $RMenuRPriv($rmenu,ini)+$RMenuRPriv(MaxNum)]
	set RMenuRPriv($rmenu,hasini) 1
    }
    $rmenu del 0 end
    if { $RMenuRPriv($rmenu,hasini) } {
	$rmenu add command -image $RMenuRPriv(upimg)
    } else {
	$rmenu add command -image $RMenuRPriv(voidimg)
    }

    for { set i $RMenuRPriv($rmenu,ini) } { $i < $RMenuRPriv($rmenu,end) } \
	    { incr i } {
	set elm [lindex $RMenuRPriv($rmenu,words) $i]
	if { [llength $elm] == 2 } {
	    $rmenu add command -label [lindex $elm 0]  -command [lindex $elm 1]
	} else {
	    $rmenu add checkbutton -label [lindex $elm 0]  -command [lindex $elm 1] \
		    -variable RMenuRPriv($rmenu,check[lindex $elm 0])
	    set RMenuRPriv($rmenu,check[lindex $elm 0]) 1
	    if { [lindex $elm 2] != "check" } {
		$rmenu entryconf end -selectcolor [lindex $elm 2]
	    }
	}
    }
    $rmenu add command -image $RMenuRPriv(downimg)

    update idletasks
    set newwidth [winfo reqwidth $rmenu]
    if { $newwidth > $RMenuRPriv($rmenu,minwidth) } {
	set RMenuRPriv($rmenu,minwidth) [expr $newwidth+10]
    }
    wm geom $rmenu $RMenuRPriv($rmenu,minwidth)x[winfo reqheight $rmenu]

    if { $repeat == 1 } {
	after 50 RMenuActiveIni $rmenu 1
    }
}

proc RMenuDestroy { rmenu } {
    global RMenuRPriv

    foreach i [array names RMenuRPriv $rmenu,*] {
	unset RMenuRPriv($i)
    }
}


