1# tipstack.tcl -- 2# 3# Based on 'tooltip', provides a dynamic stack of tip texts per 4# widget. This allows dynamic transient changes to the tips, for 5# example to temporarily replace a standard epxlanation with an 6# error message. 7# 8# Copyright (c) 2003 ActiveState Corporation. 9# 10# See the file "license.terms" for information on usage and 11# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12# 13# RCS: @(#) $Id: tipstack.tcl,v 1.4 2009/01/09 05:46:12 andreas_kupries Exp $ 14# 15 16# ### ######### ########################### 17# Requisites 18 19package require tooltip 20namespace eval ::tipstack {} 21 22# ### ######### ########################### 23# Public API 24# 25## Basic syntax for all commands having a widget reference: 26# 27## tipstack::command .w ... 28## tipstack::command .m -index foo ... 29 30# ### ######### ########################### 31## Push new text for a widget (or menu) 32 33proc ::tipstack::push {args} { 34 if {([llength $args] != 2) && (([llength $args] != 4))} { 35 return -code error "wrong#args: expected w ?-index index? text" 36 } 37 38 # Extract valueable parts. 39 40 set text [lindex $args end] 41 set wref [lrange $args 0 end-1] 42 43 # Remember new data (setup/extend db) 44 45 variable db 46 if {![info exists db($wref)]} { 47 set db($wref) [list $text] 48 } else { 49 lappend db($wref) $text 50 } 51 52 # Forward to standard tooltip package. 53 54 eval [linsert [linsert $wref end $text] 0 tooltip::tooltip] 55 return 56} 57 58# ### ######### ########################### 59## Pop text from stack of tip for widget. 60## ! Keeps the bottom-most entry. 61 62proc ::tipstack::pop {args} { 63 if {([llength $args] != 1) && (([llength $args] != 3))} { 64 return -code error "wrong#args: expected w ?-index index?" 65 } 66 # args == wref (see 'push'). 67 set wref $args 68 69 # Pop top information form the database. Except if the 70 # text is the last in the stack. Then we will keep it, it 71 # is the baseline for the widget. 72 73 variable db 74 if {![info exists db($wref)]} { 75 set text "" 76 } else { 77 set data $db($wref) 78 79 if {[llength $data] == 1} { 80 set text [lindex $data 0] 81 } else { 82 set data [lrange $data 0 end-1] 83 set text [lindex $data end] 84 85 set db($wref) $data 86 } 87 } 88 89 # Forward to standard tooltip package. 90 91 eval [linsert [linsert $wref end $text] 0 tooltip::tooltip] 92 return 93} 94 95# ### ######### ########################### 96## Clears out all data about a widget (or menu). 97 98proc ::tipstack::clear {args} { 99 100 if {([llength $args] != 1) && (([llength $args] != 3))} { 101 return -code error "wrong#args: expected w ?-index index?" 102 } 103 # args == wref (see 'push'). 104 set wref $args 105 106 # Remove data about widget. 107 108 variable db 109 catch {unset db($wref)} 110 111 eval [linsert [linsert $wref end ""] 0 tooltip::tooltip] 112 return 113} 114 115# ### ######### ########################### 116## Convenient definition of tooltips for multiple 117## independent widgets. No menus possible 118 119proc ::tipstack::def {defs} { 120 foreach {path text} $defs { 121 push $path $text 122 } 123 return 124} 125 126# ### ######### ########################### 127## Convenient definition of tooltips for multiple 128## widgets in a containing widget. No menus possible. 129## This is for megawidgets. 130 131proc ::tipstack::defsub {base defs} { 132 foreach {subpath text} $defs { 133 push $base$subpath $text 134 } 135 return 136} 137 138# ### ######### ########################### 139## Convenient clearage of tooltips for multiple 140## widgets in a containing widget. No menus possible. 141## This is for megawidgets. 142 143proc ::tipstack::clearsub {base} { 144 variable db 145 146 foreach k [array names db ${base}*] { 147 # Danger. Will fail if 'base' matches a menu reference. 148 clear $k 149 } 150 return 151} 152 153# ### ######### ########################### 154# Internal commands -- None 155 156# ### ######### ########################### 157## Data structures 158 159namespace eval ::tipstack { 160 # Map from widget references to stack of tooltips. 161 162 variable db 163 array set db {} 164} 165 166# ### ######### ########################### 167# Ready 168 169package provide tipstack 1.0.1 170