home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets2.2.0 / scripts / entryfield.itk < prev    next >
Text File  |  1999-02-24  |  18KB  |  511 lines
  1. #
  2. # Entryfield
  3. # ----------------------------------------------------------------------
  4. # Implements an enhanced text entry widget.
  5. #
  6. # ----------------------------------------------------------------------
  7. #   AUTHOR:  Sue Yockey               E-mail: syockey@spd.dsccc.com
  8. #                                             yockey@acm.org
  9. #            Mark L. Ulferts          E-mail: mulferts@spd.dsccc.com
  10. #
  11. #   @(#) $Id: entryfield.itk,v 1.2 1998/08/11 14:41:11 welch Exp $
  12. # ----------------------------------------------------------------------
  13. #            Copyright (c) 1995 DSC Technologies Corporation
  14. # ======================================================================
  15. # Permission to use, copy, modify, distribute and license this software 
  16. # and its documentation for any purpose, and without fee or written 
  17. # agreement with DSC, is hereby granted, provided that the above copyright 
  18. # notice appears in all copies and that both the copyright notice and 
  19. # warranty disclaimer below appear in supporting documentation, and that 
  20. # the names of DSC Technologies Corporation or DSC Communications 
  21. # Corporation not be used in advertising or publicity pertaining to the 
  22. # software without specific, written prior permission.
  23. # 
  24. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  25. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  26. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  27. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  28. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  29. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  30. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  31. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  32. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  33. # SOFTWARE.
  34. # ======================================================================
  35.  
  36. #
  37. # Default resources.
  38. #
  39. option add *Entryfield.borderWidth 2 widgetDefault
  40. option add *Entryfield.relief sunken widgetDefault
  41. option add *Entryfield.labelMargin 2 widgetDefault
  42.  
  43. #
  44. # Usual options.
  45. #
  46. itk::usual Entryfield {
  47.     keep -background -borderwidth -cursor -foreground -highlightcolor \
  48.      -highlightthickness -insertbackground -insertborderwidth \
  49.      -insertofftime -insertontime -insertwidth -labelfont \
  50.      -selectbackground -selectborderwidth -selectforeground \
  51.      -textbackground -textfont
  52. }
  53.  
  54. # ------------------------------------------------------------------
  55. #                            ENTRYFIELD
  56. # ------------------------------------------------------------------
  57. class iwidgets::Entryfield {
  58.     inherit iwidgets::Labeledwidget 
  59.     
  60.     constructor {args} {}
  61.     itk_option define -command command Command {}
  62.     itk_option define -focuscommand focusCommand Command {}
  63.     itk_option define -validate validate Command {}
  64.     itk_option define -invalid invalid Command {bell}
  65.     itk_option define -fixed fixed Fixed 0
  66.     itk_option define -childsitepos childSitePos Position e
  67.     
  68.     public method childsite {}
  69.     public method get {}
  70.     public method delete {args}
  71.     public method icursor {args}
  72.     public method index {args}
  73.     public method insert {args}
  74.     public method scan {args}
  75.     public method selection {args}
  76.     public method xview {args}
  77.     public method clear {}
  78.  
  79.     proc numeric {char} {}
  80.     proc integer {string} {}
  81.     proc alphabetic {char} {}
  82.     proc alphanumeric {char} {}
  83.     proc hexidecimal {string} {}
  84.     proc real {string} {}
  85.     protected method _focusCommand {}
  86.  
  87.     protected method _keyPress {char sym}
  88.  
  89.     private method _peek {char}
  90. }
  91.  
  92. #
  93. # Provide a lowercased access method for the Entryfield class.
  94. # 
  95. proc ::iwidgets::entryfield {pathName args} {
  96.     uplevel ::iwidgets::Entryfield $pathName $args
  97. }
  98.  
  99. # ------------------------------------------------------------------
  100. #                        CONSTRUCTOR
  101. # ------------------------------------------------------------------
  102. body iwidgets::Entryfield::constructor {args} {
  103.     component hull configure -borderwidth 0
  104.     
  105.     itk_component add entry {
  106.     entry $itk_interior.entry
  107.     } {
  108.     keep -borderwidth -cursor -exportselection \
  109.         -foreground -highlightcolor \
  110.         -highlightthickness -insertbackground -insertborderwidth \
  111.         -insertofftime -insertontime -insertwidth -justify \
  112.         -relief -selectbackground -selectborderwidth \
  113.         -selectforeground -show -state -textvariable -width
  114.     
  115.     rename -font -textfont textFont Font
  116.     rename -highlightbackground -background background Background
  117.     rename -background -textbackground textBackground Background
  118.     }
  119.     pack $itk_component(entry) -fill x -expand yes -side left 
  120.     
  121.     #
  122.     # Create the child site widget.
  123.     #
  124.     itk_component add efchildsite {
  125.     frame $itk_interior.efchildsite
  126.     } {
  127.     keep -background -cursor
  128.     }
  129.     set itk_interior $itk_component(efchildsite)
  130.     
  131.     #
  132.     # Entryfield instance bindings.
  133.     #
  134.     bind $itk_component(entry) <KeyPress> \
  135.         [code $this _keyPress %A %K]
  136.  
  137.     bind $itk_component(entry) <FocusIn> \
  138.         [code $this _focusCommand]
  139.     
  140.     #
  141.     # Explicitly handle configs that may have been ignored earlier.
  142.     #
  143.     eval itk_initialize $args
  144. }
  145.  
  146. # ------------------------------------------------------------------
  147. #                             OPTIONS
  148. # ------------------------------------------------------------------
  149.  
  150. # ------------------------------------------------------------------
  151. # OPTION: -command
  152. #
  153. # Command associated upon detection of Return key press event
  154. # ------------------------------------------------------------------
  155. configbody iwidgets::Entryfield::command {}
  156.  
  157. # ------------------------------------------------------------------
  158. # OPTION: -focuscommand
  159. #
  160. # Command associated upon detection of Return key press event
  161. # ------------------------------------------------------------------
  162. configbody iwidgets::Entryfield::focuscommand {}
  163.  
  164. # ------------------------------------------------------------------
  165. # OPTION: -validate
  166. #
  167. # Specify a command to executed for the validation of Entryfields.
  168. # ------------------------------------------------------------------
  169. configbody iwidgets::Entryfield::validate {
  170.     switch $itk_option(-validate) {
  171.     {} {
  172.         set itk_option(-validate) {}
  173.     }
  174.     numeric {
  175.         set itk_option(-validate) "::iwidgets::Entryfield::numeric %c"
  176.     }
  177.     integer {
  178.         set itk_option(-validate) "::iwidgets::Entryfield::integer %P"
  179.     }
  180.     hexidecimal {
  181.         set itk_option(-validate) "::iwidgets::Entryfield::hexidecimal %P"
  182.     }
  183.     real {
  184.         set itk_option(-validate) "::iwidgets::Entryfield::real %P"
  185.     }
  186.     alphabetic {
  187.         set itk_option(-validate) "::iwidgets::Entryfield::alphabetic %c"
  188.     }
  189.     alphanumeric {
  190.         set itk_option(-validate) "::iwidgets::Entryfield::alphanumeric %c"
  191.     }
  192.     }
  193. }
  194.  
  195. # ------------------------------------------------------------------
  196. # OPTION: -invalid
  197. #
  198. # Specify a command to executed should the current Entryfield contents
  199. # be proven invalid.
  200. # ------------------------------------------------------------------
  201. configbody iwidgets::Entryfield::invalid {}
  202.  
  203. # ------------------------------------------------------------------
  204. # OPTION: -fixed
  205. #
  206. # Restrict entry to 0 (unlimited) chars.  The value is the maximum 
  207. # number of chars the user may type into the field, regardles of 
  208. # field width, i.e. the field width may be 20, but the user will 
  209. # only be able to type -fixed number of characters into it (or 
  210. # unlimited if -fixed = 0).
  211. # ------------------------------------------------------------------
  212. configbody iwidgets::Entryfield::fixed {
  213.     if {[regexp {[^0-9]} $itk_option(-fixed)] || \
  214.         ($itk_option(-fixed) < 0)} {
  215.     error "bad fixed option \"$itk_option(-fixed)\",\
  216.         should be positive integer"
  217.     }
  218. }
  219.  
  220. # ------------------------------------------------------------------
  221. # OPTION: -childsitepos
  222. #
  223. # Specifies the position of the child site in the widget.
  224. # ------------------------------------------------------------------
  225. configbody iwidgets::Entryfield::childsitepos {
  226.     switch $itk_option(-childsitepos) {
  227.     n {
  228.         pack configure $itk_component(efchildsite) -side top 
  229.         pack $itk_component(entry) -fill x -expand yes -side top \
  230.             -after $itk_component(efchildsite) 
  231.     }
  232.     
  233.     e {
  234.         pack configure $itk_component(efchildsite) -side left
  235.         pack $itk_component(entry) -fill x -expand yes -side left \
  236.             -before $itk_component(efchildsite) 
  237.     }
  238.     
  239.     s {
  240.         pack $itk_component(entry) -fill x -expand yes -side top 
  241.         pack configure $itk_component(efchildsite) -side top \
  242.             -after $itk_component(entry) 
  243.     }
  244.     
  245.     w {
  246.         pack configure $itk_component(efchildsite) -side left
  247.         pack $itk_component(entry) -fill x -expand yes -side left \
  248.             -after $itk_component(efchildsite) 
  249.     }
  250.     
  251.     default {
  252.         error "bad childsite option\
  253.             \"$itk_option(-childsitepos)\":\
  254.             should be n, e, s, or w"
  255.     }
  256.     }
  257. }
  258.  
  259. # ------------------------------------------------------------------
  260. #                            METHODS
  261. # ------------------------------------------------------------------
  262.  
  263. # ------------------------------------------------------------------
  264. # METHOD: childsite
  265. #
  266. # Returns the path name of the child site widget.
  267. # ------------------------------------------------------------------
  268. body iwidgets::Entryfield::childsite {} {
  269.     return $itk_component(efchildsite)
  270. }
  271.  
  272. # ------------------------------------------------------------------
  273. # METHOD: get 
  274. #
  275. # Thin wrap of the standard entry widget get method.
  276. # ------------------------------------------------------------------
  277. body iwidgets::Entryfield::get {} {
  278.     return [$itk_component(entry) get]
  279. }
  280.  
  281. # ------------------------------------------------------------------
  282. # METHOD: delete
  283. #
  284. # Thin wrap of the standard entry widget delete method.
  285. # ------------------------------------------------------------------
  286. body iwidgets::Entryfield::delete {args} {
  287.     return [eval $itk_component(entry) delete $args]
  288. }
  289.  
  290. # ------------------------------------------------------------------
  291. # METHOD: icursor 
  292. #
  293. # Thin wrap of the standard entry widget icursor method.
  294. # ------------------------------------------------------------------
  295. body iwidgets::Entryfield::icursor {args} {
  296.     return [eval $itk_component(entry) icursor $args]
  297. }
  298.  
  299. # ------------------------------------------------------------------
  300. # METHOD: index 
  301. #
  302. # Thin wrap of the standard entry widget index method.
  303. # ------------------------------------------------------------------
  304. body iwidgets::Entryfield::index {args} {
  305.     return [eval $itk_component(entry) index $args]
  306. }
  307.  
  308. # ------------------------------------------------------------------
  309. # METHOD: insert 
  310. #
  311. # Thin wrap of the standard entry widget index method.
  312. # ------------------------------------------------------------------
  313. body iwidgets::Entryfield::insert {args} {
  314.     return [eval $itk_component(entry) insert $args]
  315. }
  316.  
  317. # ------------------------------------------------------------------
  318. # METHOD: scan 
  319. #
  320. # Thin wrap of the standard entry widget scan method.
  321. # ------------------------------------------------------------------
  322. body iwidgets::Entryfield::scan {args} {
  323.     return [eval $itk_component(entry) scan $args]
  324. }
  325.  
  326. # ------------------------------------------------------------------
  327. # METHOD: selection
  328. #
  329. # Thin wrap of the standard entry widget selection method.
  330. # ------------------------------------------------------------------
  331. body iwidgets::Entryfield::selection {args} {
  332.     return [eval $itk_component(entry) selection $args]
  333. }
  334.  
  335. # ------------------------------------------------------------------
  336. # METHOD: xview 
  337. #
  338. # Thin wrap of the standard entry widget xview method.
  339. # ------------------------------------------------------------------
  340. body iwidgets::Entryfield::xview {args} {
  341.     return [eval $itk_component(entry) xview $args]
  342. }
  343.  
  344. # ------------------------------------------------------------------
  345. # METHOD: clear 
  346. #
  347. # Delete the current entry contents.
  348. # ------------------------------------------------------------------
  349. body iwidgets::Entryfield::clear {} {
  350.     $itk_component(entry) delete 0 end
  351.     icursor 0
  352. }
  353.  
  354. # ------------------------------------------------------------------
  355. # PROCEDURE: numeric char
  356. #
  357. # The numeric procedure validates character input for a given 
  358. # Entryfield to be numeric and returns the result.
  359. # ------------------------------------------------------------------
  360. body iwidgets::Entryfield::numeric {char} {
  361.     return [regexp {[0-9]} $char]
  362. }
  363.  
  364. # ------------------------------------------------------------------
  365. # PROCEDURE: integer string
  366. #
  367. # The integer procedure validates character input for a given 
  368. # Entryfield to be integer and returns the result.
  369. # ------------------------------------------------------------------
  370. body iwidgets::Entryfield::integer {string} {
  371.     return [regexp {^[-+]?[0-9]*$} $string]
  372. }
  373.  
  374. # ------------------------------------------------------------------
  375. # PROCEDURE: alphabetic char
  376. #
  377. # The alphabetic procedure validates character input for a given 
  378. # Entryfield to be alphabetic and returns the result.
  379. # ------------------------------------------------------------------
  380. body iwidgets::Entryfield::alphabetic {char} {
  381.     return [regexp -nocase {[a-z]} $char]
  382. }
  383.  
  384. # ------------------------------------------------------------------
  385. # PROCEDURE: alphanumeric char
  386. #
  387. # The alphanumeric procedure validates character input for a given 
  388. # Entryfield to be alphanumeric and returns the result.
  389. # ------------------------------------------------------------------
  390. body iwidgets::Entryfield::alphanumeric {char} {
  391.     return [regexp -nocase {[0-9a-z]} $char]
  392. }
  393.  
  394. # ------------------------------------------------------------------
  395. # PROCEDURE: hexadecimal string
  396. #
  397. # The hexidecimal procedure validates character input for a given 
  398. # Entryfield to be hexidecimal and returns the result.
  399. # ------------------------------------------------------------------
  400. body iwidgets::Entryfield::hexidecimal {string} {
  401.     return [regexp {^(0x)?[0-9a-fA-F]*$} $string]
  402. }
  403.  
  404. # ------------------------------------------------------------------
  405. # PROCEDURE: real string
  406. #
  407. # The real procedure validates character input for a given Entryfield
  408. # to be real and returns the result.
  409. # ------------------------------------------------------------------
  410. body iwidgets::Entryfield::real {string} {
  411.     return [regexp {^\-?[0-9]*\.?[0-9]*$} $string]
  412. }
  413.  
  414. # ------------------------------------------------------------------
  415. # PRIVATE METHOD: _peek char
  416. #
  417. # The peek procedure returns the value of the Entryfield with the
  418. # char inserted at the insert position.
  419. # ------------------------------------------------------------------
  420. body iwidgets::Entryfield::_peek {char} {
  421.     set str [get]
  422.  
  423.     set insertPos [index insert] 
  424.     set firstPart [string range $str 0 [expr $insertPos - 1]]
  425.     set lastPart [string range $str $insertPos end]
  426.  
  427.     append rtnVal $firstPart $char $lastPart
  428.     return $rtnVal
  429. }
  430.  
  431. # ------------------------------------------------------------------
  432. # PROTECTED METHOD: _focusCommand
  433. #
  434. # Method bound to focus event which evaluates the current command
  435. # specified in the focuscommand option
  436. # ------------------------------------------------------------------
  437. body iwidgets::Entryfield::_focusCommand {} {
  438.     uplevel #0 $itk_option(-focuscommand)
  439. }
  440.  
  441. # ------------------------------------------------------------------
  442. # PROTECTED METHOD: _keyPress 
  443. #
  444. # Monitor the key press event checking for return keys, fixed width
  445. # specification, and optional validation procedures.
  446. # ------------------------------------------------------------------
  447. body iwidgets::Entryfield::_keyPress {char sym} {
  448.     #
  449.     # A Return key invokes the optionally specified command option.
  450.     #
  451.     if {$sym == "Return"} {
  452.     uplevel #0 $itk_option(-command)
  453.     return -code break
  454.     }
  455.     
  456.     #
  457.     # Tabs, BackSpace, and Delete and unprintable characters
  458.     # are passed on for other bindings.
  459.     #
  460.     if {($sym == "Tab") ||
  461.         ($sym == "BackSpace") ||
  462.         ($sym == "Delete") ||
  463.         ($char == "")} {
  464.     return
  465.     }
  466.     
  467.     #
  468.     # If the fixed length option is not zero, then verify that the
  469.     # current length plus one will not exceed the limit.  If so then
  470.     # invoke the invalid command procedure.
  471.     #
  472.     if {$itk_option(-fixed) != 0} {
  473.     if {[string length [get]] >= $itk_option(-fixed)} {
  474.         uplevel #0 $itk_option(-invalid)
  475.         return -code break
  476.     }
  477.     }
  478.     
  479.     #
  480.     # The validate option may contain a keyword (numeric, alphabetic),
  481.     # the name of a procedure, or nothing.  The numeric and alphabetic
  482.     # keywords engage typical base level checks.  If a command procedure
  483.     # is specified, then invoke it with the object and character passed
  484.     # as arguments.  If the validate procedure returns false, then the 
  485.     # invalid procedure is called.
  486.     #
  487.     if {[string length $itk_option(-validate)] > 0} {
  488.     set cmd $itk_option(-validate)
  489.  
  490.     regsub -all "%W" $cmd $itk_component(hull) cmd
  491.     regsub -all "%P" $cmd [_peek $char] cmd
  492.     regsub -all "%S" $cmd [get] cmd
  493.  
  494.         if {$char == "\\"} {
  495.             regsub -all "%c" $cmd {\\\\} cmd
  496.         } elseif {$char == "&"} {
  497.             regsub -all "%c" $cmd {\&} cmd
  498.         } else {
  499.             regsub "\"|\\\[|\\\]|{|}| " $char {\\\0} char
  500.             regsub -all "%c" $cmd $char cmd
  501.         }
  502.  
  503.     set valid [uplevel #0 $cmd]
  504.  
  505.     if {($valid == "") || (! $valid)} {
  506.         uplevel #0 $itk_option(-invalid)
  507.         return -code break
  508.     }
  509.     }
  510. }
  511.