Index: doc/wm.n ================================================================== --- doc/wm.n +++ doc/wm.n @@ -404,10 +404,41 @@ leader is iconified. \fIPathName\fR may be specified as an empty string to remove \fIwindow\fR from any group association. If \fIpathName\fR is specified then the command returns an empty string; otherwise it returns the path name of \fIwindow\fR's current group leader, or an empty string if \fIwindow\fR is not part of any group. +.TP +\fBwm iconbadge \fIwindow\fR \fIbadge\fR +. +Sets a badge for the icon of the \fIwindow\fR. The badge can be a positive +integer number, for instance the number of new or unread messages, or +an exclamation point denoting attention needed. If the badge is an empty +string, the badge image is removed from the application icon. Managing +these changes through bindings, such as , is the responsibility +of the developer. +.RS +.PP +On X11, for this command to work, +the variable \fB::tk::icons::base_icon($window)\fR must be set to the image that is +being used for the window icon of $window. On Windows and X11, the iconphoto +images work best at 32x32 or a similar dimension, as +the badge images are provided by Tk and drawn to overlay the icon images +using native (Windows) API's or Tk rendering. On macOS, the icon badge is +rendered by a system API and is not provided by Tk. The icon image itself +should be higher-resolution, preferably 512 pixels, to avoid being blurry. +.PP +The icon badge is intended for display in the Dock (macOS), taskbar +(Windows) or app panel (X11). On macOS, the last badge called will be +displayed in the Dock, regardless of how many different icon badges may be +assigned to different windows. On Windows, the taskbar display depends on +whether the taskbar buttons are combined or not (this is an OS setting +available to the user): if combined the behavior is the same as on macOS, +otherwise each button in the taskbar shows the badge it was assigned. +Badge display on macOS is configured in the system preferences. App +panel display behavior on X11 will depend on the window manager and/or +desktop environment. +.RE .TP \fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR? . If \fIbitmap\fR is specified, then it names a bitmap in the standard forms accepted by Tk (see the \fBTk_GetBitmap\fR manual entry for details). @@ -479,16 +510,17 @@ manager may scale provided icons to an appropriate size. .RS .PP On Windows, the images are packed into a Windows icon structure. This will override an ico specified to \fBwm iconbitmap\fR, and -vice versa. +vice versa. This command sets the taskbar icon for the window. .PP On X, the images are arranged into the _NET_WM_ICON X property, which most modern window managers support. A \fBwm iconbitmap\fR may exist simultaneously. It is recommended to use not more than 2 icons, placing -the larger icon first. +the larger icon first. This command also sets the panel icon for the +application if the window manager or desktop environment supports it. .PP On Macintosh, the first image called is loaded into an OSX-native icon format, and becomes the application icon in dialogs, the Dock, and other contexts. At the script level the command will accept only the first image passed in the Index: library/demos/tclIndex ================================================================== --- library/demos/tclIndex +++ library/demos/tclIndex @@ -64,6 +64,7 @@ set auto_index(showMessageBox) [list source -encoding utf-8 [file join $dir msgbox.tcl]] set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tcl]] set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]] set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]] set auto_index(systray) [list source -encoding utf-8 [file join $dir systray.tcl]] +set auto_index(windoicons [list source -encoding utf-8 [file join $dir windowicons.tcl]] Index: library/demos/widget ================================================================== --- library/demos/widget +++ library/demos/widget @@ -399,10 +399,12 @@ @@subtitle Miscellaneous @@demo bitmap The built-in bitmaps @@demo dialog1 A dialog box with a local grab @@demo dialog2 A dialog box with a global grab + @@new + @@demo windowicons Window icons and badges } ############################################################################## .t configure -state disabled ADDED library/demos/windowicons.tcl Index: library/demos/windowicons.tcl ================================================================== --- /dev/null +++ library/demos/windowicons.tcl @@ -0,0 +1,99 @@ +# windowicons.tcl -- +# +# This demonstration script showcases the wm iconphoto and wm iconbadge commands. +# + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .windowicons +destroy $w +toplevel $w +wm title $w "Window Icon Demonstration" +positionWindow $w + +image create photo icon -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGP + C/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3Cc + ulE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJ + QElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNU + SEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL + 8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3 + G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS + 3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3 + G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf + /8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3 + Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemx + eCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr9 + 9ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaX + TbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1c + fphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCR + xEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq + 1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8Tha + QxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe + 2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAA + DSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xs + vIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpM + DKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRi + nD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJG + nTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZ + mYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtd + EvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3 + FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1 + tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQd + V+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKF + XMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pS + CiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYi + Th1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPl + muL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXD + fZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2 + ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidw + fcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3Nxz + dwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EE + CGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvN + ubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7 + jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pj + kxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVj + hO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEs + QoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7N + xfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsR + QgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8 + N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LS + TRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE + 9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18 + tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsr + zZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66 + Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlM + pcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVw + v/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vq + fbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuM + VKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZF + Dgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0 + QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAg + UHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1v + bnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVh + dGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRl + OmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADI + elRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhW + HXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mH + oTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sK + hBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9 + moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUA + d3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29w + ZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2Vi + LWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGF + uZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC +} + +set ::tk::icons::base_icon(.) icon + +pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon(.) \ + -compound top -command {wm iconphoto . $::tk::icons::base_icon(.) }] +pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] +pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] +pack [button $w.f -text "Reset Badge" -command {wm iconbadge . ""}] + +## See Code / Dismiss buttons +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x ADDED library/iconbadges.tcl Index: library/iconbadges.tcl ================================================================== --- /dev/null +++ library/iconbadges.tcl @@ -0,0 +1,254 @@ +# iconbadges.tcl -- +# +# Notification badges for Tk applications. +# +# +# Copyright © 2021 Kevin Walzer/WordTech Communications LLC + +namespace eval ::tk::icons {} + +image create photo ::tk::icons::1-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/HBz/V1f/Rkb/BQX/Dw//oKD/////y8v/Bgb/Pz//ra3/+/v/ + zMz/Li7/5ub/+vr/8fH/Ly//uLj/Zmb/n5//Bwf/Dg7/kpL/YWH/rq7/h4f/Cgr/ + AQH/AgLXmjE+AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBib + aYUeAAAAnElEQVQY022Q5w6DMBCD78hi03RQuvegg77/25ULCakq/MenT4piGwAQ + A8aFlIKzABGAiAojbRSFihhinOheSdwyVKn+UaoQsry7x5PpjDzPgBWGlPNqUdJR + MODky9V6U20N0hwE2W5/ODokQJKdzperQ7JDt7uuPRL299o/5P+IuxA9akO4qI/n + 622jukLNp3GFBmoPjOMnHNkJv3kDExXHctm+AAAAJXRFWHRkYXRlOmNyZWF0ZQAy + MDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0RVh0ZGF0ZTptb2RpZnkA + MjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAASUVORK5CYII= +} +image create photo ::tk::icons::2-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 21BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Cwv/ODj/UlL/UFD/MjL/CAj/ExP/oKD/8fH//v7//f3/7u7/ + kJD/DAz/ZWX/9fX/jIz/lpb/+vr/9/f/TEz/TU3/m5v/iYn/Ly//6+v/////YmL/ + nJz/5OT/MDD/KSn/srL/7Oz/ZGT/AQH/Nzf/zs7/zc3/SUn/AgL/ICD/ysr/7e3/ + gYH/VVX/WVn/Kir/fX3/eXn/AwP/dnb/rKz/qan/q6vjChO4AAAAEXRSTlMAAA5V + q9/4NK/0St3cDa7z4Pnet34AAAABYktHRCy63XGrAAAAwElEQVQY021Q1xLCMAxz + uktpS9hQoOwZ9t57/P8XUSesB/RinXz2SQIAQiRZUTVNVWSJEABUdMOkHKaho0ZI + yKIfWKFAI3qY/iCsE7AdZNFYPJFMIXNskN1gpjNZL5cv+AF1ZVBwVfRK5Uq1Vkeu + gIqj0Wz57Q7rIldBe/1N91h/gER7S8ORN55MhcQP6WzOFssVFYf8/XrDtrv94Sje + cxMnxnEWJtDq5Xq7B3gkhFUeaCUwFYH+xP5TzrfCyKvCJ3EzGUFH/1QDAAAAJXRF + WHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0 + RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAA + SUVORK5CYII= +} +image create photo ::tk::icons::3-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + +VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/CQn/NTX/UlL/Tk7/Kir/BAT/ERH/mZn/8PD/+Pj/+vr/5ub/ + cHD/AgL/Vlb/9PT/5eX/X1//nZ3/////29v/HR3/Fhb/QED/RET/Cwv/f3//1dX/ + Ghr/Bwf/mpr/9vb/+fn/b2//lZX/2tr//Pz/wsL/Jyf/Dg7/Bgb/MzP/c3P/XV3/ + wMD/qqr/ExP/KSn/4+P/bm7/Q0P/6ur/vb3/x8f/19f/KCj/SEj/qan/zc3/y8v/ + oKD/ODj/BQX/DQ3/AwON+4wDAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34A + AAABYktHRCXDAckPAAAAx0lEQVQY021Q1RLCQBDbo4qW4l7ssOLu7g7//zH07oo8 + kJfNZGczyQIAQhaOF0RR4DkLQgBEkWSrSmGVJaIhZLOrH9hthoYkh/oDh4TA6SLM + 4/X5A0HCXE7gFGOGwpFoLJ7QDKpwwJNVMpXOZHEuTzgPAhmFYkkv40qVcAFEZlur + N5otysS3pLc73V6fSfRQ8wyGozges0NqP5nO5oslXjF7GmK96W53eH9gIWhU7Xg6 + X643M6pZ6D54PN+F/tT+85zvC93mC1+z9hl5VNGhJwAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMNGl+hsAAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTQtMDQ6MDCg+EKnAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::4-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 1VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AgL/OTn/W1v/ODj/QED/4uL/////oaH/AQH/KSn/zs7/oqL/ + Fhb/tbX/9PT/1NT/Cgr/l5f//Pz/h4f/fHz/dXX/+/v/trb/HBz/fX3/qKj/DAz/ + EBD/ysr/4eH/zc3/5eX/8fH/lJT/BAT/Dw//uLj/5+f/5ub/8vL/+vr/paX/BQX/ + HR3/JCT/ISH/iYn/sLD/Ghr/Tk7/rq7/a2vT0ZXAAAAAEXRSTlMAAA5Vq9/4NK/0 + St3cDa7z4Pnet34AAAABYktHRBibaYUeAAAAvklEQVQY022QVRPCMBCEL1RSg5Ji + Ibi7W9Hi//8n0aRBHtiXvflm7mZvAQChmKJquq6pSgwhAE6wYRIh08CcIWTZ5CPb + ChnCDvmRgxHEE9HspdIZ7ok4KG6EsjmaZ6G7CqgRKRQpLXFEVNAEKVeqNYk00LnV + G81WWyJdINbp9voDOhxFiC+OJ3Q6m9PFciUW+fn1xt/6O7o/HMV5HsI7BcH5Qq83 + JkK8o5L74ymjfh5iHpMP/Xn7TznfCpOywhdM6Ra8aC+AYwAAACV0RVh0ZGF0ZTpj + cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6 + bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::5-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 7VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/ICD/MjL/Li7/CQn/Bgb/q6v/8/P/8vL/9PT/4uL/FRX/0tL/ + ////wsL/xcX/uLj/Jib/Kyv/6ur/8fH/aGj/XV3/SUn/Fhb/AQH/+Pj//Pz/7Oz/ + +fn/l5f/Dg7/ODj/qan/sLD/W1v/fn7/9/f/+vr/WVn/EBD/Ghr/2dn/gID/X1// + oKD/EhL/5OT/Y2P/S0v/7e3/vb3/ycn/yMj/HR3/AwP/Skr/zc3/LCz/BQX/DAz/ + AgKLBoLHAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRB5yCiAr + AAAAyUlEQVQY021Q1RLDMAxzVhp1XcbYMXXMzIz//zmLk9HD9GKdzvZJAgBCbJKs + qKoiSzZCAFDR7A7K4bBrqBHidNEPXE6mEc1Nf+DWCOgeZD4/QyDImEcHyWAzFI5E + I7F4gFFDAhmXEkkzmUpnsshlUHDk8oViqVyxkCug4ihXa/VGtNlCrgqp3en2+oPh + SEj80AqO6WRqzsQhfz/PLJa5lbkW77mJzba225uHozDBrZ7Oncu+eaXC6ivQrXV/ + vAP9if2nnG+F3leFT2jDGOnV8F/uAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4 + LTEwVDA4OjM1OjE1LTA0OjAwd9LxrwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0w + OC0xMFQwODozNToxNS0wNDowMAaPSRMAAAAASUVORK5CYII= +} +image create photo ::tk::icons::6-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 9lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AQH/ICD/S0v/UlL/NDT/CAj/WVn/2dn/+Pj/+fn/8PD/jY3/ + Cgr/LCz/4OD//f3/hob/cHD/5eX/1NT/NTX/bGz/////39//T0//Bwf/j4//5ub/ + wcH/7+//4uL/f3//CQn/lpb/+/v/n5//iIj/8vL/9/f/UVH/hYX/3t7/Hx//vb3/ + VVX/6Oj/MzP/ExP/x8f/e3v/EhL/t7f/0tL/wMD/MTH/IiL/xsb/zc3/qKj/QkL/ + AgL/Cwv/Dg7/BQWiS7IgAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCi9sLWyAAAAyklEQVQY021Q1RLCQBDbowalBYq7y+FWirs7/P/PwPawB/Ky + mezsThIAIMTC8YIoCjxnIQQAFclq00zYrBJqhMh27QO7/NSIpGg/UCQCqgOZ2+P1 + +QPIHCpwTlSCoXAkGos/qZMDHleJZCqdyebyyHkQcBRoMeEvecrIBRBxVGi1Vm80 + W8hFJrWp3jG6vT6TzMMBHY4CY2qwQ/P9RJ/O5gu6ZO9NE6s13Wz14o6ZYFb3scPx + dHYzq69Al+vt/g70J/afcr4Vul4VPgDLCRmO3FuJegAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::7-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + xlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Hh7/Njb/NTX/Ghr/i4v/9/f/8/P/8vL/8fH/9PT/eHj/fHz/ + 3Nz/2Nj/19f/6Oj/////+Pj/YGD/DQ3/Fxf/FRX/IiL/trb/j4//CQn/Zmb/+/v/ + xsb/GBj/HR3/0tL//f3/Xl7/ZGT/1dX/BAT/p6f/n5//AQH/Fhb/09P/c3P/GRn/ + mZn/qqr/PT3/AgKXVg1iAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCJdZVysAAAAu0lEQVQY022Q1xKCMBBFN5LQixFR7Bp77wU7//9TJgTFB+7L + njmTydxdAECooGCiqgQrBYQAhNF0gyYxdE04hEyL/mKZ3CHNpn+xNQSOy6Hkl3n8 + gKPrgOLxWamGYa3eaHL0FMDieavd6fZYfyAYAxFjOBpPpmw2F0xATf9dLFfrBNSv + 2mx3e5oqIuHAjoEkIr+npzO7RFJhWYJeb+wuDS+RVKWP5+stFa8qF4riOFsoZ+2c + 42QnLKYn/ADYChWCRPB9rQAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw + ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU + MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::8-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 6lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Bwf/MjL/UVH/TU3/Kir/BAT/DAz/j4//7e3/+Pj/5+f/eXn/ + BQX/Skr/9/f/7+//Z2f/fn7/+/v/6ur/MDD/UFD/4uL/Jib/QUH/9PT/NTX/EhL/ + srL/////09P/2tr/m5v/CAj/ycn//f3/y8v/1dX/s7P/GBj/hYX/HR3/Zmb/0dH/ + LCz/5eX/dHT/S0v/wsL/NDT/V1f/sLD/zc3/ysr/paX/RUX/AQH/Bgb/Dg7/DQ3m + iTf5AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRC8j1CARAAAA + yklEQVQY021Q1RLCQBDbowZFSpEWh+J+xd3d/v936N5hD+QlmezsTrIAQIhLECVZ + lkTBRQgAOorbozN43Ap6hKhe/QOv6nhE8ek/8CkE/AFUoXAkapioAn4QNIdj8UQy + mUpnHKkJIOIom7PyhWKpjFoECalSrNbqDauJWgIZqdWmdod2e6hlbhn9wXBExxNu + scUptWfhFJ3zRXY+TheT5Yqu+XkWYmMNtkNa3fEQLGpmfziezpcrj/oqdLs/zHeh + P7X/POf7wuDrhU+46hlBGTVCQgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0x + MFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgt + MTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::9-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 8FBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/DAz/OTn/U1P/R0f/HBz/AQH/Fhb/oqL/8/P/+fn/+Pj/1NT/ + S0v/cXH/////29v/W1v/mJj/0ND/AgL/paX/np7/Ly//7e3//Pz/lZX/vr7/GBj/ + VVX/9fX/c3P/QED/5ub//f3/19f/4OD/+/v/eXn/Pz//mZn/oaH/dXX/6Oj/Z2f/ + Kir/cHD/enr/FRX/TU3/8PD/Ojr/Ozv/2tr/nJz/CAj/Tk7/sbH/z8//wcH/Bgb/ + Dw//CgoJOUsyAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCCz + az2AAAAAy0lEQVQY022Q1RLCQAxFs9QovlAozuLu7u72/39D0y3yQB6SO2cmmXsD + AITYBFGSZUkUbIQAIFHsKjVLtSvICHE46aecDoMRxUV/yqUQcHtQ+QNaMKSj8rhB + 8BozHInG4okkIq8AIs4US2eyLBdCLYJk9HyBFWmpXNEQSSDjqLJavdFkLdQyR+1O + t9cfsCFHuEj10XgynbE5XzTPL5ar9Sa+3fHzpon9rFI7sOOJmzCt5s+X6221tqxa + ge6Pp/4O9Cf2n+d8X+izXvgCm5cZM7QQ1AwAAAAldEVYdGRhdGU6Y3JlYXRlADIw + MjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAy + MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== +} + +image create photo ::tk::icons::9plus-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/ERH/AAD/NDT/AQH/AAD/AAD/Cgr/Nzf/U1P/SUn/Hx//AQH/mJj/8fH/+fn/ + 2dn/VFT/BAT/YmL//f3/4uL/YGD/j4//IyP/GBj/xsb/xcX/Fxf/lZX/////rKz/ + JSX/5eX/3t7/3Nz/AgL/hob/yMj/Hh7/Skr/fn7/MTH/srL/vr7/9fX/NDT/NTX/ + 39///v7/3d3/+vr/g4P/RET/9PT/+/v/8/P/R0f/OTn/lpb/pKT/c3P/4eH/dHT/ + Dw//Pz//VVX/5ub/ExP/JCT/bW3/fX3/Ghr/QUH/Rkb/Gxv/wsL/1dX/p6f/DAz/ + e3v/enr/Dg7/ra3/zs7/w8P/gYH/GRn/Bgb/CwuphzIHAAAAFHRSTlMAAA5Vq9/4 + NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRCy63XGrAAAA+ElEQVQY02NgYGBkZGJm + YWVjY2VhZmJkZGAAibBzcIqAAScHO0iMkZGLWwQOuLmAYozsPCJIgIedkYGXT1RM + XEJSCibGx8vAzC8tIysrJw/kKUhKKogIMDOwKCopq6gqyamJiKhraGqJiLAwsGrr + 6Erp6euoABUZGEoqGLEysBnrmJiayeiYW1haWVtbWdqwMbDZ2tnLOTjqODm7uNrb + u7q5szGwinh4enn76Pj6+QcE6gf4B7EysASHhIaFu1lHiIhEGhiGgYxnFvSxj4rW + iYkVEfGLi08AOYJXKCIxKTklFcmpQA+lJaRLIXsIi7exBA4iCIWhQQgAiNMk9J5+ + e/MAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBG + OusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAw + N2dTjgAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::!-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + olBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Fhb/QED/Pj7/ExP/VVX/9PT/8PD/SUn/WFj//v7/+fn/S0v/ + SEj/PDz/MjL/6Oj/Jyf/ICD/4+P/2Nj/Fxf/Dw//qKj/nZ3/Cgr/IyP/hIT/gYH/ + Hh7/PT3/Ly//paX/oqL/KCj/AgL///8V6AjgAAAAEXRSTlMAAA5Vq9/4NK/0St3c + Da7z4Pnet34AAAABYktHRDXettlrAAAAoElEQVQY022QxxKCQBBEZ9hERkygophz + lv//NmF3Bz0wp1dd1V3dAwCIDuNCSsGZgwjQKMr1Un2eqxoN0Q/S9gK/1lCF6d+F + CiGKNfYHw5GGOAKWaBpn+URDwoAbw3RWzA1xEAYWRVYaEiANLPPV2pAkabPd7Umy + xsPxdCajjb9cb3eKtyXq+AeVsFWfr/eHqtKgqmoHdczueM7vhT37wi9PRRMHXNeq + aAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY6 + 6zIAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3 + Z1OOAAAAAElFTkSuQmCC +} + + +if {[tk windowingsystem] eq "x11"} { + + # ::tk::icons::IconBadge -- + # This procedure creates an icon with an overlay badge on systems that + # do not have a native icon/badge API. + # + # Arguments: + # win - window name + # badgenumber - badge number to draw over the window icon + + proc ::tk::icons::IconBadge {win badgenumber} { + + variable ::tk::icons::base_icon + + if {![info exists ::tk::icons::base_icon]} { + return -code error "::tk::icons::base_icon($win) must be set on X11" + } + + if {![info exists ::tk::icons::base_icon($win)]} { + return -code error "::tk::icons::base_icon($win) must be set on X11" + } + + if {[lsearch -exact [image names] $::tk::icons::base_icon($win)] <= 0} { + return -code error "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" + } + + if {!([string is integer $badgenumber] && $badgenumber > 0) + && [string match $badgenumber "!"] == 0 + && $badgenumber ne ""} { + return -code error "can't use \"$badgenumber\" as icon badge" + } + + wm iconphoto $win $::tk::icons::base_icon($win) + + if {$badgenumber eq ""} { + return + } + + image create photo overlay + + switch -glob -- $badgenumber { + ! { + set badge ::tk::icons::!-badge + } + [1-9] { + set badge ::tk::icons::$badgenumber-badge + } + default { + set badge ::tk::icons::9plus-badge + } + + } + + overlay copy $::tk::icons::base_icon($win) + overlay copy $badge -from 0 0 18 18 -to 18 0 + wm iconphoto $win overlay + + } +} Index: library/tk.tcl ================================================================== --- library/tk.tcl +++ library/tk.tcl @@ -495,10 +495,11 @@ proc ::tk::SourceLibFile {file} { namespace eval :: [list source -encoding utf-8 [file join $::tk_library $file.tcl]] } namespace eval ::tk { SourceLibFile icons + SourceLibFile iconbadges SourceLibFile button SourceLibFile entry SourceLibFile listbox SourceLibFile menu SourceLibFile panedwindow Index: macosx/tkMacOSXWm.c ================================================================== --- macosx/tkMacOSXWm.c +++ macosx/tkMacOSXWm.c @@ -240,10 +240,13 @@ static int WmGridCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int WmIconbadgeCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmIconifyCmd(Tk_Window tkwin, TkWindow *winPtr, @@ -1189,21 +1192,21 @@ { Tk_Window tkwin = (Tk_Window)clientData; static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", - "frame", "geometry", "grid", "group", + "frame", "geometry", "grid", "group", "iconbadge", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, - WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, + WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBADGE, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, @@ -1277,10 +1280,12 @@ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GRID: return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBADGE: + return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: return WmIconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONMASK: @@ -2332,10 +2337,78 @@ } wmPtr->hints.window_group = Tk_WindowId(tkwin2); wmPtr->hints.flags |= WindowGroupHint; wmPtr->leaderName = (char *)ckalloc(length + 1); strcpy(wmPtr->leaderName, argv3); + } + return TCL_OK; +} + + /*---------------------------------------------------------------------- + * + * WmIconbadgeCmd -- + * + * This procedure is invoked to process the "wm iconbadge" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmIconbadgeCmd( + TCL_UNUSED(Tk_Window), /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + (void) winPtr; + NSString *label; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv,"window badge"); + return TCL_ERROR; + } + + label = [NSString stringWithUTF8String:Tcl_GetString(objv[3])]; + + int number = [label intValue]; + NSDockTile *dockicon = [NSApp dockTile]; + + /* + * First, check that the label is not a decimal. If it is, + * return an error. + */ + + if ([label containsString:@"."]) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + return TCL_ERROR; + } + + /* + * Next, check that label is an int, empty string, or exclamation + * point. If so, set the icon badge on the Dock icon. Otherwise, + * return an error. + */ + + NSArray *array = @[@"", @"!"]; + if ([array containsObject: label]) { + [dockicon setBadgeLabel:label]; + } else if (number > 0) { + NSString *str = [@(number) stringValue]; + [dockicon setBadgeLabel:str]; + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", Tcl_GetString(objv[3]))); + return TCL_ERROR; } return TCL_OK; } /* Index: tests/unixWm.test ================================================================== --- tests/unixWm.test +++ tests/unixWm.test @@ -900,11 +900,11 @@ list [catch {wm iconmask .t bogus} msg] $msg } {1 {bitmap "bogus" not defined}} test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} unix { list [catch {wm icon .t} msg] $msg -} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} unix { list [catch {wm iconname .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconname window ?newName?"}} test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { set result {} @@ -1349,11 +1349,11 @@ lappend result [wm state .t] [winfo ismapped .t] } {withdrawn 0 normal 1} test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix { list [catch {wm unknown .t} msg] $msg -} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} destroy .t .icon test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {unix nonPortable} { destroy .t Index: tests/wm.test ================================================================== --- tests/wm.test +++ tests/wm.test @@ -12,10 +12,75 @@ # in unixWm.test or winWm.test. package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands + +image create photo icon -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGPC/xhBQAAA + CBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAABmJLR0QA/w + D/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJQElEQVRYw+WXW2xdV5nHf/ty7lc + f2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNUSEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKq + RJgBSikiuGlN22TqhsR27OPL8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614 + f/7MP6vC3O5f8L3G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8 + pHjvfS3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3G/7 + ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf/8hj5//5H97/ + YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3Vm9vfqc0WNi9evUKWr/xL + h3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemxeCafxRcKw7TJxKC+12RpbYdAx7HsOC + rSRNpg+sQQj1w8nS0N5h8JAvm+rWr99ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/ + ++2P/eOFkV0FkJTDQgCaXTbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsP + LyxU5orFTK1cfphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vli + TCRxEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq1fn7A4 + yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8ThaQxRpIg0q6DGUNjg + 6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe2Hj1XoBLl55menqcbDb1haee + evyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAADSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7 + /uUSlk6Hed0oxG9HI9bm+Pjs2xsvIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUx + SHyqSy+f31hzaRZRpMDKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu + 7zz54SCRinD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJG + nTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZmYmMEIJmx + 6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtdEvEQrSN8IVEq5MSJ4Y + lSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3FUYyjxuEeELt7/NoP+eBVAipCFX + EsYE4xcydYFIeSHKynOXhUwM0mh32egH1tsdL16oo007kcskHs7kYly49fRcALqby+fQo + pklkZ4jHY3g6gQgjHF/QcgQdV+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQ + CyZHrv0sUe4JwKFXMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibO + vdJ7pSCiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYiTh1 + NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPlmuL4oIFWkbx8 + rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXDfZFII0NFIBW/XQiZHraoN + bsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8 + tgW/sHynAxzcVTBQYzFp4v6boBjidwfcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6 + NacWIfD/yveDmXq3F3NxzdwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pY + eh/C9QSOJ3EECGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCG + rvNubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7jee6eN + 4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pjkxuVGo7Tw+1/MAh + 83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVjhO2e16q3fzR2cjQwDPPeZrSx + 8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEsQoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkk + CHTQwa5WIjne9xY2mT+VouRfI7NxfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGn + h0oHwktlZzmBq0SNsRQgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrT + Xdzf+9Nb8N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LS + TRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE9wOIARmtw + 9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18tPSIhEfouwSuQ9cx2V + xpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsrzZ1O13eMcSuezC61LJzQRgY+KvC + JhI+WPpH0IAywIkEhaVIupAhdHS0t3F66Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL + +fzEmalTsx+emjl3YWjsaMlMpcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leY + wNoA01gr297BzVwv/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6X + Vae/Vqfbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuMVKj + C0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZFDgot6Fe8eqfw + 3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0QXV0aG9yAHdhcnN6YXdpY + W5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAgUHVibGljIERvbWFpbiBEZWRpY2F0aW + 9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1vbnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/ + G4735AAAAIXRFWHRDcmVhdGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAA + JXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0R + Vh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADIelRYdE + Rlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhWHXUrd2pmLXr7tDr + VpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mHoTeuJlUxYoly8nRRxHW4HahO + 30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sKhBuy2H4xUlM1i76+BhcBwwirLj/bAlJqj + XXzP9UyxmuHzp8feiknLPW6Q/H9moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAAB + l0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHR + wczovL29wZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2Vi + LWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGFuZ28gaW5ld + HJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC +} wm deiconify . if {![winfo ismapped .]} { tkwait visibility . } @@ -57,11 +122,11 @@ wm } -result {wrong # args: should be "wm option window ?arg ...?"} # Next test will fail every time set of subcommands is changed test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body { wm foo -} -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw} +} -result {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw} test wm-1.3 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body { wm command } -result {wrong # args: should be "wm option window ?arg ...?"} test wm-1.4 {Tk_WmObjCmd procedure, miscellaneous errors} -returnCodes error -body { wm aspect bogus @@ -722,10 +787,83 @@ lappend result [wm group .t] wm group .t {} lappend result [wm group .t] } -result [list {} . {}] + +### wm iconbadge ### +test wm-iconbadge-1.1 {usage} -body { + wm iconbadge +} -returnCodes error -result {wrong # args: should be "wm option window ?arg ...?"} +test wm-iconbadge-1.2 {usage} -body { + frame .f + set ::tk::icons::base_icon(.f) icon + wm iconbadge .f icon +} -cleanup { + destroy .f + unset ::tk::icons::base_icon(.f) +} -returnCodes error -result {window ".f" isn't a top-level window} +test wm-iconbadge-1.3 {::tk::icons::base_icon($win) must be set on X11} -constraints { + x11 +} -setup { + unset -nocomplain ::tk::icons::base_icon(.) +} -body { + wm iconbadge . ! +} -returnCodes error -result {::tk::icons::base_icon(.) must be set on X11} +test wm-iconbadge-1.4 {::tk::icons::base_icon($win) must be a Tk photo on X11} -constraints { + x11 +} -setup { + catch {image delete book} +} -body { + set ::tk::icons::base_icon(.) book + wm iconbadge . 27 +} -returnCodes error -result {can't use "book" as iconphoto: not a photo image} +test wm-iconbadge-1.5 {illegal badge number} -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } + set ::tk::icons::base_icon(.) book + wm iconbadge . illegal +} -cleanup { + image delete book +} -returnCodes error -result {can't use "illegal" as icon badge} +test wm-iconbadge-1.6 {non-integer badge number} -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } + set ::tk::icons::base_icon(.) book + wm iconbadge . 3.2 +} -cleanup { + image delete book +} -returnCodes error -result {can't use "3.2" as icon badge} +test wm-iconbadge-1.7 {negative or zero badge number} -body { + image create photo book -data { + R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAAC + wAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IM + QCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc + 0yv+DVSEUuFxIAOw== + } + set ::tk::icons::base_icon(.) book + wm iconbadge . 0 +} -cleanup { + image delete book +} -returnCodes error -result {can't use "0" as icon badge} +test wm-iconbadge-1.8 {usage, no need to call iconphoto on aqua or win32} -constraints { + aquaOrWin32 +} -body { + wm iconbadge . 3 + wm iconbadge . 5000 + wm iconbadge . ! + wm iconbadge . "" +} -result {} + ### wm iconbitmap ### test wm-iconbitmap-1.1 {usage} -returnCodes error -body { wm iconbitmap } -result {wrong # args: should be "wm option window ?arg ...?"} @@ -878,10 +1016,11 @@ wm iconphoto . -default [image create photo -file {}] } -match {glob} -result {failed to create an iconphoto with image *} test wm-iconphoto-1.5.2 {usage} -constraints x11 -body { wm iconphoto . -default [image create photo -file {}] } -result {} + # All other iconphoto tests are platform specific ### wm iconposition ### Index: unix/tkUnixWm.c ================================================================== --- unix/tkUnixWm.c +++ unix/tkUnixWm.c @@ -412,10 +412,13 @@ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmIconbadgeCmd(Tk_Window tkwin, TkWindow *winPtr, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmIconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, @@ -1014,21 +1017,21 @@ { Tk_Window tkwin = (Tk_Window)clientData; static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", - "frame", "geometry", "grid", "group", "iconbitmap", + "frame", "geometry", "grid", "group", "iconbadge", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, - WMOPT_ICONBITMAP, + WMOPT_ICONBADGE, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW }; @@ -1114,10 +1117,12 @@ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GRID: return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBADGE: + return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: return WmIconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONMASK: @@ -2114,10 +2119,52 @@ strcpy(wmPtr->leaderName, argv3); } UpdateHints(winPtr); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * WmIconbadgeCmd -- + * + * This function is invoked to process the "wm iconbadge" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmIconbadgeCmd( + TCL_UNUSED(Tk_Window), /* Main window of the application. */ + TkWindow *tkWin, /* Toplevel to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + (void) tkWin; + char cmd[4096]; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window badge"); + return TCL_ERROR; + } + + sprintf(cmd, "::tk::icons::IconBadge {%s} {%s}", + Tcl_GetString(objv[2]), + Tcl_GetString(objv[3])); + if (Tcl_EvalEx(interp, cmd, -1, TCL_EVAL_DIRECT) != TCL_OK) { + return TCL_ERROR; + } + return TCL_OK; +} /* *---------------------------------------------------------------------- * * WmIconbitmapCmd -- Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -358,11 +358,11 @@ !endif PRJ_DEFINES = /DBUILD_ttk $(CONFIG_DEFS) /Dinline=__inline /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE # Additional Link libraries needed beyond those in rules.vc -PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib +PRJ_LIBS = netapi32.lib gdi32.lib user32.lib userenv.lib winspool.lib shell32.lib ole32.lib uuid.lib #--------------------------------------------------------------------- # TkTest flags #--------------------------------------------------------------------- Index: win/tkWinWm.c ================================================================== --- win/tkWinWm.c +++ win/tkWinWm.c @@ -11,14 +11,17 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include +#include +#include +#include +#include #include "tkWinInt.h" #include "tkWinIco.h" -#include - /* * These next two defines are only valid on Win2K/XP+. */ #ifndef WS_EX_LAYERED @@ -344,10 +347,20 @@ static int initialized; /* Flag indicating whether module has been * initialized. */ TCL_DECLARE_MUTEX(winWmMutex) +/* + * The following records the "TaskbarButtonCreated" message ID + * for overlay icons. + */ + +static UINT TaskbarButtonCreatedMessageId = WM_NULL; + +/* Reference to taskbarlist API for overlay icons. */ +ITaskbarList3 *ptbl; + /* * Forward declarations for functions defined in this file: */ static int ActivateWindow(Tcl_Event *evPtr, int flags); @@ -430,10 +443,13 @@ TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int WmIconbadgeCmd(Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int WmIconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, @@ -1716,10 +1732,16 @@ if (!tsdPtr->initialized) { return; } tsdPtr->initialized = 0; + /* + * COM library cleanup. + */ + + CoUninitialize(); + UnregisterClassW(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance); } /* *-------------------------------------------------------------- @@ -1832,10 +1854,11 @@ HWND child, nextHWND, focusHWND; int x, y, width, height, state; WINDOWPLACEMENT place; HICON hSmallIcon = NULL; HICON hBigIcon = NULL; + HRESULT hr; Tcl_DString titleString; int *childStateInfo = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -2160,10 +2183,38 @@ tsdPtr->firstWindow = 0; SetActiveWindow(wmPtr->wrapper); } else if (focusHWND) { SetFocus(focusHWND); } + + /* + * Initialize hooks for overlay icon. + * Start with TaskbarButtonCreated message. + */ + + TaskbarButtonCreatedMessageId = RegisterWindowMessage(TEXT("TaskbarButtonCreated")); + + /* + * In case the application is run elevated, allow the + * TaskbarButtonCreated message through. + */ + + ChangeWindowMessageFilter(TaskbarButtonCreatedMessageId, MSGFLT_ADD); + + /* + * Load COM library for icon overlay. + */ + + hr = CoInitialize(0); + if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&CLSID_TaskbarList, NULL, CLSCTX_INPROC_SERVER, &IID_ITaskbarList3, &ptbl); + if (FAILED(hr)) { + printf("Unable to initialize ITaskbarList3 API"); + ptbl->lpVtbl->Release(NULL); + ptbl = NULL; + } + } } /* *-------------------------------------------------------------- * @@ -2611,11 +2662,11 @@ { Tk_Window tkwin = (Tk_Window)clientData; static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", "frame", - "geometry", "grid", "group", "iconbitmap", + "geometry", "grid", "group", "iconbadge", "iconbitmap", "iconify", "iconmask", "iconname", "iconphoto", "iconposition", "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", @@ -2623,11 +2674,11 @@ }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, - WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, + WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBADGE, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, @@ -2716,10 +2767,12 @@ return WmGeometryCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GRID: return WmGridCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_GROUP: return WmGroupCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_ICONBADGE: + return WmIconbadgeCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONBITMAP: return WmIconbitmapCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONIFY: return WmIconifyCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_ICONMASK: @@ -3809,10 +3862,122 @@ } /* *---------------------------------------------------------------------- * + * WmIconbadgeCmd -- + * + * This function is invoked to process the "wm iconbadge" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +WmIconbadgeCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + HWND hwnd; + Tk_PhotoHandle photo; + Tk_PhotoImageBlock block; + int width, height; + HICON overlayicon; + (void) winPtr; + int badgenumber; + char *badgestring = NULL; + char photoname[4096]; + LPCWSTR string; + HRESULT hr; + Tk_Window badgewindow; + WmInfo *wmPtr; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window badge"); + return TCL_ERROR; + } + + /* + * Parse args, get native wrapper window, and determine image. + */ + + badgewindow = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + wmPtr = ((TkWindow *) badgewindow)->wmInfoPtr; + hwnd = wmPtr->wrapper; + badgestring = Tcl_GetString(objv[3]); + + badgenumber = atoi(badgestring); + if (badgenumber > 9) { + strcpy(photoname, "::tk::icons::9plus-badge"); + } else { + strcpy(photoname, "::tk::icons::"); + strcat(photoname, badgestring); + strcat(photoname, "-badge"); + } + + /* + * If badgestring is empty string, remove icon. + */ + + if (strcmp("", badgestring) == 0) { + ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, NULL, NULL); + return TCL_OK; + } + + /* + * If photo does not exist, return error. This means we do not have + * to test for decimal or negative values; no photo for such values + * is present. + */ + + photo = Tk_FindPhoto(interp, photoname); + if (photo == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as icon badge", badgestring)); + return TCL_ERROR; + } + + /* + * We have found the image. Convert to icon. + */ + + Tk_PhotoGetSize(photo, &width, &height); + Tk_PhotoGetImage(photo, &block); + + overlayicon = CreateIcoFromPhoto(width, height, block); + if (overlayicon == NULL) { + Tcl_SetResult(interp, "Failed to create badge icon", TCL_VOLATILE); + return TCL_ERROR; + } + + /* + * Place overlay icon on taskbar icon. + */ + + string = L"Alert"; + hr = ptbl->lpVtbl->SetOverlayIcon(ptbl, hwnd, overlayicon, string); + if (hr != S_OK) { + Tcl_SetResult(interp, "Failed to display badge icon", TCL_VOLATILE); + return TCL_ERROR; + } + DestroyIcon(overlayicon); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * WmIconbitmapCmd -- * * This function is invoked to process the "wm iconbitmap" Tcl command. * See the user documentation for details on what it does. * @@ -4232,10 +4397,12 @@ return TCL_ERROR; } return TCL_OK; } + + /* *---------------------------------------------------------------------- * * WmIconpositionCmd -- *