#
# $Log: not supported by cvs2svn $
# Revision 1.23  2001/07/31 14:13:12  borland
# Modified APSMenuMakeFrame to remove the pathname from the executable name
# prior to looking for the security file.
#
# Revision 1.22  2001/07/29 19:16:53  borland
# Fixed problem with application security feature when arguments had quoted
# items.
#
# Revision 1.21  2001/07/27 15:01:02  shang
# Added new security mechanism for APSMenuMakeFrame.
#
# Revision 1.20  2001/02/06 19:44:23  soliday
# Fixed some tcl warning messages found with procheck
#
# Revision 1.19  2000/02/07 15:40:44  soliday
# Added the option to turn the auto cascade feature off.
#
# Revision 1.18  2000/02/04 20:21:58  soliday
# It now has automatic cascading.
#
# Revision 1.17  1997/08/12 14:52:52  borland
# Added support for restricting the subnet on which menu items may be
# invoked (APSMenuFrameMake).  APSSecureButton now takes a list of
# allowed subnets (e.g., 164.54.2); APSSecureButtonAlert now takes
# an argument list, allowing indication of the type of security problem
# that has occured.
#
# Revision 1.16  1997/08/11 21:31:47  borland
# Fixed bug in secureExec implementation.  How it ever worked I don't know.
#
# Revision 1.15  1996/09/18 14:52:56  saunders
# Option "-withButtons 1" added to APSScrolledStatus.
#
# Revision 1.14  1996/03/22 22:40:09  saunders
# Added APSMenuFrameFindSubMenu procedure.
#
# Revision 1.13  1996/02/14  16:40:09  saunders
# Removed APSMp dummy routines from APSMisc.tcl. This will fix the problem
# with using APSUniqueName from within a machine procedure.
#
# Revision 1.12  1996/02/13  22:35:54  saunders
# Added Close Submenus and Kill buttons to main menu widget.
#
# Revision 1.11  1996/02/13  22:16:28  saunders
# Fixed help text for menu button.
#
# Revision 1.10  1996/02/13  22:00:18  saunders
# Added "command" option to APSMenuFrameMake.
#
# Revision 1.9  1996/02/13  21:11:41  saunders
# Improved APSMenuFrameMake procedure.
#
# Revision 1.8  1996/02/13  20:45:57  saunders
# Added "Close SubMenus" button and "Kill" button.
#
# Revision 1.7  1996/02/09  23:47:41  saunders
# Minor change.
#
# Revision 1.6  1996/02/09  21:24:52  saunders
# Added -geometry option to APSFrame and APSMenuFrame to allow relative
# positioning of submenus.
#
# Revision 1.5  1996/02/09  18:09:02  saunders
# Stupid bug fix.
#
# Revision 1.4  1996/02/09  18:06:16  saunders
# Removed APSFrame title. Window manager title is sufficient.
#
# Revision 1.3  1996/02/09  17:16:41  saunders
# Added name to Frame.
#
# Revision 1.2  1996/02/09  17:11:28  saunders
# First functional release of new menu procedure.
#
# Revision 1.1  1996/02/08  23:35:59  saunders
# New procedure APSMenuFrame. Not quite operational yet.
#
#

proc APSMenuFrameHelp {} {
    return "Usage: APSMenuFrame widget \n\[-parent <string>\]\t\n\[-noPack 1\]\t\n\[-packOption <list>\]\t\n\[-menuList <string>\]\t\n\[-parentLabel <string>\]\t\n\[-subMenu 1\]\t\n\[-contextHelp <string\]\n\t\n"
}

proc APSMenuFrame {widget args} {
    global apsContextHelp apsMenuFrame apsBackground
    set parent ""
    set noPack 0
    set packOption "-side top -fill x"
    set menuList ""
    set parentLabel ""
    set subMenu ""
    set closeButton 0
    set geometry ""
    set contextHelp ""
    APSStrictParseArguments {parent noPack packOption menuList subMenu \
			       closeButton parentLabel geometry contextHelp}

    if {[winfo exists $parent$widget]} {
	raise $parent$widget
	return
    }
    if {$contextHelp != ""} {
	set apsContextHelp($parent$widget) $contextHelp
    }

    if {$parentLabel != ""} {
	set labelDelimiter :
	set labelPrefix $parentLabel$labelDelimiter
    } else {
	set labelPrefix ""
    }
    set label ""
    set maxWidth 0
    foreach item $menuList {
	switch [lindex $item 0] {
	    label {
		set label "$labelPrefix[lindex $item 1]"
		set len [string length $label]
	    }
	    exec {
		set text "[lindex $item 1]..."
		set len [string length $text]
	    }
	    secureExec {
		set text "[lindex $item 1]..."
		set len [string length $text]
	    }
	    command {
		set text [lindex $item 1]
		set len [string length $text]
	    }
	    menu {
		set text "[lindex $item 1]->"
		set len [string length $text]
	    }
	    default {

	    }
	}
	if {$len > $maxWidth} {
	    set maxWidth $len
	}
    }
    set maxWidth [expr {$maxWidth + 2}]
    if {[llength $geometry]} {
	if {[info exists apsMenuFrame(Ypos)]} {
	    set ypos [expr {($apsMenuFrame(Ypos) - 30) - ([llength $menuList] * 29)}]
	    if {$ypos > [lindex [split $geometry +] 2]} {
		set geometry "+[lindex [split $geometry +] 1]+$ypos"
	    }
	}
    }
    APSFrame $widget -name $label -parent $parent -packOption $packOption \
      -noPack $noPack -geometry $geometry

    # Initialize list for keeping track of sub-menu widgets and exec pids
    if {![info exists apsMenuFrame($parent$widget)]} {
	set apsMenuFrame($parent$widget) {}
    }
    foreach item $menuList {
	switch [lindex $item 0] {
	    exec {
		set text "[lindex $item 1]..."
		set text [APSMenuFramePadLength $text $maxWidth]
		set cmd "[lindex $item 2] &"
		set help [lindex $item 3]
		set buttonWidget [APSUniqueName .xMenuFrame]
		APSButton $buttonWidget -packOption "-side top -fill x" \
		  -parent $parent$widget.frame -text $text -command \
		  "APSMenuFrameExec [list $cmd] $parent$widget" \
		  -contextHelp $help
		bind $parent$widget.frame$buttonWidget.button <Enter> "%W configure -bg Blue -fg White"
		bind $parent$widget.frame$buttonWidget.button <Leave> "%W configure -bg $apsBackground -fg Black"
	    }
	    secureExec {
		set text "[lindex $item 1]..."
		set text [APSMenuFramePadLength $text $maxWidth]
		set cmd "[lindex $item 2] &"
		set help [lindex $item 3]
		set users [lindex $item 4]
                set subnets [lindex $item 5]
		set buttonWidget [APSUniqueName .xMenuFrame]
		APSSecureButton $buttonWidget -packOption "-side top -fill x" \
		  -parent $parent$widget.frame -text $text -command \
		  "APSMenuFrameExec [list $cmd] $parent$widget"  \
		  -contextHelp $help -allowedUsers $users \
                  -allowedSubnets $subnets
		bind $parent$widget.frame$buttonWidget.button <Enter> "%W configure -bg Blue -fg White"
		bind $parent$widget.frame$buttonWidget.button <Leave> "%W configure -bg $apsBackground -fg Black"
	    }
	    command {
		set text [lindex $item 1]
		set text [APSMenuFramePadLength $text $maxWidth]
		set cmd [lindex $item 2]
		set help [lindex $item 3]
		set buttonWidget [APSUniqueName .xMenuFrame]
		APSButton $buttonWidget -packOption "-side top -fill x" \
		  -parent $parent$widget.frame -text $text -command $cmd \
		  -contextHelp $help
		bind $parent$widget.frame$buttonWidget.button <Enter> "%W configure -bg Blue -fg White"
		bind $parent$widget.frame$buttonWidget.button <Leave> "%W configure -bg $apsBackground -fg Black"

	    }
	    menu {
		set text [lindex $item 1]
		set helpText $text
		set text [APSMenuFramePadLength $text $maxWidth]
		set text "[string range $text 0 \
			    [expr {[string length $text] - 2}]]->"
		set menuList [lindex $item 2]
		set buttonWidget [APSUniqueName .xMenuFrame]
		set menuWidget [APSUniqueName .xMenuFrame]
		APSButton $buttonWidget -packOption "-side top -fill x" \
		  -parent $parent$widget.frame -text $text -command \
		  "APSMenuFrameMenu $menuWidget [list $menuList] [list $label] $parent$widget" \
		  -contextHelp "Brings up menu of choices for $helpText"
		bind $parent$widget.frame$buttonWidget.button <Enter> "APSMenuFrameEnter -widget %W -closeSubmenus $parent$widget.frame.buttonRow.closeSubmenus.button -menuWidget $menuWidget -Y %Y"
		bind $parent$widget.frame$buttonWidget.button <Leave> "APSMenuFrameExit -widget %W"
	    }
	}
    }

    frame $parent$widget.frame.buttonRow -relief raised -bd 2
    pack $parent$widget.frame.buttonRow -side top -fill x
    set buttonRow $parent$widget.frame.buttonRow
    if {$closeButton} {
	APSButton .close -parent $buttonRow -packOption "-side left" \
	  -text "Close" -command "APSMenuFrameClose $parent$widget 1" \
	  -highlight 1 -contextHelp "Closes this menu and all submenus."
    }
    APSButton .closeSubmenus -parent $buttonRow -packOption "-side left" \
      -text "Close SubMenus" -command \
      "APSMenuFrameClose $parent$widget 0" -contextHelp "Closes submenus."
    APSButton .kill -parent $buttonRow -packOption "-side left" \
      -text "Kill" -command "APSMenuFrameKill $parent$widget" \
      -contextHelp "Kills all applications started from this menu."
}

proc APSMenuFrameEnter {args} {
    set widget ""
    set closeSubmenus ""
    set menuWidget ""
    set Y 0
    APSStrictParseArguments {widget closeSubmenus menuWidget Y}
    if {[winfo exists $widget]} {
	$widget configure -bg Blue -fg White
	global apsMenuFrame
	set apsMenuFrame(Ypos) $Y
	set apsMenuFrame(activeButton) $widget
	if {[info exists apsMenuFrame(autoCascade)]} {
	    if {$apsMenuFrame(autoCascade)} {
		after 500 "APSMenuFrameDelayedExecute -widget $widget -closeSubmenus $closeSubmenus -menuWidget $menuWidget"
	    }
	}
    }
}

proc APSMenuFrameExit {args} {
    global apsBackground
    set widget ""
    APSStrictParseArguments {widget}
    if {[winfo exists $widget]} {
	$widget configure -bg $apsBackground -fg Black
	global apsMenuFrame
	set apsMenuFrame(activeButton) ""
    }    
}

proc APSMenuFrameDelayedExecute {args} {
    set widget ""
    set closeSubmenus ""
    set menuWidget ""
    global apsMenuFrame
    APSStrictParseArguments {widget closeSubmenus menuWidget}
    if {([winfo exists $widget]) && ($widget == $apsMenuFrame(activeButton))} {
        if {[lsearch -exact [array names apsMenuFrame] $menuWidget] == -1} {
	    $closeSubmenus invoke
        }
        $widget invoke
    }
}

proc APSMenuFrameExec {command parentMenuWidget} {
    global apsMenuFrame
    if {[catch {eval exec $command} result]} {
	puts "error exec'ing $command in APSMenuFrame: $result"
	return
    } else {
	set pid $result
	lappend apsMenuFrame($parentMenuWidget) [list pid $pid]
    }
}

proc APSMenuFrameMenu {menuWidget menuList parentLabel parentMenuWidget} {
    global apsMenuFrame
    if {![info exists apsMenuFrame($parentMenuWidget)]} {
	set apsMenuFrame($parentMenuWidget) {}
    }    
    set apsMenuFrame($parentMenuWidget) \
      [APSMenuFrameListAdd $apsMenuFrame($parentMenuWidget) \
	 [list widget $menuWidget]]
    APSMenuFrame $menuWidget -menuList $menuList -parentLabel $parentLabel \
      -subMenu 1 -geometry [APSGeometryRightRelative $parentMenuWidget]
}

proc APSMenuFrameClose {parentMenuWidget {closeRoot 1}} {
    global apsMenuFrame

    if {[info exists apsMenuFrame($parentMenuWidget)]} {
	set closeList $apsMenuFrame($parentMenuWidget)
	foreach item $closeList {
	    switch [lindex $item 0] {
		widget {
		    set widget [lindex $item 1]
		    APSMenuFrameClose $widget 1
		    set apsMenuFrame($parentMenuWidget) \
		      [APSMenuFrameListDelete \
			 $apsMenuFrame($parentMenuWidget) $item]
		}
		default {
		}
	    }
	}
	if {[llength $apsMenuFrame($parentMenuWidget)] == 0} {
	    unset apsMenuFrame($parentMenuWidget)
	}
    }
    if {$closeRoot} {
	catch {destroy $parentMenuWidget}
    }
    return
}

proc APSMenuFrameKill {parentMenuWidget} {
    global apsMenuFrame

    if {[info exists apsMenuFrame($parentMenuWidget)]} {
	set closeList $apsMenuFrame($parentMenuWidget)
	foreach item $closeList {
	    switch [lindex $item 0] {
		pid {
		    set pid [lindex $item 1]
		    catch {exec kill $pid}
		    set apsMenuFrame($parentMenuWidget) \
		      [APSMenuFrameListDelete \
			 $apsMenuFrame($parentMenuWidget) $item]
		}
		default {
		}
	    }
	}
	if {[llength $apsMenuFrame($parentMenuWidget)] == 0} {
	    unset apsMenuFrame($parentMenuWidget)
	}
    }
    return
}

proc APSMenuFrameListAdd {list value} {
    set ix [lsearch -exact $list $value]
    if {$ix >= 0} {
	return $list
    } else {
	return [linsert $list 0 $value]
    }
}

proc APSMenuFrameListDelete {list value} {
    set ix [lsearch -exact $list $value]
    if {$ix >= 0} {
	return [lreplace $list $ix $ix]
    } else {
	return $list
    }
}

proc APSMenuFramePadLength {text maxWidth} {
    return [format "%-${maxWidth}s" $text]
}

proc APSMenuFrameMakeHelp {} {
    return "Usage: APSMenuFrameMake menu \n\[-type <string>\]\t\n\[-text <string>\]\t\n\[-executable <string>\]\t\n\[-contextHelp <string>\]\t\n\[-allowedUsers <string>\]\t\n\[-menuList <list>\]\t\n\[-command <string>\]\t\n"
}
proc APSMenuFrameMake {menu args} {
    global status apsMenuFrameMakeDataNames apsScriptUser
    upvar $menu localMenu
    set dir "/home/helios/oagData/applicationSecurity/"
    set ext ".sdds"
    set menuList ""
    set type ""
    set text ""
    set executable ""
    set command ""
    set contextHelp ""
    set allowedUsers ""
    set allowedSubnets ""
    APSStrictParseArguments {menuList type text executable contextHelp \
			       command allowedUsers allowedSubnets}
    set pre [file tail [lindex $executable 0]]
    # replace " with ' so that lrange doesn't remove quotes or translate them into {}
    set arg1 [lrange [eval set dummy [os editstring %g/\"/'/ $executable]] 1 end]
    set filename $dir$pre$ext
    
    switch $type {
	label {
	    set item [list label $text]
	}
	exec {
	    set item [list exec $text $executable $contextHelp]
	}
	secureExec {
            if {[file exists $filename]} {
                set data apsMenuFrameMakeData$pre
                global $data
                if {[info exists $data]} {
                    # replace " with ' for same reason as above
                    eval set argList [os editstring %g/\"/'/ [set [set data](Parameter.Arguments)]]
                    set page [lsearch $argList $arg1]
                    if {$page == -1} {
                        set allowedUsers " "
                    } else {
                        set allowedUsers [lindex [set [set data](Column.AllowedUsers)] $page]
                    }
                } else {
                    if {[catch {sdds load $filename $data} result]} {
                        set allowedUsers " "
                    } else {
                        lappend apsMenuFrameMakeDataNames $data
                        # replace " with ' for same reason as above
                        eval set argList [os editstring %g/\"/'/ [set [set data](Parameter.Arguments)]]
                        set page [lsearch $argList $arg1]
                        if {$page == -1} {
                            set allowedUsers " "
                        } else {
                            set allowedUsers [lindex [set [set data](Column.AllowedUsers)] $page]
                        }
                    }
                }

            } else {
                set allowedUsers "$apsScriptUser "
            }
            set item [list secureExec $text $executable $contextHelp $allowedUsers $allowedSubnets]
	}
	menu {
	    # Label this menu button using label specification of submenu.
	    # If user hasn't supplied one, use text option of procedure.
	    set subMenuLabel ""
	    foreach entry $menuList {
		if {[lindex $entry 0] == "label"} {
		    set subMenuLabel [lindex $entry 1]
		}
	    }
	    if {$subMenuLabel == ""} {
		set item [list menu $text $menuList]
	    } else {
		set item [list menu $subMenuLabel $menuList]
	    }
	}
        
	command {
	    set item [list command $text $command $contextHelp]
	}
	default {
            APSAlertBox [APSUniqueName .uniqueNameError] -errorMessage "APSMenuFrameMake: unknown -type $type"
	    return $menu
	}
    }
    if {![info exists localMenu]} {
	set localMenu {}
    }
    set localMenu [linsert $localMenu end $item]
}

proc APSMenuFrameMakeFreeData {args} {
    global apsMenuFrameMakeDataNames
    if {[info exists apsMenuFrameMakeDataNames]} {
        foreach name $apsMenuFrameMakeDataNames {
            global $name
            unset -nocomplain $name
        }
    }
}

proc APSMenuFrameFindSubMenu {subMenu menuList} {
    
    set first ""
    set second ""
    set rest ""
    regexp {([^:]*)(.*)} $subMenu match first rest
    regexp {:([^:]*)(.*)} $rest match second rest

    set menuLabel ""
    foreach entry $menuList {
	if {[lindex $entry 0] == "label"} {
	    set menuLabel [lindex $entry 1]
	}
    }
    if {$first != $menuLabel} {
	return {}
    } elseif {$second == ""} {
	return $menuList
    } else {
	set list {}
	foreach item $menuList {
	    if {([lindex $item 0] == "menu") && \
		  ($second == [lindex $item 1])} {
		set list \
		  [APSMenuFrameFindSubMenu $second$rest [lindex $item 2]]
	    }
	}
	return $list
    }
}	
   
