it seems the options -label and -image at the same time... but it's weird
because the man pages say that they
cannot be used both at the same time... anyways... I couldn't find anything
that sets the background color of
the menu apart from :
proc tileutils::ThemeChanged {} {
array set style [style configure .]
array set map [style map .]
if {[info exists style(-background)]} {
set color $style(-background)
....
option add *Menu.background $color $priority
....
}
}
and here's the code that creates the taskbar menu (in
components/taskbar/Taskbar.tcl) :
# Build popup menu.
set m $wmenu
menu $m -tearoff 1 -postcommand [list [namespace current]::Post $m] \
-tearoffcommand [namespace current]::TearOff -title $prefs(theAppName)
set subPath [file join $this(images) 16]
set COCI [::Theme::GetImage coccinella $subPath]
set INFO [::Theme::GetImage info $subPath]
set SET [::Theme::GetImage settings $subPath]
set MSG [::Theme::GetImage newmsg $subPath]
set ADD [::Theme::GetImage adduser $subPath]
set EXIT [::Theme::GetImage exit $subPath]
set STAT [::Roster::GetMyPresenceIcon]
set menuDef {
{cascade mStatus @::Status::BuildMainMenu {-image @STAT
-compound left}}
{command mHideMain ::Taskbar::HideMain }
{command mSendMessage ::NewMsg::Build {-image @MSG
-compound left}}
{command mPreferences... ::Preferences::Build {-image @SET
-compound left}}
{command mAddNewUser ::JUser::NewDlg {-image @ADD -compound
left}}
{cascade mInfo {
{command mAboutCoccinella ::Splash::SplashScreen {-image @COCI
-compound left}}
{command mCoccinellaHome ::JUI::OpenCoccinellaURL}
{command mBugReport ::JUI::OpenBugURL }
} {-image @INFO -compound left}
}
{separator}
{command mQuit ::UserActions::DoQuit {-image @EXIT
-compound left}}
}
set menuDef [string map [list \
@STAT $STAT @COCI $COCI @ADD $ADD @INFO $INFO @SET $SET \
@MSG $MSG @EXIT $EXIT] $menuDef]
::AMenu::Build $m $menuDef
array set menuIndex [::AMenu::GetMenuIndexArray $m]
as you can see it uses ::AMenu which is a high level utility for handling
menus...
here's its code :
# AMenu.tcl ---
#
# This file is part of The Coccinella application.
# It implements some menu support functions.
#
# @@@ This is supposed to replace much of the other menu code.
#
# Copyright (c) 2006 Mats Bengtsson
#
# $Id: AMenu.tcl,v 1.6 2006/03/14 07:18:59 matben Exp $
package provide AMenu 1.0
namespace eval ::AMenu {
}
# AMenu::Build --
#
# High level utility for handling menus.
# We use the 'name' for the menu entry index which is the untranslated
# key, typically mLabel etc.
#
# Arguments:
# m menu widget path; must exist
# menuDef a list of lines:
# {type name command ?{-key value..}?}
# name: always the key that is used for msgcat::mc
# args -varlist list of {name value ...} which sets variables used
# for substitutions in command and options
#
# Results:
# menu widget path
proc ::AMenu::Build {m menuDef args} {
variable menuIndex
array set aArr {-varlist {}}
array set aArr $args
foreach {key value} $aArr(-varlist) {
set $key $value
}
set isub 0
bind $m <Destroy> {+::AMenu::Free %W }
foreach line $menuDef {
lassign $line op name cmd opts
if {[tk windowingsystem] eq "aqua"} {
set idx [lsearch $opts -image]
if {$idx >= 0} {
set opts [lreplace $opts $idx [expr {$idx+1}]]
}
}
set lname [mc $name]
set opts [eval list $opts]
# Parse any "&" in name to -underline.
set ampersand [string first & $lname]
if {$ampersand != -1} {
regsub -all & $lname "" lname
lappend opts -underline $ampersand
}
switch -glob -- $op {
com* {
set cmd [list after 40 [eval list $cmd]]
eval {$m add command -label $lname -command $cmd} $opts
}
rad* {
set cmd [list after 40 [eval list $cmd]]
eval {$m add radiobutton -label $lname -command $cmd} $opts
}
che* {
set cmd [list after 40 [eval list $cmd]]
eval {$m add checkbutton -label $lname -command $cmd} $opts
}
sep* {
$m add separator
}
cas* {
set mt [menu $m.sub$isub -tearoff 0]
eval {$m add cascade -label $lname -menu $mt} $opts
if {[string index $cmd 0] eq "@"} {
eval [string range $cmd 1 end] $mt
} else {
Build $mt $cmd
}
incr isub
}
}
if {$name ne ""} {
set menuIndex($m,$name) [$m index $lname]
}
}
return $m
}
proc ::AMenu::GetMenuIndex {m name} {
variable menuIndex
if {[info exists menuIndex($m,$name)]} {
return $menuIndex($m,$name)
} else {
return ""
}
}
proc ::AMenu::GetMenuIndexArray {m} {
variable menuIndex
set alist {}
foreach {key value} [array get menuIndex $m,*] {
set name [string map [list $m, ""] $key]
lappend alist $name $value
}
return $alist
}
# AMenu::EntryConfigure --
#
# As 'menuWidget entryconfigure index ?-keu value...?'
# but using mLabel as index instead.
#
# Arguments:
# m menu widget path
# mLabel
# args
#
#
# Results:
# menu widget path
proc ::AMenu::EntryConfigure {m mLabel args} {
variable menuIndex
if {[tk windowingsystem] eq "aqua"} {
set idx [lsearch $args -image]
if {$idx >= 0} {
set args [lreplace $args $idx [expr {$idx+1}]]
}
}
set index $menuIndex($m,$mLabel)
eval {$m entryconfigure $index} $args
}
proc ::AMenu::EntryExists {m mLabel} {
variable menuIndex
if {[info exists menuIndex($m,$mLabel)]} {
return 1
} else {
return 0
}
}
proc ::AMenu::Free {m} {
variable menuIndex
array unset menuIndex $m,*
}
On Wed, Feb 21, 2007 at 09:56:53AM +0000, [EMAIL PROTECTED] wrote:
> Wow, that's great! I took a quick look at the code but couldn't find what
> options they used to do that...
>
> On 21/02/07, Youness Alaoui <[EMAIL PROTECTED]> wrote:
> >
> >Hello,
> >I just saw Coccinella's menus.. wow! it's nice :) and I looked through the
> >code to see if it was GTK+ or
> >whatever... but hey! no, it's 100% TCL menus! but they look so much
> >nicer...
> >Take a look yourself :
> >http://kakaroto.homelinux.net/~kakaroto/coccinella.jpg
> >of course, with low jpg quality... maybe you should try it instead!
> >so.. who's willing to make them nice for amsn too? :D
> >btw, Gus.. would you be available for drawing us pixmaps for the menus ?
> >thx
> >
> >KKRT
> >
> >-------------------------------------------------------------------------
> >Take Surveys. Earn Cash. Influence the Future of IT
> >Join SourceForge.net's Techsay panel and you'll get the chance to share
> >your
> >opinions on IT & business topics through brief surveys-and earn cash
> >http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
> >_______________________________________________
> >Amsn-devel mailing list
> >[email protected]
> >https://lists.sourceforge.net/lists/listinfo/amsn-devel
> >
> -------------------------------------------------------------------------
> Take Surveys. Earn Cash. Influence the Future of IT
> Join SourceForge.net's Techsay panel and you'll get the chance to share your
> opinions on IT & business topics through brief surveys-and earn cash
> http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
> _______________________________________________
> Amsn-devel mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/amsn-devel
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys-and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
Amsn-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/amsn-devel
