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