| 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 |
|---|
| 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. |
|---|
| 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 | } |
|---|
| 60 | |
|---|
| 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 { |
|---|
| 76 | entry $itk_interior.editor -highlightthickness 0 |
|---|
| 77 | } { |
|---|
| 78 | usual |
|---|
| 79 | keep -relief |
|---|
| 80 | ignore -highlightthickness |
|---|
| 81 | ignore -highlightcolor |
|---|
| 82 | ignore -highlightbackground |
|---|
| 83 | } |
|---|
| 84 | pack $itk_component(editor) -expand yes -fill both |
|---|
| 85 | |
|---|
| 86 | bind $itk_component(editor) <KeyPress> \ |
|---|
| 87 | [itcl::code $this _resize] |
|---|
| 88 | bind $itk_component(editor) <KeyPress-Return> \ |
|---|
| 89 | [itcl::code $this deactivate] |
|---|
| 90 | bind $itk_component(editor) <KeyPress-Escape> \ |
|---|
| 91 | [itcl::code $this deactivate -abort] |
|---|
| 92 | bind $itk_component(editor) <ButtonPress> \ |
|---|
| 93 | [itcl::code $this _click %X %Y] |
|---|
| 94 | |
|---|
| 95 | itk_component add emenu { |
|---|
| 96 | menu $itk_component(editor).menu -tearoff 0 |
|---|
| 97 | } { |
|---|
| 98 | usual |
|---|
| 99 | ignore -tearoff |
|---|
| 100 | ignore -background -foreground |
|---|
| 101 | } |
|---|
| 102 | $itk_component(emenu) add command -label "Cut" -accelerator "^X" \ |
|---|
| 103 | -command [list event generate $itk_component(editor) <<Cut>>] |
|---|
| 104 | $itk_component(emenu) add command -label "Copy" -accelerator "^C" \ |
|---|
| 105 | -command [list event generate $itk_component(editor) <<Copy>>] |
|---|
| 106 | $itk_component(emenu) add command -label "Paste" -accelerator "^V" \ |
|---|
| 107 | -command [list event generate $itk_component(editor) <<Paste>>] |
|---|
| 108 | bind $itk_component(editor) <<PopupMenu>> { |
|---|
| 109 | tk_popup %W.menu %X %Y |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 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) |
|---|
| 125 | if {[winfo ismapped $e]} { |
|---|
| 126 | return ;# already mapped -- nothing to do |
|---|
| 127 | } |
|---|
| 128 | |
|---|
| 129 | set info "" |
|---|
| 130 | if {[string length $itk_option(-activatecommand)] > 0} { |
|---|
| 131 | set status [catch {uplevel #0 $itk_option(-activatecommand)} info] |
|---|
| 132 | if {$status != 0} { |
|---|
| 133 | bgerror $info |
|---|
| 134 | return |
|---|
| 135 | } |
|---|
| 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)]} { |
|---|
| 147 | return |
|---|
| 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)]} { |
|---|
| 156 | $itk_component(editor) insert end $vals(text) |
|---|
| 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 -force $itk_component(editor) |
|---|
| 165 | |
|---|
| 166 | # try to grab the pointer, and keep trying... |
|---|
| 167 | update |
|---|
| 168 | while {[catch {grab set -global $itk_component(editor)}]} { |
|---|
| 169 | after 100 |
|---|
| 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"} { |
|---|
| 190 | grab release $itk_component(editor) |
|---|
| 191 | wm withdraw $itk_component(hull) |
|---|
| 192 | return |
|---|
| 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} { |
|---|
| 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 | } |
|---|
| 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} { |
|---|
| 225 | set cmd "uplevel #0 [list $itk_option(-applycommand) [list $str]]" |
|---|
| 226 | if {[catch $cmd result]} { |
|---|
| 227 | bgerror $result |
|---|
| 228 | return |
|---|
| 229 | } |
|---|
| 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)} { |
|---|
| 257 | deactivate |
|---|
| 258 | } else { |
|---|
| 259 | # make sure the editor has keyboard focus! |
|---|
| 260 | # it loses focus sometimes during cut/copy/paste operations |
|---|
| 261 | focus -force $itk_component(editor) |
|---|
| 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]} { |
|---|
| 280 | set w [expr {[winfo screenwidth $e]-$_loc(x)}] |
|---|
| 281 | } |
|---|
| 282 | |
|---|
| 283 | set h [expr {[font metrics $fnt -linespace]+4}] |
|---|
| 284 | set h [expr {($h < $_loc(h)) ? $_loc(h) : $h}] |
|---|
| 285 | if {$h+$_loc(y) >= [winfo screenheight $e]} { |
|---|
| 286 | set h [expr {[winfo screenheight $e]-$_loc(y)}] |
|---|
| 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)" |
|---|
| 293 | } |
|---|
| 294 | } |
|---|
| 295 | |
|---|
| 296 | # ---------------------------------------------------------------------- |
|---|
| 297 | # CONFIGURATION OPTION: -outline |
|---|
| 298 | # ---------------------------------------------------------------------- |
|---|
| 299 | itcl::configbody Rappture::Editor::outline { |
|---|
| 300 | component hull configure -background $itk_option(-outline) |
|---|
| 301 | } |
|---|
