[1] | 1 | # ---------------------------------------------------------------------- |
---|
| 2 | # COMPONENT: editor - pop-up editor for little bits of text |
---|
| 3 | # |
---|
| 4 | # This widget acts as a pop-up editor for small text fields. It |
---|
| 5 | # pops up on top of any text field, accepts edits, and then attempts |
---|
| 6 | # to validate and apply changes back to the underlying widget. |
---|
| 7 | # |
---|
| 8 | # This widget uses a number of callbacks to handle communication |
---|
| 9 | # with the underlying widget: |
---|
| 10 | # |
---|
| 11 | # -activatecommand .... Should return a key/value list with the |
---|
| 12 | # following elements: |
---|
| 13 | # x ...... root x coordinate for editor |
---|
| 14 | # y ...... root y coordinate for editor |
---|
| 15 | # w ...... width of text being edited |
---|
| 16 | # h ...... height of text being edited |
---|
| 17 | # text ... initial text for the editor |
---|
| 18 | # |
---|
| 19 | # -validatecommand .... Invoked with the new value as an argument. |
---|
| 20 | # Should return 1 if the value is okay, and |
---|
| 21 | # 0 otherwise. |
---|
| 22 | # |
---|
| 23 | # -applycommand ....... Invoked with the new value as an argument. |
---|
| 24 | # Should apply the new value to the underlying |
---|
| 25 | # widget. |
---|
| 26 | # |
---|
| 27 | # ====================================================================== |
---|
| 28 | # AUTHOR: Michael McLennan, Purdue University |
---|
[115] | 29 | # Copyright (c) 2004-2005 Purdue Research Foundation |
---|
| 30 | # |
---|
| 31 | # See the file "license.terms" for information on usage and |
---|
| 32 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
[1] | 33 | # ====================================================================== |
---|
| 34 | package require Itk |
---|
| 35 | |
---|
| 36 | option add *Editor.background white widgetDefault |
---|
| 37 | option add *Editor.outline black widgetDefault |
---|
| 38 | option add *Editor.borderwidth 1 widgetDefault |
---|
| 39 | option add *Editor.relief flat widgetDefault |
---|
| 40 | option add *Editor.selectBorderWidth 0 widgetDefault |
---|
| 41 | |
---|
| 42 | itcl::class Rappture::Editor { |
---|
| 43 | inherit itk::Toplevel |
---|
| 44 | |
---|
| 45 | itk_option define -outline outline Outline "" |
---|
| 46 | itk_option define -activatecommand activateCommand ActivateCommand "" |
---|
| 47 | itk_option define -validatecommand validateCommand ValidateCommand "" |
---|
| 48 | itk_option define -applycommand applyCommand ApplyCommand "" |
---|
| 49 | |
---|
| 50 | constructor {args} { # defined below } |
---|
| 51 | |
---|
| 52 | public method activate {} |
---|
| 53 | public method deactivate {args} |
---|
| 54 | public method value {newval} |
---|
| 55 | |
---|
| 56 | protected method _click {x y} |
---|
| 57 | protected method _resize {} |
---|
| 58 | protected variable _loc ;# array of editor location parameters |
---|
| 59 | } |
---|
[1342] | 60 | |
---|
[1] | 61 | itk::usual Editor { |
---|
| 62 | keep -cursor -font |
---|
| 63 | } |
---|
| 64 | |
---|
| 65 | # ---------------------------------------------------------------------- |
---|
| 66 | # CONSTRUCTOR |
---|
| 67 | # ---------------------------------------------------------------------- |
---|
| 68 | itcl::body Rappture::Editor::constructor {args} { |
---|
| 69 | wm overrideredirect $itk_component(hull) yes |
---|
| 70 | wm withdraw $itk_component(hull) |
---|
| 71 | |
---|
| 72 | itk_option remove hull.background hull.borderwidth |
---|
| 73 | component hull configure -borderwidth 1 |
---|
| 74 | |
---|
| 75 | itk_component add editor { |
---|
[1342] | 76 | entry $itk_interior.editor -highlightthickness 0 |
---|
[1] | 77 | } { |
---|
[1342] | 78 | usual |
---|
| 79 | keep -relief |
---|
| 80 | ignore -highlightthickness |
---|
| 81 | ignore -highlightcolor |
---|
| 82 | ignore -highlightbackground |
---|
[1] | 83 | } |
---|
| 84 | pack $itk_component(editor) -expand yes -fill both |
---|
| 85 | |
---|
| 86 | bind $itk_component(editor) <KeyPress> \ |
---|
[1342] | 87 | [itcl::code $this _resize] |
---|
[1] | 88 | bind $itk_component(editor) <KeyPress-Return> \ |
---|
[1342] | 89 | [itcl::code $this deactivate] |
---|
[1] | 90 | bind $itk_component(editor) <KeyPress-Escape> \ |
---|
[1342] | 91 | [itcl::code $this deactivate -abort] |
---|
[1] | 92 | bind $itk_component(editor) <ButtonPress> \ |
---|
[1342] | 93 | [itcl::code $this _click %X %Y] |
---|
[1] | 94 | |
---|
[17] | 95 | itk_component add emenu { |
---|
[1342] | 96 | menu $itk_component(editor).menu -tearoff 0 |
---|
[17] | 97 | } { |
---|
[1342] | 98 | usual |
---|
| 99 | ignore -tearoff |
---|
| 100 | ignore -background -foreground |
---|
[17] | 101 | } |
---|
| 102 | $itk_component(emenu) add command -label "Cut" -accelerator "^X" \ |
---|
[1342] | 103 | -command [list event generate $itk_component(editor) <<Cut>>] |
---|
[17] | 104 | $itk_component(emenu) add command -label "Copy" -accelerator "^C" \ |
---|
[1342] | 105 | -command [list event generate $itk_component(editor) <<Copy>>] |
---|
[17] | 106 | $itk_component(emenu) add command -label "Paste" -accelerator "^V" \ |
---|
[1342] | 107 | -command [list event generate $itk_component(editor) <<Paste>>] |
---|
[17] | 108 | bind $itk_component(editor) <<PopupMenu>> { |
---|
[1342] | 109 | tk_popup %W.menu %X %Y |
---|
[17] | 110 | } |
---|
| 111 | |
---|
[1] | 112 | eval itk_initialize $args |
---|
| 113 | } |
---|
| 114 | |
---|
| 115 | # ---------------------------------------------------------------------- |
---|
| 116 | # USAGE: activate |
---|
| 117 | # |
---|
| 118 | # Clients use this to start the editing process on the underlying |
---|
| 119 | # widget. This pops up the editor with the current text from the |
---|
| 120 | # underlying widget and allows the user to edit the text. The editor |
---|
| 121 | # remains up until it is deactivated. |
---|
| 122 | # ---------------------------------------------------------------------- |
---|
| 123 | itcl::body Rappture::Editor::activate {} { |
---|
| 124 | set e $itk_component(editor) |
---|
[17] | 125 | if {[winfo ismapped $e]} { |
---|
[1342] | 126 | return ;# already mapped -- nothing to do |
---|
[17] | 127 | } |
---|
[1] | 128 | |
---|
| 129 | set info "" |
---|
| 130 | if {[string length $itk_option(-activatecommand)] > 0} { |
---|
[1342] | 131 | set status [catch {uplevel #0 $itk_option(-activatecommand)} info] |
---|
| 132 | if {$status != 0} { |
---|
| 133 | bgerror $info |
---|
| 134 | return |
---|
| 135 | } |
---|
[1] | 136 | } |
---|
| 137 | |
---|
| 138 | # |
---|
| 139 | # Pull out the location information from the values passed back |
---|
| 140 | # from the activation command. We must have at least an x,y |
---|
| 141 | # coordinate. If we get width and height too, then use it. |
---|
| 142 | # If not, figure out the width and height based on the size |
---|
| 143 | # of the string. |
---|
| 144 | # |
---|
| 145 | array set vals $info |
---|
| 146 | if {![info exists vals(x)] || ![info exists vals(y)]} { |
---|
[1342] | 147 | return |
---|
[1] | 148 | } |
---|
| 149 | set _loc(x) $vals(x) |
---|
| 150 | set _loc(y) $vals(y) |
---|
| 151 | set _loc(w) [expr {([info exists vals(w)]) ? $vals(w) : 0}] |
---|
| 152 | set _loc(h) [expr {([info exists vals(h)]) ? $vals(h) : 0}] |
---|
| 153 | |
---|
| 154 | $itk_component(editor) delete 0 end |
---|
| 155 | if {[info exists vals(text)]} { |
---|
[1342] | 156 | $itk_component(editor) insert end $vals(text) |
---|
[1] | 157 | } |
---|
| 158 | $itk_component(editor) select from 0 |
---|
| 159 | $itk_component(editor) select to end |
---|
| 160 | |
---|
| 161 | _resize |
---|
| 162 | wm deiconify $itk_component(hull) |
---|
| 163 | raise $itk_component(hull) |
---|
| 164 | focus $itk_component(editor) |
---|
| 165 | |
---|
| 166 | # try to grab the pointer, and keep trying... |
---|
| 167 | update |
---|
| 168 | while {[catch {grab set -global $itk_component(editor)}]} { |
---|
[1342] | 169 | after 100 |
---|
[1] | 170 | } |
---|
| 171 | } |
---|
| 172 | |
---|
| 173 | # ---------------------------------------------------------------------- |
---|
| 174 | # USAGE: deactivate ?-abort? |
---|
| 175 | # |
---|
| 176 | # This is invoked automatically whenever the user presses Enter or |
---|
| 177 | # Escape in the editor. Clients can also use it explicitly to |
---|
| 178 | # deactivate the editor. |
---|
| 179 | # |
---|
| 180 | # If the -abort flag is specified, then the editor is taken down |
---|
| 181 | # without any validation or application of the result. Otherwise, |
---|
| 182 | # we validate the contents of the editor and apply the change back |
---|
| 183 | # to the widget. |
---|
| 184 | # ---------------------------------------------------------------------- |
---|
| 185 | itcl::body Rappture::Editor::deactivate {args} { |
---|
| 186 | # take down any error cue that might be up |
---|
| 187 | ::Rappture::Tooltip::cue hide |
---|
| 188 | |
---|
| 189 | if {$args == "-abort"} { |
---|
[1342] | 190 | grab release $itk_component(editor) |
---|
| 191 | wm withdraw $itk_component(hull) |
---|
| 192 | return |
---|
[1] | 193 | } |
---|
| 194 | |
---|
| 195 | set str [$itk_component(editor) get] |
---|
| 196 | |
---|
| 197 | # |
---|
| 198 | # If there's a -validatecommand option, then invoke the code |
---|
| 199 | # now to check the new value. |
---|
| 200 | # |
---|
| 201 | if {[string length $itk_option(-validatecommand)] > 0} { |
---|
[1342] | 202 | set cmd "uplevel #0 [list $itk_option(-validatecommand) [list $str]]" |
---|
| 203 | if {[catch $cmd result]} { |
---|
| 204 | bgerror $result |
---|
| 205 | set result 1 |
---|
| 206 | } |
---|
| 207 | if {$result == 0} { |
---|
| 208 | bell |
---|
| 209 | $itk_component(editor) select from 0 |
---|
| 210 | $itk_component(editor) select to end |
---|
| 211 | $itk_component(editor) icursor end |
---|
| 212 | focus $itk_component(editor) |
---|
| 213 | return |
---|
| 214 | } |
---|
[1] | 215 | } |
---|
| 216 | |
---|
| 217 | grab release $itk_component(editor) |
---|
| 218 | wm withdraw $itk_component(hull) |
---|
| 219 | |
---|
| 220 | # |
---|
| 221 | # If there's an -applycommand option, then invoke the code |
---|
| 222 | # now to apply the new value. |
---|
| 223 | # |
---|
| 224 | if {[string length $itk_option(-applycommand)] > 0} { |
---|
[1342] | 225 | set cmd "uplevel #0 [list $itk_option(-applycommand) [list $str]]" |
---|
| 226 | if {[catch $cmd result]} { |
---|
| 227 | bgerror $result |
---|
| 228 | return |
---|
| 229 | } |
---|
[1] | 230 | } |
---|
| 231 | } |
---|
| 232 | |
---|
| 233 | # ---------------------------------------------------------------------- |
---|
| 234 | # USAGE: value <newval> |
---|
| 235 | # |
---|
| 236 | # Clients use this to suggest a new value, particular when they've |
---|
| 237 | # caught an error in the editing process. For example, if the user's |
---|
| 238 | # value is below the minimum allowed value, a client would call this |
---|
| 239 | # method to suggest the minimum value. |
---|
| 240 | # ---------------------------------------------------------------------- |
---|
| 241 | itcl::body Rappture::Editor::value {newval} { |
---|
| 242 | $itk_component(editor) delete 0 end |
---|
| 243 | $itk_component(editor) insert end $newval |
---|
| 244 | } |
---|
| 245 | |
---|
| 246 | # ---------------------------------------------------------------------- |
---|
| 247 | # USAGE: _click <X> <Y> |
---|
| 248 | # |
---|
| 249 | # This is invoked automatically whenever the user clicks somewhere |
---|
| 250 | # inside or outside of the editor. If the <X>,<Y> coordinate is |
---|
| 251 | # outside the editor, then we assume the user is done and wants to |
---|
| 252 | # take the editor down. Otherwise, we do nothing, and let the entry |
---|
| 253 | # bindings take over. |
---|
| 254 | # ---------------------------------------------------------------------- |
---|
| 255 | itcl::body Rappture::Editor::_click {x y} { |
---|
| 256 | if {[winfo containing $x $y] != $itk_component(editor)} { |
---|
[1342] | 257 | deactivate |
---|
[17] | 258 | } else { |
---|
[1342] | 259 | # make sure the editor has keyboard focus! |
---|
| 260 | # it loses focus sometimes during cut/copy/paste operations |
---|
| 261 | focus -force $itk_component(editor) |
---|
[1] | 262 | } |
---|
| 263 | } |
---|
| 264 | |
---|
| 265 | # ---------------------------------------------------------------------- |
---|
| 266 | # USAGE: _resize |
---|
| 267 | # |
---|
| 268 | # Invoked automatically as each key is pressed in the editor. |
---|
| 269 | # Resizes the editor so that it is just big enough to show all |
---|
| 270 | # of the text within it. |
---|
| 271 | # ---------------------------------------------------------------------- |
---|
| 272 | itcl::body Rappture::Editor::_resize {} { |
---|
| 273 | set e $itk_component(editor) |
---|
| 274 | set str [$e get] |
---|
| 275 | set fnt [$e cget -font] |
---|
| 276 | |
---|
| 277 | set w [expr {[font measure $fnt $str]+20}] |
---|
| 278 | set w [expr {($w < $_loc(w)) ? $_loc(w) : $w}] |
---|
| 279 | if {$w+$_loc(x) >= [winfo screenwidth $e]} { |
---|
[1342] | 280 | set w [expr {[winfo screenwidth $e]-$_loc(x)}] |
---|
[1] | 281 | } |
---|
| 282 | |
---|
| 283 | set h [expr {[font metrics $fnt -linespace]+4}] |
---|
| 284 | set h [expr {($h < $_loc(h)) ? $_loc(h) : $h}] |
---|
[440] | 285 | if {$h+$_loc(y) >= [winfo screenheight $e]} { |
---|
[1342] | 286 | set h [expr {[winfo screenheight $e]-$_loc(y)}] |
---|
[1258] | 287 | } |
---|
| 288 | # Temporary fix to prevent Opps. Don't deal with negative dimensions. |
---|
| 289 | if { $w <= 0 || $h <= 0 } { |
---|
| 290 | wm geometry $itk_component(hull) "+$_loc(x)+$_loc(y)" |
---|
| 291 | } else { |
---|
| 292 | wm geometry $itk_component(hull) "${w}x${h}+$_loc(x)+$_loc(y)" |
---|
[1] | 293 | } |
---|
| 294 | } |
---|
| 295 | |
---|
| 296 | # ---------------------------------------------------------------------- |
---|
| 297 | # CONFIGURATION OPTION: -outline |
---|
| 298 | # ---------------------------------------------------------------------- |
---|
| 299 | itcl::configbody Rappture::Editor::outline { |
---|
| 300 | component hull configure -background $itk_option(-outline) |
---|
| 301 | } |
---|