PageRenderTime 52ms CodeModel.GetById 23ms RepoModel.GetById 0ms app.codeStats 0ms

/brlcad/branches/dmtogl/src/other/iwidgets/generic/finddialog.itk

https://bitbucket.org/vrrm/brl-cad-copy-for-fast-history-browsing-in-git
TCL | 488 lines | 220 code | 57 blank | 211 comment | 36 complexity | 8b9e95f6024fe9468b1ed8ae3da2e80b MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, LGPL-2.1, Apache-2.0, AGPL-3.0, LGPL-3.0, GPL-3.0, MPL-2.0-no-copyleft-exception, CC-BY-SA-3.0, 0BSD, BSD-3-Clause
  1. #
  2. # Finddialog
  3. # ----------------------------------------------------------------------
  4. # This class implements a dialog for searching text. It prompts the
  5. # user for a search string and the method of searching which includes
  6. # case sensitive, regular expressions, backwards, and all.
  7. #
  8. # ----------------------------------------------------------------------
  9. # AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
  10. #
  11. # @(#) RCS: $Id$
  12. # ----------------------------------------------------------------------
  13. # Copyright (c) 1996 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. # Usual options.
  37. #
  38. itk::usual Finddialog {
  39. keep -background -cursor -foreground -selectcolor
  40. }
  41. # ------------------------------------------------------------------
  42. # IPRFINDDIALOG
  43. # ------------------------------------------------------------------
  44. itcl::class ::iwidgets::Finddialog {
  45. inherit iwidgets::Dialogshell
  46. constructor {args} {}
  47. itk_option define -selectcolor selectColor Background {}
  48. itk_option define -clearcommand clearCommand Command {}
  49. itk_option define -matchcommand matchCommand Command {}
  50. itk_option define -patternbackground patternBackground Background \#707070
  51. itk_option define -patternforeground patternForeground Foreground White
  52. itk_option define -searchbackground searchBackground Background \#c4c4c4
  53. itk_option define -searchforeground searchForeground Foreground Black
  54. itk_option define -textwidget textWidget TextWidget {}
  55. public {
  56. method clear {}
  57. method find {}
  58. }
  59. protected {
  60. method _get {setting}
  61. method _textExists {}
  62. common _optionValues ;# Current settings of check buttons.
  63. common _searchPoint ;# Starting location for searches
  64. common _matchLen ;# Matching pattern string length
  65. }
  66. }
  67. #
  68. # Provide a lowercased access method for the ::finddialog class.
  69. #
  70. proc ::iwidgets::finddialog {pathName args} {
  71. uplevel ::iwidgets::Finddialog $pathName $args
  72. }
  73. #
  74. # Use option database to override default resources of base classes.
  75. #
  76. option add *Finddialog.title "Find" widgetDefault
  77. # ------------------------------------------------------------------
  78. # CONSTRUCTOR
  79. # ------------------------------------------------------------------
  80. itcl::body ::iwidgets::Finddialog::constructor {args} {
  81. #
  82. # Add the find pattern entryfield.
  83. #
  84. itk_component add pattern {
  85. iwidgets::Entryfield $itk_interior.pattern -labeltext "Find:"
  86. }
  87. bind [$itk_component(pattern) component entry] \
  88. <Return> "[itcl::code $this invoke]; break"
  89. #
  90. # Add the find all checkbutton.
  91. #
  92. itk_component add all {
  93. checkbutton $itk_interior.all \
  94. -variable [itcl::scope _optionValues($this-all)] \
  95. -text "All"
  96. }
  97. #
  98. # Add the case consideration checkbutton.
  99. #
  100. itk_component add case {
  101. checkbutton $itk_interior.case \
  102. -variable [itcl::scope _optionValues($this-case)] \
  103. -text "Consider Case"
  104. }
  105. #
  106. # Add the regular expression checkbutton.
  107. #
  108. itk_component add regexp {
  109. checkbutton $itk_interior.regexp \
  110. -variable [itcl::scope _optionValues($this-regexp)] \
  111. -text "Use Regular Expression"
  112. }
  113. #
  114. # Add the find backwards checkbutton.
  115. #
  116. itk_component add backwards {
  117. checkbutton $itk_interior.backwards \
  118. -variable [itcl::scope _optionValues($this-backwards)] \
  119. -text "Find Backwards"
  120. }
  121. #
  122. # Add the find, clear, and close buttons, making find be the default.
  123. #
  124. add Find -text Find -command [itcl::code $this find]
  125. add Clear -text Clear -command [itcl::code $this clear]
  126. add Close -text Close -command [itcl::code $this deactivate 0]
  127. default Find
  128. #
  129. # Use the grid to layout the components.
  130. #
  131. grid $itk_component(pattern) -row 0 -column 0 \
  132. -padx 10 -pady 10 -columnspan 4 -sticky ew
  133. grid $itk_component(all) -row 1 -column 0
  134. grid $itk_component(case) -row 1 -column 1
  135. grid $itk_component(regexp) -row 1 -column 2
  136. grid $itk_component(backwards) -row 1 -column 3
  137. grid columnconfigure $itk_interior 0 -weight 1
  138. grid columnconfigure $itk_interior 1 -weight 1
  139. grid columnconfigure $itk_interior 2 -weight 1
  140. grid columnconfigure $itk_interior 3 -weight 1
  141. #
  142. # Initialize all the configuration options.
  143. #
  144. eval itk_initialize $args
  145. }
  146. # ------------------------------------------------------------------
  147. # OPTIONS
  148. # ------------------------------------------------------------------
  149. # ------------------------------------------------------------------
  150. # OPTION: -clearcommand
  151. #
  152. # Specifies a command to be invoked following a clear operation.
  153. # The command is meant to be a means of notification that the
  154. # clear has taken place and allow other actions to take place such
  155. # as disabling a find again menu.
  156. # ------------------------------------------------------------------
  157. itcl::configbody iwidgets::Finddialog::clearcommand {}
  158. # ------------------------------------------------------------------
  159. # OPTION: -matchcommand
  160. #
  161. # Specifies a command to be invoked following a find operation.
  162. # The command is called with a match point as an argument. Should
  163. # a match not be found the match point is {}.
  164. # ------------------------------------------------------------------
  165. itcl::configbody iwidgets::Finddialog::matchcommand {}
  166. # ------------------------------------------------------------------
  167. # OPTION: -patternbackground
  168. #
  169. # Specifies the background color of the text matching the search
  170. # pattern. It may have any of the forms accepted by Tk_GetColor.
  171. # ------------------------------------------------------------------
  172. itcl::configbody iwidgets::Finddialog::patternbackground {}
  173. # ------------------------------------------------------------------
  174. # OPTION: -patternforeground
  175. #
  176. # Specifies the foreground color of the pattern matching a search
  177. # operation. It may have any of the forms accepted by Tk_GetColor.
  178. # ------------------------------------------------------------------
  179. itcl::configbody iwidgets::Finddialog::patternforeground {}
  180. # ------------------------------------------------------------------
  181. # OPTION: -searchforeground
  182. #
  183. # Specifies the foreground color of the line containing the matching
  184. # pattern from a search operation. It may have any of the forms
  185. # accepted by Tk_GetColor.
  186. # ------------------------------------------------------------------
  187. itcl::configbody iwidgets::Finddialog::searchforeground {}
  188. # ------------------------------------------------------------------
  189. # OPTION: -searchbackground
  190. #
  191. # Specifies the background color of the line containing the matching
  192. # pattern from a search operation. It may have any of the forms
  193. # accepted by Tk_GetColor.
  194. # ------------------------------------------------------------------
  195. itcl::configbody iwidgets::Finddialog::searchbackground {}
  196. # ------------------------------------------------------------------
  197. # OPTION: -textwidget
  198. #
  199. # Specifies the scrolledtext or text widget to be searched.
  200. # ------------------------------------------------------------------
  201. itcl::configbody iwidgets::Finddialog::textwidget {
  202. if {$itk_option(-textwidget) != {}} {
  203. set _searchPoint($itk_option(-textwidget)) 1.0
  204. }
  205. }
  206. # ------------------------------------------------------------------
  207. # METHODS
  208. # ------------------------------------------------------------------
  209. # ------------------------------------------------------------------
  210. # PUBLIC METHOD: clear
  211. #
  212. # Clear the pattern entryfield and the indicators.
  213. # ------------------------------------------------------------------
  214. itcl::body ::iwidgets::Finddialog::clear {} {
  215. $itk_component(pattern) clear
  216. if {[_textExists]} {
  217. set _searchPoint($itk_option(-textwidget)) 1.0
  218. $itk_option(-textwidget) tag remove search-line 1.0 end
  219. $itk_option(-textwidget) tag remove search-pattern 1.0 end
  220. }
  221. if {$itk_option(-clearcommand) != {}} {
  222. eval $itk_option(-clearcommand)
  223. }
  224. }
  225. # ------------------------------------------------------------------
  226. # PUBLIC METHOD: find
  227. #
  228. # Search for a specific text string in the text widget given by
  229. # the -textwidget option. Should this option not be set to an
  230. # existing widget, then a quick exit is made.
  231. # ------------------------------------------------------------------
  232. itcl::body ::iwidgets::Finddialog::find {} {
  233. if {! [_textExists]} {
  234. return
  235. }
  236. #
  237. # Clear any existing indicators in the text widget.
  238. #
  239. $itk_option(-textwidget) tag remove search-line 1.0 end
  240. $itk_option(-textwidget) tag remove search-pattern 1.0 end
  241. #
  242. # Make sure the search pattern isn't just blank. If so, skip this.
  243. #
  244. set pattern [_get pattern]
  245. if {[string trim $pattern] == ""} {
  246. return
  247. }
  248. #
  249. # After clearing out any old highlight indicators from a previous
  250. # search, we'll be building our search command piece-meal based on
  251. # the current settings of the checkbuttons in the find dialog. The
  252. # first we'll add is a variable to catch the count of the length
  253. # of the string matching the pattern.
  254. #
  255. set precmd "$itk_option(-textwidget) search \
  256. -count [list [itcl::scope _matchLen($this)]]"
  257. if {! [_get case]} {
  258. append precmd " -nocase"
  259. }
  260. if {[_get regexp]} {
  261. append precmd " -regexp"
  262. } else {
  263. append precmd " -exact"
  264. }
  265. #
  266. # If we are going to find all matches, then the start point for
  267. # the search will be the beginning of the text; otherwise, we'll
  268. # use the last known starting point +/- a character depending on
  269. # the direction.
  270. #
  271. if {[_get all]} {
  272. set _searchPoint($itk_option(-textwidget)) 1.0
  273. } else {
  274. if {[_get backwards]} {
  275. append precmd " -backwards"
  276. } else {
  277. append precmd " -forwards"
  278. }
  279. }
  280. #
  281. # Get the pattern to be matched and add it to the search command.
  282. # Since it may contain embedded spaces, we'll wrap it in a list.
  283. #
  284. append precmd " [list $pattern]"
  285. #
  286. # If the search is for all matches, then we'll be performing the
  287. # search until no more matches are found; otherwise, we'll break
  288. # out of the loop after one search.
  289. #
  290. while {1} {
  291. if {[_get all]} {
  292. set postcmd " $_searchPoint($itk_option(-textwidget)) end"
  293. } else {
  294. set postcmd " $_searchPoint($itk_option(-textwidget))"
  295. }
  296. #
  297. # Create the final search command out of the pre and post parts
  298. # and evaluate it which returns the location of the matching string.
  299. #
  300. set cmd {}
  301. append cmd $precmd $postcmd
  302. if {[catch {eval $cmd} matchPoint] != 0} {
  303. set _searchPoint($itk_option(-textwidget)) 1.0
  304. return {}
  305. }
  306. #
  307. # If a match exists, then we'll make this spot be the new starting
  308. # position. Then we'll tag the line and the pattern in the line.
  309. # The foreground and background settings will lite these positions
  310. # in the text widget up.
  311. #
  312. if {$matchPoint != {}} {
  313. set _searchPoint($itk_option(-textwidget)) $matchPoint
  314. $itk_option(-textwidget) tag add search-line \
  315. "$_searchPoint($itk_option(-textwidget)) linestart" \
  316. "$_searchPoint($itk_option(-textwidget))"
  317. $itk_option(-textwidget) tag add search-line \
  318. "$_searchPoint($itk_option(-textwidget)) + \
  319. $_matchLen($this) chars" \
  320. "$_searchPoint($itk_option(-textwidget)) lineend"
  321. $itk_option(-textwidget) tag add search-pattern \
  322. $_searchPoint($itk_option(-textwidget)) \
  323. "$_searchPoint($itk_option(-textwidget)) + \
  324. $_matchLen($this) chars"
  325. }
  326. #
  327. # Set the search point for the next time through to be one
  328. # character more or less from the current search point based
  329. # on the direction.
  330. #
  331. if {[_get all] || ! [_get backwards]} {
  332. set _searchPoint($itk_option(-textwidget)) \
  333. [$itk_option(-textwidget) index \
  334. "$_searchPoint($itk_option(-textwidget)) + 1c"]
  335. } else {
  336. set _searchPoint($itk_option(-textwidget)) \
  337. [$itk_option(-textwidget) index \
  338. "$_searchPoint($itk_option(-textwidget)) - 1c"]
  339. }
  340. #
  341. # If this isn't a find all operation or we didn't get a match, exit.
  342. #
  343. if {(! [_get all]) || ($matchPoint == {})} {
  344. break
  345. }
  346. }
  347. #
  348. # Configure the colors for the search-line and search-pattern.
  349. #
  350. $itk_option(-textwidget) tag configure search-line \
  351. -foreground $itk_option(-searchforeground)
  352. $itk_option(-textwidget) tag configure search-line \
  353. -background $itk_option(-searchbackground)
  354. $itk_option(-textwidget) tag configure search-pattern \
  355. -background $itk_option(-patternbackground)
  356. $itk_option(-textwidget) tag configure search-pattern \
  357. -foreground $itk_option(-patternforeground)
  358. #
  359. # Adjust the view to be the last matched position.
  360. #
  361. if {$matchPoint != {}} {
  362. $itk_option(-textwidget) see $matchPoint
  363. }
  364. #
  365. # There may be multiple matches of the pattern on a single line,
  366. # so we'll set the tag priorities such that the pattern tag is higher.
  367. #
  368. $itk_option(-textwidget) tag raise search-pattern search-line
  369. #
  370. # If a match command is defined, then call it with the match point.
  371. #
  372. if {$itk_option(-matchcommand) != {}} {
  373. [subst $itk_option(-matchcommand)] $matchPoint
  374. }
  375. #
  376. # Return the match point to the caller so they know if we found
  377. # anything and if so where
  378. #
  379. return $matchPoint
  380. }
  381. # ------------------------------------------------------------------
  382. # PROTECTED METHOD: _get setting
  383. #
  384. # Get the current value for the pattern, case, regexp, or backwards.
  385. # ------------------------------------------------------------------
  386. itcl::body ::iwidgets::Finddialog::_get {setting} {
  387. switch $setting {
  388. pattern {
  389. return [$itk_component(pattern) get]
  390. }
  391. case {
  392. return $_optionValues($this-case)
  393. }
  394. regexp {
  395. return $_optionValues($this-regexp)
  396. }
  397. backwards {
  398. return $_optionValues($this-backwards)
  399. }
  400. all {
  401. return $_optionValues($this-all)
  402. }
  403. default {
  404. error "bad get setting: \"$setting\", should be pattern,\
  405. case, regexp, backwards, or all"
  406. }
  407. }
  408. }
  409. # ------------------------------------------------------------------
  410. # PROTECTED METHOD: _textExists
  411. #
  412. # Check the validity of the text widget option. Does it exist and
  413. # is it of the class Text or Scrolledtext.
  414. # ------------------------------------------------------------------
  415. itcl::body ::iwidgets::Finddialog::_textExists {} {
  416. if {$itk_option(-textwidget) == {}} {
  417. return 0
  418. }
  419. if {! [winfo exists $itk_option(-textwidget)]} {
  420. error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
  421. the widget doesn't exist"
  422. }
  423. if {([winfo class $itk_option(-textwidget)] != "Text") &&
  424. ([itcl::find objects -isa iwidgets::Scrolledtext *::$itk_option(-textwidget)] == "")} {
  425. error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
  426. must be of the class Text or based on Scrolledtext"
  427. }
  428. return 1
  429. }